{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Internal.Keys.Mnemonics
  ( MnemonicSize (..)
  , generateMnemonic
  , MnemonicToSigningKeyError (..)
  , signingKeyFromMnemonic
  , signingKeyFromMnemonicWithPaymentKeyIndex
  , findMnemonicWordsWithPrefix
  , autocompleteMnemonicPrefix
  )
where

import Cardano.Api.Internal.Error (Error (..))
import Cardano.Api.Internal.Keys.Class (Key (..))
import Cardano.Api.Internal.Keys.Shelley
  ( AsType
  , CommitteeColdExtendedKey
  , CommitteeHotExtendedKey
  , DRepExtendedKey
  , PaymentExtendedKey
  , SigningKey (..)
  , StakeExtendedKey
  )

import Cardano.Address.Derivation
  ( Depth (..)
  , DerivationType (..)
  , HardDerivation (..)
  , Index
  , XPrv
  , genMasterKeyFromMnemonic
  , indexFromWord32
  )
import Cardano.Address.Style.Shelley
  ( Role (..)
  , Shelley (..)
  , deriveCCColdPrivateKey
  , deriveCCHotPrivateKey
  , deriveDRepPrivateKey
  )
import Cardano.Crypto.Encoding.BIP39 (Dictionary (dictionaryIndexToWord))
import Cardano.Mnemonic
  ( MkSomeMnemonic (mkSomeMnemonic)
  , MkSomeMnemonicError (..)
  , SomeMnemonic
  , entropyToMnemonic
  , genEntropy
  , mnemonicToText
  )

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bifunctor (first)
import Data.ByteString qualified as BS
import Data.Either.Combinators (mapLeft, maybeToRight)
import Data.Either.Extra (maybeToEither)
import Data.Foldable (toList)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Trie (submap)
import Data.Trie qualified as Trie
import Data.Trie.Convenience qualified as Trie
import Data.Word (Word32)
import Prettyprinter (Doc, Pretty (..))

import Basement.Compat.IsList qualified as Basement
import Basement.String qualified as Basement
import Crypto.Encoding.BIP39.English (english)

-- | The size of a mnemonic sentence.
-- The size is given in the number of words in the sentence.
-- The allowed sizes are 12, 15, 18, 21, and 24.
data MnemonicSize
  = MS12
  | MS15
  | MS18
  | MS21
  | MS24
  deriving (MnemonicSize -> MnemonicSize -> Bool
(MnemonicSize -> MnemonicSize -> Bool)
-> (MnemonicSize -> MnemonicSize -> Bool) -> Eq MnemonicSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MnemonicSize -> MnemonicSize -> Bool
== :: MnemonicSize -> MnemonicSize -> Bool
$c/= :: MnemonicSize -> MnemonicSize -> Bool
/= :: MnemonicSize -> MnemonicSize -> Bool
Eq, Int -> MnemonicSize -> ShowS
[MnemonicSize] -> ShowS
MnemonicSize -> String
(Int -> MnemonicSize -> ShowS)
-> (MnemonicSize -> String)
-> ([MnemonicSize] -> ShowS)
-> Show MnemonicSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MnemonicSize -> ShowS
showsPrec :: Int -> MnemonicSize -> ShowS
$cshow :: MnemonicSize -> String
show :: MnemonicSize -> String
$cshowList :: [MnemonicSize] -> ShowS
showList :: [MnemonicSize] -> ShowS
Show)

-- | Generate a mnemonic sentence of the given size.
generateMnemonic
  :: MonadIO m
  => MnemonicSize
  -- ^ The size of the mnemonic sentence to generate.
  -- Must be one of 12, 15, 18, 21, or 24.
  -> m [Text]
generateMnemonic :: forall (m :: * -> *). MonadIO m => MnemonicSize -> m [Text]
generateMnemonic MnemonicSize
MS12 = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText @12 (Mnemonic 12 -> [Text])
-> (Entropy 128 -> Mnemonic 12) -> Entropy 128 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy 128 -> Mnemonic 12
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic (Entropy 128 -> [Text]) -> IO (Entropy 128) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Entropy 128)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
IO (Entropy ent)
genEntropy)
generateMnemonic MnemonicSize
MS15 = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText @15 (Mnemonic 15 -> [Text])
-> (Entropy 160 -> Mnemonic 15) -> Entropy 160 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy 160 -> Mnemonic 15
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic (Entropy 160 -> [Text]) -> IO (Entropy 160) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Entropy 160)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
IO (Entropy ent)
genEntropy)
generateMnemonic MnemonicSize
MS18 = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText @18 (Mnemonic 18 -> [Text])
-> (Entropy 192 -> Mnemonic 18) -> Entropy 192 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy 192 -> Mnemonic 18
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic (Entropy 192 -> [Text]) -> IO (Entropy 192) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Entropy 192)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
IO (Entropy ent)
genEntropy)
generateMnemonic MnemonicSize
MS21 = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText @21 (Mnemonic 21 -> [Text])
-> (Entropy 224 -> Mnemonic 21) -> Entropy 224 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy 224 -> Mnemonic 21
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic (Entropy 224 -> [Text]) -> IO (Entropy 224) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Entropy 224)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
IO (Entropy ent)
genEntropy)
generateMnemonic MnemonicSize
MS24 = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (mw :: Nat). Mnemonic mw -> [Text]
mnemonicToText @24 (Mnemonic 24 -> [Text])
-> (Entropy 256 -> Mnemonic 24) -> Entropy 256 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy 256 -> Mnemonic 24
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ValidMnemonicSentence mw, ValidEntropySize ent,
 ValidChecksumSize ent csz, ent ~ EntropySize mw,
 mw ~ MnemonicWords ent) =>
