-- |
-- Module      : Cardano.Crypto.Encoding.Seed
-- Description : tools relating to Paper Wallet
-- Maintainer  : nicolas.diprima@iohk.io
--
-- implementation of the proposal specification for Paper Wallet
-- see https://github.com/input-output-hk/cardano-specs/blob/master/proposals/0001-PaperWallet.md
--
-- however we allow more genericity in the implementation to allow
-- not only 12 mnemonic words to freeze but also 15, 18 and 21.
--
-- because the output mnemonic words are always 3 words longer (for the IV)
-- we cannot use 24 words long mnemonic sentence.
--
-- assumption:
--
-- * we use 'PBKDF2' with 'HMAC 512' to generate the OTP.
-- * we use 10000 iteration for the PBKDF2
-- * we use the 4 bytes "IOHK" for the CONSTANT
--

{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}

module Cardano.Crypto.Encoding.Seed
    ( Entropy
    , Passphrase
    , MnemonicSentence
    , ConsistentEntropy
    , ScrambleIV
    , mkScrambleIV
    , scramble
    , unscramble

    , IVSizeWords
    , IVSizeBits

    , -- helpers
      scrambleMnemonic
    ) where

import Foundation
import Foundation.Check
import Basement.Nat
import Crypto.Error

import Data.ByteArray (xor, ScrubbedBytes)
import Crypto.Encoding.BIP39
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import           Basement.Sized.List (ListN)
import qualified Basement.Sized.List as ListN
import Data.ByteArray (ByteArrayAccess)

import Data.ByteString (ByteString)
import qualified Data.ByteString as B

type IVSizeWords = 6
type IVSizeBytes = 8
type IVSizeBits  = 64

ivSizeBytes :: Int
ivSizeBytes :: Int
ivSizeBytes = Int
8

-- | Number of iteration of the PBKDF2
iterations :: Int
iterations :: Int
iterations = Int
10000

newtype ScrambleIV = ScrambleIV ByteString
    deriving (ScrambleIV -> ScrambleIV -> Bool
(ScrambleIV -> ScrambleIV -> Bool)
-> (ScrambleIV -> ScrambleIV -> Bool) -> Eq ScrambleIV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrambleIV -> ScrambleIV -> Bool
$c/= :: ScrambleIV -> ScrambleIV -> Bool
== :: ScrambleIV -> ScrambleIV -> Bool
$c== :: ScrambleIV -> ScrambleIV -> Bool
Eq,Eq ScrambleIV
Eq ScrambleIV
-> (ScrambleIV -> ScrambleIV -> Ordering)
-> (ScrambleIV -> ScrambleIV -> Bool)
-> (ScrambleIV -> ScrambleIV -> Bool)
-> (ScrambleIV -> ScrambleIV -> Bool)
-> (ScrambleIV -> ScrambleIV -> Bool)
-> (ScrambleIV -> ScrambleIV -> ScrambleIV)
-> (ScrambleIV -> ScrambleIV -> ScrambleIV)
-> Ord ScrambleIV
ScrambleIV -> ScrambleIV -> Bool
ScrambleIV -> ScrambleIV -> Ordering
ScrambleIV -> ScrambleIV -> ScrambleIV
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 :: ScrambleIV -> ScrambleIV -> ScrambleIV
$cmin :: ScrambleIV -> ScrambleIV -> ScrambleIV
max :: ScrambleIV -> ScrambleIV -> ScrambleIV
$cmax :: ScrambleIV -> ScrambleIV -> ScrambleIV
>= :: ScrambleIV -> ScrambleIV -> Bool
$c>= :: ScrambleIV -> ScrambleIV -> Bool
> :: ScrambleIV -> ScrambleIV -> Bool
$c> :: ScrambleIV -> ScrambleIV -> Bool
<= :: ScrambleIV -> ScrambleIV -> Bool
$c<= :: ScrambleIV -> ScrambleIV -> Bool
< :: ScrambleIV -> ScrambleIV -> Bool
$c< :: ScrambleIV -> ScrambleIV -> Bool
compare :: ScrambleIV -> ScrambleIV -> Ordering
$ccompare :: ScrambleIV -> ScrambleIV -> Ordering
$cp1Ord :: Eq ScrambleIV
Ord,Int -> ScrambleIV -> ShowS
[ScrambleIV] -> ShowS
ScrambleIV -> String
(Int -> ScrambleIV -> ShowS)
-> (ScrambleIV -> String)
-> ([ScrambleIV] -> ShowS)
-> Show ScrambleIV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrambleIV] -> ShowS
$cshowList :: [ScrambleIV] -> ShowS
show :: ScrambleIV -> String
$cshow :: ScrambleIV -> String
showsPrec :: Int -> ScrambleIV -> ShowS
$cshowsPrec :: Int -> ScrambleIV -> ShowS
Show,Typeable,ScrambleIV -> Int
ScrambleIV -> Ptr p -> IO ()
ScrambleIV -> (Ptr p -> IO a) -> IO a
(ScrambleIV -> Int)
-> (forall p a. ScrambleIV -> (Ptr p -> IO a) -> IO a)
-> (forall p. ScrambleIV -> Ptr p -> IO ())
-> ByteArrayAccess ScrambleIV
forall p. ScrambleIV -> 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. ScrambleIV -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: ScrambleIV -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. ScrambleIV -> Ptr p -> IO ()
withByteArray :: ScrambleIV -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. ScrambleIV -> (Ptr p -> IO a) -> IO a
length :: ScrambleIV -> Int
$clength :: ScrambleIV -> Int
ByteArrayAccess)
instance Arbitrary ScrambleIV where
    arbitrary :: Gen ScrambleIV
