{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK prune #-}

module Cardano.Mnemonic
    (
      -- * Introduction
      -- $introduction

      -- * @SomeMnemonic@
      SomeMnemonic(..)
    , MkSomeMnemonic (..)
    , MkSomeMnemonicError(..)
    , someMnemonicToBytes
    , NatVals (..)

      -- * @Mnemonic@
    , Mnemonic
    , mkMnemonic
    , MkMnemonicError(..)
    , mnemonicToText
    , mnemonicToEntropy

      -- * @Entropy@
    , Entropy
    , genEntropy
    , mkEntropy
    , entropyToBytes
    , entropyToMnemonic

      -- Internals & Re-export from @Crypto.Encoding.BIP39@
    , EntropyError(..)
    , DictionaryError(..)
    , MnemonicWordsError(..)
    , ValidEntropySize
    , ValidChecksumSize
    , ValidMnemonicSentence
    , ConsistentEntropy
    , CheckSumBits
    , EntropySize
    , MnemonicWords
    , MnemonicException(..)

      -- * Troubleshooting
      -- $troubleshooting
    ) where

import Prelude

import Basement.NormalForm
    ( NormalForm (..) )
import Basement.Sized.List
    ( unListN )
import Control.Arrow
    ( left )
import Control.DeepSeq
    ( NFData (..) )
import Control.Monad.Catch
    ( throwM )
import Crypto.Encoding.BIP39
    ( CheckSumBits
    , ConsistentEntropy
    , DictionaryError (..)
    , Entropy
    , EntropyError (..)
    , EntropySize
    , MnemonicSentence
    , MnemonicWords
    , MnemonicWordsError (..)
    , ValidChecksumSize
    , ValidEntropySize
    , ValidMnemonicSentence
    , dictionaryIndexToWord
    , entropyRaw
    , entropyToWords
    , mnemonicPhrase
    , mnemonicPhraseToMnemonicSentence
    , mnemonicSentenceToListN
    , toEntropy
    , wordsToEntropy
    )
import Data.Bifunctor
    ( bimap )
import Data.ByteArray
    ( ScrubbedBytes )
import Data.List
    ( intercalate )
import Data.Proxy
    ( Proxy (..) )
import Data.Text
    ( Text )
import Data.Type.Equality
    ( (:~:) (..), testEquality )
import Data.Typeable
    ( Typeable )
import GHC.TypeLits
    ( KnownNat, Nat, natVal )
import Type.Reflection
    ( typeOf )

import qualified Basement.Compat.Base as Basement
import qualified Basement.String as Basement
import qualified Crypto.Encoding.BIP39.English as Dictionary
import qualified Crypto.Random.Entropy as Crypto
import qualified Data.ByteArray as BA
import qualified Data.Text as T


-- $introduction
--
-- We call 'Entropy' an arbitrary sequence of bytes that has been generated through __high quality randomness methods__.
-- The allowed size of an 'Entropy' is @96-256@ bits and is __necessarily a multiple of 32 bits__ (4 bytes).
--
-- We call 'Mnemonic' an 'Entropy' with an appended checksum calculated by taking the first @ent / 32@ bits of the /SHA256/ hash of it,
-- where ent designates the 'Entropy' size in bits.
--
-- The concatenated result is split into groups of @11@ bits, each encoding a number from 0 to 2047 serving as an index into a [known dictionary](https://github.com/input-output-hk/cardano-wallet/tree/master/specifications/mnemonic/english.txt).
-- This makes for a __human-readable sentence__ of English words.
--
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | Entropy Size        | Checksum Size | Sentence Length | Example                                                                                                                                         |
-- +=====================+===============+=================+=================================================================================================================================================+
-- | 96  bits (12 bytes) | 3 bits        | 9 words         | test child burst immense armed parrot company walk dog                                                                                          |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | 128 bits (16 bytes) | 4 bits        | 12 words        | test walk nut penalty hip pave soap entry language right filter choice                                                                          |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | 160 bits (20 bytes) | 5 bits        | 15 words        | art forum devote street sure rather head chuckle guard poverty release quote oak craft enemy                                                    |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | 192 bits (24 bytes) | 6 bits        | 18 words        | churn shaft spoon second erode useless thrive burst group seed element sign scrub buffalo jelly grace neck useless                              |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | 224 bits (28 bytes) | 7 bits        | 21 words        | draft ability female child jump maid roof hurt below live topple paper exclude ordinary coach churn sunset emerge blame ketchup much            |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+
-- | 256 bits (32 bytes) | 8 bits        | 24 words        | excess behave track soul table wear ocean cash stay nature item turtle palm soccer lunch horror start stumble month panic right must lock dress |
-- +---------------------+---------------+-----------------+-------------------------------------------------------------------------------------------------------------------------------------------------+

-- A opaque 'Mnemonic' type.
data Mnemonic (mw :: Nat) = Mnemonic
    { Mnemonic mw -> Entropy (EntropySize mw)
mnemonicToEntropy  :: Entropy (EntropySize mw)
        -- ^ Convert a 'Mnemonic' back to an 'Entropy'.
        --
        -- @since 1.0.0
    , Mnemonic mw -> MnemonicSentence mw
mnemonicToSentence :: MnemonicSentence mw
    } deriving stock (Mnemonic mw -> Mnemonic mw -> Bool
(Mnemonic mw -> Mnemonic mw -> Bool)
-> (Mnemonic mw -> Mnemonic mw -> Bool) -> Eq (Mnemonic mw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mw :: Nat). Mnemonic mw -> Mnemonic mw -> Bool
/= :: Mnemonic mw -> Mnemonic mw -> Bool
$c/= :: forall (mw :: Nat). Mnemonic mw -> Mnemonic mw -> Bool
== :: Mnemonic mw -> Mnemonic mw -> Bool
$c== :: forall (mw :: Nat). Mnemonic mw -> Mnemonic mw -> Bool
Eq, Int -> Mnemonic mw -> ShowS
[Mnemonic mw] -> ShowS
Mnemonic mw -> String
(Int -> Mnemonic mw -> ShowS)
-> (Mnemonic mw -> String)
-> ([Mnemonic mw] -> ShowS)
-> Show (Mnemonic mw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mw :: Nat). Int -> Mnemonic mw -> ShowS
forall (mw :: Nat). [Mnemonic mw] -> ShowS
forall (mw :: Nat). Mnemonic mw -> String
showList :: [Mnemonic mw] -> ShowS
$cshowList :: forall (mw :: Nat). [Mnemonic mw] -> ShowS
show :: Mnemonic mw -> String
$cshow :: forall (mw :: Nat). Mnemonic mw -> String
showsPrec :: Int -> Mnemonic mw -> ShowS
$cshowsPrec :: forall (mw :: Nat). Int -> Mnemonic mw -> ShowS
Show)

-- This wraps EntropyError of "Cardano.Encoding.BIP39"
newtype MnemonicException csz =
    UnexpectedEntropyError (EntropyError csz)
    -- ^ Invalid entropy length or checksum
    deriving stock (Int -> MnemonicException csz -> ShowS
[MnemonicException csz] -> ShowS
MnemonicException csz -> String
(Int -> MnemonicException csz -> ShowS)
-> (MnemonicException csz -> String)
-> ([MnemonicException csz] -> ShowS)
-> Show (MnemonicException csz)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (csz :: Nat). Int -> MnemonicException csz -> ShowS
forall (csz :: Nat). [MnemonicException csz] -> ShowS
forall (csz :: Nat). MnemonicException csz -> String
showList :: [MnemonicException csz] -> ShowS
$cshowList :: forall (csz :: Nat). [MnemonicException csz] -> ShowS
show :: MnemonicException csz -> String
$cshow :: forall (csz :: Nat). MnemonicException csz -> String
showsPrec :: Int -> MnemonicException csz -> ShowS
$cshowsPrec :: forall (csz :: Nat). Int -> MnemonicException csz -> ShowS
Show, Typeable)
    deriving newtype MnemonicException csz -> ()
(MnemonicException csz -> ()) -> NFData (MnemonicException csz)
forall a. (a -> ()) -> NFData a
forall (csz :: Nat). MnemonicException csz -> ()
rnf :: MnemonicException csz -> ()
$crnf :: forall (csz :: Nat). MnemonicException csz -> ()
NFData

-- | This wraps errors from "Cardano.Encoding.BIP39"
data MkMnemonicError csz
    = ErrMnemonicWords MnemonicWordsError
      -- ^ Wrong number of words in mnemonic.
    | ErrEntropy (EntropyError csz)
      -- ^ Invalid entropy length or checksum.
    | ErrDictionary DictionaryError
      -- ^ Invalid word in mnemonic.
    deriving stock (MkMnemonicError csz -> MkMnemonicError csz -> Bool
(MkMnemonicError csz -> MkMnemonicError csz -> Bool)
-> (MkMnemonicError csz -> MkMnemonicError csz -> Bool)
-> Eq (MkMnemonicError csz)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (csz :: Nat).
MkMnemonicError csz -> MkMnemonicError csz -> Bool
/= :: MkMnemonicError csz -> MkMnemonicError csz -> Bool
$c/= :: forall (csz :: Nat).
MkMnemonicError csz -> MkMnemonicError csz -> Bool
== :: MkMnemonicError csz -> MkMnemonicError csz -> Bool
$c== :: forall (csz :: Nat).
MkMnemonicError csz -> MkMnemonicError csz -> Bool
Eq, Int -> MkMnemonicError csz -> ShowS
[MkMnemonicError csz] -> ShowS
MkMnemonicError csz -> String
(Int -> MkMnemonicError csz -> ShowS)
-> (MkMnemonicError csz -> String)
-> ([MkMnemonicError csz] -> ShowS)
-> Show (MkMnemonicError csz)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (csz :: Nat). Int -> MkMnemonicError csz -> ShowS
forall (csz :: Nat). [MkMnemonicError csz] -> ShowS
forall (csz :: Nat). MkMnemonicError csz -> String
showList :: [MkMnemonicError csz] -> ShowS
$cshowList :: forall (csz :: Nat). [MkMnemonicError csz] -> ShowS
show :: MkMnemonicError csz -> String
$cshow :: forall (csz :: Nat). MkMnemonicError csz -> String
showsPrec :: Int -> MkMnemonicError csz -> ShowS
$cshowsPrec :: forall (csz :: Nat). Int -> MkMnemonicError csz -> ShowS
Show)

deriving instance Eq (EntropyError czs)
deriving instance Eq MnemonicWordsError
deriving instance Eq DictionaryError

-- NFData instances
instance NFData (Mnemonic mw) where
    rnf :: Mnemonic mw -> ()
rnf (Mnemonic Entropy (EntropySize mw)
ent MnemonicSentence mw
ws) = Entropy (EntropySize mw) -> ()
forall a. NormalForm a => a -> ()
toNormalForm Entropy (EntropySize mw)
ent () -> () -> ()
`seq` MnemonicSentence mw -> ()
forall a. NormalForm a => a -> ()
toNormalForm MnemonicSentence mw
ws
instance NFData (EntropyError csz) where
    rnf :: EntropyError csz -> ()
rnf (ErrInvalidEntropyLength Int
a Int
b) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
a () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
b
    rnf (ErrInvalidEntropyChecksum Checksum csz
a Checksum csz
b) = Checksum csz -> ()
forall a. NormalForm a => a -> ()
toNormalForm Checksum csz
a () -> () -> ()
`seq` Checksum csz -> ()
forall a. NormalForm a => a -> ()
toNormalForm Checksum csz
b
instance NFData MnemonicWordsError where
    rnf :: MnemonicWordsError -> ()
rnf (ErrWrongNumberOfWords Int
a Int
b) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
a () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
b
instance NFData DictionaryError where
    rnf :: DictionaryError -> ()
rnf (ErrInvalidDictionaryWord String
s) = String -> ()
forall a. NormalForm a => a -> ()
toNormalForm String
s
instance NFData (MkMnemonicError csz) where
    rnf :: MkMnemonicError csz -> ()
rnf (ErrMnemonicWords MnemonicWordsError
e) = MnemonicWordsError -> ()
forall a. NFData a => a -> ()
rnf MnemonicWordsError
e
    rnf (ErrEntropy EntropyError csz
e) = EntropyError csz -> ()
forall a. NFData a => a -> ()
rnf EntropyError csz
e
    rnf (ErrDictionary DictionaryError
e) = DictionaryError -> ()
forall a. NFData a => a -> ()
rnf DictionaryError
e

-- | Smart-constructor for the 'Entropy'. Make sure the 'ByteString' comes from a highly random source or use 'genEntropy'.
--
-- __example__:
--
-- >>> mkEntropy @160 bytes
-- Entropy {} :: Entropy 160
--
-- __property__:
--
-- prop> mkEntropy (entropyToBytes ent) == Right ent
--
-- @since 1.0.0
mkEntropy
    :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz)
    => ScrubbedBytes
    -> Either (EntropyError csz) (Entropy ent)
mkEntropy :: ScrubbedBytes -> Either (EntropyError csz) (Entropy ent)
mkEntropy = ScrubbedBytes -> Either (EntropyError csz) (Entropy ent)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy

-- | Generate Entropy of a given size using a cryptographically secure random seed.
--
-- __example:__
--
-- >>> genEntropy @128
-- Entropy {} :: Entropy 128
--
-- @since 1.0.0
genEntropy
    :: forall (ent :: Nat) csz. (ValidEntropySize ent, ValidChecksumSize ent csz)
    => IO (Entropy ent)
genEntropy :: IO (Entropy ent)
genEntropy =
    let
        size :: Int
size =
            Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy ent -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal @ent Proxy ent
forall k (t :: k). Proxy t
Proxy
        eitherToIO :: Either (EntropyError csz) a -> IO a
eitherToIO =
            (EntropyError csz -> IO a)
-> (a -> IO a) -> Either (EntropyError csz) a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MnemonicException csz -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (MnemonicException csz -> IO a)
-> (EntropyError csz -> MnemonicException csz)
-> EntropyError csz
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntropyError csz -> MnemonicException csz
forall (csz :: Nat). EntropyError csz -> MnemonicException csz
UnexpectedEntropyError) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    in
        (Either (EntropyError csz) (Entropy ent) -> IO (Entropy ent)
forall a. Either (EntropyError csz) a -> IO a
eitherToIO (Either (EntropyError csz) (Entropy ent) -> IO (Entropy ent))
-> (ScrubbedBytes -> Either (EntropyError csz) (Entropy ent))
-> ScrubbedBytes
-> IO (Entropy ent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> Either (EntropyError csz) (Entropy ent)
forall (ent :: Nat) (csz :: Nat).
(ValidEntropySize ent, ValidChecksumSize ent csz) =>
ScrubbedBytes -> Either (EntropyError csz) (Entropy ent)
mkEntropy) (ScrubbedBytes -> IO (Entropy ent))
-> IO ScrubbedBytes -> IO (Entropy ent)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO ScrubbedBytes
forall byteArray. ByteArray byteArray => Int -> IO byteArray
Crypto.getEntropy (Int
size Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)

-- | Smart-constructor for 'Mnemonic'. Requires a type application to
-- disambiguate the mnemonic size.
--
-- __example__:
--
-- >>> mkMnemonic @15 sentence
-- Mnemonic {} :: Mnemonic 15
--
-- __property__:
--
-- prop> mkMnemonic (mnemonicToText mnemonic) == Right mnemonic
--
-- @since 1.0.0
mkMnemonic
    :: forall (mw :: Nat) (ent :: Nat) csz.
     ( ConsistentEntropy ent mw csz
     , EntropySize mw ~ ent
     )
    => [Text]
    -> Either (MkMnemonicError csz) (Mnemonic mw)
mkMnemonic :: [Text] -> Either (MkMnemonicError csz) (Mnemonic mw)
mkMnemonic [Text]
wordsm = do
    MnemonicPhrase mw
phrase <- (MnemonicWordsError -> MkMnemonicError csz)
-> Either MnemonicWordsError (MnemonicPhrase mw)
-> Either (MkMnemonicError csz) (MnemonicPhrase mw)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left MnemonicWordsError -> MkMnemonicError csz
forall (csz :: Nat). MnemonicWordsError -> MkMnemonicError csz
ErrMnemonicWords
        (Either MnemonicWordsError (MnemonicPhrase mw)
 -> Either (MkMnemonicError csz) (MnemonicPhrase mw))
-> Either MnemonicWordsError (MnemonicPhrase mw)
-> Either (MkMnemonicError csz) (MnemonicPhrase mw)
forall a b. (a -> b) -> a -> b
$ [String] -> Either MnemonicWordsError (MnemonicPhrase mw)
forall (mw :: Nat).
ValidMnemonicSentence mw =>
[String] -> Either MnemonicWordsError (MnemonicPhrase mw)
mnemonicPhrase @mw (Text -> String
toUtf8String (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
wordsm)

    MnemonicSentence mw
sentence <- (DictionaryError -> MkMnemonicError csz)
-> Either DictionaryError (MnemonicSentence mw)
-> Either (MkMnemonicError csz) (MnemonicSentence mw)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left DictionaryError -> MkMnemonicError csz
forall (csz :: Nat). DictionaryError -> MkMnemonicError csz
ErrDictionary
        (Either DictionaryError (MnemonicSentence mw)
 -> Either (MkMnemonicError csz) (MnemonicSentence mw))
-> Either DictionaryError (MnemonicSentence mw)
-> Either (MkMnemonicError csz) (MnemonicSentence mw)
forall a b. (a -> b) -> a -> b
$ Dictionary
-> MnemonicPhrase mw
-> Either DictionaryError (MnemonicSentence mw)
forall (mw :: Nat).
ValidMnemonicSentence mw =>
Dictionary
-> MnemonicPhrase mw
-> Either DictionaryError (MnemonicSentence mw)
mnemonicPhraseToMnemonicSentence Dictionary
Dictionary.english MnemonicPhrase mw
phrase

    Entropy ent
entropy <- (EntropyError csz -> MkMnemonicError csz)
-> Either (EntropyError csz) (Entropy ent)
-> Either (MkMnemonicError csz) (Entropy ent)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left EntropyError csz -> MkMnemonicError csz
forall (csz :: Nat). EntropyError csz -> MkMnemonicError csz
ErrEntropy
        (Either (EntropyError csz) (Entropy ent)
 -> Either (MkMnemonicError csz) (Entropy ent))
-> Either (EntropyError csz) (Entropy ent)
-> Either (MkMnemonicError csz) (Entropy ent)
forall a b. (a -> b) -> a -> b
$ MnemonicSentence mw -> Either (EntropyError csz) (Entropy ent)
forall (ent :: Nat) (csz :: Nat) (mw :: Nat).
ConsistentEntropy ent mw csz =>
MnemonicSentence mw -> Either (EntropyError csz) (Entropy ent)
wordsToEntropy MnemonicSentence mw
sentence

    Mnemonic mw -> Either (MkMnemonicError csz) (Mnemonic mw)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mnemonic :: forall (mw :: Nat).
Entropy (EntropySize mw) -> MnemonicSentence mw -> Mnemonic mw
Mnemonic
        { mnemonicToEntropy :: Entropy (EntropySize mw)
mnemonicToEntropy  = Entropy ent
Entropy (EntropySize mw)
entropy
        , mnemonicToSentence :: MnemonicSentence mw
mnemonicToSentence = MnemonicSentence mw
sentence
        }

-- | Convert an Entropy to a corresponding Mnemonic Sentence. Since 'Entropy'
-- and 'Mnemonic' can only be created through smart-constructors, this function
-- cannot fail and is total.
--
-- @since 1.0.0
entropyToMnemonic
    :: forall mw ent csz.
     ( ValidMnemonicSentence mw
     , ValidEntropySize ent
     , ValidChecksumSize ent csz
     , ent ~ EntropySize mw
     , mw ~ MnemonicWords ent
     )
    => Entropy ent
    -> Mnemonic mw
entropyToMnemonic :: Entropy ent -> Mnemonic mw
entropyToMnemonic Entropy ent
entropy = Mnemonic :: forall (mw :: Nat).
Entropy (EntropySize mw) -> MnemonicSentence mw -> Mnemonic mw
Mnemonic
    { mnemonicToSentence :: MnemonicSentence mw
mnemonicToSentence = Entropy ent -> MnemonicSentence mw
forall (n :: Nat) (csz :: Nat) (mw :: Nat).
ConsistentEntropy n mw csz =>
Entropy n -> MnemonicSentence mw
entropyToWords Entropy ent
entropy
    , mnemonicToEntropy :: Entropy (EntropySize mw)
mnemonicToEntropy  = Entropy ent
Entropy (EntropySize mw)
entropy
    }

-- | Convert 'Entropy' to plain bytes.
--
-- @since 1.0.0
entropyToBytes
    :: Entropy n
    -> ScrubbedBytes
entropyToBytes :: Entropy n -> ScrubbedBytes
entropyToBytes = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ScrubbedBytes)
-> (Entropy n -> ByteString) -> Entropy n -> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entropy n -> ByteString
forall (n :: Nat). Entropy n -> ByteString
entropyRaw

toUtf8String
    :: Text
    -> Basement.String
toUtf8String :: Text -> String
toUtf8String = String -> String
forall a. IsString a => String -> a
Basement.fromString (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

fromUtf8String
    :: Basement.String
    -> Text
fromUtf8String :: String -> Text
fromUtf8String = String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall l. IsList l => l -> [Item l]
Basement.toList

instance (KnownNat csz) => Basement.Exception (MnemonicException csz)

-- | Convert a 'Mnemonic' to a sentence of English mnemonic words.
--
-- @since 1.0.0
mnemonicToText
    :: Mnemonic mw
    -> [Text]
mnemonicToText :: Mnemonic mw -> [Text]
mnemonicToText =
    (WordIndex -> Text) -> [WordIndex] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
fromUtf8String (String -> Text) -> (WordIndex -> String) -> WordIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dictionary -> WordIndex -> String
dictionaryIndexToWord Dictionary
Dictionary.english)
    ([WordIndex] -> [Text])
-> (Mnemonic mw -> [WordIndex]) -> Mnemonic mw -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListN mw WordIndex -> [WordIndex]
forall (n :: Nat) a. ListN n a -> [a]
unListN
    (ListN mw WordIndex -> [WordIndex])
-> (Mnemonic mw -> ListN mw WordIndex)
-> Mnemonic mw
-> [WordIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MnemonicSentence mw -> ListN mw WordIndex
forall (mw :: Nat). MnemonicSentence mw -> ListN mw WordIndex
mnemonicSentenceToListN
    (MnemonicSentence mw -> ListN mw WordIndex)
-> (Mnemonic mw -> MnemonicSentence mw)
-> Mnemonic mw
-> ListN mw WordIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mnemonic mw -> MnemonicSentence mw
forall (mw :: Nat). Mnemonic mw -> MnemonicSentence mw
mnemonicToSentence

-- | Convert a 'SomeMnemonic' to bytes.
--
-- @since 1.0.1
someMnemonicToBytes :: SomeMnemonic -> ScrubbedBytes
someMnemonicToBytes :: SomeMnemonic -> ScrubbedBytes
someMnemonicToBytes (SomeMnemonic Mnemonic mw
mw) = Entropy (EntropySize mw) -> ScrubbedBytes
forall (n :: Nat). Entropy n -> ScrubbedBytes
entropyToBytes (Entropy (EntropySize mw) -> ScrubbedBytes)
-> Entropy (EntropySize mw) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Mnemonic mw -> Entropy (EntropySize mw)
forall (mw :: Nat). Mnemonic mw -> Entropy (EntropySize mw)
mnemonicToEntropy Mnemonic mw
mw

-- | Ease the manipulation of 'Mnemonic' by encapsulating the type constraints inside a constructor.
-- This is particularly useful for functions which do not require anything but a valid 'Mnemonic' without any
-- particular pre-condition on the size of the 'Mnemonic' itself.
--
-- @since 1.0.0
data SomeMnemonic where
    SomeMnemonic :: forall mw. KnownNat mw => Mnemonic mw -> SomeMnemonic

deriving instance Show SomeMnemonic
instance Eq SomeMnemonic where
    (SomeMnemonic Mnemonic mw
mwa) == :: SomeMnemonic -> SomeMnemonic -> Bool
== (SomeMnemonic Mnemonic mw
mwb) =
        case Mnemonic mw -> TypeRep (Mnemonic mw)
forall a. Typeable a => a -> TypeRep a
typeOf Mnemonic mw
mwa TypeRep (Mnemonic mw)
-> TypeRep (Mnemonic mw) -> Maybe (Mnemonic mw :~: Mnemonic mw)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` Mnemonic mw -> TypeRep (Mnemonic mw)
forall a. Typeable a => a -> TypeRep a
typeOf Mnemonic mw
mwb of
            Maybe (Mnemonic mw :~: Mnemonic mw)
Nothing -> Bool
False
            Just Mnemonic mw :~: Mnemonic mw
Refl -> Mnemonic mw
mwa Mnemonic mw -> Mnemonic mw -> Bool
forall a. Eq a => a -> a -> Bool
== Mnemonic mw
Mnemonic mw
mwb
instance NFData SomeMnemonic where
    rnf :: SomeMnemonic -> ()
rnf (SomeMnemonic Mnemonic mw
mnem) = Mnemonic mw -> ()
forall a. NFData a => a -> ()
rnf Mnemonic mw
mnem

-- | 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 MkSomeMnemonic (sz :: [Nat]) where
    -- | Construct a mnemonic from a list of words. This function is particularly useful when the
    -- number of words is not necessarily known at runtime. The function is however /ambiguous/ and
    -- requires thereby a type application.
    --
    -- __examples:__
    --
    -- >>> mkSomeMnemonic @'[ 12 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ]
    -- Left "Invalid number of words: 12 words are expected."
    --
    -- >>> mkSomeMnemonic @'[ 9, 12, 15 ] [ "test", "child", "burst", "immense", "armed", "parrot", "company", "walk", "dog" ]
    -- Right (SomeMnemonic ...)
    --
    -- @since 1.0.0
    mkSomeMnemonic :: [Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic

-- | Error reported from trying to create a passphrase from a given mnemonic
--
-- @since 1.0.0
newtype MkSomeMnemonicError (sz :: [Nat]) =
    MkSomeMnemonicError { MkSomeMnemonicError sz -> String
getMkSomeMnemonicError :: String }
    deriving stock (MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
(MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool)
-> (MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool)
-> Eq (MkSomeMnemonicError sz)
forall (sz :: [Nat]).
MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
$c/= :: forall (sz :: [Nat]).
MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
== :: MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
$c== :: forall (sz :: [Nat]).
MkSomeMnemonicError sz -> MkSomeMnemonicError sz -> Bool
Eq, Int -> MkSomeMnemonicError sz -> ShowS
[MkSomeMnemonicError sz] -> ShowS
MkSomeMnemonicError sz -> String
(Int -> MkSomeMnemonicError sz -> ShowS)
-> (MkSomeMnemonicError sz -> String)
-> ([MkSomeMnemonicError sz] -> ShowS)
-> Show (MkSomeMnemonicError sz)
forall (sz :: [Nat]). Int -> MkSomeMnemonicError sz -> ShowS
forall (sz :: [Nat]). [MkSomeMnemonicError sz] -> ShowS
forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkSomeMnemonicError sz] -> ShowS
$cshowList :: forall (sz :: [Nat]). [MkSomeMnemonicError sz] -> ShowS
show :: MkSomeMnemonicError sz -> String
$cshow :: forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
showsPrec :: Int -> MkSomeMnemonicError sz -> ShowS
$cshowsPrec :: forall (sz :: [Nat]). Int -> MkSomeMnemonicError sz -> ShowS
Show)

instance {-# OVERLAPS #-}
    ( n ~ EntropySize mw
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
    , MkSomeMnemonic rest
    , NatVals rest
    ) =>
    MkSomeMnemonic (mw ': rest)
  where
    mkSomeMnemonic :: [Text] -> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
mkSomeMnemonic [Text]
parts = case Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
parseMW of
        Left MkSomeMnemonicError (mw : rest)
err -> (MkSomeMnemonicError (mw : rest)
 -> MkSomeMnemonicError (mw : rest))
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (MkSomeMnemonicError (mw : rest)
-> MkSomeMnemonicError (mw : rest)
-> MkSomeMnemonicError (mw : rest)
promote MkSomeMnemonicError (mw : rest)
err) Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
parseRest
        Right SomeMnemonic
mw -> SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall a b. b -> Either a b
Right SomeMnemonic
mw
      where
        parseMW :: Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
parseMW = (MkSomeMnemonicError '[mw] -> MkSomeMnemonicError (mw : rest))
-> Either (MkSomeMnemonicError '[mw]) SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> MkSomeMnemonicError (mw : rest)
forall (sz :: [Nat]). String -> MkSomeMnemonicError sz
MkSomeMnemonicError (String -> MkSomeMnemonicError (mw : rest))
-> (MkSomeMnemonicError '[mw] -> String)
-> MkSomeMnemonicError '[mw]
-> MkSomeMnemonicError (mw : rest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MkSomeMnemonicError '[mw] -> String
forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
getMkSomeMnemonicError) (Either (MkSomeMnemonicError '[mw]) SomeMnemonic
 -> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic)
-> Either (MkSomeMnemonicError '[mw]) SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall a b. (a -> b) -> a -> b
$ -- coerce
            [Text] -> Either (MkSomeMnemonicError '[mw]) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @'[mw] [Text]
parts
        parseRest :: Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
parseRest = (MkSomeMnemonicError rest -> MkSomeMnemonicError (mw : rest))
-> Either (MkSomeMnemonicError rest) SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> MkSomeMnemonicError (mw : rest)
forall (sz :: [Nat]). String -> MkSomeMnemonicError sz
MkSomeMnemonicError (String -> MkSomeMnemonicError (mw : rest))
-> (MkSomeMnemonicError rest -> String)
-> MkSomeMnemonicError rest
-> MkSomeMnemonicError (mw : rest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MkSomeMnemonicError rest -> String
forall (sz :: [Nat]). MkSomeMnemonicError sz -> String
getMkSomeMnemonicError) (Either (MkSomeMnemonicError rest) SomeMnemonic
 -> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic)
-> Either (MkSomeMnemonicError rest) SomeMnemonic
-> Either (MkSomeMnemonicError (mw : rest)) SomeMnemonic
forall a b. (a -> b) -> a -> b
$ -- coerce
            [Text] -> Either (MkSomeMnemonicError rest) SomeMnemonic
forall (sz :: [Nat]).
MkSomeMnemonic sz =>
[Text] -> Either (MkSomeMnemonicError sz) SomeMnemonic
mkSomeMnemonic @rest [Text]
parts
        promote :: MkSomeMnemonicError (mw : rest)
-> MkSomeMnemonicError (mw : rest)
-> MkSomeMnemonicError (mw : rest)
promote MkSomeMnemonicError (mw : rest)
e MkSomeMnemonicError (mw : rest)
e' =
            let
                sz :: [Int]
sz = Integer -> Int
forall a. Enum a => a -> Int
fromEnum (Integer -> Int) -> [Integer] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (mw : rest) -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy (mw : rest)
forall k (t :: k). Proxy t
Proxy :: Proxy (mw ': rest))
                mw :: Int
mw = Integer -> Int
forall a. Enum a => a -> Int
fromEnum (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy mw -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy mw
forall k (t :: k). Proxy t
Proxy :: Proxy mw)
            in if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
parts Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
sz
                then String -> MkSomeMnemonicError (mw : rest)
forall (sz :: [Nat]). String -> MkSomeMnemonicError sz
MkSomeMnemonicError
                    (String -> MkSomeMnemonicError (mw : rest))
-> String -> MkSomeMnemonicError (mw : rest)
forall a b. (a -> b) -> a -> b
$  String
"Invalid number of words: "
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
sz)
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then String
" or " else String
"") String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Int] -> Int
forall a. [a] -> a
last [Int]
sz)
                    String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" words are expected."
                else if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
mw then MkSomeMnemonicError (mw : rest)
e else MkSomeMnemonicError (mw : rest)
e'

-- | Small helper to collect 'Nat' values from a type-level list
class NatVals (ns :: [Nat]) where
    natVals :: Proxy ns -> [Integer]

instance NatVals '[] where
    natVals :: Proxy '[] -> [Integer]
natVals Proxy '[]
_ = []

instance (KnownNat n, NatVals rest) => NatVals (n ': rest) where
    natVals :: Proxy (n : rest) -> [Integer]
natVals Proxy (n : rest)
_ = Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n) Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: Proxy rest -> [Integer]
forall (ns :: [Nat]). NatVals ns => Proxy ns -> [Integer]
natVals (Proxy rest
forall k (t :: k). Proxy t
Proxy :: Proxy rest)

instance
    ( n ~ EntropySize mw
    , csz ~ CheckSumBits n
    , ConsistentEntropy n mw csz
    ) =>
    MkSomeMnemonic (mw ': '[])
  where
    mkSomeMnemonic :: [Text] -> Either (MkSomeMnemonicError '[mw]) SomeMnemonic
mkSomeMnemonic [Text]
parts = do
        (MkMnemonicError csz -> MkSomeMnemonicError '[mw])
-> (Mnemonic mw -> SomeMnemonic)
-> Either (MkMnemonicError csz) (Mnemonic mw)
-> Either (MkSomeMnemonicError '[mw]) SomeMnemonic
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> MkSomeMnemonicError '[mw]
forall (sz :: [Nat]). String -> MkSomeMnemonicError sz
MkSomeMnemonicError (String -> MkSomeMnemonicError '[mw])
-> (MkMnemonicError csz -> String)
-> MkMnemonicError csz
-> MkSomeMnemonicError '[mw]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MkMnemonicError csz -> String
pretty) Mnemonic mw -> SomeMnemonic
forall (mw :: Nat). KnownNat mw => Mnemonic mw -> SomeMnemonic
SomeMnemonic ([Text] -> Either (MkMnemonicError csz) (Mnemonic mw)
forall (mw :: Nat) (ent :: Nat) (csz :: Nat).
(ConsistentEntropy ent mw csz, EntropySize mw ~ ent) =>
[Text] -> Either (MkMnemonicError csz) (Mnemonic mw)
mkMnemonic @mw [Text]
parts)
      where
        pretty :: MkMnemonicError csz -> String
pretty = \case
            ErrMnemonicWords ErrWrongNumberOfWords{} ->
                String
"Invalid number of words: "
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show (Proxy mw -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy mw
forall k (t :: k). Proxy t
Proxy :: Proxy mw))
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" words are expected."
            ErrDictionary (ErrInvalidDictionaryWord String
_) ->
                String
"Found an unknown word not present in the pre-defined dictionary. \
                \The full dictionary is available here: \
                \https://github.com/input-output-hk/cardano-wallet/tree/master/specifications/mnemonic/english.txt"
            ErrEntropy ErrInvalidEntropyChecksum{} ->
                String
"Invalid entropy checksum: please double-check the last word of \
                \your mnemonic sentence."
            ErrEntropy ErrInvalidEntropyLength{} ->
                String
"Something went wrong when trying to generate the entropy from \
                \the given mnemonic. As a user, there's nothing you can do."

-- $troubleshooting
--
-- - /Natural XX is out of bounds for Int/:
--   This usually occurs when ones is trying to specify an invalid size for an
--   'Entropy' or 'Mnemonic'. For example:
--
--   >>> genEntropy @42
--   error:
--     • Natural CheckSumBits 42 is out of bounds for Int
--
-- - This could be the case as well when forgetting to use an adequate type application:
--
--   >>> mkEntropy mempty
--   error:
--     • Natural ent is out of bounds for Int