Entropy ent -> Mnemonic mw
entropyToMnemonic (Entropy 256 -> [Text]) -> IO (Entropy 256) -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Entropy 256)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
IO (Entropy ent)
genEntropy)

-- | Errors that can occur when converting a mnemonic sentence to a signing key
data MnemonicToSigningKeyError
  = InvalidMnemonicError String
  | InvalidAccountNumberError Word32
  | InvalidPaymentKeyNoError Word32
  deriving (MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool
(MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool)
-> (MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool)
-> Eq MnemonicToSigningKeyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool
== :: MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool
$c/= :: MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool
/= :: MnemonicToSigningKeyError -> MnemonicToSigningKeyError -> Bool
Eq, Int -> MnemonicToSigningKeyError -> ShowS
[MnemonicToSigningKeyError] -> ShowS
MnemonicToSigningKeyError -> String
(Int -> MnemonicToSigningKeyError -> ShowS)
-> (MnemonicToSigningKeyError -> String)
-> ([MnemonicToSigningKeyError] -> ShowS)
-> Show MnemonicToSigningKeyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MnemonicToSigningKeyError -> ShowS
showsPrec :: Int -> MnemonicToSigningKeyError -> ShowS
$cshow :: MnemonicToSigningKeyError -> String
show :: MnemonicToSigningKeyError -> String
$cshowList :: [MnemonicToSigningKeyError] -> ShowS
showList :: [MnemonicToSigningKeyError] -> ShowS
Show)

-- For information about address derivation check:
--  * https://cips.cardano.org/cip/CIP-1852
--  * https://github.com/uniVocity/cardano-tutorials/blob/master/cardano-addresses.md#understanding-the-hd-wallet-address-format-bip-44
--  * https://cips.cardano.org/cip/CIP-0105
instance Error MnemonicToSigningKeyError where
  prettyError :: MnemonicToSigningKeyError -> Doc ann
  prettyError :: forall ann. MnemonicToSigningKeyError -> Doc ann
prettyError (InvalidMnemonicError String
str) = Doc ann
"Invalid mnemonic sentence: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
str
  prettyError (InvalidAccountNumberError Word32
accNo) = Doc ann
"Invalid account number: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word32 -> Doc ann
forall ann. Word32 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word32
accNo
  prettyError (InvalidPaymentKeyNoError Word32
keyNo) = Doc ann
"Invalid payment key number: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word32 -> Doc ann
forall ann. Word32 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word32
keyNo

