{-# LANGUAGE GADTs                #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Crypto.Encoding.BIP39
    ( -- * Entropy
      Entropy
    , ValidEntropySize
    , Checksum
    , ValidChecksumSize
    , MnemonicWords
    , EntropySize
    , toEntropy
    , entropyRaw
    , entropyChecksum

    , entropyToWords
    , wordsToEntropy

    , -- * Seed
      Seed
    , Passphrase
    , sentenceToSeed
    , phraseToSeed

    , -- * Mnemonic Sentence
      MnemonicSentence
    , MnemonicPhrase
    , ValidMnemonicSentence
    , mnemonicPhrase
    , checkMnemonicPhrase
    , mnemonicPhraseToMnemonicSentence
    , mnemonicSentenceToMnemonicPhrase
    , mnemonicSentenceToString
    , mnemonicSentenceToListN
    , mnemonicPhraseToString
    , translateTo
    , -- ** Dictionary
      Dictionary(..)
    , WordIndex
    , wordIndex
    , unWordIndex

    , -- * helpers
      ConsistentEntropy
    , CheckSumBits
    , Elem

    , -- * Errors
      DictionaryError(..)
    , EntropyError(..)
    , MnemonicWordsError(..)
    ) where

import Prelude ((-), (*), (+), div, divMod, (^), fromIntegral)

import qualified Basement.String as String
import           Basement.Nat
import qualified Basement.Sized.List as ListN
import           Basement.Sized.List (ListN)
import           Basement.NormalForm
import           Basement.Compat.Typeable
import           Basement.Numerical.Number (IsIntegral(..))
import           Basement.Imports

import           Foundation.Check

import           Control.Monad (replicateM, (<=<))
import           Data.Bits
import           Data.Maybe (fromMaybe)
import           Data.List (reverse, intersperse, length)
import           Data.Kind (Constraint)
import           Data.ByteArray (ByteArrayAccess, ByteArray)
import qualified Data.ByteArray as BA
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS

import           Data.Proxy

import           GHC.TypeLits

import           Crypto.Hash (hashWith, SHA256(..))
import           Crypto.Number.Serialize (os2ip, i2ospOf_)
import qualified Crypto.KDF.PBKDF2 as PBKDF2

import           Crypto.Encoding.BIP39.Dictionary
import           Cardano.Internal.Compat (fromRight)

-- -------------------------------------------------------------------------- --
-- Entropy
-- -------------------------------------------------------------------------- --

-- | this is the `Checksum` of a given 'Entropy'
--
-- the 'Nat' type parameter represent the size, in bits, of this checksum.
newtype Checksum (bits :: Nat) = Checksum Word8
    deriving (Int -> Checksum bits -> ShowS
[Checksum bits] -> ShowS
Checksum bits -> String
(Int -> Checksum bits -> ShowS)
-> (Checksum bits -> String)
-> ([Checksum bits] -> ShowS)
-> Show (Checksum bits)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (bits :: Nat). Int -> Checksum bits -> ShowS
forall (bits :: Nat). [Checksum bits] -> ShowS
forall (bits :: Nat). Checksum bits -> String
showList :: [Checksum bits] -> ShowS
$cshowList :: forall (bits :: Nat). [Checksum bits] -> ShowS
show :: Checksum bits -> String
$cshow :: forall (bits :: Nat). Checksum bits -> String
showsPrec :: Int -> Checksum bits -> ShowS
$cshowsPrec :: forall (bits :: Nat). Int -> Checksum bits -> ShowS
Show, Checksum bits -> Checksum bits -> Bool
(Checksum bits -> Checksum bits -> Bool)
-> (Checksum bits -> Checksum bits -> Bool) -> Eq (Checksum bits)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (bits :: Nat). Checksum bits -> Checksum bits -> Bool
/= :: Checksum bits -> Checksum bits -> Bool
$c/= :: forall (bits :: Nat). Checksum bits -> Checksum bits -> Bool
== :: Checksum bits -> Checksum bits -> Bool
$c== :: forall (bits :: Nat). Checksum bits -> Checksum bits -> Bool
Eq, Typeable, Checksum bits -> ()
(Checksum bits -> ()) -> NormalForm (Checksum bits)
forall a. (a -> ()) -> NormalForm a
forall (bits :: Nat). Checksum bits -> ()
toNormalForm :: Checksum bits -> ()
$ctoNormalForm :: forall (bits :: Nat). Checksum bits -> ()
NormalForm)

checksum :: forall csz ba . (KnownNat csz, ByteArrayAccess ba)
         => ba -> Checksum csz
checksum :: ba -> Checksum csz
checksum ba
bs = Word8 -> Checksum csz
forall (bits :: Nat). Word8 -> Checksum bits
Checksum (Word8 -> Checksum csz) -> Word8 -> Checksum csz
forall a b. (a -> b) -> a -> b
$ (SHA256 -> ba -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ba
bs Digest SHA256 -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
`BA.index` Int
0) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
csz)
  where
    csz :: Int
csz = Integer -> Int
forall a. Integral a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy csz -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy csz
forall k (t :: k). Proxy t
Proxy @csz)

type ValidChecksumSize (ent :: Nat) (csz :: Nat) =
    ( KnownNat csz, NatWithinBound Int csz
    , Elem csz '[3, 4, 5, 6, 7, 8]
    , CheckSumBits ent ~ csz
    )

-- | Number of bits of checksum related to a specific entropy size in bits
type family CheckSumBits (n :: Nat) :: Nat where
    CheckSumBits 96  = 3
    CheckSumBits 128 = 4
    CheckSumBits 160 = 5
    CheckSumBits 192 = 6
    CheckSumBits 224 = 7
    CheckSumBits 256 = 8

