Wallet.hs

-- |
-- Module      : Cardano.Crypto.Wallet
-- Description : HD Wallet routines
-- Maintainer  : vincent@typed.io
--
-- This provides similar functionality to BIP32 but using
-- Ed25519 arithmetic instead of P256K1 arithmethic.
--
-- Key can be hierarchically derived from private key in two
-- fashions: Hardened or Normal.
--
-- In the hardened scheme, the child secret key is not linearly
-- derived, so that the child public key has no way
-- to be efficiently computed from the parent public key.
--
-- The normal scheme allows anyone to derive public keys from
-- public key.
--
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE PatternSynonyms     #-}

module Cardano.Crypto.Wallet
    ( ChainCode(..)
    , DerivationScheme(..)
    , DerivationIndex
    , pattern LatestScheme
    -- * Extended Private & Public types
    , XPrv
    , XPub(..)
    , XSignature
    , generate
    , generateNew
    , xprv
    , xpub
    , xsignature
    , unXPrv
    , unXPub
    , unXSignature
    , toXPub
    , xPubGetPublicKey
    , xPrvChangePass
    -- * Derivation function
    , deriveXPrv
    , deriveXPub
    -- * Signature & Verification from extended types
    , sign
    , verify
    ) where

import           Basement.Compat.Typeable
import           Control.DeepSeq                 (NFData)
import           Control.Arrow                   (second)
import           Crypto.Error                    (throwCryptoError, CryptoFailable(..), CryptoError(..))
import qualified Crypto.MAC.HMAC                 as HMAC
import qualified Crypto.PubKey.Ed25519           as Ed25519
import           Crypto.KDF.PBKDF2               (fastPBKDF2_SHA512, Parameters(..))
import           Data.ByteArray                  (ByteArrayAccess, convert)
import qualified Data.ByteArray                  as B (append, length, splitAt)
import           Data.ByteString                 (ByteString)
import qualified Data.ByteString.Char8           as BC
import           Data.Hashable                   (Hashable)
import           Data.Word
import           GHC.Generics                    (Generic)

import           Cardano.Crypto.Wallet.Encrypted
import           Cardano.Crypto.Wallet.Pure      ({-XPub (..),-} hFinalize,
                                                  hInitSeed)
import           Cardano.Crypto.Wallet.Types

import           GHC.Stack

newtype XPrv = XPrv EncryptedKey
    deriving (NFData, Typeable, ByteArrayAccess)

data XPub = XPub
    { xpubPublicKey :: !ByteString
    , xpubChaincode :: !ChainCode
    } deriving (Eq, Show, Ord, Typeable, Generic)

instance NFData XPub
instance Hashable XPub

newtype XSignature = XSignature
    { unXSignature :: ByteString
    } deriving (Show, Eq, Ord, NFData, Hashable, ByteArrayAccess)

-- | Generate a new XPrv
--
-- The seed needs to be at least 32 bytes, otherwise an asynchronous error is thrown
generate :: (ByteArrayAccess passPhrase, ByteArrayAccess seed)
         => seed
         -> passPhrase
         -> XPrv
generate seed passPhrase
    | B.length seed < 32 = error ("Wallet.generate: seed needs to be >= 32 bytes, got : " ++ show (B.length seed))
    | otherwise          = loop 1
  where
    phrase :: Int -> ByteString
    phrase i = "Root Seed Chain " `B.append` BC.pack (show i)

    -- repeatdly try to generate from a seed, if we reach 1000th iteration we just bail
    -- this should find a candidate after 2 tries on average
    loop i
        | i > 1000  = error "internal error: Wallet.generate looping forever"
        | otherwise =
            case encryptedCreate iL passPhrase iR of
                    CryptoPassed k -> XPrv k
                    CryptoFailed err
                        | err == CryptoError_SecretKeyStructureInvalid -> loop (i+1)
                        | otherwise                                    -> error "internal error: Wallet.generate: got error from encryptedCreate"
      where (iL, iR) = hFinalize
                     $ flip HMAC.update (phrase i)
                     $ hInitSeed seed