-- | Key roles that can be derived from a mnemonic sentence and only accept
-- one key per account number.
--
-- We derive one key per account following the advice in https://cips.cardano.org/cip/CIP-0105:
-- "Since it is best practice to use a single cryptographic key for a single purpose,
-- we opt to keep DRep and committee keys separate from other keys in Cardano."
--
-- We still need to specify a payment key number for payment and stake keys,
-- see 'IndexedSigningKeyFromRootKey' class for those roles (payment and stake keys).
class SigningKeyFromRootKey keyrole where
  -- | Derive an extended private key of the keyrole from an account extended private key
  deriveSigningKeyFromAccount
    :: AsType keyrole
    -- ^ Type of the extended signing key to generate.
    -> Shelley 'AccountK XPrv
    -- ^ The account extended private key from which to derivate the private key for the keyrole.
    -> SigningKey keyrole
    -- ^ The derived extended signing key or the 'indexType' if it is 'Word32' and it is invalid.

-- | Key roles that can be derived from a mnemonic sentence and accept multiple keys
-- per account number. For other key roles (DRep, and committee keys), see 'SigningKeyFromRootKey'.
class IndexedSigningKeyFromRootKey keyrole where
  -- | Derive an extended private key of the keyrole from an account extended private key
  deriveSigningKeyFromAccountWithPaymentKeyIndex
    :: AsType keyrole
    -- ^ Type of the extended signing key to generate.
    -> Shelley 'AccountK XPrv
    -- ^ The account extended private key from which to derivate the private key for the keyrole.
    -> Word32
    -- ^ The payment key number in the derivation path.
    -> Either Word32 (SigningKey keyrole)
    -- ^ The derived extended signing key or the 'indexType' if it is invalid.

instance IndexedSigningKeyFromRootKey PaymentExtendedKey where
  deriveSigningKeyFromAccountWithPaymentKeyIndex
    :: AsType PaymentExtendedKey
    -> Shelley 'AccountK XPrv
    -> Word32
    -> Either Word32 (SigningKey PaymentExtendedKey)
  deriveSigningKeyFromAccountWithPaymentKeyIndex :: AsType PaymentExtendedKey
-> Shelley 'AccountK XPrv
-> Word32
-> Either Word32 (SigningKey PaymentExtendedKey)
deriveSigningKeyFromAccountWithPaymentKeyIndex AsType PaymentExtendedKey
_ Shelley 'AccountK XPrv
accK Word32
idx = do
    Index 'Soft 'PaymentK
payKeyIx <- Word32
-> Maybe (Index 'Soft 'PaymentK)
-> Either Word32 (Index 'Soft 'PaymentK)
forall a b. a -> Maybe b -> Either a b
maybeToEither Word32
idx (Maybe (Index 'Soft 'PaymentK)
 -> Either Word32 (Index 'Soft 'PaymentK))
-> Maybe (Index 'Soft 'PaymentK)
-> Either Word32 (Index 'Soft 'PaymentK)
forall a b. (a -> b) -> a -> b
$ forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Soft 'PaymentK) Word32
idx
    SigningKey PaymentExtendedKey
-> Either Word32 (SigningKey PaymentExtendedKey)
forall a. a -> Either Word32 a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey PaymentExtendedKey
 -> Either Word32 (SigningKey PaymentExtendedKey))
-> SigningKey PaymentExtendedKey
-> Either Word32 (SigningKey PaymentExtendedKey)
forall a b. (a -> b) -> a -> b
$ XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey (XPrv -> SigningKey PaymentExtendedKey)
-> XPrv -> SigningKey PaymentExtendedKey
forall a b. (a -> b) -> a -> b
$ Shelley 'PaymentK XPrv -> XPrv
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'PaymentK XPrv -> XPrv) -> Shelley 'PaymentK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv
-> WithRole Shelley
-> Index (AddressIndexDerivationType Shelley) 'PaymentK
-> Shelley 'PaymentK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'AccountK XPrv
-> WithRole key
-> Index (AddressIndexDerivationType key) 'PaymentK
-> key 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accK WithRole Shelley
Role
UTxOExternal Index 'Soft 'PaymentK
Index (AddressIndexDerivationType Shelley) 'PaymentK
payKeyIx

instance IndexedSigningKeyFromRootKey StakeExtendedKey where
  deriveSigningKeyFromAccountWithPaymentKeyIndex
    :: AsType StakeExtendedKey
    -> Shelley 'AccountK XPrv
    -> Word32
    -> Either Word32 (SigningKey StakeExtendedKey)
  deriveSigningKeyFromAccountWithPaymentKeyIndex :: AsType StakeExtendedKey
