Merge #1343

1343: Introduce SomeMnemonic as source of root keys (instead of entropy) r=Anviking a=Anviking

Issue Number

#1316, preliminary work to unblock #1321

Overview

  • Add SomeMnemonic as return type of fromMnemonic
  • Make e.g. unsafeGenerateKeyFromSeed take a SomeMnemonic instead entropy. This is more similar to Icarus.generateKeyFromHardwareLedger
  • Add genMnemonic helper in a shared location

Comments

Co-authored-by: Johannes Lund [email protected]

View on GitHub
File Changes
import Control.Applicative
    ( optional, some, (<|>) )
import Control.Arrow
-
    ( first, left, second )
+
    ( first, left )
import Control.Exception
    ( bracket, catch )
import Control.Monad
    ( bimap )
import Data.Char
    ( toLower )
-
import Data.Functor
-
    ( (<$), (<&>) )
import Data.List.Extra
    ( enumerate )
import Data.List.NonEmpty
  where
    cmd = pure exec
    exec = do
-
        wSeed <- fst <$> do
+
        wSeed <- do
            let prompt = "Please enter your 15–24 word mnemonic sentence: "
-
            let parser = fromMnemonic @'[15,18,21,24] @"seed" . T.words
-
            getLine prompt parser
-
        wSndFactor <- maybe mempty fst <$> do
+
            let parser = fromMnemonic @'[15,18,21,24] . T.words
+
            fst <$> getLine prompt parser
+
        wSndFactor <- do
            let prompt =
                    "(Enter a blank line if you didn't use a second factor.)\n"
                    <> "Please enter your 9–12 word mnemonic second factor: "
-
            let parser =