-- | BIP39's entropy is a byte array of a given size (in bits, see
-- 'ValidEntropySize' for the valid size).
--
-- To it is associated
data Entropy (n :: Nat) = Entropy
     { Entropy n -> ByteString
entropyRaw :: !ByteString
        -- ^ Get the raw binary associated with the entropy
     , Entropy n -> Checksum (CheckSumBits n)
entropyChecksum :: !(Checksum (CheckSumBits n))
        -- ^ Get the checksum of the Entropy
     }
  deriving (Int -> Entropy n -> ShowS
[Entropy n] -> ShowS
Entropy n -> String
(Int -> Entropy n -> ShowS)
-> (Entropy n -> String)
-> ([Entropy n] -> ShowS)
-> Show (Entropy n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat). Int -> Entropy n -> ShowS
forall (n :: Nat). [Entropy n] -> ShowS
forall (n :: Nat). Entropy n -> String
showList :: [Entropy n] -> ShowS
$cshowList :: forall (n :: Nat). [Entropy n] -> ShowS
show :: Entropy n -> String
$cshow :: forall (n :: Nat). Entropy n -> String
showsPrec :: Int -> Entropy n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> Entropy n -> ShowS
Show, Entropy n -> Entropy n -> Bool
(Entropy n -> Entropy n -> Bool)
-> (Entropy n -> Entropy n -> Bool) -> Eq (Entropy n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat). Entropy n -> Entropy n -> Bool
/= :: Entropy n -> Entropy n -> Bool
$c/= :: forall (n :: Nat). Entropy n -> Entropy n -> Bool
== :: Entropy n -> Entropy n -> Bool
$c== :: forall (n :: Nat). Entropy n -> Entropy n -> Bool
Eq, Typeable)
instance NormalForm (Entropy n) where
    toNormalForm :: Entropy n -> ()
toNormalForm (Entropy !ByteString
_ Checksum (CheckSumBits n)
cs) = Checksum (CheckSumBits n) -> ()
forall a. NormalForm a => a -> ()
toNormalForm Checksum (CheckSumBits n)
cs
instance Arbitrary (Entropy 96) where
    arbitrary :: Gen (Entropy 96)
arbitrary = Entropy 96 -> Either (EntropyError 3) (Entropy 96) -> Entropy 96
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 96
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 96)") (Either (EntropyError 3) (Entropy 96) -> Entropy 96)
-> ([Word8] -> Either (EntropyError 3) (Entropy 96))
-> [Word8]
-> Entropy 96
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 3) (Entropy 96)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 3) (Entropy 96))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 3) (Entropy 96)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 96) -> Gen [Word8] -> Gen (Entropy 96)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
12 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Entropy 128) where
    arbitrary :: Gen (Entropy 128)
arbitrary = Entropy 128 -> Either (EntropyError 4) (Entropy 128) -> Entropy 128
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 128
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 128)") (Either (EntropyError 4) (Entropy 128) -> Entropy 128)
-> ([Word8] -> Either (EntropyError 4) (Entropy 128))
-> [Word8]
-> Entropy 128
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 4) (Entropy 128)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 4) (Entropy 128))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 4) (Entropy 128)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 128) -> Gen [Word8] -> Gen (Entropy 128)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
16 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Entropy 160) where
    arbitrary :: Gen (Entropy 160)
arbitrary = Entropy 160 -> Either (EntropyError 5) (Entropy 160) -> Entropy 160
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 160
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 160)") (Either (EntropyError 5) (Entropy 160) -> Entropy 160)
-> ([Word8] -> Either (EntropyError 5) (Entropy 160))
-> [Word8]
-> Entropy 160
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 5) (Entropy 160)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 5) (Entropy 160))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 5) (Entropy 160)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 160) -> Gen [Word8] -> Gen (Entropy 160)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Entropy 192) where
    arbitrary :: Gen (Entropy 192)
arbitrary = Entropy 192 -> Either (EntropyError 6) (Entropy 192) -> Entropy 192
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 192
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 192)") (Either (EntropyError 6) (Entropy 192) -> Entropy 192)
-> ([Word8] -> Either (EntropyError 6) (Entropy 192))
-> [Word8]
-> Entropy 192
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 6) (Entropy 192)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 6) (Entropy 192))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 6) (Entropy 192)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 192) -> Gen [Word8] -> Gen (Entropy 192)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
24 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Entropy 224) where
    arbitrary :: Gen (Entropy 224)
arbitrary = Entropy 224 -> Either (EntropyError 7) (Entropy 224) -> Entropy 224
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 224
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 224)") (Either (EntropyError 7) (Entropy 224) -> Entropy 224)
-> ([Word8] -> Either (EntropyError 7) (Entropy 224))
-> [Word8]
-> Entropy 224
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 7) (Entropy 224)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 7) (Entropy 224))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 7) (Entropy 224)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 224) -> Gen [Word8] -> Gen (Entropy 224)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
28 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (Entropy 256) where
    arbitrary :: Gen (Entropy 256)
arbitrary = Entropy 256 -> Either (EntropyError 8) (Entropy 256) -> Entropy 256
forall b a. b -> Either a b -> b
fromRight (String -> Entropy 256
forall a. HasCallStack => String -> a
error String
"arbitrary (Entropy 256)") (Either (EntropyError 8) (Entropy 256) -> Entropy 256)
-> ([Word8] -> Either (EntropyError 8) (Entropy 256))
-> [Word8]
-> Entropy 256
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either (EntropyError 8) (Entropy 256)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy (ByteString -> Either (EntropyError 8) (Entropy 256))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either (EntropyError 8) (Entropy 256)
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Word8] -> ByteString
BS.pack ([Word8] -> Entropy 256) -> Gen [Word8] -> Gen (Entropy 256)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m [a]
replicateM Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Type Constraint Alias to check a given 'Nat' is valid for an entropy size
--
-- i.e. it must be one of the following: 96, 128, 160, 192, 224, 256.
--
type ValidEntropySize (n :: Nat) =
    ( KnownNat n, NatWithinBound Int n
    , Elem n '[96, 128, 160, 192, 224, 256]
    )

-- | Create a specific entropy type of known size from a raw bytestring
toEntropy :: forall n csz ba
           . (ValidEntropySize n, ValidChecksumSize n csz, ByteArrayAccess ba)
          => ba
          -> Either (EntropyError csz) (Entropy n)
toEntropy :: ba -> Either (EntropyError csz) (Entropy n)
toEntropy ba
bs
    | Int
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expected = Entropy n -> Either (EntropyError csz) (Entropy n)
forall a b. b -> Either a b
Right (Entropy n -> Either (EntropyError csz) (Entropy n))
-> Entropy n -> Either (EntropyError csz) (Entropy n)
forall a b. (a -> b) -> a -> b
$ ByteString -> Checksum (CheckSumBits n) -> Entropy n
forall (n :: Nat).
ByteString -> Checksum (CheckSumBits n) -> Entropy n
Entropy (ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
bs) (ba -> Checksum csz
forall (csz :: Nat) ba.
(KnownNat csz, ByteArrayAccess ba) =>
ba -> Checksum csz
checksum @csz ba
bs)
    | Bool
