From dee07aaf5ff1458594886b2fdcd2edb8f07d8103 Mon Sep 17 00:00:00 2001 From: Pawel Jakubas Date: Mon, 11 Mar 2019 09:27:37 +0100 Subject: [PATCH] [16] first commit [16] mnemonic module and unit tests working properly [16] add mnemonic executable [16] weeder and hlint fixes [16] one more hlint suggestion [16] move exec to app directory [16] Review changes [16] Removing aeson and resigning from forbiddenMnemonics --- app/mnemonic/GenerateMnemonic.hs | 46 +++++ cardano-wallet.cabal | 30 ++- src/Cardano/Wallet/Mnemonic.hs | 222 +++++++++++++++++++++++ test/unit/Cardano/Wallet/MnemonicSpec.hs | 188 +++++++++++++++++++ 4 files changed, 485 insertions(+), 1 deletion(-) create mode 100755 app/mnemonic/GenerateMnemonic.hs create mode 100644 src/Cardano/Wallet/Mnemonic.hs create mode 100644 test/unit/Cardano/Wallet/MnemonicSpec.hs diff --git a/app/mnemonic/GenerateMnemonic.hs b/app/mnemonic/GenerateMnemonic.hs new file mode 100755 index 00000000000..25ac9b5fc32 --- /dev/null +++ b/app/mnemonic/GenerateMnemonic.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- | Mnemonic generation executable + + +import Prelude + +import Cardano.Wallet.Mnemonic + ( Mnemonic, entropyToMnemonic, genEntropy, mnemonicToText ) +import Data.Function + ( flip ) +import Data.Text + ( Text ) + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main + :: IO () +main = do + backupPhrase <- generateBackupPhrase + let backupPhraseString = backupPhraseToString backupPhrase + T.putStrLn $ formatOutput backupPhraseString + +generateBackupPhrase + :: IO (Mnemonic 15) +generateBackupPhrase = + entropyToMnemonic <$> genEntropy + +backupPhraseToString + :: Mnemonic 15 + -> [Text] +backupPhraseToString = mnemonicToText + +formatOutput + :: [Text] + -> Text +formatOutput = + flip T.snoc ']' + . T.append "[" + . T.intercalate "," + . map (T.append "\"" . flip T.snoc '"' ) diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 688cb2c223a..d656e00d82b 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -33,14 +33,18 @@ library build-depends: base , base58-bytestring + , basement , binary , bytestring + , cardano-crypto + , cryptonite , cborg , containers , cryptonite , deepseq , digest , fmt + , exceptions , http-api-data , http-client , http-media @@ -63,6 +67,7 @@ library Cardano.Wallet.Binary Cardano.Wallet.Binary.Packfile Cardano.Wallet.BlockSyncer + Cardano.Wallet.Mnemonic Cardano.Wallet.Primitive Cardano.Wallet.Slotting Servant.Extra.ContentTypes @@ -88,6 +93,26 @@ executable cardano-wallet-server Main.hs +executable cardano-generate-mnemonic + default-language: + Haskell2010 + default-extensions: + NoImplicitPrelude + OverloadedStrings + ghc-options: + -threaded -rtsopts + -with-rtsopts=-N + -Wall + build-depends: + base + , cardano-wallet + , text + hs-source-dirs: + app/mnemonic + main-is: + GenerateMnemonic.hs + + test-suite unit default-language: Haskell2010 @@ -104,6 +129,7 @@ test-suite unit base , base58-bytestring , bytestring + , cardano-crypto , cardano-wallet , cborg , containers @@ -113,9 +139,10 @@ test-suite unit , hspec-expectations , memory , mtl - , QuickCheck + , text , time-units , transformers + , QuickCheck type: exitcode-stdio-1.0 hs-source-dirs: @@ -129,6 +156,7 @@ test-suite unit Cardano.ChainProducer.RustHttpBridgeSpec Cardano.Wallet.Binary.PackfileSpec Cardano.Wallet.BlockSyncerSpec + Cardano.Wallet.MnemonicSpec Cardano.Wallet.PrimitiveSpec Cardano.Wallet.SlottingOrphans Cardano.Wallet.SlottingSpec diff --git a/src/Cardano/Wallet/Mnemonic.hs b/src/Cardano/Wallet/Mnemonic.hs new file mode 100644 index 00000000000..72d1227f39d --- /dev/null +++ b/src/Cardano/Wallet/Mnemonic.hs @@ -0,0 +1,222 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- | Module provides mnemonic creation and +-- | restoring from backup phrase functionality + +module Cardano.Wallet.Mnemonic + ( + -- * Types + Mnemonic + , Entropy + , EntropySize + , MnemonicWords + + -- * Errors + , MnemonicError(..) + , MnemonicException(..) + , EntropyError(..) + , DictionaryError(..) + , MnemonicWordsError(..) + + -- * Creating @Mnemonic@ (resp. @Entropy@) + , mkEntropy + , mkMnemonic + , genEntropy + + -- * Converting from and to @Mnemonic@ (resp. @Entropy@) + , mnemonicToEntropy + , entropyToMnemonic + , entropyToByteString + + , ambiguousNatVal + , mnemonicToText + ) where + +import Prelude + +import Basement.Sized.List + ( unListN ) +import Control.Arrow + ( left ) +import Control.Monad.Catch + ( throwM ) +import Crypto.Encoding.BIP39 + ( ConsistentEntropy + , DictionaryError (..) + , Entropy + , EntropyError (..) + , EntropySize + , MnemonicSentence + , MnemonicWords + , MnemonicWordsError (..) + , ValidChecksumSize + , ValidEntropySize + , ValidMnemonicSentence + , dictionaryIndexToWord + , entropyRaw + , entropyToWords + , mnemonicPhrase + , mnemonicPhraseToMnemonicSentence + , mnemonicSentenceToListN + , toEntropy + , wordsToEntropy + ) +import Data.ByteString + ( ByteString ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Typeable + ( Typeable ) +import GHC.TypeLits + ( KnownNat, Nat, natVal ) + +import qualified Basement.Compat.Base as Basement +import qualified Basement.String as Basement +import qualified Crypto.Encoding.BIP39.English as Dictionary +import qualified Crypto.Random.Entropy as Crypto +import qualified Data.Text as T + +-- | A backup-phrase in the form of a non-empty of Mnemonic words +-- Constructor isn't exposed. +data Mnemonic (mw :: Nat) = Mnemonic + { mnemonicToEntropy :: Entropy (EntropySize mw) + , mnemonicToSentence :: MnemonicSentence mw + } deriving (Eq, Show) + +-- | This is the wrapping of EntropyError of Cardano.Encoding.BIP39 +-- | The EntropyError can be either due to : +-- | (a) invalid entropy length (ErrInvalidEntropyLength) +-- | (b) invalid entropy checksum (ErrInvalidEntropyChecksum) +newtype MnemonicException csz = + UnexpectedEntropyError (EntropyError csz) + deriving (Show, Typeable) + +-- | This is the wrapping of errors from Cardano.Encoding.BIP39 +-- | The MnemonicWordsError can be due +-- | to wrong number of words (ErrWrongNumberOfWords) +-- | The EntropyError can be either due to : +-- | (a) invalid entropy length (ErrInvalidEntropyLength) +-- | (b) invalid entropy checksum (ErrInvalidEntropyChecksum) +-- | The DictionaryError can be due to +-- | invalid word (ErrInvalidDictionaryWord) +data MnemonicError csz + = ErrMnemonicWords MnemonicWordsError + | ErrEntropy (EntropyError csz) + | ErrDictionary DictionaryError + deriving (Eq, Show) + +deriving instance Eq (EntropyError czs) +deriving instance Eq MnemonicWordsError +deriving instance Eq DictionaryError + +-- | Smart-constructor for the Entropy +mkEntropy + :: forall n csz. (ValidEntropySize n, ValidChecksumSize n csz) + => ByteString + -> Either (EntropyError csz) (Entropy n) +mkEntropy = toEntropy + +ambiguousNatVal + :: forall n . (KnownNat n) + => Integer +ambiguousNatVal = natVal @n Proxy + +-- | Generate Entropy of a given size using a random seed. +-- +-- Example: +-- do +-- ent <- genEntropy :: IO (Entropy 12) +genEntropy + :: forall n csz. (ValidEntropySize n, ValidChecksumSize n csz) + => IO (Entropy n) +genEntropy = + let + size = + fromIntegral $ ambiguousNatVal @n + eitherToIO = + either (throwM . UnexpectedEntropyError) return + in + (eitherToIO . mkEntropy) =<< Crypto.getEntropy (size `div` 8) + +-- | Smart-constructor for the Mnemonic +mkMnemonic + :: forall mw n csz. + ( ConsistentEntropy n mw csz + , EntropySize mw ~ n + ) + => [Text] + -> Either (MnemonicError csz) (Mnemonic mw) +mkMnemonic wordsm = do + phrase <- left ErrMnemonicWords + $ mnemonicPhrase @mw (toUtf8String <$> wordsm) + + sentence <- left ErrDictionary + $ mnemonicPhraseToMnemonicSentence Dictionary.english phrase + + entropy <- left ErrEntropy + $ wordsToEntropy sentence + + pure Mnemonic + { mnemonicToEntropy = entropy + , mnemonicToSentence = sentence + } + +-- | Convert an Entropy to a corresponding Mnemonic Sentence +entropyToMnemonic + :: forall mw n csz. + ( ValidMnemonicSentence mw + , ValidEntropySize n + , ValidChecksumSize n csz + , n ~ EntropySize mw + , mw ~ MnemonicWords n + ) + => Entropy n + -> Mnemonic mw +entropyToMnemonic entropy = Mnemonic + { mnemonicToSentence = entropyToWords entropy + , mnemonicToEntropy = entropy + } + +-- | Convert 'Entropy' to a raw 'ByteString' +entropyToByteString + :: Entropy n + -> ByteString +entropyToByteString = entropyRaw + +toUtf8String + :: Text + -> Basement.String +toUtf8String = Basement.fromString . T.unpack + +fromUtf8String + :: Basement.String + -> Text +fromUtf8String = T.pack . Basement.toList + +instance (KnownNat csz) => Basement.Exception (MnemonicException csz) + +mnemonicToText + :: Mnemonic mw + -> [Text] +mnemonicToText = + map (fromUtf8String . dictionaryIndexToWord Dictionary.english) + . unListN + . mnemonicSentenceToListN + . mnemonicToSentence diff --git a/test/unit/Cardano/Wallet/MnemonicSpec.hs b/test/unit/Cardano/Wallet/MnemonicSpec.hs new file mode 100644 index 00000000000..ccdc330b00e --- /dev/null +++ b/test/unit/Cardano/Wallet/MnemonicSpec.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Cardano.Wallet.MnemonicSpec + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Mnemonic + ( Entropy + , EntropyError + , EntropySize + , Mnemonic + , MnemonicException (..) + , MnemonicWords + , ambiguousNatVal + , entropyToByteString + , entropyToMnemonic + , genEntropy + , mkEntropy + , mkMnemonic + , mnemonicToEntropy + , mnemonicToText + ) +import Control.Monad + ( forM_ ) +import Crypto.Encoding.BIP39 + ( ValidChecksumSize, ValidEntropySize, ValidMnemonicSentence, toEntropy ) +import Data.ByteString + ( ByteString ) +import Data.Either + ( isLeft ) +import Data.Function + ( on ) +import Data.Text + ( Text ) +import Test.Hspec + ( Spec, describe, it, shouldBe, shouldReturn, shouldSatisfy ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary, arbitrary, vectorOf, (===) ) + +import qualified Cardano.Crypto.Wallet as CC +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T + +-- | By default, private keys aren't comparable for security reasons (timing +-- attacks). We allow it here for testing purpose which is fine. +instance Eq CC.XPrv where + (==) = (==) `on` CC.unXPrv + +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 "(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 + + describe "golden tests" $ do + it "No empty mnemonic" $ + mkMnemonic @12 [] `shouldSatisfy` isLeft + + it "No empty entropy" $ + mkEntropy @(EntropySize 12) "" `shouldSatisfy` isLeft + + it "Can generate 96 bits entropy" $ + (BS.length . entropyToByteString <$> genEntropy @96) `shouldReturn` 12 + + it "Can generate 128 bits entropy" $ + (BS.length . entropyToByteString <$> genEntropy @128) `shouldReturn` 16 + + 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 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` isLeft + + it "Mnemonic to Entropy" $ forM_ testVectors $ \TestVector{..} -> + mnemonicToEntropy mnemonic `shouldBe` entropy + 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 == ']') + +-- | The initial seed has to be vector or length multiple of 4 bytes and shorter +-- than 64 bytes. Note that this is good for testing or examples, but probably +-- not for generating truly random Mnemonic words. +-- +-- See 'Crypto.Random.Entropy (getEntropy)' +instance + ( ValidEntropySize n + , ValidChecksumSize n csz + ) => Arbitrary (Entropy n) where + arbitrary = + let + size = fromIntegral $ ambiguousNatVal @n + entropy = + mkEntropy @n . B8.pack <$> vectorOf (size `quot` 8) arbitrary + in + either (error . show . UnexpectedEntropyError) id <$> entropy + +-- | Same remark from 'Arbitrary Entropy' applies here. +instance + ( n ~ EntropySize mw + , mw ~ MnemonicWords n + , ValidChecksumSize n csz + , ValidEntropySize n + , ValidMnemonicSentence mw + , Arbitrary (Entropy n) + ) => Arbitrary (Mnemonic mw) where + arbitrary = + entropyToMnemonic <$> arbitrary @(Entropy n)