-> Shelley 'AccountK XPrv
-> Word32
-> Either Word32 (SigningKey StakeExtendedKey)
deriveSigningKeyFromAccountWithPaymentKeyIndex AsType StakeExtendedKey
_ Shelley 'AccountK XPrv
accK Word32
idx = do
    Index 'Soft 'PaymentK
payKeyIx <- Word32
-> Maybe (Index 'Soft 'PaymentK)
-> Either Word32 (Index 'Soft 'PaymentK)
forall a b. a -> Maybe b -> Either a b
maybeToEither Word32
idx (Maybe (Index 'Soft 'PaymentK)
 -> Either Word32 (Index 'Soft 'PaymentK))
-> Maybe (Index 'Soft 'PaymentK)
-> Either Word32 (Index 'Soft 'PaymentK)
forall a b. (a -> b) -> a -> b
$ forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Soft 'PaymentK) Word32
idx
    SigningKey StakeExtendedKey
-> Either Word32 (SigningKey StakeExtendedKey)
forall a. a -> Either Word32 a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey StakeExtendedKey
 -> Either Word32 (SigningKey StakeExtendedKey))
-> SigningKey StakeExtendedKey
-> Either Word32 (SigningKey StakeExtendedKey)
forall a b. (a -> b) -> a -> b
$ XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey (XPrv -> SigningKey StakeExtendedKey)
-> XPrv -> SigningKey StakeExtendedKey
forall a b. (a -> b) -> a -> b
$ Shelley 'PaymentK XPrv -> XPrv
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'PaymentK XPrv -> XPrv) -> Shelley 'PaymentK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv
-> WithRole Shelley
-> Index (AddressIndexDerivationType Shelley) 'PaymentK
-> Shelley 'PaymentK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'AccountK XPrv
-> WithRole key
-> Index (AddressIndexDerivationType key) 'PaymentK
-> key 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accK WithRole Shelley
Role
Stake Index 'Soft 'PaymentK
Index (AddressIndexDerivationType Shelley) 'PaymentK
payKeyIx

instance SigningKeyFromRootKey DRepExtendedKey where
  deriveSigningKeyFromAccount
    :: AsType DRepExtendedKey
    -> Shelley 'AccountK XPrv
    -> SigningKey DRepExtendedKey
  deriveSigningKeyFromAccount :: AsType DRepExtendedKey
-> Shelley 'AccountK XPrv -> SigningKey DRepExtendedKey
deriveSigningKeyFromAccount AsType DRepExtendedKey
_ Shelley 'AccountK XPrv
accK =
    XPrv -> SigningKey DRepExtendedKey
DRepExtendedSigningKey (XPrv -> SigningKey DRepExtendedKey)
-> XPrv -> SigningKey DRepExtendedKey
forall a b. (a -> b) -> a -> b
$ Shelley 'DRepK XPrv -> XPrv
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'DRepK XPrv -> XPrv) -> Shelley 'DRepK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv -> Shelley 'DRepK XPrv
deriveDRepPrivateKey Shelley 'AccountK XPrv
accK

instance SigningKeyFromRootKey CommitteeColdExtendedKey where
  deriveSigningKeyFromAccount
    :: AsType CommitteeColdExtendedKey
    -> Shelley 'AccountK XPrv
    -> SigningKey CommitteeColdExtendedKey
  deriveSigningKeyFromAccount :: AsType CommitteeColdExtendedKey
-> Shelley 'AccountK XPrv -> SigningKey CommitteeColdExtendedKey
deriveSigningKeyFromAccount AsType CommitteeColdExtendedKey
_ Shelley 'AccountK XPrv
accK =
    XPrv -> SigningKey CommitteeColdExtendedKey
CommitteeColdExtendedSigningKey (XPrv -> SigningKey CommitteeColdExtendedKey)
-> XPrv -> SigningKey CommitteeColdExtendedKey
forall a b. (a -> b) -> a -> b
$ Shelley 'CCColdK XPrv -> XPrv
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'CCColdK XPrv -> XPrv) -> Shelley 'CCColdK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv -> Shelley 'CCColdK XPrv
deriveCCColdPrivateKey Shelley 'AccountK XPrv
accK