otherwise          = EntropyError csz -> Either (EntropyError csz) (Entropy n)
forall a b. a -> Either a b
Left  (EntropyError csz -> Either (EntropyError csz) (Entropy n))
-> EntropyError csz -> Either (EntropyError csz) (Entropy n)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> EntropyError csz
forall (csz :: Nat). Int -> Int -> EntropyError csz
ErrInvalidEntropyLength Int
actual Int
expected
  where
    actual :: Int
actual   = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
bsInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8
    expected :: Int
expected = Proxy n -> Int
forall (n :: Nat) (proxy :: Nat -> Type).
(KnownNat n, NatWithinBound Int n) =>
proxy n -> Int
natValInt (Proxy n
forall k (t :: k). Proxy t
Proxy @n)

toEntropyCheck :: forall n csz ba
                . (ValidEntropySize n, ValidChecksumSize n csz, ByteArrayAccess ba)
               => ba
               -> Checksum csz
               -> Either (EntropyError csz) (Entropy n)
toEntropyCheck :: ba -> Checksum csz -> Either (EntropyError csz) (Entropy n)
toEntropyCheck ba
bs Checksum csz
s = case ba -> Either (EntropyError csz) (Entropy n)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy ba
bs of
    Left EntropyError csz
err -> EntropyError csz -> Either (EntropyError csz) (Entropy n)
forall a b. a -> Either a b
Left EntropyError csz
err
    Right e :: Entropy n
e@(Entropy ByteString
_ Checksum (CheckSumBits n)
cs) | Checksum csz
Checksum (CheckSumBits n)
cs Checksum csz -> Checksum csz -> Bool
forall a. Eq a => a -> a -> Bool
== Checksum csz
s   -> Entropy n -> Either (EntropyError csz) (Entropy n)
forall a b. b -> Either a b
Right Entropy n
e
                           | Bool
otherwise -> EntropyError csz -> Either (EntropyError csz) (Entropy n)
forall a b. a -> Either a b
Left (EntropyError csz -> Either (EntropyError csz) (Entropy n))
-> EntropyError csz -> Either (EntropyError csz) (Entropy n)
forall a b. (a -> b) -> a -> b
$ Checksum csz -> Checksum csz -> EntropyError csz
forall (csz :: Nat).
Checksum csz -> Checksum csz -> EntropyError csz
ErrInvalidEntropyChecksum Checksum csz
Checksum (CheckSumBits n)
cs Checksum csz
s

-- | Number of Words related to a specific entropy size in bits
type family MnemonicWords (n :: Nat) :: Nat where
    MnemonicWords 96  = 9
    MnemonicWords 128 = 12
    MnemonicWords 160 = 15
    MnemonicWords 192 = 18
    MnemonicWords 224 = 21
    MnemonicWords 256 = 24

-- | Corresponding entropy size in bits for a given number of words
type family EntropySize (n :: Nat) :: Nat where
    EntropySize 9  = 96
    EntropySize 12 = 128
    EntropySize 15 = 160
    EntropySize 18 = 192
    EntropySize 21 = 224
    EntropySize 24 = 256


-- | Type Constraint Alias to check the entropy size, the number of mnemonic
-- words and the checksum size is consistent. i.e. that the following is true:
--
-- |  entropysize  | checksumsize | entropysize + checksumsize | mnemonicsize |
-- +---------------+--------------+----------------------------+--------------+
-- |           96  |            3 |                        99  |           9  |
-- |          128  |            4 |                       132  |          12  |
-- |          160  |            5 |                       165  |          15  |
-- |          192  |            6 |                       198  |          18  |
-- |          224  |            7 |                       231  |          21  |
-- |          256  |            8 |                       264  |          24  |
--
-- This type constraint alias also perform all the GHC's cumbersome type level
-- literal handling.
--
type ConsistentEntropy ent mw csz =
    ( ValidEntropySize ent
    , ValidChecksumSize ent csz
    , ValidMnemonicSentence mw
    , MnemonicWords ent ~ mw
    )

-- | retrieve the initial entropy from a given 'MnemonicSentence'
--
-- This function validate the retrieved 'Entropy' is valid, i.e. that the
-- checksum is correct.
-- This means you should not create a new 'Entropy' from a 'MnemonicSentence',
-- instead, you should use a Random Number Generator to create a new 'Entropy'.
--
wordsToEntropy :: forall ent csz mw
                . ConsistentEntropy ent mw csz
               => MnemonicSentence mw
               -> Either (EntropyError csz) (Entropy ent)
wordsToEntropy :: MnemonicSentence mw -> Either (EntropyError csz) (Entropy ent)
wordsToEntropy (MnemonicSentence ListN mw WordIndex
ms) =
    let -- we don't revese the list here, we know that the first word index
        -- is the highest first 11 bits of the entropy.
        entropy :: Integer
entropy         = (Integer -> WordIndex -> Integer)
-> Integer -> ListN mw WordIndex -> Integer
forall b a (n :: Nat). (b -> a -> b) -> b -> ListN n a -> b
ListN.foldl' (\Integer
acc WordIndex
x -> Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
11 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Offset String -> Integer
forall a. IsIntegral a => a -> Integer
toInteger (WordIndex -> Offset String
unWordIndex WordIndex
x)) Integer
0 ListN mw WordIndex
ms
        initialEntropy :: ByteString
        initialEntropy :: ByteString
initialEntropy = Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
nb (Integer
entropy Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Integer -> Int
forall a. Integral a => Integer -> a
fromInteger Integer
checksumsize)
        cs :: Checksum csz
cs = Word8 -> Checksum csz
forall (bits :: Nat). Word8 -> Checksum bits
Checksum (Word8 -> Checksum csz) -> Word8 -> Checksum csz
forall a b. (a -> b) -> a -> b
$ Integer -> Word8
forall a. Integral a => Integer -> a
fromInteger (Integer
entropy Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
mask)
     in ByteString
-> Checksum csz -> Either (EntropyError csz) (Entropy ent)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Checksum csz -> Either (EntropyError csz) (Entropy n)
toEntropyCheck ByteString
initialEntropy Checksum csz
cs
  where
    checksumsize :: Integer
