{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Crypto.Encoding.BIP39
    ( cardanoSlSeed
    , module X
    ) where

import           Data.Proxy (Proxy)
import           Data.ByteString (ByteString)
import qualified Data.ByteArray as BA
import           Crypto.Hash (Blake2b_256, Digest, hash)

import           Crypto.Encoding.BIP39 as X

-- | **this is not a BIP39 function**
--
-- This function is the function used in `cardano-sl` (and Daedalus) to
-- generate a seed from a given mnemonic list.
--
-- https://github.com/input-output-hk/cardano-sl/blob/f5b8073b92b8219ae5fbb038c0ceb4a19502a86b/wallet/src/Pos/Util/BackupPhrase.hs#L59-L65
-- https://github.com/input-output-hk/cardano-sl/blob/429efc2426c63802ae86789f5b828dcbb42de88a/wallet/src/Pos/Util/Mnemonics.hs#L66-L87
--
cardanoSlSeed :: forall n csz mw . ConsistentEntropy n mw csz
              => Proxy n
              -> MnemonicSentence mw
              -> Maybe Seed
cardanoSlSeed :: Proxy n -> MnemonicSentence mw -> Maybe Seed
cardanoSlSeed Proxy n
_ MnemonicSentence mw
mw =
    case MnemonicSentence mw -> Either (EntropyError csz) (Entropy n)
forall (ent :: Nat) (csz :: Nat) (mw :: Nat).
ConsistentEntropy ent mw csz =>
MnemonicSentence mw -> Either (EntropyError csz) (Entropy ent)
wordsToEntropy @n @csz @mw MnemonicSentence mw
mw of
        Left EntropyError csz
_ -> Maybe Seed
forall a. Maybe a
Nothing
        Right Entropy n
e -> Seed -> Maybe Seed
forall a. a -> Maybe a
Just (Seed -> Maybe Seed) -> Seed -> Maybe Seed
forall a b. (a -> b) -> a -> b
$ ByteString -> Seed
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Seed) -> ByteString -> Seed
forall a b. (a -> b) -> a -> b
$ Digest Blake2b_256 -> ByteString
forall ba. ByteArrayAccess ba => ba -> ByteString
toCbor (Digest Blake2b_256 -> ByteString)
-> Digest Blake2b_256 -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest Blake2b_256
blake2b (ByteString -> Digest Blake2b_256)
-> ByteString -> Digest Blake2b_256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall ba. ByteArrayAccess ba => ba -> ByteString
toCbor (Entropy n -> ByteString
forall (n :: Nat). Entropy n -> ByteString
entropyRaw Entropy n
e)
  where blake2b :: ByteString -> Digest Blake2b_256
        blake2b :: ByteString -> Digest Blake2b_256
blake2b = ByteString -> Digest Blake2b_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash

        toCbor :: BA.ByteArrayAccess ba => ba -> ByteString
        toCbor :: ba -> ByteString
toCbor ba
bs
            | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24    = Word8 -> ByteString -> ByteString
forall a. ByteArray a => Word8 -> a -> a
BA.cons (Word8
0x40 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
bs
            | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x100 = Word8 -> ByteString -> ByteString
forall a. ByteArray a => Word8 -> a -> a
BA.cons Word8
0x58 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
forall a. ByteArray a => Word8 -> a -> a
BA.cons (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
bs
            | Bool
otherwise   = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"we do not support entropy of length > 256 bytes"
          where
            len :: Int
len = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
bs