instance SigningKeyFromRootKey CommitteeHotExtendedKey where
  deriveSigningKeyFromAccount
    :: AsType CommitteeHotExtendedKey
    -> Shelley 'AccountK XPrv
    -> SigningKey CommitteeHotExtendedKey
  deriveSigningKeyFromAccount :: AsType CommitteeHotExtendedKey
-> Shelley 'AccountK XPrv -> SigningKey CommitteeHotExtendedKey
deriveSigningKeyFromAccount AsType CommitteeHotExtendedKey
_ Shelley 'AccountK XPrv
accK =
    XPrv -> SigningKey CommitteeHotExtendedKey
CommitteeHotExtendedSigningKey (XPrv -> SigningKey CommitteeHotExtendedKey)
-> XPrv -> SigningKey CommitteeHotExtendedKey
forall a b. (a -> b) -> a -> b
$ Shelley 'CCHotK XPrv -> XPrv
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'CCHotK XPrv -> XPrv) -> Shelley 'CCHotK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv -> Shelley 'CCHotK XPrv
deriveCCHotPrivateKey Shelley 'AccountK XPrv
accK

-- | Generate a signing key from a mnemonic sentence given a function that
-- derives a key from an account extended key.
signingKeyFromMnemonicWithDerivationFunction
  :: (Shelley AccountK XPrv -> Either Word32 (SigningKey keyrole))
  -- ^ Function to derive the signing key from the account key.
  -> [Text]
  -- ^ The mnemonic sentence. The length must be one of 12, 15, 18, 21, or 24.
  -- Each element of the list must be a single word.
  -> Word32
  -- ^ The account number in the derivation path. First account is 0.
  -> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithDerivationFunction :: forall keyrole.
(Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole))
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithDerivationFunction Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole)
derivationFunction [Text]
mnemonicWords Word32
accNo = do
  -- Convert raw types to the ones used in the cardano-addresses library
  SomeMnemonic
someMnemonic <- (String -> MnemonicToSigningKeyError)
-> Either String SomeMnemonic
-> Either MnemonicToSigningKeyError SomeMnemonic
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> MnemonicToSigningKeyError
InvalidMnemonicError (Either String SomeMnemonic
 -> Either MnemonicToSigningKeyError SomeMnemonic)
-> Either String SomeMnemonic
-> Either MnemonicToSigningKeyError SomeMnemonic
forall a b. (a -> b) -> a -> b
$ [Text] -> Either String SomeMnemonic
wordsToSomeMnemonic [Text]
mnemonicWords
  Index 'Hardened 'AccountK
accIx <-
    MnemonicToSigningKeyError
-> Maybe (Index 'Hardened 'AccountK)
-> Either MnemonicToSigningKeyError (Index 'Hardened 'AccountK)
forall a b. a -> Maybe b -> Either a b
maybeToRight (Word32 -> MnemonicToSigningKeyError
InvalidAccountNumberError Word32
accNo) (Maybe (Index 'Hardened 'AccountK)
 -> Either MnemonicToSigningKeyError (Index 'Hardened 'AccountK))
-> Maybe (Index 'Hardened 'AccountK)
-> Either MnemonicToSigningKeyError (Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$
      forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Hardened 'AccountK) (Word32
0x80000000 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
accNo)

  -- Derive the rootk key
  let rootK :: Shelley 'RootK XPrv
rootK = SomeMnemonic -> SecondFactor Shelley -> Shelley 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
SomeMnemonic -> SecondFactor key -> key 'RootK XPrv
genMasterKeyFromMnemonic SomeMnemonic
someMnemonic ScrubbedBytes
SecondFactor Shelley
forall a. Monoid a => a
mempty :: Shelley 'RootK XPrv
      -- Derive the account key
      accK :: Shelley 'AccountK XPrv
accK = Shelley 'RootK XPrv
-> Index (AccountIndexDerivationType Shelley) 'AccountK
-> Shelley 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'RootK XPrv
-> Index (AccountIndexDerivationType key) 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Shelley 'RootK XPrv
rootK Index 'Hardened 'AccountK
Index (AccountIndexDerivationType Shelley) 'AccountK
accIx

  -- Derive the extended private key
  (Word32 -> MnemonicToSigningKeyError)