checksumsize = Proxy csz -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy csz
forall k (t :: k). Proxy t
Proxy @csz)
    entropysize :: Integer
entropysize  = Proxy ent -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy ent
forall k (t :: k). Proxy t
Proxy @ent)
    nb :: Int
nb  = Integer -> Int
forall a. Integral a => Integer -> a
fromInteger Integer
entropysize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
    mask :: Integer
mask = Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
checksumsize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1

-- | Given an entropy of size n, Create a list
--
entropyToWords :: forall n csz mw . ConsistentEntropy n mw csz
               => Entropy n
               -> MnemonicSentence mw
entropyToWords :: Entropy n -> MnemonicSentence mw
entropyToWords (Entropy ByteString
bs (Checksum Word8
w)) =
    [Item (MnemonicSentence mw)] -> MnemonicSentence mw
forall l. IsList l => [Item l] -> l
fromList ([Item (MnemonicSentence mw)] -> MnemonicSentence mw)
-> [Item (MnemonicSentence mw)] -> MnemonicSentence mw
forall a b. (a -> b) -> a -> b
$ [WordIndex] -> [WordIndex]
forall a. [a] -> [a]
reverse ([WordIndex] -> [WordIndex]) -> [WordIndex] -> [WordIndex]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [WordIndex]
forall t t. (Integral t, Num t, Eq t) => t -> t -> [WordIndex]
loop Integer
mw Integer
g
  where
    g :: Integer
g = (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bs Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
csz) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
    csz :: Integer
csz = Proxy csz -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy csz
forall k (t :: k). Proxy t
Proxy @csz)
    mw :: Integer
mw  = Proxy mw -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy mw
forall k (t :: k). Proxy t
Proxy @mw)
    loop :: t -> t -> [WordIndex]
loop t
nbWords t
acc
        | t
nbWords t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = []
        | Bool
otherwise    =
            let (t
acc', t
d) = t
acc t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`divMod` t
2048
             in Offset String -> WordIndex
wordIndex (t -> Offset String
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
d) WordIndex -> [WordIndex] -> [WordIndex]
forall a. a -> [a] -> [a]
: t -> t -> [WordIndex]
loop (t
nbWords t -> t -> t
forall a. Num a => a -> a -> a
- t
1) t
acc'

-- -------------------------------------------------------------------------- --
-- Seed
-- -------------------------------------------------------------------------- --

newtype Seed = Seed ByteString
  deriving (Int -> Seed -> ShowS
[Seed] -> ShowS
Seed -> String
(Int -> Seed -> ShowS)
-> (Seed -> String) -> ([Seed] -> ShowS) -> Show Seed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seed] -> ShowS
$cshowList :: [Seed] -> ShowS
show :: Seed -> String
$cshow :: Seed -> String
showsPrec :: Int -> Seed -> ShowS
$cshowsPrec :: Int -> Seed -> ShowS
Show, Seed -> Seed -> Bool
(Seed -> Seed -> Bool) -> (Seed -> Seed -> Bool) -> Eq Seed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seed -> Seed -> Bool
$c/= :: Seed -> Seed -> Bool
== :: Seed -> Seed -> Bool
$c== :: Seed -> Seed -> Bool
Eq, Eq Seed
Eq Seed
-> (Seed -> Seed -> Ordering)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Bool)
-> (Seed -> Seed -> Seed)
-> (Seed -> Seed -> Seed)
-> Ord Seed
Seed -> Seed -> Bool
Seed -> Seed -> Ordering
Seed -> Seed -> Seed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Seed -> Seed -> Seed
$cmin :: Seed -> Seed -> Seed
max :: Seed -> Seed -> Seed
$cmax :: Seed -> Seed -> Seed
>= :: Seed -> Seed -> Bool
$c>= :: Seed -> Seed -> Bool
> :: Seed -> Seed -> Bool
$c> :: Seed -> Seed -> Bool
<= :: Seed -> Seed -> Bool
$c<= :: Seed -> Seed -> Bool
< :: Seed -> Seed -> Bool
$c< :: Seed -> Seed -> Bool
compare :: Seed -> Seed -> Ordering
$ccompare :: Seed -> Seed -> Ordering
$cp1Ord :: Eq Seed
Ord, Typeable, b -> Seed -> Seed
NonEmpty Seed -> Seed
Seed -> Seed -> Seed
(Seed -> Seed -> Seed)
-> (NonEmpty Seed -> Seed)
-> (forall b. Integral b => b -> Seed -> Seed)
-> Semigroup Seed
forall b. Integral b => b -> Seed -> Seed
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Seed -> Seed
$cstimes :: forall b. Integral b => b -> Seed -> Seed
sconcat :: NonEmpty Seed -> Seed
$csconcat :: NonEmpty Seed -> Seed
<> :: Seed -> Seed -> Seed
$c<> :: Seed -> Seed -> Seed
Semigroup, Semigroup Seed
Seed
Semigroup Seed
-> Seed
-> (Seed -> Seed -> Seed)
-> ([Seed] -> Seed)
-> Monoid Seed
[Seed] -> Seed
Seed -> Seed -> Seed
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Seed] -> Seed
$cmconcat :: [Seed] -> Seed
mappend :: Seed -> Seed -> Seed
$cmappend :: Seed -> Seed -> Seed
mempty :: Seed
$cmempty :: Seed
$cp1Monoid :: Semigroup Seed
Monoid, Seed -> Int
Seed -> Ptr p -> IO ()
Seed -> (Ptr p -> IO a) -> IO a
(Seed -> Int)
-> (forall p a. Seed -> (Ptr p -> IO a) -> IO a)
-> (forall p. Seed -> Ptr p -> IO ())
-> ByteArrayAccess Seed
forall p. Seed -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Seed -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: Seed -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. Seed -> Ptr p -> IO ()
withByteArray :: Seed -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. Seed -> (Ptr p -> IO a) -> IO a
length :: Seed -> Int
$clength :: Seed -> Int
ByteArrayAccess, Eq Seed
Ord Seed
Monoid Seed
ByteArrayAccess Seed
Eq Seed
-> Ord Seed
-> Monoid Seed
-> ByteArrayAccess Seed
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, Seed))
-> ByteArray Seed
Int -> (Ptr p -> IO a) -> IO (a, Seed)
forall ba.
Eq ba
-> Ord ba
-> Monoid ba
-> ByteArrayAccess ba
-> (forall p a. Int -> (Ptr p -> IO a) -> IO (a, ba))
-> ByteArray ba
forall p a. Int -> (Ptr p -> IO a) -> IO (a, Seed)
allocRet :: Int -> (Ptr p -> IO a) -> IO (a, Seed)
$callocRet :: forall p a. Int -> (Ptr p -> IO a) -> IO (a, Seed)
$cp4ByteArray :: ByteArrayAccess Seed
$cp3ByteArray :: Monoid Seed
$cp2ByteArray :: Ord Seed
$cp1ByteArray :: Eq Seed
ByteArray, String -> Seed
(String -> Seed) -> IsString Seed
forall a. (String -> a) -> IsString a
fromString :: String -> Seed
$cfromString :: String -> Seed
IsString)