-- | Generate a new XPrv from an entropy seed
--
-- The seed should be at least 16 bytes, although it is not enforced
--
-- The passphrase encrypt the secret key in memory
generateNew :: (ByteArrayAccess keyPassPhrase, ByteArrayAccess generationPassPhrase, ByteArrayAccess seed)
            => seed                 -- ^ Raw entropy used as source of randomness for this algorithm
            -> generationPassPhrase -- ^ User chosen passphrase for the generation phase
            -> keyPassPhrase        -- ^ Symmetric encryption key passphrase used for the in-memory security
            -> XPrv
generateNew seed genPassPhrase memPassPhrase =
    XPrv $ encryptedCreateDirectWithTweak out memPassPhrase
  where
    out :: ByteString
    out = fastPBKDF2_SHA512 (Parameters 4096 96) genPassPhrase seed

-- | Simple constructor
xprv :: ByteArrayAccess bin => bin -> Either String XPrv
xprv bs =
      maybe (Left "error: xprv needs to be 128 bytes") (Right . XPrv)
    $ encryptedKey
    $ convert bs

unXPrv :: XPrv -> ByteString
unXPrv (XPrv e) = unEncryptedKey e

xpub :: ByteString -> Either String XPub
xpub bs
    | B.length bs /= 64 = Left ("error: xprv needs to be 64 bytes: got " ++ show (B.length bs) ++ " bytes")
    | otherwise         =
        let (b1, b2) = B.splitAt 32 bs
         in Right $ XPub b1 (ChainCode $ convert b2)

unXPub :: XPub -> ByteString
unXPub (XPub pub (ChainCode cc)) = B.append pub cc

xsignature :: ByteString -> Either String XSignature
xsignature bs
    | B.length bs /= 64 = Left ("error: xsignature needs to be 64 bytes: got " ++ show (B.length bs) ++ " bytes")
    | otherwise         = Right $ XSignature bs

-- | Generate extended public key from private key
toXPub :: HasCallStack => XPrv -> XPub
toXPub (XPrv ekey) = XPub pub (ChainCode cc)
  where (_,r)     = B.splitAt 64 $ convert ekey
        (pub, cc) = B.splitAt 32 r

-- | Return the Ed25519 public key associated with a XPub context
xPubGetPublicKey :: XPub -> Ed25519.PublicKey
xPubGetPublicKey (XPub pub _) =
    throwCryptoError $ Ed25519.publicKey pub

xPrvChangePass :: (ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase)
               => oldPassPhrase -- ^ passphrase to decrypt the current encrypted key
               -> newPassPhrase -- ^ new passphrase to use for the new encrypted key
               -> XPrv
               -> XPrv
xPrvChangePass oldPass newPass (XPrv ekey) =
    XPrv $ encryptedChangePass oldPass newPass ekey

-- | Derive a child extended private key from an extended private key
deriveXPrv :: ByteArrayAccess passPhrase => DerivationScheme -> passPhrase -> XPrv -> Word32 -> XPrv
deriveXPrv ds passPhrase (XPrv ekey) n =
    XPrv (encryptedDerivePrivate ds ekey passPhrase n)

-- | Derive a child extended public key from an extended public key
deriveXPub :: DerivationScheme -> XPub -> Word32 -> Maybe XPub
deriveXPub ds (XPub pub (ChainCode cc)) n
    | n >= 0x80000000 = Nothing
    | otherwise       = Just $ uncurry XPub $ second ChainCode $ encryptedDerivePublic ds (pub,cc) n

sign :: (ByteArrayAccess passPhrase, ByteArrayAccess msg)
     => passPhrase
     -> XPrv
     -> msg
     -> XSignature
sign passphrase (XPrv ekey) ba =
    XSignature $ let (Signature sig) = encryptedSign ekey passphrase ba in sig

verify :: ByteArrayAccess msg => XPub -> msg -> XSignature -> Bool
verify (XPub point _) ba (XSignature signature) =
    let pub = throwCryptoError $ Ed25519.publicKey point
        sig = throwCryptoError $ Ed25519.signature signature
     in Ed25519.verify pub ba sig