arbitrary = do
        ListN IVSizeBytes Word8
l <- Gen (ListN IVSizeBytes Word8)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (ListN IVSizeBytes Word8)
        ScrambleIV -> Gen ScrambleIV
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ScrambleIV -> Gen ScrambleIV) -> ScrambleIV -> Gen ScrambleIV
forall a b. (a -> b) -> a -> b
$ CryptoFailable ScrambleIV -> ScrambleIV
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable ScrambleIV -> ScrambleIV)
-> CryptoFailable ScrambleIV -> ScrambleIV
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable ScrambleIV
mkScrambleIV (ByteString -> CryptoFailable ScrambleIV)
-> ByteString -> CryptoFailable ScrambleIV
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ ListN IVSizeBytes Word8 -> [Word8]
forall (n :: Nat) a. ListN n a -> [a]
ListN.unListN ListN IVSizeBytes Word8
l

mkScrambleIV :: ByteString -> CryptoFailable ScrambleIV
mkScrambleIV :: ByteString -> CryptoFailable ScrambleIV
mkScrambleIV ByteString
bs
    | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ivSizeBytes = ScrambleIV -> CryptoFailable ScrambleIV
forall a. a -> CryptoFailable a
CryptoPassed (ByteString -> ScrambleIV
ScrambleIV ByteString
bs)
    | Bool
otherwise                  = CryptoError -> CryptoFailable ScrambleIV
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_IvSizeInvalid

-- | scramble the given entropy into an entropy slighly larger.
--
-- This entropy can then be converted to a mnemonic sentence:
--
-- @
-- freeze iv mnemonics passphrase = entropyToWords . scramble iv entropy passphrase
--   where
--     entropy = case wordsToEntropy mnemonics of
--         Nothing -> error "mnemonic to entropy failed"
--         Just e  -> e
-- @
scramble :: forall entropysizeI entropysizeO mnemonicsize scramblesize csI csO
         . ( ConsistentEntropy entropysizeI mnemonicsize csI
           , ConsistentEntropy entropysizeO scramblesize csO
           , (mnemonicsize + IVSizeWords) ~ scramblesize
           , (entropysizeI + IVSizeBits)  ~ entropysizeO
           )
         => ScrambleIV
         -> Entropy entropysizeI
         -> Passphrase
         -> Entropy entropysizeO
scramble :: ScrambleIV
-> Entropy entropysizeI -> Passphrase -> Entropy entropysizeO
scramble (ScrambleIV ByteString
iv) Entropy entropysizeI
e Passphrase
passphrase =
    let salt :: ByteString