type Passphrase = String

-- | Create a seed from 'MmemonicSentence' and 'Passphrase' using the BIP39
-- algorithm.
sentenceToSeed :: ValidMnemonicSentence mw
               => MnemonicSentence mw -- ^ 'MmenomicPhrase' of mw words
               -> Dictionary          -- ^  Dictionary' of words/indexes
               -> Passphrase          -- ^ 'Passphrase' used to generate
               -> Seed
sentenceToSeed :: MnemonicSentence mw -> Dictionary -> String -> Seed
sentenceToSeed MnemonicSentence mw
mw Dictionary
dic =
    MnemonicPhrase mw -> Dictionary -> String -> Seed
forall (mw :: Nat).
ValidMnemonicSentence mw =>
MnemonicPhrase mw -> Dictionary -> String -> Seed
phraseToSeed (Dictionary -> MnemonicSentence mw -> MnemonicPhrase mw
forall (mw :: Nat).
ValidMnemonicSentence mw =>
Dictionary -> MnemonicSentence mw -> MnemonicPhrase mw
mnemonicSentenceToMnemonicPhrase Dictionary
dic MnemonicSentence mw
mw) Dictionary
dic

-- | Create a seed from 'MmemonicPhrase' and 'Passphrase' using the BIP39
-- algorithm.
phraseToSeed :: ValidMnemonicSentence mw
             => MnemonicPhrase mw -- ^ 'MmenomicPhrase' of mw words
             -> Dictionary        -- ^  Dictionary' of words/indexes
             -> Passphrase        -- ^ 'Passphrase' used to generate
             -> Seed
phraseToSeed :: MnemonicPhrase mw -> Dictionary -> String -> Seed
phraseToSeed MnemonicPhrase mw
mw Dictionary
dic String
passphrase =
    Parameters -> UArray Word8 -> UArray Word8 -> Seed
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA512
                    (Int -> Int -> Parameters
PBKDF2.Parameters Int
2048 Int
64)
                    UArray Word8
sentence
                    (String -> UArray Word8
toData (String
"mnemonic" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
passphrase))
  where
    sentence :: UArray Word8
sentence = String -> UArray Word8
toData (String -> UArray Word8) -> String -> UArray Word8
forall a b. (a -> b) -> a -> b
$ Dictionary -> MnemonicPhrase mw -> String
forall (mw :: Nat).
ValidMnemonicSentence mw =>
Dictionary -> MnemonicPhrase mw -> String
mnemonicPhraseToString Dictionary
dic MnemonicPhrase mw
mw
    toData :: String -> UArray Word8
toData = Encoding -> String -> UArray Word8
String.toBytes Encoding
String.UTF8


-- -------------------------------------------------------------------------- --
-- Mnemonic Sentence and Mnemonic Phrase
-- -------------------------------------------------------------------------- --

