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 8240750600f..cbf1061866f 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -32,15 +32,20 @@ library ghc-options: -Werror build-depends: base + , aeson , base58-bytestring + , basement , binary , bytestring + , cardano-crypto + , cryptonite , cborg , containers , cryptonite , deepseq , digest , fmt + , exceptions , http-api-data , http-media , memory @@ -54,12 +59,13 @@ library exposed-modules: Cardano.ChainProducer.RustHttpBridge.Api Cardano.ChainProducer.RustHttpBridge.Client - Cardano.Wallet.BlockSyncer - Servant.Extra.ContentTypes Cardano.Wallet Cardano.Wallet.Binary Cardano.Wallet.Binary.Packfile + Cardano.Wallet.BlockSyncer + Cardano.Wallet.Mnemonic Cardano.Wallet.Primitive + Servant.Extra.ContentTypes other-modules: Paths_cardano_wallet @@ -82,6 +88,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 @@ -96,17 +122,21 @@ test-suite unit ghc-options: -Werror build-depends: base + , aeson , base58-bytestring , bytestring + , cardano-crypto , cardano-wallet , cborg , containers , deepseq , hspec , memory - , QuickCheck + , hspec-expectations + , text , time-units , transformers + , QuickCheck type: exitcode-stdio-1.0 hs-source-dirs: @@ -117,5 +147,6 @@ test-suite unit Cardano.WalletSpec Cardano.Wallet.BinarySpec Cardano.Wallet.Binary.PackfileSpec - Cardano.Wallet.PrimitiveSpec Cardano.Wallet.BlockSyncerSpec + Cardano.Wallet.MnemonicSpec + Cardano.Wallet.PrimitiveSpec diff --git a/src/Cardano/Wallet/Mnemonic.hs b/src/Cardano/Wallet/Mnemonic.hs new file mode 100644 index 00000000000..a1a27c9bf65 --- /dev/null +++ b/src/Cardano/Wallet/Mnemonic.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# 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 + , specMnemonic15 + + -- * 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 + ( when, (>=>) ) +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 + , mnemonicSentenceToString + , toEntropy + , wordsToEntropy + ) +import Data.Aeson + ( FromJSON (..), ToJSON (..) ) +import Data.Aeson.Types + ( Parser ) +import Data.ByteArray + ( constEq ) +import Data.ByteString + ( ByteString ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Typeable + ( Typeable ) +import Data.Word + ( Word8 ) +import GHC.TypeLits + ( KnownNat, Nat, natVal ) + +import qualified Basement.Compat.Base as Basement +import qualified Basement.String as Basement +import qualified Basement.UArray 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 mainly 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) +-- | ErrForbidden is used when forbidden mnemonic is used upon +-- | construction, for example, api spec mnemonic, +data MnemonicError csz + = ErrMnemonicWords MnemonicWordsError + | ErrEntropy (EntropyError csz) + | ErrDictionary DictionaryError + | ErrForbidden + deriving (Show) + +-- | 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 + + when (isForbiddenMnemonic sentence) $ Left ErrForbidden + + 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 + +-- | Constant-time comparison of any sentence with the 12-word +-- | and 15-word example mnemonic +isForbiddenMnemonic + :: (ValidMnemonicSentence mw) + => MnemonicSentence mw + -> Bool +isForbiddenMnemonic sentence = + let + bytes = + sentenceToRawString sentence + + forbiddenMnemonics = sentenceToRawString <$> + [ mnemonicToSentence specMnemonic15 + ] + in + any (constEq bytes) forbiddenMnemonics + +sentenceToRawString + :: (ValidMnemonicSentence mw) + => MnemonicSentence mw + -> Basement.UArray Word8 +sentenceToRawString = + Basement.toBytes Basement.UTF8 . mnemonicSentenceToString Dictionary.english + +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) + +specMnemonic15 + :: Mnemonic 15 +specMnemonic15 = + let + wordsm = + [ "squirrel" + , "material" + , "silly" + , "twice" + , "direct" + , "slush" + , "pistol" + , "razor" + , "become" + , "junk" + , "kingdom" + , "flee" + , "squirrel" + , "silly" + , "twice" + ] + phrase = either (error . show) id + (mnemonicPhrase @15 (toUtf8String <$> wordsm)) + sentence = either (error . show) id + (mnemonicPhraseToMnemonicSentence Dictionary.english phrase) + entropy = either (error . show) id + (wordsToEntropy @(EntropySize 15) sentence) + in Mnemonic + { mnemonicToSentence = sentence + , mnemonicToEntropy = entropy + } + +instance + ( n ~ EntropySize mw + , mw ~ MnemonicWords n + , ValidChecksumSize n csz + , ValidEntropySize n + , ValidMnemonicSentence mw + ) => FromJSON (Mnemonic mw) where + parseJSON = + parseJSON >=> (eitherToParser . mkMnemonic) + +instance ToJSON (Mnemonic mw) where + toJSON = toJSON . mnemonicToText + +-- | Convert a given Either to an Aeson Parser +eitherToParser + :: Show a + => Either a b + -> Parser b +eitherToParser = either (fail . show) pure + +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..acb9b92bdac --- /dev/null +++ b/test/unit/Cardano/Wallet/MnemonicSpec.hs @@ -0,0 +1,181 @@ +{-# 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 + , specMnemonic15 + ) +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.Aeson as Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BL + +-- | 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 + { + -- | Raw JSON encoding (V1) + bytes :: BL.ByteString + + -- | 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 "(9) parseJSON . toJSON == pure" $ + \(mw :: Mnemonic 9) -> (Aeson.decode . Aeson.encode) mw === pure mw + + prop "(12) parseJSON . toJSON == pure" $ + \(mw :: Mnemonic 12) -> (Aeson.decode . Aeson.encode) mw === pure mw + + describe "golden tests" $ do + it "No example mnemonic" $ + mkMnemonic @15 defMnemonic `shouldSatisfy` isLeft + + 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 JSON" $ forM_ testVectors $ \TestVector{..} -> + Aeson.encode mnemonic `shouldBe` bytes + + it "Mnemonic from JSON" $ forM_ testVectors $ \TestVector{..} -> + Aeson.decode bytes `shouldBe` pure mnemonic + + 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 + + defMnemonic + :: [Text] + defMnemonic = either (error . (<>) "Failed to encode/decode default menmonic " . show) id + $ Aeson.eitherDecode + $ Aeson.encode specMnemonic15 + + + +-- | 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)