salt = ByteString
iv
        otp :: ScrubbedBytes
        otp :: ScrubbedBytes
otp = Parameters -> Passphrase -> ByteString -> ScrubbedBytes
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA512
                    (Int -> Int -> Parameters
PBKDF2.Parameters Int
iterations Int
entropySize)
                    Passphrase
passphrase
                    ByteString
salt
        ee :: ByteString
ee = ScrubbedBytes -> ByteString -> ByteString
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
xor ScrubbedBytes
otp (Entropy entropysizeI -> ByteString
forall (n :: Nat). Entropy n -> ByteString
entropyRaw Entropy entropysizeI
e)
     in case ByteString -> Either (EntropyError csO) (Entropy entropysizeO)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy @entropysizeO (ByteString
iv ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
ee) of
            Left EntropyError csO
err -> Passphrase -> Entropy entropysizeO
forall a. HasCallStack => Passphrase -> a
error (Passphrase -> Entropy entropysizeO)
-> Passphrase -> Entropy entropysizeO
forall a b. (a -> b) -> a -> b
$ Passphrase
"scramble: the function BIP39.toEntropy returned an error: " Passphrase -> Passphrase -> Passphrase
forall a. Semigroup a => a -> a -> a
<> EntropyError csO -> Passphrase
forall a. Show a => a -> Passphrase
show EntropyError csO
err
            Right Entropy entropysizeO
e' -> Entropy entropysizeO
e'
  where
    entropySize :: Int
entropySize = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy entropysizeI -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy entropysizeI
forall k (t :: k). Proxy t
Proxy @entropysizeI)) Int -> Int -> Int
forall a. IDivisible a => a -> a -> a
`div` Int
8

-- | helper function to scramble mnemonics
scrambleMnemonic :: forall entropysizeI entropysizeO mnemonicsize scramblesize csI csO
                 . ( ConsistentEntropy entropysizeI mnemonicsize csI
                   , ConsistentEntropy entropysizeO scramblesize csO
                   , (mnemonicsize + IVSizeWords) ~ scramblesize
                   , (entropysizeI + IVSizeBits)  ~ entropysizeO
                   )
                 => Proxy entropysizeI
                 -> ScrambleIV
                 -> MnemonicSentence mnemonicsize
                 -> Passphrase
                 -> MnemonicSentence scramblesize
scrambleMnemonic :: Proxy entropysizeI
-> ScrambleIV
-> MnemonicSentence mnemonicsize
-> Passphrase
-> MnemonicSentence scramblesize
scrambleMnemonic Proxy entropysizeI
_ ScrambleIV
iv MnemonicSentence mnemonicsize
mw Passphrase
passphrase =
      forall (csz :: Nat) (mw :: Nat).
ConsistentEntropy entropysizeO mw csz =>
Entropy entropysizeO -> MnemonicSentence mw
forall (n :: Nat) (csz :: Nat) (mw :: Nat).
ConsistentEntropy n mw csz =>
Entropy n -> MnemonicSentence mw
entropyToWords @entropysizeO
    (Entropy entropysizeO -> MnemonicSentence scramblesize)
-> Entropy entropysizeO -> MnemonicSentence scramblesize
forall a b. (a -> b) -> a -> b
$ ScrambleIV
-> Entropy entropysizeI -> Passphrase -> Entropy entropysizeO
forall (entropysizeI :: Nat) (entropysizeO :: Nat)
       (mnemonicsize :: Nat) (scramblesize :: Nat) (csI :: Nat)
       (csO :: Nat).
(ConsistentEntropy entropysizeI mnemonicsize csI,
 ConsistentEntropy entropysizeO scramblesize csO,
 (mnemonicsize + IVSizeWords) ~ scramblesize,
 (entropysizeI + IVSizeBits) ~ entropysizeO) =>
ScrambleIV
-> Entropy entropysizeI -> Passphrase -> Entropy entropysizeO
scramble @entropysizeI @entropysizeO ScrambleIV
iv Entropy entropysizeI
entropy Passphrase
passphrase
  where
    entropy :: Entropy entropysizeI