-- | Mnemonic Sentence is a list of 'WordIndex'.
--
-- This is the generic representation of a mnemonic phrase that can be used for
-- transalating to a different dictionary (example: English to Japanese).
--
-- This is mainly used to convert from/to the 'Entropy' and for 'cardanoSlSeed'
--
newtype MnemonicSentence (mw :: Nat) = MnemonicSentence
    { MnemonicSentence mw -> ListN mw WordIndex
mnemonicSentenceToListN :: ListN mw WordIndex
    }
  deriving (Int -> MnemonicSentence mw -> ShowS
[MnemonicSentence mw] -> ShowS
MnemonicSentence mw -> String
(Int -> MnemonicSentence mw -> ShowS)
-> (MnemonicSentence mw -> String)
-> ([MnemonicSentence mw] -> ShowS)
-> Show (MnemonicSentence mw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mw :: Nat). Int -> MnemonicSentence mw -> ShowS
forall (mw :: Nat). [MnemonicSentence mw] -> ShowS
forall (mw :: Nat). MnemonicSentence mw -> String
showList :: [MnemonicSentence mw] -> ShowS
$cshowList :: forall (mw :: Nat). [MnemonicSentence mw] -> ShowS
show :: MnemonicSentence mw -> String
$cshow :: forall (mw :: Nat). MnemonicSentence mw -> String
showsPrec :: Int -> MnemonicSentence mw -> ShowS
$cshowsPrec :: forall (mw :: Nat). Int -> MnemonicSentence mw -> ShowS
Show, MnemonicSentence mw -> MnemonicSentence mw -> Bool
(MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> Eq (MnemonicSentence mw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
/= :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c/= :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
== :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c== :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
Eq, Eq (MnemonicSentence mw)
Eq (MnemonicSentence mw)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Ordering)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> (MnemonicSentence mw -> MnemonicSentence mw -> Bool)
-> (MnemonicSentence mw
    -> MnemonicSentence mw -> MnemonicSentence mw)
-> (MnemonicSentence mw
    -> MnemonicSentence mw -> MnemonicSentence mw)
-> Ord (MnemonicSentence mw)
MnemonicSentence mw -> MnemonicSentence mw -> Bool
MnemonicSentence mw -> MnemonicSentence mw -> Ordering
MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (mw :: Nat). Eq (MnemonicSentence mw)
forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Ordering
forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
min :: MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
$cmin :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
max :: MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
$cmax :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> MnemonicSentence mw
>= :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c>= :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
> :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c> :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
<= :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c<= :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
< :: MnemonicSentence mw -> MnemonicSentence mw -> Bool
$c< :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Bool
compare :: MnemonicSentence mw -> MnemonicSentence mw -> Ordering
$ccompare :: forall (mw :: Nat).
MnemonicSentence mw -> MnemonicSentence mw -> Ordering
$cp1Ord :: forall (mw :: Nat). Eq (MnemonicSentence mw)
Ord, Typeable, MnemonicSentence mw -> ()
(MnemonicSentence mw -> ()) -> NormalForm (MnemonicSentence mw)
forall a. (a -> ()) -> NormalForm a
forall (mw :: Nat). MnemonicSentence mw -> ()
toNormalForm :: MnemonicSentence mw -> ()
$ctoNormalForm :: forall (mw :: Nat). MnemonicSentence mw -> ()
NormalForm)
instance ValidMnemonicSentence mw => IsList (MnemonicSentence mw) where
    type Item (MnemonicSentence mw) = WordIndex
    fromList :: [Item (MnemonicSentence mw)] -> MnemonicSentence mw
fromList = ListN mw WordIndex -> MnemonicSentence mw
forall (mw :: Nat). ListN mw WordIndex -> MnemonicSentence mw
MnemonicSentence (ListN mw WordIndex -> MnemonicSentence mw)
-> ([WordIndex] -> ListN mw WordIndex)
-> [WordIndex]
-> MnemonicSentence mw
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ListN mw WordIndex
-> Maybe (ListN mw WordIndex) -> ListN mw WordIndex
forall a. a -> Maybe a -> a
fromMaybe (String -> ListN mw WordIndex
forall a. HasCallStack => String -> a
error String
"invalid mnemonic size") (Maybe (ListN mw WordIndex) -> ListN mw WordIndex)
-> ([WordIndex] -> Maybe (ListN mw WordIndex))
-> [WordIndex]
-> ListN mw WordIndex
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [WordIndex] -> Maybe (ListN mw WordIndex)
forall (n :: Nat) a.
(KnownNat n, NatWithinBound Int n) =>
[a] -> Maybe (ListN n a)
ListN.toListN
    toList :: MnemonicSentence mw -> [Item (MnemonicSentence mw)]
toList = ListN mw WordIndex -> [WordIndex]
forall (n :: Nat) a. ListN n a -> [a]
ListN.unListN (ListN mw WordIndex -> [WordIndex])
-> (MnemonicSentence mw -> ListN mw WordIndex)
-> MnemonicSentence mw
-> [WordIndex]
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MnemonicSentence mw -> ListN mw WordIndex
forall (mw :: Nat). MnemonicSentence mw -> ListN mw WordIndex
mnemonicSentenceToListN

-- | Type Constraint to validate the given 'Nat' is valid for the supported
-- 'MnemonicSentence'
type ValidMnemonicSentence (mw :: Nat) =
    ( KnownNat mw
    , NatWithinBound Int mw
    , Elem mw '[9, 12, 15, 18, 21, 24]
    )

-- | Human readable representation of a 'MnemonicSentence'
--
newtype MnemonicPhrase (mw :: Nat) = MnemonicPhrase
    { MnemonicPhrase mw -> ListN mw String
mnemonicPhraseToListN :: ListN mw String
    }
  deriving (Int -> MnemonicPhrase mw -> ShowS
[MnemonicPhrase mw] -> ShowS
MnemonicPhrase mw -> String
(Int -> MnemonicPhrase mw -> ShowS)
-> (MnemonicPhrase mw -> String)
-> ([MnemonicPhrase mw] -> ShowS)
-> Show (MnemonicPhrase mw)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (mw :: Nat). Int -> MnemonicPhrase mw -> ShowS
forall (mw :: Nat). [MnemonicPhrase mw] -> ShowS
forall (mw :: Nat). MnemonicPhrase mw -> String
showList :: [MnemonicPhrase mw] -> ShowS
$cshowList :: forall (mw :: Nat). [MnemonicPhrase mw] -> ShowS
show :: MnemonicPhrase mw -> String
$cshow :: forall (mw :: Nat). MnemonicPhrase mw -> String
showsPrec :: Int -> MnemonicPhrase mw -> ShowS
$cshowsPrec :: forall (mw :: Nat). Int -> MnemonicPhrase mw -> ShowS
Show, MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
(MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> Eq (MnemonicPhrase mw)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
/= :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c/= :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
== :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c== :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
Eq, Eq (MnemonicPhrase mw)
Eq (MnemonicPhrase mw)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Ordering)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> Bool)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw)
-> (MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw)
-> Ord (MnemonicPhrase mw)
MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
MnemonicPhrase mw -> MnemonicPhrase mw -> Ordering
MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (mw :: Nat). Eq (MnemonicPhrase mw)
forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
forall (mw :: Nat).
MnemonicPhrase mw -> MnemonicPhrase mw -> Ordering
forall (mw :: Nat).
MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
min :: MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
$cmin :: forall (mw :: Nat).
MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
max :: MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
$cmax :: forall (mw :: Nat).
MnemonicPhrase mw -> MnemonicPhrase mw -> MnemonicPhrase mw
>= :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c>= :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
> :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c> :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
<= :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c<= :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
< :: MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
$c< :: forall (mw :: Nat). MnemonicPhrase mw -> MnemonicPhrase mw -> Bool
compare :: MnemonicPhrase mw -> MnemonicPhrase mw -> Ordering
$ccompare :: forall (mw :: Nat).
MnemonicPhrase mw -> MnemonicPhrase mw -> Ordering
$cp1Ord :: forall (mw :: Nat). Eq (MnemonicPhrase mw)
Ord, Typeable, MnemonicPhrase mw -> ()
(MnemonicPhrase mw -> ()) -> NormalForm (MnemonicPhrase mw)
forall a. (a -> ()) -> NormalForm a
forall (mw :: Nat). MnemonicPhrase mw -> ()
toNormalForm :: MnemonicPhrase mw -> ()
$ctoNormalForm :: forall (mw :: Nat). MnemonicPhrase mw -> ()
NormalForm)
instance ValidMnemonicSentence mw => IsList (MnemonicPhrase mw) where
    type Item (MnemonicPhrase mw) = String
    fromList :: [Item (MnemonicPhrase mw)] -> MnemonicPhrase mw