-> Either Word32 (SigningKey keyrole)
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Word32 -> MnemonicToSigningKeyError
InvalidPaymentKeyNoError (Either Word32 (SigningKey keyrole)
 -> Either MnemonicToSigningKeyError (SigningKey keyrole))
-> Either Word32 (SigningKey keyrole)
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
forall a b. (a -> b) -> a -> b
$ Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole)
derivationFunction Shelley 'AccountK XPrv
accK
 where
  wordsToSomeMnemonic :: [Text] -> Either String SomeMnemonic
  wordsToSomeMnemonic :: [Text] -> Either String SomeMnemonic
wordsToSomeMnemonic = (MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String)
-> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
-> Either String SomeMnemonic
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft MkSomeMnemonicError '[12, 15, 18, 21, 24] -> String
forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
getMkSomeMnemonicError (Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic
 -> Either String SomeMnemonic)
-> ([Text]
    -> Either (MkSomeMnemonicError '[12, 15, 18, 21, 24]) SomeMnemonic)
-> [Text]
-> Either String SomeMnemonic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @[12, 15, 18, 21, 24]

-- | Generate a signing key from a mnemonic sentence for a key role that
-- accepts several payment keys from an account number (extended payment and stake keys).
-- For other key roles (DRep and committee keys), see 'signingKeyFromMnemonic'.
--
-- A derivation path is like a file path in a file system. It specifies the
-- location of a key in the key tree. The path is a list of indices, one for each
-- level of the tree. The indices are separated by a forward slash (/).
-- In this function, we only ask for two indices: the account number and the
-- payment key number. Each account can have multiple payment keys.
--
-- For more information about address derivation, check:
--  * https://cips.cardano.org/cip/CIP-1852
--  * https://github.com/uniVocity/cardano-tutorials/blob/master/cardano-addresses.md#understanding-the-hd-wallet-address-format-bip-44
--  * https://cips.cardano.org/cip/CIP-0105
signingKeyFromMnemonicWithPaymentKeyIndex
  :: IndexedSigningKeyFromRootKey keyrole
  => AsType keyrole
  -- ^ Type of the extended signing key to generate.
  -> [Text]
  -- ^ The mnemonic sentence. The length must be one of 12, 15, 18, 21, or 24.
  -- Each element of the list must be a single word.
  -> Word32
  -- ^ The account number in the derivation path. The first account is 0.
  -> Word32
  -- ^ The payment key number in the derivation path.
  --
  -- Consider that wallets following the BIP-44 standard only check 20 addresses
  -- without transactions before giving up. For example, if you have a fresh wallet
  -- and receive a payment on the address generated with address_index = 6, your
  -- wallet may only display the money received on addresses from 0 to 26.
  -- If you receive payment on an address with address_index = 30, the funds may not
  -- be displayed to you even though it's on the blockchain. It will only appear
  -- once there is a transaction in some address where address_index is between 10
  -- and 29. The gap limit can be customized on some wallets, but increasing it
  -- reduces synchronization performance.
  -> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithPaymentKeyIndex :: forall keyrole.
IndexedSigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithPaymentKeyIndex AsType keyrole
keyRole [Text]
mnemonicWords Word32
accNo Word32
payKeyNo = do
  (Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole))
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
forall keyrole.
(Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole))
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithDerivationFunction
    (\Shelley 'AccountK XPrv
accK -> AsType keyrole
-> Shelley 'AccountK XPrv
-> Word32
-> Either Word32 (SigningKey keyrole)
forall keyrole.
IndexedSigningKeyFromRootKey keyrole =>
AsType keyrole
-> Shelley 'AccountK XPrv
-> Word32
-> Either Word32 (SigningKey keyrole)
deriveSigningKeyFromAccountWithPaymentKeyIndex AsType keyrole
keyRole Shelley 'AccountK XPrv
accK Word32
payKeyNo)
    [Text]
mnemonicWords
    Word32
accNo