-
                    optionalE (fromMnemonic @'[9,12] @"generation") . T.words
-
            getLine prompt parser <&> \case
-
                (Nothing, _) -> Nothing
-
                (Just a, t) -> Just (a, t)
+
            let parser = optionalE $ fromMnemonic @'[9,12] . T.words
+
            fst <$> getLine prompt parser

                      
        let rootXPrv = Shelley.generateKeyFromSeed (wSeed, wSndFactor) mempty
        let rewardAccountXPrv = deriveRewardAccount mempty rootXPrv
    exec (WalletCreateArgs wPort wName wGap) = do
        wSeed <- do
            let prompt = "Please enter a 15–24 word mnemonic sentence: "
-
            let parser = fromMnemonic @'[15,18,21,24] @"seed" . T.words
-
            getLine prompt parser
+
            let parser = fromMnemonic @'[15,18,21,24] . T.words
+
            fst <$> getLine prompt parser
        wSndFactor <- do
            let prompt =
                    "(Enter a blank line if you do not wish to use a second " <>
                    "factor.)\n" <>
                    "Please enter a 9–12 word mnemonic second factor: "
            let parser =
-
                    optionalE (fromMnemonic @'[9,12] @"generation") . T.words
-
            getLine prompt parser <&> \case
-
                (Nothing, _) -> Nothing
-
                (Just a, t) -> Just (a, t)
+
                    optionalE (fromMnemonic @'[9,12]) . T.words
+
            fst <$> getLine prompt parser
        wPwd <- getPassphraseWithConfirm "Please enter a passphrase: "
        runClient wPort Aeson.encodePretty $ postWallet (walletClient @t) $
            WalletPostData
                (Just $ ApiT wGap)
-
                (ApiMnemonicT . second T.words $ wSeed)
-
                (ApiMnemonicT . second T.words <$> wSndFactor)
+
                (ApiMnemonicT wSeed)
+
                (ApiMnemonicT <$> wSndFactor)
                (ApiT wName)
                (ApiT wPwd)

                      
      Cardano.Pool.DB.SqliteSpec
      Cardano.Pool.MetadataSpec
      Cardano.Pool.MetricsSpec
+
      Cardano.Wallet.Gen
      Cardano.Pool.PerformanceSpec
      Cardano.Pool.RankingSpec
      Cardano.Wallet.Api.ServerSpec
    ( SeqState (..), defaultAddressPoolGap, mkSeqState )
import Cardano.Wallet.Primitive.CoinSelection
    ( CoinSelection (..), changeBalance, feeBalance, inputBalance )
-
import Cardano.Wallet.Primitive.Mnemonic
-
    ( mkMnemonic )
import Cardano.Wallet.Primitive.Model
    ( Wallet, availableBalance, currentTip, getState, totalBalance )
import Cardano.Wallet.Primitive.Types
    fst <$> getWallet ctx (mkShelleyWallet @_ @s @t @k) (ApiT wid)
  where
    seed = getApiMnemonicT (body ^. #mnemonicSentence)
-
    secondFactor = maybe mempty getApiMnemonicT (body ^. #mnemonicSecondFactor)
+
    secondFactor = getApiMnemonicT <$> (body ^. #mnemonicSecondFactor)
    pwd = getApiT (body ^. #passphrase)
    rootXPrv = Seq.generateKeyFromSeed (seed, secondFactor) pwd
    g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap)
  where
    wName = getApiT (body ^. #name)
    pwd   = getApiT (body ^. #passphrase)
-
    ApiMnemonicT (_, mw) = body ^. #mnemonicSentence
-

                      
-
    -- NOTE Safe because #mnemonicSentence has been parsed successfully
-
    rootXPrv = case length mw of
-
        n | n == 12 ->
-
            let Right mnemonic = mkMnemonic @12 mw
-
            in  Ica.generateKeyFromHardwareLedger mnemonic pwd
-
        n | n == 15 ->
-
            let Right mnemonic = mkMnemonic @15 mw
-
            in  Ica.generateKeyFromHardwareLedger mnemonic pwd
-
        n | n == 18 ->
-
            let Right mnemonic = mkMnemonic @18 mw
-
            in  Ica.generateKeyFromHardwareLedger mnemonic pwd
-
        n | n == 21 ->
-
            let Right mnemonic = mkMnemonic @21 mw
-
            in  Ica.generateKeyFromHardwareLedger mnemonic pwd
-
        _  {- 24 -} ->
-
            let Right mnemonic = mkMnemonic @24 mw
-
            in  Ica.generateKeyFromHardwareLedger mnemonic pwd
+
    rootXPrv = Ica.generateKeyFromHardwareLedger mw pwd
+
      where mw = getApiMnemonicT (body ^. #mnemonicSentence)

                      
{-------------------------------------------------------------------------------
                             ApiLayer Discrimination
{-# LANGUAGE AllowAmbiguousTypes #-}
-
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
+
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
    -- * Polymorphic Types
    , ApiT (..)
    , ApiMnemonicT (..)
-
    , getApiMnemonicT
    ) where

                      
import Prelude
    , Passphrase (..)
    , PassphraseMaxLength (..)
    , PassphraseMinLength (..)
+
    , SomeMnemonic (..)
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( decodeLegacyAddress )
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
    ( decodeShelleyAddress )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( AddressPoolGap, getAddressPoolGap )
+
import Cardano.Wallet.Primitive.Mnemonic
+
    ( mnemonicToText )
import Cardano.Wallet.Primitive.Types
    ( ActiveSlotCoefficient (..)
    , Address (..)
    | Trezor
    | Ledger

                      
+
data SndFactor
+
    = SndFactor
+

                      
type family StyleSymbol (style :: ByronWalletStyle) :: Symbol where
    StyleSymbol 'Random  = "random"
    StyleSymbol 'Icarus  = "icarus"
    StyleSymbol 'Trezor  = "trezor"
    StyleSymbol 'Ledger  = "ledger"

                      
-
type family AllowedMnemonics (style :: ByronWalletStyle) :: [Nat] where
-
    AllowedMnemonics 'Random  = '[12]
-
    AllowedMnemonics 'Icarus  = '[15]
-
    AllowedMnemonics 'Trezor  = '[12,15,18,21,24]
-
    AllowedMnemonics 'Ledger  = '[12,15,18,21,24]
+
type family AllowedMnemonics (style :: k) :: [Nat]
+

                      
+
type instance AllowedMnemonics 'Random    = '[12]
+
type instance AllowedMnemonics 'Icarus    = '[15]
+
type instance AllowedMnemonics 'Trezor    = '[12,15,18,21,24]
+
type instance AllowedMnemonics 'Ledger    = '[12,15,18,21,24]
+
type instance AllowedMnemonics 'Shelley   = '[15,18,21,24]
+
type instance AllowedMnemonics 'SndFactor = '[9,12]

                      
{-------------------------------------------------------------------------------
                                  API Types

                      
data WalletPostData = WalletPostData
    { addressPoolGap :: !(Maybe (ApiT AddressPoolGap))
-
    , mnemonicSentence :: !(ApiMnemonicT '[15,18,21,24] "seed")
-
    , mnemonicSecondFactor :: !(Maybe (ApiMnemonicT '[9,12] "generation"))
+
    , mnemonicSentence :: !(ApiMnemonicT (AllowedMnemonics 'Shelley))
+
    , mnemonicSecondFactor :: !(Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor)))
    , name :: !(ApiT WalletName)
    , passphrase :: !(ApiT (Passphrase "encryption"))
    } deriving (Eq, Generic, Show)

                      
data ByronWalletPostData mw = ByronWalletPostData
-
    { mnemonicSentence :: !(ApiMnemonicT mw "seed")
+
    { mnemonicSentence :: !(ApiMnemonicT mw)
    , name :: !(ApiT WalletName)
    , passphrase :: !(ApiT (Passphrase "encryption"))
    } deriving (Eq, Generic, Show)
--
-- @
-- data MyWallet
-
--     { mnemonic :: ApiMnemonicT '[15,18,21,24] "root-seed"
+
--     { mnemonic :: ApiMnemonicT '[15,18,21,24]
--     }
-- @
--
-- mnemonic words that was parsed. This is only to be able to implement the
-- 'ToJSON' instances and roundtrip, which is a very dubious argument. In
-- practice, we'll NEVER peek at the mnemonic, output them and whatnot.
-
newtype ApiMnemonicT (sizes :: [Nat]) (purpose :: Symbol) =
-
    ApiMnemonicT (Passphrase purpose, [Text])
+
newtype ApiMnemonicT (sizes :: [Nat]) =
+
    ApiMnemonicT { getApiMnemonicT :: SomeMnemonic }
    deriving (Generic, Show, Eq)

                      
-
getApiMnemonicT :: ApiMnemonicT sizes purpose -> Passphrase purpose
-
getApiMnemonicT (ApiMnemonicT (pw, _)) = pw
-

                      
{-------------------------------------------------------------------------------
                               JSON Instances
-------------------------------------------------------------------------------}
instance ToJSON  WalletPostData where
    toJSON = genericToJSON defaultRecordTypeOptions

                      
-
instance FromMnemonic mw "seed" => FromJSON (ByronWalletPostData mw) where
+
instance FromMnemonic mw => FromJSON (ByronWalletPostData mw) where
    parseJSON = genericParseJSON defaultRecordTypeOptions
instance ToJSON (ByronWalletPostData mw) where
    toJSON = genericToJSON defaultRecordTypeOptions
instance ToJSON (ApiT (Passphrase purpose)) where
    toJSON = toJSON . toText . getApiT

                      
-
instance FromMnemonic sizes purpose => FromJSON (ApiMnemonicT sizes purpose)
+
instance FromMnemonic sizes => FromJSON (ApiMnemonicT sizes)
  where
    parseJSON bytes = do
        xs <- parseJSON bytes
-
        m <- eitherToParser $ left ShowFmt $ fromMnemonic @sizes @purpose xs
-
        return $ ApiMnemonicT (m, xs)
+
        m <- eitherToParser $ left ShowFmt $ fromMnemonic @sizes xs
+
        return $ ApiMnemonicT m

                      
-
instance ToJSON (ApiMnemonicT sizes purpose) where
-
    toJSON (ApiMnemonicT (!_, xs)) = toJSON xs
+
instance ToJSON (ApiMnemonicT sizes) where
+
    toJSON (ApiMnemonicT (SomeMnemonic mw)) = toJSON (mnemonicToText mw)

                      
instance FromJSON (ApiT WalletId) where
    parseJSON = parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
+
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
    , Passphrase(..)
    , PassphraseMinLength(..)
    , PassphraseMaxLength(..)
+
    , SomeMnemonic(..)
    , FromMnemonic(..)
    , FromMnemonicError(..)
    , ErrWrongPassphrase(..)
    , DictionaryError (..)
    , EntropyError (..)
    , EntropySize
+
    , Mnemonic
    , MnemonicError (..)
    , MnemonicWordsError (..)
-
    , entropyToBytes
    , mkMnemonic
-
    , mnemonicToEntropy
    )
import Cardano.Wallet.Primitive.Types
    ( Address (..), ChimericAccount (..), Hash (..) )
import Crypto.Random.Types
    ( MonadRandom (..) )
import Data.Bifunctor
-
    ( first )
+
    ( bimap )
import Data.ByteArray
    ( ByteArray, ByteArrayAccess, ScrubbedBytes )
import Data.ByteArray.Encoding
    , fromTextToBoundedEnum
    , toTextFromBoundedEnum
    )
+
import Data.Type.Equality
+
    ( (:~:) (..), testEquality )
import Data.Typeable
    ( Typeable )
import Data.Word
    ( Generic )
import GHC.TypeLits
    ( KnownNat, Nat, Symbol, natVal )
+
import Type.Reflection
+
    ( typeOf )

                      
import qualified Basement.Compat.Base as B
import qualified Data.ByteArray as BA
instance ToText (Passphrase purpose) where
    toText (Passphrase bytes) = T.decodeUtf8 $ BA.convert bytes

                      
+
data SomeMnemonic where
+
    SomeMnemonic :: forall mw. KnownNat mw => Mnemonic mw -> SomeMnemonic
+

                      
+
deriving instance Show SomeMnemonic
+
instance Eq SomeMnemonic where
+
    (SomeMnemonic mwa) == (SomeMnemonic mwb) =
+
        case typeOf mwa `testEquality` typeOf mwb of
+
            Nothing -> False
+
            Just Refl -> mwa == mwb
+

                      
-- | Create a passphrase from a mnemonic sentence. This class enables caller to
-- parse text list of variable length into mnemonic sentences.
--
--
-- Note that the given 'Nat's **have** to be valid mnemonic sizes, otherwise the
-- underlying code won't even compile, with not-so-friendly error messages.
-
class FromMnemonic (sz :: [Nat]) (purpose :: Symbol) where
-
    fromMnemonic :: [Text] -> Either (FromMnemonicError sz) (Passphrase purpose)
+
class FromMnemonic (sz :: [Nat]) where
+
    fromMnemonic :: [Text] -> Either (FromMnemonicError sz) SomeMnemonic

                      
-- | Error reported from trying to create a passphrase from a given mnemonic
newtype FromMnemonicError (sz :: [Nat]) =
    ( n ~ EntropySize mw
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
-
    , FromMnemonic rest purpose
+
    , FromMnemonic rest
    , NatVals rest
    ) =>
-
    FromMnemonic (mw ': rest) purpose
+
    FromMnemonic (mw ': rest)
  where
    fromMnemonic parts = case parseMW of
        Left err -> left (promote err) parseRest
        Right mw -> Right mw
      where
        parseMW = left (FromMnemonicError . getFromMnemonicError) $ -- coerce
-
            fromMnemonic @'[mw] @purpose parts
+
            fromMnemonic @'[mw] parts
        parseRest = left (FromMnemonicError . getFromMnemonicError) $ -- coerce
-
            fromMnemonic @rest @purpose parts
+
            fromMnemonic @rest parts
        promote e e' =
            let
                sz = fromEnum <$> natVals (Proxy :: Proxy (mw ': rest))
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
    ) =>
-
    FromMnemonic (mw ': '[]) purpose
+
    FromMnemonic (mw ': '[])
  where
    fromMnemonic parts = do
-
        m <- first (FromMnemonicError . pretty) (mkMnemonic @mw parts)
-
        return $ Passphrase $ entropyToBytes $ mnemonicToEntropy m
+
        bimap (FromMnemonicError . pretty) SomeMnemonic (mkMnemonic @mw parts)
      where
        pretty = \case
            ErrMnemonicWords ErrWrongNumberOfWords{} ->
    , Passphrase (..)
    , PaymentAddress (..)
    , PersistPrivateKey (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , fromHex
    , hex
    )
+
import Cardano.Wallet.Primitive.Mnemonic
+
    ( entropyToBytes, mnemonicToEntropy )
import Cardano.Wallet.Primitive.Types
    ( Address (..), Hash (..), invariant, testnetMagic )
import Control.DeepSeq
-- | Generate a root key from a corresponding seed.
-- The seed should be at least 16 bytes.
generateKeyFromSeed
-
    :: Passphrase "seed"
+
    :: SomeMnemonic
    -> Passphrase "encryption"
    -> ByronKey 'RootK XPrv
generateKeyFromSeed = unsafeGenerateKeyFromSeed ()
-- use 'generateKeyFromSeed'.
unsafeGenerateKeyFromSeed
    :: DerivationPath depth
-
    -> Passphrase "seed"
+
    -> SomeMnemonic
    -> Passphrase "encryption"
    -> ByronKey depth XPrv
-
unsafeGenerateKeyFromSeed derivationPath (Passphrase seed) (Passphrase pwd) = ByronKey
+
unsafeGenerateKeyFromSeed derivationPath (SomeMnemonic mw) (Passphrase pwd) = ByronKey
    { getKey = masterKey
    , derivationPath
    , payloadPassphrase = hdPassphrase (toXPub masterKey)
    }
  where
    masterKey = generate (hashSeed seed') pwd
+
    seed  = entropyToBytes $ mnemonicToEntropy mw
    seed' = invariant
        ("seed length : " <> show (BA.length seed)
            <> " in (Passphrase \"seed\") is not valid")
    , PersistPrivateKey (..)
    , PersistPublicKey (..)
    , SoftDerivation (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , fromHex
    , hex
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( decodeLegacyAddress )
import Cardano.Wallet.Primitive.Mnemonic
-
    ( Mnemonic, mnemonicToText )
+
    ( entropyToBytes, mnemonicToEntropy, mnemonicToText )
import Cardano.Wallet.Primitive.Types
    ( Address (..), Hash (..), invariant )
import Control.Arrow
-- | Generate a root key from a corresponding seed.
-- The seed should be at least 16 bytes.
generateKeyFromSeed
-
    :: Passphrase "seed"
-
        -- ^ The actual seed
+
    :: SomeMnemonic
+
        -- ^ The root mnemonic
    -> Passphrase "encryption"
        -- ^ Master encryption passphrase
    -> IcarusKey 'RootK XPrv
-- - What seems to be arbitrary changes from Ledger regarding the calculation of
--   the initial chain code and generation of the root private key.
generateKeyFromHardwareLedger
-
    :: Mnemonic mw
-
        -- ^ The actual seed
+
    :: SomeMnemonic
+
        -- ^ The root mnemonic
    -> Passphrase "encryption"
        -- ^ Master encryption passphrase
    -> IcarusKey 'RootK XPrv
-
generateKeyFromHardwareLedger mnemonic (Passphrase pwd) = unsafeFromRight $ do
+
generateKeyFromHardwareLedger (SomeMnemonic mw) (Passphrase pwd) = unsafeFromRight $ do
    let seed = pbkdf2HmacSha512
            $ T.encodeUtf8
            $ T.intercalate " "
-
            $ mnemonicToText mnemonic
+
            $ mnemonicToText mw

                      
    -- NOTE
    -- SLIP-0010 refers to `iR` as the chain code. Here however, the chain code
-- testing, in practice, seeds are used to represent root keys, and one should
-- use 'generateKeyFromSeed'.
unsafeGenerateKeyFromSeed
-
    :: Passphrase "seed"
-
        -- ^ The actual seed
+
    :: SomeMnemonic
+
        -- ^ The root mnemonic
    -> Passphrase "encryption"
        -- ^ Master encryption passphrase
    -> IcarusKey depth XPrv
-
unsafeGenerateKeyFromSeed (Passphrase seed) (Passphrase pwd) =
+
unsafeGenerateKeyFromSeed (SomeMnemonic mw) (Passphrase pwd) =
    let
+
        seed  = entropyToBytes $ mnemonicToEntropy mw
        seed' = invariant
            ("seed length : "
                <> show (BA.length seed)
    , PersistPrivateKey (..)
    , PersistPublicKey (..)
    , SoftDerivation (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , fromHex
    , hex
    , networkDiscriminantVal
    )
+
import Cardano.Wallet.Primitive.Mnemonic
+
    ( entropyToBytes, mnemonicToEntropy )
import Cardano.Wallet.Primitive.Types
    ( Address (..), Hash (..), invariant )
import Control.DeepSeq
-- | Generate a root key from a corresponding seed.
-- The seed should be at least 16 bytes.
generateKeyFromSeed
-
    :: (Passphrase "seed", Passphrase "generation")
+
    :: (SomeMnemonic, Maybe SomeMnemonic)
       -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> ShelleyKey 'RootK XPrv
-- testing, in practice, seeds are used to represent root keys, and one should
-- use 'generateKeyFromSeed'.
unsafeGenerateKeyFromSeed
-
    :: (Passphrase "seed", Passphrase "generation")
+
    :: (SomeMnemonic, Maybe SomeMnemonic)
        -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> ShelleyKey depth XPrv
-
unsafeGenerateKeyFromSeed (Passphrase seed, Passphrase gen) (Passphrase pwd) =
-
    let
-
        seed' = invariant
-
            ("seed length : " <> show (BA.length seed) <> " in (Passphrase \"seed\") is not valid")
-
            seed
-
            (\s -> BA.length s >= minSeedLengthBytes && BA.length s <= 255)
-
    in ShelleyKey $ generateNew seed' gen pwd
+
unsafeGenerateKeyFromSeed (root, m2nd) (Passphrase pwd) =
+
    ShelleyKey $ generateNew seed' (maybe mempty mnemonicToBytes m2nd) pwd
+
  where
+
    mnemonicToBytes (SomeMnemonic mw) = entropyToBytes $ mnemonicToEntropy mw
+
    seed  = mnemonicToBytes root
+
    seed' = invariant
+
        ("seed length : " <> show (BA.length seed) <> " in (Passphrase \"seed\") is not valid")
+
        seed
+
        (\s -> BA.length s >= minSeedLengthBytes && BA.length s <= 255)
+

                      

                      
instance HardDerivation ShelleyKey where
    type AddressIndexDerivationType ShelleyKey = 'Soft
    , MnemonicWordsError(..)
    , ValidEntropySize
    , ValidChecksumSize
+
    , ValidMnemonicSentence
    , ConsistentEntropy
    , CheckSumBits
    , EntropySize
    , unsafeRunExceptT
    , unsafeXPrv
    , unsafeMkMnemonic
+
    , unsafeMkEntropy
+
    , unsafeMkSomeMnemonicFromEntropy
    , unsafeDeserialiseCbor
    , unsafeBech32DecodeFile
    , unsafeBech32Decode
    ( XPrv )
import Cardano.Wallet.Api.Types
    ( DecodeAddress (..) )
+
import Cardano.Wallet.Primitive.AddressDerivation
+
    ( SomeMnemonic (..) )
import Cardano.Wallet.Primitive.Mnemonic
-
    ( ConsistentEntropy, EntropySize, Mnemonic, mkMnemonic )
+
    ( ConsistentEntropy
+
    , Entropy
+
    , EntropySize
+
    , Mnemonic
+
    , MnemonicWords
+
    , ValidChecksumSize
+
    , ValidEntropySize
+
    , ValidMnemonicSentence
+
    , entropyToMnemonic
+
    , mkEntropy
+
    , mkMnemonic
+
    )
import Cardano.Wallet.Primitive.Types
    ( Address )
import Control.Monad
    ( ByteString )
import Data.Char
    ( isHexDigit )
+
import Data.Proxy
+
    ( Proxy )
import Data.Text
    ( Text )
import Data.Text.Class
    snd
    (CBOR.deserialiseFromBytes decoder bytes)

                      
+
unsafeMkEntropy
+
    :: forall ent csz.
+
        ( HasCallStack
+
        , ValidEntropySize ent
+
        , ValidChecksumSize ent csz
+
        )
+
    => ByteString
+
    -> Entropy ent
+
unsafeMkEntropy = either (error . show) id . mkEntropy
+

                      
+
unsafeMkSomeMnemonicFromEntropy
+
    :: forall mw ent csz.
+
        ( HasCallStack
+
        , ValidEntropySize ent
+
        , ValidChecksumSize ent csz
+
        , ValidMnemonicSentence mw
+
        , ent ~ EntropySize mw
+
        , mw ~ MnemonicWords ent
+
        )
+
    => Proxy mw
+
    -> ByteString
+
    -> SomeMnemonic
+
unsafeMkSomeMnemonicFromEntropy _ = SomeMnemonic
+
    . entropyToMnemonic
+
    . unsafeMkEntropy @ent
+

                      
-- | Load the data part of a bech32-encoded string from file. These files often
-- come from @[email protected] Only the first line of the file is read.
unsafeBech32DecodeFile :: HasCallStack => FilePath -> IO BL.ByteString
    ( DelegationAddress (..)
    , Depth (..)
    , NetworkDiscriminant (..)
-
    , Passphrase (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , XPub
    , xpub
    , mkSeqState
    )
import Cardano.Wallet.Primitive.Mnemonic
-
    ( EntropySize, entropyToBytes, genEntropy )
+
    ( EntropySize, entropyToMnemonic, genEntropy )
import Cardano.Wallet.Primitive.Model
    ( Wallet, initWallet, unsafeInitWallet )
import Cardano.Wallet.Primitive.Types
    , fromFlatSlot
    )
import Cardano.Wallet.Unsafe
-
    ( unsafeRunExceptT )
+
    ( unsafeMkSomeMnemonicFromEntropy, unsafeRunExceptT )
import Control.DeepSeq
    ( NFData (..), force )
import Control.Exception
    ( ByteString )
import Data.Functor
    ( ($>) )
+
import Data.Proxy
+
    ( Proxy (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Time.Clock.System
import System.Random
    ( mkStdGen, randoms )

                      
-
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as Map
testCp :: WalletBench
testCp = snd $ initWallet block0 genesisParameters initDummyState

                      
+
{-# NOINLINE initDummyState #-}
initDummyState :: SeqState 'Testnet ShelleyKey
initDummyState =
    mkSeqState (xprv, mempty) defaultAddressPoolGap
  where
-
    bytes = entropyToBytes <$> unsafePerformIO $ genEntropy @(EntropySize 15)
-
    xprv = generateKeyFromSeed (Passphrase bytes, mempty) mempty
+
    mnemonic = unsafePerformIO
+
        $ SomeMnemonic . entropyToMnemonic @15
+
        <$> genEntropy @(EntropySize 15)
+
    xprv = generateKeyFromSeed (mnemonic, Nothing) mempty

                      
testMetadata :: WalletMetadata
testMetadata = WalletMetadata
testPk = PrimaryKey testWid

                      
ourAccount :: ShelleyKey 'AccountK XPub
-
ourAccount = publicKey $ unsafeGenerateKeyFromSeed (seed, mempty) mempty
-
  where seed = Passphrase $ BA.convert $ BS.replicate 32 0
+
ourAccount = publicKey $ unsafeGenerateKeyFromSeed (seed, Nothing) mempty
+
  where
+
    seed = unsafeMkSomeMnemonicFromEntropy (Proxy @15) (BS.replicate 32 0)

                      
rewardAccount :: ShelleyKey 'AddressK XPub
-
rewardAccount = publicKey $ unsafeGenerateKeyFromSeed (seed, mempty) mempty
-
  where seed = Passphrase $ BA.convert $ BS.replicate 32 0
+
rewardAccount = publicKey $ unsafeGenerateKeyFromSeed (seed, Nothing) mempty
+
  where
+
    seed = unsafeMkSomeMnemonicFromEntropy (Proxy @15) (BS.replicate 32 0)

                      
-- | Make a prefixed bytestring for use as a Hash or Address.
label :: Show n => String -> n -> B8.ByteString
    , PassphraseMaxLength (..)
    , PassphraseMinLength (..)
    , PaymentAddress (..)
+
    , SomeMnemonic (..)
    , XPub (..)
    , networkDiscriminantVal
    , passphraseMaxLength
    , MnemonicException (..)
    , ValidChecksumSize
    , ValidEntropySize
-
    , entropyToBytes
    , entropyToMnemonic
    , mkEntropy
-
    , mnemonicToText
    )
import Cardano.Wallet.Primitive.Types
    ( Address (..)
                    \ are expected."
            Aeson.parseEither parseJSON [aesonQQ|
                ["toilet", "toilet", "toilet"]
-
            |] `shouldBe` (Left @String @(ApiMnemonicT '[12] "test") msg)
+
            |] `shouldBe` (Left @String @(ApiMnemonicT '[12]) msg)

                      
        it "ApiT AddressPoolGap (too small)" $ do
            let msg = "Error in $: An address pool gap must be a natural number between "
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
    )
-
    => Arbitrary (ApiMnemonicT (mw ': '[]) purpose)
+
    => Arbitrary (ApiMnemonicT (mw ': '[]))
  where
    arbitrary = do
        ent <- arbitrary @(Entropy n)
-
        return $ ApiMnemonicT
-
            ( Passphrase $ entropyToBytes ent
-
            , mnemonicToText $ entropyToMnemonic ent
-
            )
+
        return
+
            . ApiMnemonicT
+
            . SomeMnemonic
+
            $ entropyToMnemonic ent

                      
instance
    ( n ~ EntropySize mw
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
-
    , Arbitrary (ApiMnemonicT rest purpose)
+
    , Arbitrary (ApiMnemonicT rest)
    )
-
    => Arbitrary (ApiMnemonicT (mw ': rest) purpose)
+
    => Arbitrary (ApiMnemonicT (mw ': rest))
  where
    arbitrary = do
-
        ApiMnemonicT x <- arbitrary @(ApiMnemonicT '[mw] purpose)
-
        ApiMnemonicT y <- arbitrary @(ApiMnemonicT rest purpose)
+
        ApiMnemonicT x <- arbitrary @(ApiMnemonicT '[mw])
+
        ApiMnemonicT y <- arbitrary @(ApiMnemonicT rest)
        -- NOTE
        -- If we were to "naively" combine previous generators without weights,
        -- we would be tilting probabilities towards the leftmost element, so
    ( TxHistory, filterTxHistory )
import Cardano.Wallet.DummyTarget.Primitive.Types as DummyTarget
    ( block0, genesisParameters, mkTx, mockHash )
+
import Cardano.Wallet.Gen
+
    ( genMnemonic )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , DerivationType (..)
    , Index (..)
    , NetworkDiscriminant (..)
    , Passphrase (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , XPrv
    , XPub
    , unsafeEpochNo
    , wholeRange
    )
+
import Cardano.Wallet.Unsafe
+
    ( unsafeMkSomeMnemonicFromEntropy )
import Control.Arrow
    ( second )
import Control.DeepSeq
    ()
import Data.List
    ( unfoldr )
+
import Data.Proxy
+
    ( Proxy (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Text.Class
    , arbitrarySizedBoundedIntegral
    , choose
    , elements
+
    , frequency
    , generate
    , genericShrink
    , liftArbitrary
  where
    genRootKeysSeq :: Gen (ShelleyKey 'RootK XPrv)
    genRootKeysSeq = do
-
        (s, g, e) <- (,,)
-
            <$> genPassphrase @"seed" (16, 32)
-
            <*> genPassphrase @"generation" (0, 16)
-
            <*> genPassphrase @"encryption" (0, 16)
+
        s <- SomeMnemonic <$> genMnemonic @12
+
        g <- frequency
+
                [ (1, return Nothing)
+
                , (3, Just . SomeMnemonic <$> genMnemonic @12)
+
                ]
+
        e <- genPassphrase @"encryption" (0, 16)
        return $ Seq.generateKeyFromSeed (s, g) e
{-# NOINLINE rootKeysSeq #-}

                      
arbitrarySeqAccount
    :: ShelleyKey 'AccountK XPub
arbitrarySeqAccount =
-
    publicKey $ unsafeGenerateKeyFromSeed (seed, mempty) mempty
+
    publicKey $ unsafeGenerateKeyFromSeed (mw, Nothing) mempty
  where
-
    seed = Passphrase $ BA.convert $ BS.replicate 32 0
+
    mw = unsafeMkSomeMnemonicFromEntropy (Proxy @15) (BS.replicate 32 0)

                      
arbitraryRewardAccount
    :: ShelleyKey 'AddressK XPub
arbitraryRewardAccount =
-
    publicKey $ unsafeGenerateKeyFromSeed (seed, mempty) mempty
+
    publicKey $ unsafeGenerateKeyFromSeed (mw, Nothing) mempty
  where
-
    seed = Passphrase $ BA.convert $ BS.replicate 32 0
+
    mw = unsafeMkSomeMnemonicFromEntropy (Proxy @15) (BS.replicate 32 0)

                      
{-------------------------------------------------------------------------------
                                 Random State

                      
genRootKeysRnd :: Gen (ByronKey 'RootK XPrv)
genRootKeysRnd = Rnd.generateKeyFromSeed
-
    <$> genPassphrase @"seed" (16, 32)
+
    <$> arbitrary
    <*> genPassphrase @"encryption" (0, 16)

                      
genPassphrase :: (Int, Int) -> Gen (Passphrase purpose)

                      
instance Buildable MockChain where
    build (MockChain chain) = blockListF' mempty build chain
+

                      
+
instance Arbitrary SomeMnemonic where
+
    arbitrary = SomeMnemonic <$> genMnemonic @12
    ( prop_parallel, prop_sequential )
import Cardano.Wallet.DummyTarget.Primitive.Types
    ( block0, genesisParameters, mockHash )
+
import Cardano.Wallet.Gen
+
    ( genMnemonic )
import Cardano.Wallet.Logging
    ( trMessageText )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , NetworkDiscriminant (..)
-
    , Passphrase (..)
    , PersistPrivateKey
+
    , SomeMnemonic (..)
    , encryptPassphrase
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( RndState (..) )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( SeqState (..), defaultAddressPoolGap, mkSeqState )
-
import Cardano.Wallet.Primitive.Mnemonic
-
    ( EntropySize, entropyToBytes, genEntropy )
import Cardano.Wallet.Primitive.Model
    ( Wallet, initWallet )
import Cardano.Wallet.Primitive.Types
    , xit
    )
import Test.QuickCheck
-
    ( Property, property, (==>) )
+
    ( Property, generate, property, (==>) )
import Test.QuickCheck.Monadic
    ( monadicIO )

                      
    -> ExceptT ErrNoSuchWallet IO (ShelleyKey 'RootK XPrv, Hash "encryption")
attachPrivateKey DBLayer{..} wid = do
    let Right pwd = fromText "simplevalidphrase"
-
    let k = generateKeyFromSeed (coerce pwd, coerce pwd) pwd
+
    seed <- liftIO $ generate $ SomeMnemonic <$> genMnemonic @15
+
    let k = generateKeyFromSeed (seed, Nothing) pwd
    h <- liftIO $ encryptPassphrase pwd
    mapExceptT atomically $ putPrivateKey wid (k, h)
    return (k, h)
    initDummyState :: SeqState 'Testnet ShelleyKey
    initDummyState = mkSeqState (xprv, mempty) defaultAddressPoolGap
      where
-
        bytes = entropyToBytes <$> unsafePerformIO $ genEntropy @(EntropySize 15)
-
        xprv = generateKeyFromSeed (Passphrase bytes, mempty) mempty
+
        mw = SomeMnemonic . unsafePerformIO . generate $ genMnemonic @15
+
        xprv = generateKeyFromSeed (mw, Nothing) mempty

                      
testMetadata :: WalletMetadata
testMetadata = WalletMetadata
initDummyStateSeq :: SeqState 'Testnet ShelleyKey
initDummyStateSeq = mkSeqState (xprv, mempty) defaultAddressPoolGap
  where
-
      bytes = entropyToBytes <$> unsafePerformIO $ genEntropy @(EntropySize 15)
-
      xprv = Seq.generateKeyFromSeed (Passphrase bytes, mempty) mempty
+
      mw = SomeMnemonic $ unsafePerformIO (generate $ genMnemonic @15)
+
      xprv = Seq.generateKeyFromSeed (mw, Nothing) mempty

                      
{-------------------------------------------------------------------------------
                      Test data and instances - Random AD
+
{-# LANGUAGE ScopedTypeVariables #-}
+
{-# LANGUAGE TypeApplications #-}
+
{-# LANGUAGE TypeFamilies #-}
+

                      
+
-- | Shared QuickCheck generators for wallet types.
+
--
+
-- Our convention is to let each test module define its own @[email protected] orphans.
+
-- This module allows for code-reuse where desired, by providing generators.
+
module Cardano.Wallet.Gen
+
    ( genMnemonic
+
    ) where
+

                      
+
import Prelude
+

                      
+
import Cardano.Wallet.Primitive.Mnemonic
+
    ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic, mkEntropy )
+
import Data.Proxy
+
    ( Proxy (..) )
+
import GHC.TypeLits
+
    ( natVal )
+
import Test.QuickCheck
+
    ( Arbitrary (..), Gen, vectorOf )
+

                      
+
import qualified Data.ByteString as BS
+

                      
+
-- | Generates an arbitrary mnemonic of a size according to the type parameter.
+
--
+
-- E.g:
+
-- >>> arbitrary = SomeMnemonic <$> genMnemonic @12
+
genMnemonic
+
    :: forall mw ent csz.
+
     ( ConsistentEntropy ent mw csz
+
     , EntropySize mw ~ ent
+
     )
+
    => Gen (Mnemonic mw)
+
genMnemonic = do
+
        let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8
+
        bytes <- BS.pack <$> vectorOf n arbitrary
+
        let ent = either (error . show) id $ mkEntropy @(EntropySize mw) bytes
+
        return $ entropyToMnemonic ent
    , Index
    , Index (..)
    , Passphrase (..)
+
    , SomeMnemonic (..)
    , XPrv
-
    , fromMnemonic
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( ByronKey (..)
    , generateKeyFromSeed
    , minSeedLengthBytes
    , unsafeGenerateKeyFromSeed
    )
-

                      
import Cardano.Wallet.Primitive.AddressDerivationSpec
    ()
+
import Cardano.Wallet.Unsafe
+
    ( unsafeMkMnemonic )
import Control.Monad
    ( (<=<) )
import Data.ByteArray.Encoding
-------------------------------------------------------------------------------}

                      
prop_keyDerivation
-
    :: Passphrase "seed"
+
    :: SomeMnemonic
    -> Passphrase "encryption"
    -> Index 'WholeDomain 'AccountK
    -> Index 'WholeDomain 'AddressK

                      
generateTest :: GenerateKeyFromSeed -> Expectation
generateTest GenerateKeyFromSeed{..} =
-
    getKey (generateKeyFromSeed (Passphrase seed) pwd)
+
    getKey (generateKeyFromSeed mw pwd)
    `shouldBe`
    getKey rootKey
  where
-
    Right (Passphrase seed) = fromMnemonic @'[12] mnem
+
    mw = SomeMnemonic $ unsafeMkMnemonic @12 mnem

                      
generateTest1 :: GenerateKeyFromSeed
generateTest1 = GenerateKeyFromSeed
    , Passphrase (..)
    , PaymentAddress (..)
    , SoftDerivation (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , XPrv
    )
    ( ConsistentEntropy, EntropySize, mkMnemonic )
import Cardano.Wallet.Primitive.Types
    ( Address )
+
import Cardano.Wallet.Unsafe
+
    ( unsafeMkSomeMnemonicFromEntropy )
import Control.Monad
    ( forM_ )
+
import Data.Proxy
+
    ( Proxy (..) )
import Data.Text
    ( Text )
import Test.Hspec
spec :: Spec
spec = do
    describe "Golden Tests - Icarus' style addresses" $ do
-
        let seed0 = Passphrase "4\175\242L\184\243\191 \169]\171 \207\r\v\233\NUL~&\ETB"
+
        let seed0 = unsafeMkSomeMnemonicFromEntropy (Proxy @15)
+
                "4\175\242L\184\243\191 \169]\171 \207\r\v\233\NUL~&\ETB"

                      
        goldenAddressGeneration $ GoldenAddressGeneration
            seed0 (toEnum 0x80000000) UTxOExternal (toEnum 0x00000000)
        goldenAddressGeneration $ GoldenAddressGeneration
            seed0 (toEnum 0x8000000E) UTxOInternal (toEnum 0x0000002A)
            "Ae2tdPwUPEZFRbyhz3cpfC2CumGzNkFBN2L42rcUc2yjQpEkxDbkPodpMAi"
-

                      
        let (Right seed1) = fromMnemonic @'[12]
-
                [ "ghost", "buddy", "neutral", "broccoli", "face", "rack"
-
                , "relief", "odor", "swallow", "real", "once", "ecology"
-
                ]
+
              [ "ghost", "buddy", "neutral", "broccoli", "face", "rack"
+
              , "relief", "odor", "swallow", "real", "once", "ecology"
+
              ]

                      
        goldenAddressGeneration $ GoldenAddressGeneration
            seed1 (toEnum 0x80000000) UTxOExternal (toEnum 0x00000000)
-------------------------------------------------------------------------------}

                      
data GoldenAddressGeneration = GoldenAddressGeneration
-
    { goldSeed :: Passphrase "seed"
+
    { goldSeed :: SomeMnemonic
    , goldAcctIx :: Index 'Hardened 'AccountK
    , goldAcctStyle :: AccountingStyle
    , goldAddrIx :: Index 'Soft 'AddressK
    -> Spec
goldenHardwareLedger encPwd sentence addrs =
    it title $ do
-
        let Right mnemonic = mkMnemonic @mw sentence
+
        let Right mnemonic = SomeMnemonic <$> mkMnemonic @mw sentence
        let rootXPrv = generateKeyFromHardwareLedger mnemonic encPwd
        let acctXPrv = deriveAccountPrivateKey encPwd rootXPrv minBound
        let deriveAddr = deriveAddressPrivateKey encPwd acctXPrv UTxOExternal
--
-- For details see <https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki#private-parent-key--public-child-key bip-0039>
prop_publicChildKeyDerivation
-
    :: Passphrase "seed"
+
    :: SomeMnemonic
    -> Passphrase "encryption"
    -> AccountingStyle
    -> Index 'Soft 'AddressK
    addrXPub2 = deriveAddressPublicKey (publicKey accXPrv) cc ix

                      
prop_accountKeyDerivation
-
    :: Passphrase "seed"
+
    :: SomeMnemonic
    -> Passphrase "encryption"
    -> Index 'Hardened 'AccountK
    -> Property
    , Passphrase (..)
    , PaymentAddress (..)
    , SoftDerivation (..)
+
    , SomeMnemonic
    , WalletKey (..)
    , XPrv
    , XPub (..)
--
-- For details see <https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki#private-parent-key--public-child-key bip-0039>
prop_publicChildKeyDerivation
-
    :: (Passphrase "seed", Passphrase "generation")
+
    :: (SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption"
    -> AccountingStyle
    -> Index 'Soft 'AddressK
    addrXPub2 = deriveAddressPublicKey (publicKey accXPrv) cc ix

                      
prop_accountKeyDerivation
-
    :: (Passphrase "seed", Passphrase "generation")
+
    :: (SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption"
    -> Index 'Hardened 'AccountK
    -> Property

                      
import Cardano.Crypto.Wallet
    ( XPub, unXPrv )
+
import Cardano.Wallet.Gen
+
    ( genMnemonic )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , DerivationType (..)
    , PassphraseMinLength (..)
    , PersistPrivateKey (..)
    , PersistPublicKey (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , XPrv
    , checkPassphrase
                \aster/specifications/mnemonic/english.txt"

                      
        it "early error reported first (Invalid Entropy)" $ do
-
            let res = fromMnemonic @'[15,18,21] @"testing"
+
            let res = fromMnemonic @'[15,18,21]
                        [ "glimpse", "paper", "toward", "fine", "alert"
                        , "baby", "pyramid", "alone", "shaft", "force"
                        , "circle", "fancy", "squeeze", "cannon", "toilet"
                \please double-check the last word of your mnemonic sentence.")

                      
        it "early error reported first (Non-English Word)" $ do
-
            let res = fromMnemonic @'[15,18,21] @"testing"
+
            let res = fromMnemonic @'[15,18,21]
                        [ "baguette", "paper", "toward", "fine", "alert"
                        , "baby", "pyramid", "alone", "shaft", "force"
                        , "circle", "fancy", "squeeze", "cannon", "toilet"
                        ]
            res `shouldBe` Left (FromMnemonicError (noInDictErr "baguette"))

                      
        it "early error reported first (Wrong number of words - 1)" $ do
-
            let res = fromMnemonic @'[15,18,21] @"testing"
+
            let res = fromMnemonic @'[15,18,21]
                        ["mom", "unveil", "slim", "abandon"
                        , "nut", "cash", "laugh", "impact"
                        , "system", "split", "depth", "sun"
                \15, 18 or 21 words are expected.")

                      
        it "early error reported first (Wrong number of words - 2)" $ do
-
            let res = fromMnemonic @'[15] @"testing"
+
            let res = fromMnemonic @'[15]
                        ["mom", "unveil", "slim", "abandon"
                        , "nut", "cash", "laugh", "impact"
                        , "system", "split", "depth", "sun"
                \15 words are expected.")

                      
        it "early error reported first (Error not in first constructor)" $ do
-
            let res = fromMnemonic @'[15,18,21,24] @"testing"
+
            let res = fromMnemonic @'[15,18,21,24]
                        ["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵"
                        ,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻"
                        ]
            res `shouldBe` Left (FromMnemonicError (noInDictErr "盗"))

                      
        it "early error reported first (Error not in first constructor)" $ do
-
            let res = fromMnemonic @'[12,15,18] @"testing"
+
            let res = fromMnemonic @'[12,15,18]
                        ["盗", "精", "序", "郎", "赋", "姿", "委", "善", "酵"
                        ,"祥", "赛", "矩", "蜡", "注", "韦", "效", "义", "冻"
                        ]
            res `shouldBe` Left (FromMnemonicError (noInDictErr "盗"))

                      
        it "successfully parse 15 words in [15,18,21]" $ do
-
            let res = fromMnemonic @'[15,18,21] @"testing"
+
            let res = fromMnemonic @'[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 = fromMnemonic @'[12,15,18] @"testing"
+
            let res = fromMnemonic @'[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 = fromMnemonic @'[9,12,15] @"testing"
+
            let res = fromMnemonic @'[9,12,15]
                        ["cushion", "anxiety", "oval", "village", "choose"
                        , "shoot", "over", "behave", "category", "cruise"
                        , "track", "either", "maid", "organ", "sock"
genRootKeysSeq :: Gen (ShelleyKey depth XPrv)
genRootKeysSeq = do
    (s, g, e) <- (,,)
-
        <$> genPassphrase @"seed" (16, 32)
-
        <*> genPassphrase @"generation" (0, 16)
+
        <$> (SomeMnemonic <$> genMnemonic @15)
+
        <*> (Just . SomeMnemonic <$> genMnemonic @12)
        <*> genPassphrase @"encryption" (0, 16)
    return $ Seq.unsafeGenerateKeyFromSeed (s, g) e

                      
genRootKeysRnd :: Gen (ByronKey 'RootK XPrv)
genRootKeysRnd = Rnd.generateKeyFromSeed
-
    <$> genPassphrase @"seed" (16, 32)
+
    <$> (SomeMnemonic <$> genMnemonic @12)
    <*> genPassphrase @"encryption" (0, 16)

                      
genRootKeysIca :: Gen (IcarusKey depth XPrv)
genRootKeysIca = Ica.unsafeGenerateKeyFromSeed
-
    <$> genPassphrase @"seed" (16, 32)
+
    <$> (SomeMnemonic <$> genMnemonic @15)
    <*> genPassphrase @"encryption" (0, 16)

                      
genPassphrase :: (Int, Int) -> Gen (Passphrase purpose)
    addrPayload <- BS.pack <$> vectorOf n arbitrary
    let crc = BS.pack [26,1,2,3,4]
    return $ Address (prefix <> addrPayload <> crc)
+

                      
+
instance Arbitrary SomeMnemonic where
+
    arbitrary = SomeMnemonic <$> genMnemonic @12

                      
import Prelude

                      
+
import Cardano.Wallet.Gen
+
    ( genMnemonic )
import Cardano.Wallet.Primitive.AddressDerivation
    ( Depth (..)
    , DerivationType (..)
+
    , FromMnemonic (..)
    , Index (..)
    , NetworkDiscriminant (..)
    , Passphrase (..)
    , PaymentAddress (..)
+
    , SomeMnemonic (..)
    , WalletKey (..)
    , XPrv
-
    , fromMnemonic
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( ByronKey (..)
    ( Base (..), convertFromBase )
import Data.ByteString
    ( ByteString )
-
import Data.Text
-
    ( Text )
import Data.Word
    ( Word32 )
import Test.Hspec
-------------------------------------------------------------------------------}

                      
data GoldenTest = GoldenTest
-
    { mnem :: [Text]
+
    { mnem :: SomeMnemonic
    , addr :: ByteString
    , accIndex :: Word32
    , addrIndex :: Word32
    , expected :: Bool
    } deriving (Show, Eq)

                      
-- An arbitrary mnemonic sentence for the tests
-
arbitraryMnemonic :: [Text]
-
arbitraryMnemonic =
+
arbitraryMnemonic :: SomeMnemonic
+
arbitraryMnemonic = either (error . show) id $ fromMnemonic @'[12]
    [ "price", "whip", "bottom", "execute", "resist", "library"
    , "entire", "purse", "assist", "clock", "still", "noble" ]

                      
        Just (addrXPrv, pwd)
        else Nothing

                      
-
rndStateFromMnem :: [Text] -> (ByronKey 'RootK XPrv, RndState 'Testnet)
-
rndStateFromMnem mnem = (rootXPrv, mkRndState @'Testnet rootXPrv 0)
+
rndStateFromMnem :: SomeMnemonic -> (ByronKey 'RootK XPrv, RndState 'Testnet)
+
rndStateFromMnem mnemonic = (rootXPrv, mkRndState @'Testnet rootXPrv 0)
  where
-
    rootXPrv = generateKeyFromSeed (Passphrase seed) (Passphrase "")
-
    Right (Passphrase seed) = fromMnemonic @'[12] mnem
+
    rootXPrv = generateKeyFromSeed mnemonic (Passphrase "")

                      
{-------------------------------------------------------------------------------
                               Properties
instance Arbitrary Rnd where
    shrink _ = []  -- no shrinking
    arbitrary = do
-
        s <- genPassphrase @"seed" (16, 32)
+
        s <- SomeMnemonic <$> genMnemonic @12
        e <- genPassphrase @"encryption" (0, 16)
        let key = generateKeyFromSeed s e
        pure $ Rnd (mkRndState key 0) key e
Diff too large – View on GitHub