fromList = MnemonicPhrase mw
-> Either MnemonicWordsError (MnemonicPhrase mw)
-> MnemonicPhrase mw
forall b a. b -> Either a b -> b
fromRight (String -> MnemonicPhrase mw
forall a. HasCallStack => String -> a
error String
"invalid mnemonic phrase") (Either MnemonicWordsError (MnemonicPhrase mw)
 -> MnemonicPhrase mw)
-> ([String] -> Either MnemonicWordsError (MnemonicPhrase mw))
-> [String]
-> MnemonicPhrase mw
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [String] -> Either MnemonicWordsError (MnemonicPhrase mw)
forall (mw :: Nat).
ValidMnemonicSentence mw =>
[String] -> Either MnemonicWordsError (MnemonicPhrase mw)
mnemonicPhrase
    toList :: MnemonicPhrase mw -> [Item (MnemonicPhrase mw)]
toList = ListN mw String -> [String]
forall (n :: Nat) a. ListN n a -> [a]
ListN.unListN (ListN mw String -> [String])
-> (MnemonicPhrase mw -> ListN mw String)
-> MnemonicPhrase mw
-> [String]
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MnemonicPhrase mw -> ListN mw String
forall (mw :: Nat). MnemonicPhrase mw -> ListN mw String
mnemonicPhraseToListN

mnemonicPhrase :: forall mw . ValidMnemonicSentence mw => [String] -> Either MnemonicWordsError (MnemonicPhrase mw)
mnemonicPhrase :: [String] -> Either MnemonicWordsError (MnemonicPhrase mw)
mnemonicPhrase [String]
l = ListN mw String -> MnemonicPhrase mw
forall (mw :: Nat). ListN mw String -> MnemonicPhrase mw
MnemonicPhrase (ListN mw String -> MnemonicPhrase mw)
-> Either MnemonicWordsError (ListN mw String)
-> Either MnemonicWordsError (MnemonicPhrase mw)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either MnemonicWordsError (ListN mw String)
-> (ListN mw String -> Either MnemonicWordsError (ListN mw String))
-> Maybe (ListN mw String)
-> Either MnemonicWordsError (ListN mw String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (MnemonicWordsError -> Either MnemonicWordsError (ListN mw String)
forall a b. a -> Either a b
Left (MnemonicWordsError -> Either MnemonicWordsError (ListN mw String))
-> MnemonicWordsError
-> Either MnemonicWordsError (ListN mw String)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MnemonicWordsError
ErrWrongNumberOfWords ([String] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [String]
l) (Proxy mw -> Int
forall (n :: Nat) (proxy :: Nat -> Type).
(KnownNat n, NatWithinBound Int n) =>
proxy n -> Int
natValInt @mw Proxy mw
forall k (t :: k). Proxy t
Proxy))
     ListN mw String -> Either MnemonicWordsError (ListN mw String)
forall a b. b -> Either a b
Right
    ([String] -> Maybe (ListN mw String)
forall (n :: Nat) a.
(KnownNat n, NatWithinBound Int n) =>
[a] -> Maybe (ListN n a)
ListN.toListN [String]
l)
{-# INLINABLE mnemonicPhrase #-}

-- | check a given 'MnemonicPhrase' is valid for the given 'Dictionary'
--
checkMnemonicPhrase :: forall mw . ValidMnemonicSentence mw
                    => Dictionary
                    -> MnemonicPhrase mw
                    -> Bool
checkMnemonicPhrase :: Dictionary -> MnemonicPhrase mw -> Bool
checkMnemonicPhrase Dictionary
dic (MnemonicPhrase ListN mw String
ln) =
    (Bool -> String -> Bool) -> Bool -> ListN mw String -> Bool
forall b a (n :: Nat). (b -> a -> b) -> b -> ListN n a -> b
ListN.foldl' (\Bool
acc String
s -> (Dictionary -> String -> Bool
dictionaryTestWord Dictionary
dic String
s Bool -> Bool -> Bool
&& Bool
acc)) Bool
True ListN mw String
ln

-- | convert the given 'MnemonicPhrase' to a generic 'MnemonicSentence'
-- with the given 'Dictionary'.
--
-- This function assumes the 'Dictionary' and the 'MnemonicPhrase' are
-- compatible (see 'checkMnemonicPhrase').
--
mnemonicPhraseToMnemonicSentence :: forall mw . ValidMnemonicSentence mw
                                 => Dictionary
                                 -> MnemonicPhrase mw
                                 -> Either DictionaryError (MnemonicSentence mw)
mnemonicPhraseToMnemonicSentence :: Dictionary
-> MnemonicPhrase mw
-> Either DictionaryError (MnemonicSentence mw)
mnemonicPhraseToMnemonicSentence Dictionary
dic (MnemonicPhrase ListN mw String
ln) = ListN mw WordIndex -> MnemonicSentence mw
forall (mw :: Nat). ListN mw WordIndex -> MnemonicSentence mw
MnemonicSentence (ListN mw WordIndex -> MnemonicSentence mw)
-> Either DictionaryError (ListN mw WordIndex)
-> Either DictionaryError (MnemonicSentence mw)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> Either DictionaryError WordIndex)
-> ListN mw String -> Either DictionaryError (ListN mw WordIndex)
forall (m :: Type -> Type) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m (ListN n b)
ListN.mapM (Dictionary -> String -> Either DictionaryError WordIndex
dictionaryWordToIndex Dictionary
dic) ListN mw String
ln

-- | convert the given generic 'MnemonicSentence' to a human readable
-- 'MnemonicPhrase' targetting the language of the given 'Dictionary'.
mnemonicSentenceToMnemonicPhrase :: forall mw . ValidMnemonicSentence mw
                                 => Dictionary
                                 -> MnemonicSentence mw
                                 -> MnemonicPhrase mw
mnemonicSentenceToMnemonicPhrase :: Dictionary -> MnemonicSentence mw -> MnemonicPhrase mw
mnemonicSentenceToMnemonicPhrase Dictionary
dic (MnemonicSentence ListN mw WordIndex
ln) = ListN mw String -> MnemonicPhrase mw
forall (mw :: Nat). ListN mw String -> MnemonicPhrase mw
MnemonicPhrase (ListN mw String -> MnemonicPhrase mw)
-> ListN mw String -> MnemonicPhrase mw
forall a b. (a -> b) -> a -> b
$
    (WordIndex -> String) -> ListN mw WordIndex -> ListN mw String
