Seed.hs

-- |
-- 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 = 8

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

newtype ScrambleIV = ScrambleIV ByteString
    deriving (Eq,Ord,Show,Typeable,ByteArrayAccess)
instance Arbitrary ScrambleIV where
    arbitrary = do
        l <- arbitrary :: Gen (ListN IVSizeBytes Word8)
        pure $ throwCryptoError $ mkScrambleIV $ B.pack $ ListN.unListN l

mkScrambleIV :: ByteString -> CryptoFailable ScrambleIV
mkScrambleIV bs
    | B.length bs == ivSizeBytes = CryptoPassed (ScrambleIV bs)
    | otherwise                  = CryptoFailed 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 iv) e passphrase =
    let salt = iv
        otp :: ScrubbedBytes
        otp = PBKDF2.fastPBKDF2_SHA512
                    (PBKDF2.Parameters iterations entropySize)
                    passphrase
                    salt
        ee = xor otp (entropyRaw e)
     in case toEntropy @entropysizeO (iv <> ee) of
            Left err -> error $ "scramble: the function BIP39.toEntropy returned an error: " <> show err
            Right e' -> e'
  where
    entropySize = fromIntegral (natVal (Proxy @entropysizeI)) `div` 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 _ iv mw passphrase =
      entropyToWords @entropysizeO
    $ scramble @entropysizeI @entropysizeO iv entropy passphrase
  where
    entropy = case wordsToEntropy @entropysizeI mw of
        Left  err -> error $ "mnemonic to entropy failed: " <> show err
        Right e   -> 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 e passphrase =
    let ee = xor otp eraw :: ByteString
     in case toEntropy @entropysizeO ee of
      Left err -> error $ "unscramble: the function BIP39.toEntropy returned an error: " <> show err
      Right e' -> e'
  where
    (iv, eraw) = B.splitAt ivSizeBytes (entropyRaw e) :: (ByteString, ByteString)
    salt = iv
    otp :: ScrubbedBytes
    otp = PBKDF2.fastPBKDF2_SHA512
                  (PBKDF2.Parameters iterations entropySize)
                  passphrase
                  salt
    entropySize = fromIntegral (natVal (Proxy @entropysizeO)) `div` 8