never executed always true always false
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DataKinds #-}
3 {-# LANGUAGE DerivingStrategies #-}
4 {-# LANGUAGE FlexibleContexts #-}
5 {-# LANGUAGE FlexibleInstances #-}
6 {-# LANGUAGE GADTs #-}
7 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
8 {-# LANGUAGE LambdaCase #-}
9 {-# LANGUAGE RankNTypes #-}
10 {-# LANGUAGE ScopedTypeVariables #-}
11 {-# LANGUAGE StandaloneDeriving #-}
12 {-# LANGUAGE TypeApplications #-}
13 {-# LANGUAGE TypeFamilies #-}
14 {-# LANGUAGE TypeOperators #-}
15 {-# LANGUAGE UndecidableInstances #-}
16
17 {-# OPTIONS_GHC -fno-warn-orphans #-}
18 {-# OPTIONS_HADDOCK prune #-}
19
20 module Cardano.Mnemonic
21 (
22 -- * Introduction
23 -- $introduction
24
25 -- * @SomeMnemonic@
26 SomeMnemonic(..)
27 , MkSomeMnemonic (..)
28 , MkSomeMnemonicError(..)
29 , someMnemonicToBytes
30 , NatVals (..)
31
32 -- * @Mnemonic@
33 , Mnemonic
34 , mkMnemonic
35 , MkMnemonicError(..)
36 , mnemonicToText
37 , mnemonicToEntropy
38
39 -- * @Entropy@
40 , Entropy
41 , genEntropy
42 , mkEntropy
43 , entropyToBytes
44 , entropyToMnemonic
45
46 -- Internals & Re-export from @Crypto.Encoding.BIP39@
47 , EntropyError(..)
48 , DictionaryError(..)
49 , MnemonicWordsError(..)
50 , ValidEntropySize
51 , ValidChecksumSize
52 , ValidMnemonicSentence
53 , ConsistentEntropy
54 , CheckSumBits
55 , EntropySize
56 , MnemonicWords
57 , MnemonicException(..)
58
59 -- * Troubleshooting
60 -- $troubleshooting
61 ) where
62
63 import Prelude
64
65 import Basement.NormalForm
66 ( NormalForm (..) )
67 import Basement.Sized.List
68 ( unListN )
69 import Control.Arrow
70 ( left )
71 import Control.DeepSeq
72 ( NFData (..) )
73 import Control.Monad.Catch
74 ( throwM )
75 import Crypto.Encoding.BIP39
76 ( CheckSumBits
77 , ConsistentEntropy
78 , DictionaryError (..)
79 , Entropy
80 , EntropyError (..)
81 , EntropySize
82 , MnemonicSentence
83 , MnemonicWords
84 , MnemonicWordsError (..)
85 , ValidChecksumSize
86 , ValidEntropySize
87 , ValidMnemonicSentence
88 , dictionaryIndexToWord
89 , entropyRaw
90 , entropyToWords
91 , mnemonicPhrase
92 , mnemonicPhraseToMnemonicSentence
93 , mnemonicSentenceToListN
94 , toEntropy
95 , wordsToEntropy
96 )
97 import Data.Bifunctor
98 ( bimap )
99 import Data.ByteArray
100 ( ScrubbedBytes )
101 import Data.List
102 ( intercalate )
103 import Data.Proxy
104 ( Proxy (..) )
105 import Data.Text
106 ( Text )
107 import Data.Type.Equality
108 ( (:~:) (..), testEquality )
109 import Data.Typeable
110 ( Typeable )
111 import GHC.TypeLits
112 ( KnownNat, Nat, natVal )
113 import Type.Reflection
114 ( typeOf )
115
116 import qualified Basement.Compat.Base as Basement
117 import qualified Basement.String as Basement
118 import qualified Crypto.Encoding.BIP39.English as Dictionary
119 import qualified Crypto.Random.Entropy as Crypto
120 import qualified Data.ByteArray as BA
121 import qualified Data.Text as T
122
123 -- $introduction
124 --
125 -- We call 'Entropy' an arbitrary sequence of bytes that has been generated
126 -- through __high quality randomness methods__. The allowed size of an
127 -- 'Entropy' is @96-256@ bits and is __necessarily a multiple of 32 bits__ (4
128 -- bytes).
129 --
130 -- We call 'Mnemonic' an 'Entropy' with an appended checksum calculated by
131 -- taking the first @ent / 32@ bits of the /SHA256/ hash of it, where ent
132 -- designates the 'Entropy' size in bits.
133 --
134 -- The concatenated result is split into groups of @11@ bits, each encoding a
135 -- number from 0 to 2047 serving as an index into a known dictionary:
136 --
137 -- https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt
138 --
139 -- This makes for a __human-readable sentence__ of English words.
140 --
141 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
142 -- | Entropy Size | Checksum Size | Sentence Length | Example |
143 -- +=====================+===============+=================+=================================================================================================================================================+
144 -- | 96 bits (12 bytes) | 3 bits | 9 words | test child burst immense armed parrot company walk dog |
145 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
146 -- | 128 bits (16 bytes) | 4 bits | 12 words | test walk nut penalty hip pave soap entry language right filter choice |
147 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
148 -- | 160 bits (20 bytes) | 5 bits | 15 words | art forum devote street sure rather head chuckle guard poverty release quote oak craft enemy |
149 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
150 -- | 192 bits (24 bytes) | 6 bits | 18 words | churn shaft spoon second erode useless thrive burst group seed element sign scrub buffalo jelly grace neck useless |
151 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
152 -- | 224 bits (28 bytes) | 7 bits | 21 words | draft ability female child jump maid roof hurt below live topple paper exclude ordinary coach churn sunset emerge blame ketchup much |
153 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
154 -- | 256 bits (32 bytes) | 8 bits | 24 words | excess behave track soul table wear ocean cash stay nature item turtle palm soccer lunch horror start stumble month panic right must lock dress |
155 -- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
156
157 -- A opaque 'Mnemonic' type.
158 data Mnemonic (mw :: Nat) = Mnemonic
159 { mnemonicToEntropy :: Entropy (EntropySize mw)
160 -- ^ Convert a 'Mnemonic' back to an 'Entropy'.
161 --
162 -- @since 1.0.0
163 , mnemonicToSentence :: MnemonicSentence mw
164 } deriving stock (Eq, Show)
165
166 -- This wraps EntropyError of "Cardano.Encoding.BIP39"
167 newtype MnemonicException csz =
168 UnexpectedEntropyError (EntropyError csz)
169 -- ^ Invalid entropy length or checksum
170 deriving stock (Show, Typeable)
171 deriving newtype NFData
172
173 -- | This wraps errors from "Cardano.Encoding.BIP39"
174 data MkMnemonicError csz
175 = ErrMnemonicWords MnemonicWordsError
176 -- ^ Wrong number of words in mnemonic.
177 | ErrEntropy (EntropyError csz)
178 -- ^ Invalid entropy length or checksum.
179 | ErrDictionary DictionaryError
180 -- ^ Invalid word in mnemonic.
181 deriving stock (Eq, Show)
182
183 deriving instance Eq (EntropyError czs)
184 deriving instance Eq MnemonicWordsError
185 deriving instance Eq DictionaryError
186
187 -- NFData instances
188 instance NFData (Mnemonic mw) where
189 rnf (Mnemonic ent ws) = toNormalForm ent `seq` toNormalForm ws
190 instance NFData (EntropyError csz) where
191 rnf (ErrInvalidEntropyLength a b) = rnf a `seq` rnf b
192 rnf (ErrInvalidEntropyChecksum a b) = toNormalForm a `seq` toNormalForm b
193 instance NFData MnemonicWordsError where
194 rnf (ErrWrongNumberOfWords a b) = rnf a `seq` rnf b
195 instance NFData DictionaryError where
196 rnf (ErrInvalidDictionaryWord s) = toNormalForm s
197 instance NFData (MkMnemonicError csz) where
198 rnf (ErrMnemonicWords e) = rnf e
199 rnf (ErrEntropy e) = rnf e
200 rnf (ErrDictionary e) = rnf e
201
202 -- | Smart-constructor for the 'Entropy'. Make sure the 'ByteString' comes from a highly random source or use 'genEntropy'.
203 --
204 -- __example__:
205 --
206 -- >>> mkEntropy @160 bytes
207 -- Entropy {} :: Entropy 160
208 --
209 -- __property__:
210 --
211 -- prop> mkEntropy (entropyToBytes ent) == Right ent
212 --
213 -- @since 1.0.0
214 mkEntropy
215 :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz)
216 => ScrubbedBytes
217 -> Either (EntropyError csz) (Entropy ent)
218 mkEntropy = toEntropy
219
220 -- | Generate Entropy of a given size using a cryptographically secure random seed.
221 --
222 -- __example:__
223 --
224 -- >>> genEntropy @128
225 -- Entropy {} :: Entropy 128
226 --
227 -- @since 1.0.0
228 genEntropy
229 :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz)
230 => IO (Entropy ent)
231 genEntropy =
232 let
233 size =
234 fromIntegral $ natVal @ent Proxy
235 eitherToIO =
236 either (throwM . UnexpectedEntropyError) return
237 in
238 (eitherToIO . mkEntropy) =<< Crypto.getEntropy (size `div` 8)
239
240 -- | Smart-constructor for 'Mnemonic'. Requires a type application to
241 -- disambiguate the mnemonic size.
242 --
243 -- __example__:
244 --
245 -- >>> mkMnemonic @15 sentence
246 -- Mnemonic {} :: Mnemonic 15
247 --
248 -- __property__:
249 --
250 -- prop> mkMnemonic (mnemonicToText mnemonic) == Right mnemonic
251 --
252 -- @since 1.0.0
253 mkMnemonic
254 :: forall (mw :: Nat) (ent :: Nat) csz.
255 ( ConsistentEntropy ent mw csz
256 , EntropySize mw ~ ent
257 )
258 => [Text]
259 -> Either (MkMnemonicError csz) (Mnemonic mw)
260 mkMnemonic wordsm = do
261 phrase <- left ErrMnemonicWords
262 $ mnemonicPhrase @mw (toUtf8String <$> wordsm)
263
264 sentence <- left ErrDictionary
265 $ mnemonicPhraseToMnemonicSentence Dictionary.english phrase
266
267 entropy <- left ErrEntropy
268 $ wordsToEntropy sentence
269
270 pure Mnemonic
271 { mnemonicToEntropy = entropy
272 , mnemonicToSentence = sentence
273 }
274
275 -- | Convert an Entropy to a corresponding Mnemonic Sentence. Since 'Entropy'
276 -- and 'Mnemonic' can only be created through smart-constructors, this function
277 -- cannot fail and is total.
278 --
279 -- @since 1.0.0
280 entropyToMnemonic
281 :: forall mw ent csz.
282 ( ValidMnemonicSentence mw
283 , ValidEntropySize ent
284 , ValidChecksumSize ent csz
285 , ent ~ EntropySize mw
286 , mw ~ MnemonicWords ent
287 )
288 => Entropy ent
289 -> Mnemonic mw
290 entropyToMnemonic entropy = Mnemonic
291 { mnemonicToSentence = entropyToWords entropy
292 , mnemonicToEntropy = entropy
293 }
294
295 -- | Convert 'Entropy' to plain bytes.
296 --
297 -- @since 1.0.0
298 entropyToBytes
299 :: Entropy n
300 -> ScrubbedBytes
301 entropyToBytes = BA.convert . entropyRaw
302
303 toUtf8String
304 :: Text
305 -> Basement.String
306 toUtf8String = Basement.fromString . T.unpack
307
308 fromUtf8String
309 :: Basement.String
310 -> Text
311 fromUtf8String = T.pack . Basement.toList
312
313 instance (KnownNat csz) => Basement.Exception (MnemonicException csz)
314
315 -- | Convert a 'Mnemonic' to a sentence of English mnemonic words.
316 --
317 -- @since 1.0.0
318 mnemonicToText
319 :: Mnemonic mw
320 -> [Text]
321 mnemonicToText =
322 map (fromUtf8String . dictionaryIndexToWord Dictionary.english)
323 . unListN
324 . mnemonicSentenceToListN
325 . mnemonicToSentence
326
327 -- | Convert a 'SomeMnemonic' to bytes.
328 --
329 -- @since 1.0.1
330 someMnemonicToBytes :: SomeMnemonic -> ScrubbedBytes
331 someMnemonicToBytes (SomeMnemonic mw) = entropyToBytes $ mnemonicToEntropy mw
332
333 -- | Ease the manipulation of 'Mnemonic' by encapsulating the type constraints inside a constructor.
334 -- This is particularly useful for functions which do not require anything but a valid 'Mnemonic' without any
335 -- particular pre-condition on the size of the 'Mnemonic' itself.
336 --
337 -- @since 1.0.0
338 data SomeMnemonic where
339 SomeMnemonic :: forall mw. KnownNat mw => Mnemonic mw -> SomeMnemonic
340
341 deriving instance Show SomeMnemonic
342 instance Eq SomeMnemonic where
343 (SomeMnemonic mwa) == (SomeMnemonic mwb) =
344 case typeOf mwa `testEquality` typeOf mwb of
345 Nothing -> False
346 Just Refl -> mwa == mwb
347 instance NFData SomeMnemonic where
348 rnf (SomeMnemonic mnem) = rnf mnem
349
350 -- | This class enables caller to parse text list of variable length
351 -- into mnemonic sentences.
352 --
353 -- Note that the given 'Nat's **have** to be valid mnemonic sizes, otherwise the
354 -- underlying code won't even compile, with not-so-friendly error messages.
355 class MkSomeMnemonic (sz :: [Nat]) where
356 -- | Construct a mnemonic from a list of words. This function is particularly useful when the
357 -- number of words is not necessarily known at runtime. The function is however /ambiguous/ and
358 -- requires thereby a type application.
359 --
360 -- __examples:__
361 --
362 -- >>> mkSomeMnemonic @'[ 12 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ]
363 -- Left "Invalid number of words: 12 words are expected."
364 --
365 -- >>> mkSomeMnemonic @'[ 9, 12, 15 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ]
366 -- Right (SomeMnemonic ...)
367 --
368 -- @since 1.0.0
369 mkSomeMnemonic :: [Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
370
371 -- | Error reported from trying to create a passphrase from a given mnemonic
372 --
373 -- @since 1.0.0
374 newtype MkSomeMnemonicError (sz :: [Nat]) =
375 MkSomeMnemonicError { getMkSomeMnemonicError :: String }
376 deriving stock (Eq, Show)
377
378 instance {-# OVERLAPS #-}
379 ( n ~ EntropySize mw
380 , csz ~ CheckSumBits n
381 , ConsistentEntropy n mw csz
382 , MkSomeMnemonic rest
383 , NatVals rest
384 ) =>
385 MkSomeMnemonic (mw ': rest)
386 where
387 mkSomeMnemonic parts = case parseMW of
388 Left err -> left (promote err) parseRest
389 Right mw -> Right mw
390 where
391 parseMW = left (MkSomeMnemonicError . getMkSomeMnemonicError) $ -- coerce
392 mkSomeMnemonic @'[mw] parts
393 parseRest = left (MkSomeMnemonicError . getMkSomeMnemonicError) $ -- coerce
394 mkSomeMnemonic @rest parts
395 promote e e' =
396 let
397 sz = fromEnum <$> natVals (Proxy :: Proxy (mw ': rest))
398 mw = fromEnum $ natVal (Proxy :: Proxy mw)
399 in if length parts `notElem` sz
400 then MkSomeMnemonicError
401 $ "Invalid number of words: "
402 <> intercalate ", " (show <$> init sz)
403 <> (if length sz > 1 then " or " else "") <> show (last sz)
404 <> " words are expected."
405 else if length parts == mw then e else e'
406
407 -- | Small helper to collect 'Nat' values from a type-level list
408 class NatVals (ns :: [Nat]) where
409 natVals :: Proxy ns -> [Integer]
410
411 instance NatVals '[] where
412 natVals _ = []
413
414 instance (KnownNat n, NatVals rest) => NatVals (n ': rest) where
415 natVals _ = natVal (Proxy :: Proxy n) : natVals (Proxy :: Proxy rest)
416
417 instance
418 ( n ~ EntropySize mw
419 , csz ~ CheckSumBits n
420 , ConsistentEntropy n mw csz
421 ) =>
422 MkSomeMnemonic (mw ': '[])
423 where
424 mkSomeMnemonic parts = do
425 bimap (MkSomeMnemonicError . pretty) SomeMnemonic (mkMnemonic @mw parts)
426 where
427 pretty = \case
428 ErrMnemonicWords ErrWrongNumberOfWords{} ->
429 "Invalid number of words: "
430 <> show (natVal (Proxy :: Proxy mw))
431 <> " words are expected."
432 ErrDictionary (ErrInvalidDictionaryWord _) ->
433 "Found an unknown word not present in the pre-defined dictionary. \
434 \The full dictionary is available here: \
435 \https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt"
436 ErrEntropy ErrInvalidEntropyChecksum{} ->
437 "Invalid entropy checksum: please double-check the last word of \
438 \your mnemonic sentence."
439 ErrEntropy ErrInvalidEntropyLength{} ->
440 "Something went wrong when trying to generate the entropy from \
441 \the given mnemonic. As a user, there's nothing you can do."
442
443 -- $troubleshooting
444 --
445 -- - /Natural XX is out of bounds for Int/:
446 -- This usually occurs when ones is trying to specify an invalid size for an
447 -- 'Entropy' or 'Mnemonic'. For example:
448 --
449 -- >>> genEntropy @42
450 -- error:
451 -- • Natural CheckSumBits 42 is out of bounds for Int
452 --
453 -- - This could be the case as well when forgetting to use an adequate type application:
454 --
455 -- >>> mkEntropy mempty
456 -- error:
457 -- • Natural ent is out of bounds for Int