cardano-addresses-4.0.1: test/Cardano/MnemonicSpec.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.MnemonicSpec
( spec
) where
import Prelude
import Cardano.Dictionary
( SupportedDictionary, dictionaryFromLanguage )
import Cardano.Mnemonic
( Entropy
, EntropyError
, EntropySize
, MkMnemonicError (..)
, MkSomeMnemonicError (..)
, Mnemonic
, entropyToBytes
, entropyToMnemonic
, genEntropy
, mkEntropy
, mkMnemonic
, mkMnemonicWithDict
, mkSomeMnemonic
, mnemonicToEntropy
, mnemonicToText
, mnemonicToTextWithDict
)
import Control.Monad
( forM_ )
import Crypto.Encoding.BIP39
( DictionaryError (..)
, EntropyError (..)
, MnemonicWordsError (..)
, toEntropy
)
import Data.ByteString
( ByteString )
import Data.Either
( isRight )
import Data.Text
( Text )
import Test.Arbitrary
()
import Test.Hspec
( Spec, describe, it, shouldBe, shouldReturn, shouldSatisfy )
import Test.Hspec.QuickCheck
( prop )
import Test.QuickCheck
( (===) )
import qualified Data.ByteArray as BA
import qualified Data.Text as T
data TestVector = TestVector
{
-- | Text
string :: Text
-- | Corresponding Entropy
, entropy :: Entropy (EntropySize 12)
-- | Corresponding Mnemonic
, mnemonic :: Mnemonic 12
}
spec :: Spec
spec = do
prop "(9) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @9 . entropyToMnemonic @9 @(EntropySize 9)) e == e
prop "(12) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @12 . entropyToMnemonic @12 @(EntropySize 12)) e == e
prop "(15) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @15 . entropyToMnemonic @15 @(EntropySize 15)) e == e
prop "(18) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @18 . entropyToMnemonic @18 @(EntropySize 18)) e == e
prop "(21) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @21 . entropyToMnemonic @21 @(EntropySize 21)) e == e
prop "(24) entropyToMnemonic . mnemonicToEntropy == identity" $ \e ->
(mnemonicToEntropy @24 . entropyToMnemonic @24 @(EntropySize 24)) e == e
prop "(9) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 9) -> (mkMnemonic @9 . mnemonicToText) mw === pure mw
prop "(12) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 12) -> (mkMnemonic @12 . mnemonicToText) mw === pure mw
prop "(15) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 15) -> (mkMnemonic @15 . mnemonicToText) mw === pure mw
prop "(18) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 18) -> (mkMnemonic @18 . mnemonicToText) mw === pure mw
prop "(21) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 21) -> (mkMnemonic @21 . mnemonicToText) mw === pure mw
prop "(24) mkMnemonic . mnemonicToText == pure" $
\(mw :: Mnemonic 24) -> (mkMnemonic @24 . mnemonicToText) mw === pure mw
prop "(9) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 9) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @9 (mnemonicToTextWithDict mw dict) dict === pure mw
prop "(12) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 12) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @12 (mnemonicToTextWithDict mw dict) dict === pure mw
prop "(15) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 15) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @15 (mnemonicToTextWithDict mw dict) dict === pure mw
prop "(18) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 18) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @18 (mnemonicToTextWithDict mw dict) dict === pure mw
prop "(21) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 21) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @21 (mnemonicToTextWithDict mw dict) dict === pure mw
prop "(24) mkMnemonicWithDict . mnemonicToTextWithDict == pure" $
\(lang :: SupportedDictionary, mw :: Mnemonic 24) -> do
let dict = dictionaryFromLanguage lang
mkMnemonicWithDict @24 (mnemonicToTextWithDict mw dict) dict === pure mw
describe "MkSomeMnemonic" $ do
let noInDictErr =
"Found an unknown word not present in the pre-defined dictionary. \
\The full dictionary is available here: \
\https://github.com/cardano-foundation/cardano-wallet/tree/master/specifications/mnemonic/english.txt"
it "early error reported first (Invalid Entropy)" $ do
let res = mkSomeMnemonic @'[15,18,21]
[ "glimpse", "paper", "toward", "fine", "alert"
, "baby", "pyramid", "alone", "shaft", "force"
, "circle", "fancy", "squeeze", "cannon", "toilet"
]
res `shouldBe` Left (MkSomeMnemonicError "Invalid entropy checksum: \
\please double-check the last word of your mnemonic sentence.")
it "early error reported first (Non-English Word)" $ do
let res = mkSomeMnemonic @'[15,18,21]
[ "baguette", "paper", "toward", "fine", "alert"
, "baby", "pyramid", "alone", "shaft", "force"
, "circle", "fancy", "squeeze", "cannon", "toilet"
]
res `shouldBe` Left (MkSomeMnemonicError noInDictErr)
it "early error reported first (Wrong number of words - 1)" $ do
let res = mkSomeMnemonic @'[15,18,21]
["mom", "unveil", "slim", "abandon"
, "nut", "cash", "laugh", "impact"
, "system", "split", "depth", "sun"
]
res `shouldBe` Left (MkSomeMnemonicError "Invalid number of words: \
\15, 18 or 21 words are expected.")
it "early error reported first (Wrong number of words - 2)" $ do
let res = mkSomeMnemonic @'[15]
["mom", "unveil", "slim", "abandon"
, "nut", "cash", "laugh", "impact"
, "system", "split", "depth", "sun"
]
res `shouldBe` Left (MkSomeMnemonicError "Invalid number of words: \
\15 words are expected.")
it "early error reported first (Error not in first constructor)" $ do
let res = mkSomeMnemonic @'[15,18,21,24]
["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵"
,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻"
]
res `shouldBe` Left (MkSomeMnemonicError noInDictErr)
it "early error reported first (Error not in first constructor)" $ do
let res = mkSomeMnemonic @'[12,15,18]
["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵"
,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻"
]
res `shouldBe` Left (MkSomeMnemonicError noInDictErr)
it "successfully parse 15 words in [15,18,21]" $ do
let res = mkSomeMnemonic @'[15,18,21]
["cushion", "anxiety", "oval", "village", "choose"
, "shoot", "over", "behave", "category", "cruise"
, "track", "either", "maid", "organ", "sock"
]
res `shouldSatisfy` isRight
it "successfully parse 15 words in [12,15,18]" $ do
let res = mkSomeMnemonic @'[12,15,18]
["cushion", "anxiety", "oval", "village", "choose"
, "shoot", "over", "behave", "category", "cruise"
, "track", "either", "maid", "organ", "sock"
]
res `shouldSatisfy` isRight
it "successfully parse 15 words in [9,12,15]" $ do
let res = mkSomeMnemonic @'[9,12,15]
["cushion", "anxiety", "oval", "village", "choose"
, "shoot", "over", "behave", "category", "cruise"
, "track", "either", "maid", "organ", "sock"
]
res `shouldSatisfy` isRight
describe "golden tests" $ do
it "No empty mnemonic" $
mkMnemonic @15 [] `shouldBe`
Left (ErrMnemonicWords (ErrWrongNumberOfWords 0 15))
it "No 1 word mnemonic" $
mkMnemonic @15 ["material"] `shouldBe`
Left (ErrMnemonicWords (ErrWrongNumberOfWords 1 15))
it "No too long fake mnemonic" $ do
let sentence =
[ "squirrel","material","silly","twice","direct"
, "slush","pistol","razor","become","twice"
]
mkMnemonic @9 sentence `shouldBe`
Left (ErrMnemonicWords (ErrWrongNumberOfWords 10 9))
it "No empty entropy" $
mkEntropy @(EntropySize 12) "" `shouldBe`
Left (ErrInvalidEntropyLength 0 128)
it "No too short entropy" $
mkEntropy @(EntropySize 15) "000000" `shouldBe`
Left (ErrInvalidEntropyLength 48 160)
it "No too long entropy" $
mkEntropy @(EntropySize 15) "1234512345123451234512345" `shouldBe`
Left (ErrInvalidEntropyLength 200 160)
it "Can make entropy" $
mkEntropy @(EntropySize 15) "12345123451234512345" `shouldSatisfy`
isRight
it "Can generate 96 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @96) `shouldReturn` 12
it "Can generate 128 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @128) `shouldReturn` 16
it "Can generate 160 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @160) `shouldReturn` 20
it "Can generate 192 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @192) `shouldReturn` 24
it "Can generate 224 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @224) `shouldReturn` 28
it "Can generate 256 bits entropy" $
(BA.length . entropyToBytes <$> genEntropy @256) `shouldReturn` 32
it "Mnemonic to Text" $ forM_ testVectors $ \TestVector{..} ->
mnemonicToText mnemonic `shouldBe` extractWords string
it "Mnemonic from Text" $ forM_ testVectors $ \TestVector{..} ->
(mkMnemonic @12 . extractWords) string `shouldBe` pure mnemonic
it "Mnemonic to Entropy" $ forM_ testVectors $ \TestVector{..} ->
mnemonicToEntropy mnemonic `shouldBe` entropy
it "Mnemonic from Api is invalid" $ do
let mnemonicFromApi =
"[squirrel,material,silly,twice,direct,slush,pistol,razor,\
\become,junk,kingdom,flee,squirrel,silly,twice]"
(mkMnemonic @15 . extractWords) mnemonicFromApi `shouldSatisfy`
isErrInvalidEntropyChecksum
it "Mnemonic 2nd factor from Api is invalid" $ do
let mnemonicFromApi =
"[squirrel,material,silly,twice,direct,slush,pistol,razor,\
\become]"
(mkMnemonic @9 . extractWords) mnemonicFromApi `shouldSatisfy`
isErrInvalidEntropyChecksum
it "15 long mnemonics not valid for mkMnemonic @12" $ do
let mnemonicFromApi =
"[trigger,artwork,lab,raw,confirm,visual,energy,double,\
\coral,fat,hen,ghost,phone,yellow,bag]"
(mkMnemonic @12 . extractWords) mnemonicFromApi `shouldBe`
Left (ErrMnemonicWords (ErrWrongNumberOfWords 15 12))
it "15 long mnemonics not valid for mkMnemonic @24" $ do
let mnemonicFromApi =
"[trigger,artwork,lab,raw,confirm,visual,energy,double,\
\coral,fat,hen,ghost,phone,yellow,bag]"
(mkMnemonic @24 . extractWords) mnemonicFromApi `shouldBe`
Left (ErrMnemonicWords (ErrWrongNumberOfWords 15 24))
it "Non-English mnemonics don't work" $ do
let mnemonicFromApi =
"[むしば,いてん,ぜんりゃく,になう,きあい,よっか,けんま,\
\げきげん,きおん,こふん,しゅらば,しあさって,てんし,わかめ,\
\いわば]"
(mkMnemonic @15 . extractWords) mnemonicFromApi `shouldBe`
Left (ErrDictionary (ErrInvalidDictionaryWord "むしば"))
where
testVectors :: [TestVector]
testVectors =
[ TestVector
"[abandon,abandon,abandon,abandon,abandon,abandon,abandon,abandon,\
\abandon,abandon,abandon,about]"
(orFail $ mkEntropy'
"\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\
\\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL")
(orFail $ mkMnemonic
[ "abandon", "abandon", "abandon", "abandon", "abandon", "abandon"
, "abandon", "abandon", "abandon", "abandon", "abandon", "about"
])
, TestVector
"[letter,advice,cage,absurd,amount,doctor,acoustic,avoid,letter,\
\advice,cage,above]"
(orFail $ mkEntropy'
"\128\128\128\128\128\128\128\128\
\\128\128\128\128\128\128\128\128")
(orFail $ mkMnemonic
[ "letter", "advice", "cage", "absurd", "amount", "doctor"
, "acoustic", "avoid", "letter", "advice", "cage", "above"
])
, TestVector
"[zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,zoo,wrong]"
(orFail $ mkEntropy'
"\255\255\255\255\255\255\255\255\
\\255\255\255\255\255\255\255\255")
(orFail $ mkMnemonic
[ "zoo", "zoo", "zoo", "zoo", "zoo", "zoo"
, "zoo", "zoo", "zoo", "zoo", "zoo", "wrong" ])
]
where
orFail
:: Show e
=> Either e a
-> a
orFail =
either (error . (<>) "Failed to create golden Mnemonic: " . show) id
mkEntropy'
:: ByteString
-> Either (EntropyError 4) (Entropy 128)
mkEntropy' = toEntropy @128 @4 @ByteString
extractWords :: Text -> [Text]
extractWords =
T.splitOn ","
. T.dropAround (\c -> c == '[' || c == ']')
isErrInvalidEntropyChecksum :: Either (MkMnemonicError e) b -> Bool
isErrInvalidEntropyChecksum = \case
Left (ErrEntropy ErrInvalidEntropyChecksum{}) -> True
_ -> False