entropy = case MnemonicSentence mnemonicsize
-> Either (EntropyError csI) (Entropy entropysizeI)
forall (ent :: Nat) (csz :: Nat) (mw :: Nat).
ConsistentEntropy ent mw csz =>
MnemonicSentence mw -> Either (EntropyError csz) (Entropy ent)
wordsToEntropy @entropysizeI MnemonicSentence mnemonicsize
mw of
        Left  EntropyError csI
err -> Passphrase -> Entropy entropysizeI
forall a. HasCallStack => Passphrase -> a
error (Passphrase -> Entropy entropysizeI)
-> Passphrase -> Entropy entropysizeI
forall a b. (a -> b) -> a -> b
$ Passphrase
"mnemonic to entropy failed: " Passphrase -> Passphrase -> Passphrase
forall a. Semigroup a => a -> a -> a
<> EntropyError csI -> Passphrase
forall a. Show a => a -> Passphrase
show EntropyError csI
err
        Right Entropy entropysizeI
e   -> Entropy entropysizeI
e

-- |
-- The reverse operation of 'scramble'
--
-- This function recovers the original entropy from the given scrambled entropy
-- and the associated password.
--
-- @
-- recover scrambled passphrase = entropyToWords @entropysizeO .
--     unscramble @entropysizeI @entropysizeO entropyScrambled passphrase
--   where
--     entropyScrambled = case wordsToEntropy @entropysizeI scrambled of
--         Nothing -> error "mnemonic to entropy failed"
--         Just e  -> e
-- @
--
unscramble :: forall entropysizeI entropysizeO mnemonicsize scramblesize csI csO
           . ( ConsistentEntropy entropysizeI scramblesize csI
             , ConsistentEntropy entropysizeO mnemonicsize csO
             , (mnemonicsize + IVSizeWords) ~ scramblesize
             , (entropysizeO + IVSizeBits)  ~ entropysizeI
             )
          => Entropy entropysizeI
          -> Passphrase
          -> Entropy entropysizeO
unscramble :: Entropy entropysizeI -> Passphrase -> Entropy entropysizeO
unscramble Entropy entropysizeI
e Passphrase
passphrase =
    let ee :: ByteString
ee = ScrubbedBytes -> ByteString -> ByteString
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
xor ScrubbedBytes
otp ByteString
eraw :: ByteString
     in case ByteString -> Either (EntropyError csO) (Entropy entropysizeO)
forall (n :: Nat) (csz :: Nat) ba.
(ValidEntropySize n, ValidChecksumSize n csz,
 ByteArrayAccess ba) =>
ba -> Either (EntropyError csz) (Entropy n)
toEntropy @entropysizeO ByteString
ee of
      Left EntropyError csO
err -> Passphrase -> Entropy entropysizeO
forall a. HasCallStack => Passphrase -> a
error (Passphrase -> Entropy entropysizeO)
-> Passphrase -> Entropy entropysizeO
forall a b. (a -> b) -> a -> b
$ Passphrase
"unscramble: the function BIP39.toEntropy returned an error: " Passphrase -> Passphrase -> Passphrase
forall a. Semigroup a => a -> a -> a
<> EntropyError csO -> Passphrase
forall a. Show a => a -> Passphrase
show EntropyError csO
err
      Right Entropy entropysizeO
e' -> Entropy entropysizeO
e'
  where
    (ByteString
iv, ByteString
eraw) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
ivSizeBytes (Entropy entropysizeI -> ByteString
forall (n :: Nat). Entropy n -> ByteString
entropyRaw Entropy entropysizeI
e) :: (ByteString, ByteString)
    salt :: ByteString
salt = ByteString
iv
    otp :: ScrubbedBytes
    otp :: ScrubbedBytes
otp = Parameters -> Passphrase -> ByteString -> ScrubbedBytes
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA512
                  (Int -> Int -> Parameters
PBKDF2.Parameters Int
iterations Int
entropySize)
                  Passphrase
passphrase
                  ByteString
salt
    entropySize :: Int
entropySize = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy entropysizeO -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy entropysizeO
forall k (t :: k). Proxy t
Proxy @entropysizeO)) Int -> Int -> Int
forall a. IDivisible a => a -> a -> a
`div` Int
8