-- | Generate a signing key from a mnemonic sentence for a key role that
-- accepts only one payment key from an account number (DRep and committee keys).
-- For other key roles (extended payment and stake keys), see 'signingKeyFromMnemonicWithPaymentKeyIndex'.
--
-- We derive one key per account following the advice in https://cips.cardano.org/cip/CIP-0105:
-- "Since it is best practice to use a single cryptographic key for a single purpose,
-- we opt to keep DRep and committee keys separate from other keys in Cardano."
--
-- A derivation path is like a file path in a file system. It specifies the
-- location of a key in the key tree. The path is a list of indices, one for each
-- level of the tree. The indices are separated by a forward slash (/).
-- In this function we only ask for one index: the account number.
--
-- For more information about address derivation check:
--  * https://cips.cardano.org/cip/CIP-1852
--  * https://github.com/uniVocity/cardano-tutorials/blob/master/cardano-addresses.md#understanding-the-hd-wallet-address-format-bip-44
--  * https://cips.cardano.org/cip/CIP-0105
signingKeyFromMnemonic
  :: SigningKeyFromRootKey keyrole
  => AsType keyrole
  -- ^ Type of the extended signing key to generate.
  -> [Text]
  -- ^ The mnemonic sentence. The length must be one of 12, 15, 18, 21, or 24.
  -- Each element of the list must be a single word.
  -> Word32
  -- ^ The account number in the derivation path. First account is 0.
  -> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonic :: forall keyrole.
SigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonic AsType keyrole
keyRole [Text]
mnemonicWords Word32
accNo = do
  (Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole))
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
forall keyrole.
(Shelley 'AccountK XPrv -> Either Word32 (SigningKey keyrole))
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithDerivationFunction
    (SigningKey keyrole -> Either Word32 (SigningKey keyrole)
forall a. a -> Either Word32 a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey keyrole -> Either Word32 (SigningKey keyrole))
-> (Shelley 'AccountK XPrv -> SigningKey keyrole)
-> Shelley 'AccountK XPrv
-> Either Word32 (SigningKey keyrole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType keyrole -> Shelley 'AccountK XPrv -> SigningKey keyrole
forall keyrole.
SigningKeyFromRootKey keyrole =>
AsType keyrole -> Shelley 'AccountK XPrv -> SigningKey keyrole
deriveSigningKeyFromAccount AsType keyrole
keyRole)
    [Text]
mnemonicWords
    Word32
accNo

-- | Obtain the list of all mnemonic words that start with the given prefix and their index in the dictionary.
-- For example:
-- >>> findMnemonicWordsWithPrefix "cha"
-- [("chair",302),("chalk",303),("champion",304),("change",305),("chaos",306),("chapter",307),("charge",308),("chase",309),("chat",310)]
findMnemonicWordsWithPrefix :: Text -> [(Text, Int)]
findMnemonicWordsWithPrefix :: Text -> [(Text, Int)]
findMnemonicWordsWithPrefix Text
word = [(Text, Int)] -> [(Text, Int)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([(Text, Int)] -> [(Text, Int)]) -> [(Text, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ ((ByteString, Int) -> (Text, Int))
-> [(ByteString, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Text) -> (ByteString, Int) -> (Text, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Text
decodeUtf8) ([(ByteString, Int)] -> [(Text, Int)])
-> [(ByteString, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ Trie Int -> [(ByteString, Int)]
forall a. Trie a -> [(ByteString, a)]
Trie.toList Trie Int
matchingSubTrie
 where
  matchingSubTrie :: Trie.Trie Int
  matchingSubTrie :: Trie Int
matchingSubTrie = ByteString -> Trie Int -> Trie Int
forall a. ByteString -> Trie a -> Trie a
submap (Text -> ByteString
encodeUtf8 Text
word) Trie Int
englishMnemonicTrie

-- | Autocomplete the prefix of the mnemonic word as much as possible.
-- In other words, find the longest common prefix for all the words
-- that start with the given prefix.
-- For example:
-- >>> autocompleteMnemonicPrefix "ty"
-- Just "typ"
--
-- Because "type" and "typical" are the only words that start with "ty".
--
-- >>> autocompleteMnemonicPrefix "vani"
-- Just "vanish"
--
-- Because "vanish" is the only word that starts with "vani".
--
-- >>> autocompleteMnemonicPrefix "medo"
-- Nothing
--
-- Because there are no words that start with "medo".
autocompleteMnemonicPrefix :: Text -> Maybe Text
autocompleteMnemonicPrefix :: Text -> Maybe Text
autocompleteMnemonicPrefix Text
word =
  let subtrie :: Trie Int
subtrie = Text -> Trie Int -> Trie Int
matchingSubTrie Text
word Trie Int
englishMnemonicTrie
      matches :: [(Text, Int)]
matches = [(Text, Int)] -> [(Text, Int)]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([(Text, Int)] -> [(Text, Int)]) -> [(Text, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ ((ByteString, Int) -> (Text, Int))
-> [(ByteString, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Text) -> (ByteString, Int) -> (Text, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Text
decodeUtf8) ([(ByteString, Int)] -> [(Text, Int)])
-> [(ByteString, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$ Trie Int -> [(ByteString, Int)]
forall a. Trie a -> [(ByteString, a)]
Trie.toList Trie Int
subtrie
      numMatches :: Int
numMatches = Trie Int -> Int
forall a. Trie a -> Int
Trie.size Trie Int
subtrie
   in case [(Text, Int)]
matches of
        [] -> Maybe Text
forall a. Maybe a
Nothing
        (Text
firstMatch, Int
_) : [(Text, Int)]
_ -> Int -> Text -> Text -> Trie Int -> Maybe Text
expandWhileSameNumberOfMatches Int
numMatches Text
word (Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
word) Text
firstMatch) Trie Int
subtrie
 where
  matchingSubTrie :: Text -> Trie.Trie Int -> Trie.Trie Int
  matchingSubTrie :: Text -> Trie Int -> Trie Int
matchingSubTrie Text
w = ByteString -> Trie Int -> Trie Int
forall a. ByteString -> Trie a -> Trie a
submap (Text -> ByteString
encodeUtf8 Text
w)

  expandWhileSameNumberOfMatches :: Int -> Text -> Text -> Trie.Trie Int -> Maybe Text
  expandWhileSameNumberOfMatches :: Int -> Text -> Text -> Trie Int -> Maybe Text
expandWhileSameNumberOfMatches Int
numMatches Text
curPrefix Text
potentialExtensions Trie Int
subTrie =
    case Text -> Maybe (Char, Text)
Text.uncons Text
potentialExtensions of
      Maybe (Char, Text)
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
curPrefix
      Just (Char
newChar, Text
remainingPotentialExtensions) ->
        let potentialNewPrefix :: Text
potentialNewPrefix = Text -> Char -> Text
Text.snoc Text
curPrefix Char
newChar
            newSubTrie :: Trie Int
newSubTrie = Text -> Trie Int -> Trie Int
matchingSubTrie Text
potentialNewPrefix Trie Int
subTrie
         in if Trie Int -> Int
forall a. Trie a -> Int
Trie.size Trie Int
newSubTrie Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numMatches
              then
                Int -> Text -> Text -> Trie Int -> Maybe Text
expandWhileSameNumberOfMatches Int
numMatches Text
potentialNewPrefix Text
remainingPotentialExtensions Trie Int
newSubTrie
              else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
curPrefix

-- | Trie of English mnemonic words with their index.
englishMnemonicTrie :: Trie.Trie Int
englishMnemonicTrie :: Trie Int
englishMnemonicTrie =
  [(ByteString, Int)] -> Trie Int
forall a. [(ByteString, a)] -> Trie a
Trie.fromListL
    ( (WordIndex -> (ByteString, Int))
-> [WordIndex] -> [(ByteString, Int)]
forall a b. (a -> b) -> [a] -> [b]
map
        ( \WordIndex
i ->
            (,WordIndex -> Int
forall a. Enum a => a -> Int
fromEnum WordIndex
i) (ByteString -> (ByteString, Int))
-> ByteString -> (ByteString, Int)
forall a b. (a -> b) -> a -> b
$
              [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UArray Word8 -> [Word8]
UArray Word8 -> [Item (UArray Word8)]
forall l. IsList l => l -> [Item l]
Basement.toList (UArray Word8 -> [Word8])
-> (String -> UArray Word8) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> String -> UArray Word8
Basement.toBytes Encoding
Basement.UTF8 (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
                Dictionary -> WordIndex -> String
dictionaryIndexToWord Dictionary
english WordIndex
i
        )
        [WordIndex
forall a. Bounded a => a
minBound .. WordIndex
forall a. Bounded a => a
maxBound]
    )