forall a b (n :: Nat). (a -> b) -> ListN n a -> ListN n b
ListN.map (Dictionary -> WordIndex -> String
dictionaryIndexToWord Dictionary
dic) ListN mw WordIndex
ln

mnemonicPhraseToString :: forall mw . ValidMnemonicSentence mw
                       => Dictionary
                       -> MnemonicPhrase mw
                       -> String
mnemonicPhraseToString :: Dictionary -> MnemonicPhrase mw -> String
mnemonicPhraseToString Dictionary
dic (MnemonicPhrase ListN mw String
ln) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse (Dictionary -> String
dictionaryWordSeparator Dictionary
dic) (ListN mw String -> [String]
forall (n :: Nat) a. ListN n a -> [a]
ListN.unListN ListN mw String
ln)

mnemonicSentenceToString :: forall mw . ValidMnemonicSentence mw
                         => Dictionary
                         -> MnemonicSentence mw
                         -> String
mnemonicSentenceToString :: Dictionary -> MnemonicSentence mw -> String
mnemonicSentenceToString Dictionary
dic = Dictionary -> MnemonicPhrase mw -> String
forall (mw :: Nat).
ValidMnemonicSentence mw =>
Dictionary -> MnemonicPhrase mw -> String
mnemonicPhraseToString Dictionary
dic
                             (MnemonicPhrase mw -> String)
-> (MnemonicSentence mw -> MnemonicPhrase mw)
-> MnemonicSentence mw
-> String
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dictionary -> MnemonicSentence mw -> MnemonicPhrase mw
forall (mw :: Nat).
ValidMnemonicSentence mw =>
Dictionary -> MnemonicSentence mw -> MnemonicPhrase mw
mnemonicSentenceToMnemonicPhrase Dictionary
dic

-- | translate the given 'MnemonicPhrase' from one dictionary into another.
--
-- This function assumes the source dictionary is compatible with the given
-- 'MnemonicPhrase' (see 'checkMnemonicPhrase')
--
translateTo :: forall mw . ValidMnemonicSentence mw
            => Dictionary -- ^ source dictionary
            -> Dictionary -- ^ destination dictionary
            -> MnemonicPhrase mw
            -> Either DictionaryError (MnemonicPhrase mw)
translateTo :: Dictionary
-> Dictionary
-> MnemonicPhrase mw
-> Either DictionaryError (MnemonicPhrase mw)
translateTo Dictionary
dicSrc Dictionary
dicDst (MnemonicPhrase ListN mw String
ln) = ListN mw String -> MnemonicPhrase mw
forall (mw :: Nat). ListN mw String -> MnemonicPhrase mw
MnemonicPhrase (ListN mw String -> MnemonicPhrase mw)
-> Either DictionaryError (ListN mw String)
-> Either DictionaryError (MnemonicPhrase mw)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (String -> Either DictionaryError String)
-> ListN mw String -> Either DictionaryError (ListN mw String)
forall (m :: Type -> Type) a b (n :: Nat).
Monad m =>
(a -> m b) -> ListN n a -> m (ListN n b)
ListN.mapM (String -> Either DictionaryError String
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either DictionaryError String)
-> (WordIndex -> String)
-> WordIndex
-> Either DictionaryError String
forall k (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dictionary -> WordIndex -> String
dictionaryIndexToWord Dictionary
dicDst (WordIndex -> Either DictionaryError String)
-> (String -> Either DictionaryError WordIndex)
-> String
-> Either DictionaryError String
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Dictionary -> String -> Either DictionaryError WordIndex
dictionaryWordToIndex Dictionary
dicSrc) ListN mw String
ln

------------------------------------------------------------------------
-- Helpers
------------------------------------------------------------------------

-- | convenient type level constraint to validate a given 'Nat' e is an elemnt
-- of the list of 'Nat' l.
type family Elem (e :: Nat) (l :: [Nat]) :: Constraint where
    Elem e '[] = TypeError ('Text "offset: field "
             ':<>: 'ShowType e
             ':<>: 'Text " not elements of valids values")
    Elem e (e ': _) = ()
    Elem e (_ ': xs) = Elem e xs

-- -------------------------------------------------------------------------- --
-- Errors
-- -------------------------------------------------------------------------- --

data EntropyError csz
    = ErrInvalidEntropyLength
          Int             --  Actual length in bits
          Int             --  Expected length in bits
    | ErrInvalidEntropyChecksum
          (Checksum csz)  --  Actual checksum
          (Checksum csz)  --  Expected checksum
    deriving (Int -> EntropyError csz -> ShowS
[EntropyError csz] -> ShowS
EntropyError csz -> String
(Int -> EntropyError csz -> ShowS)
-> (EntropyError csz -> String)
-> ([EntropyError csz] -> ShowS)
-> Show (EntropyError csz)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (csz :: Nat). Int -> EntropyError csz -> ShowS
forall (csz :: Nat). [EntropyError csz] -> ShowS
forall (csz :: Nat). EntropyError csz -> String
showList :: [EntropyError csz] -> ShowS
$cshowList :: forall (csz :: Nat). [EntropyError csz] -> ShowS
show :: EntropyError csz -> String
$cshow :: forall (csz :: Nat). EntropyError csz -> String
showsPrec :: Int -> EntropyError csz -> ShowS
$cshowsPrec :: forall (csz :: Nat). Int -> EntropyError csz -> ShowS
Show)

data MnemonicWordsError
    = ErrWrongNumberOfWords
          Int -- Actual number of words
          Int -- Expected number of words
    deriving (Int -> MnemonicWordsError -> ShowS
[MnemonicWordsError] -> ShowS
MnemonicWordsError -> String
(Int -> MnemonicWordsError -> ShowS)
-> (MnemonicWordsError -> String)
-> ([MnemonicWordsError] -> ShowS)
-> Show MnemonicWordsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MnemonicWordsError] -> ShowS
$cshowList :: [MnemonicWordsError] -> ShowS
show :: MnemonicWordsError -> String
$cshow :: MnemonicWordsError -> String
showsPrec :: Int -> MnemonicWordsError -> ShowS
$cshowsPrec :: Int -> MnemonicWordsError -> ShowS
Show)