{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Implementation of address derivation for 'Shared' Keys.

module Cardano.Wallet.Primitive.AddressDerivation.Shared
    ( -- * Types
      SharedKey(..)

    -- * Generation and derivation
    , generateKeyFromSeed
    , unsafeGenerateKeyFromSeed

    , purposeCIP1854
    ) where

import Prelude

import Cardano.Address.Derivation
    ( xpubPublicKey )
import Cardano.Crypto.Wallet
    ( XPrv, XPub, toXPub, unXPrv, unXPub, xprv, xpub )
import Cardano.Mnemonic
    ( SomeMnemonic )
import Cardano.Wallet.Primitive.AddressDerivation
    ( BoundedAddressLength (..)
    , Depth (..)
    , DerivationType (..)
    , HardDerivation (..)
    , KeyFingerprint (..)
    , MkKeyFingerprint (..)
    , NetworkDiscriminant (..)
    , PersistPrivateKey (..)
    , PersistPublicKey (..)
    , SoftDerivation (..)
    , WalletKey (..)
    , fromHex
    , hex
    )
import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
    ( SharedKey (..), purposeCIP1854 )
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
    ( deriveAccountPrivateKeyShelley
    , deriveAddressPrivateKeyShelley
    , deriveAddressPublicKeyShelley
    , unsafeGenerateKeyFromSeedShelley
    )
import Cardano.Wallet.Primitive.AddressDiscovery
    ( GetPurpose (..) )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase (..), PassphraseHash (..), changePassphraseXPrv )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Control.Monad
    ( (<=<) )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_224 (..) )
import Crypto.Hash.IO
    ( HashAlgorithm (hashDigestSize) )
import Crypto.Hash.Utils
    ( blake2b224 )
import Data.ByteString
    ( ByteString )
import Data.Proxy
    ( Proxy (..) )

import qualified Data.ByteString as BS

{-------------------------------------------------------------------------------
                            Sequential Derivation
-------------------------------------------------------------------------------}

-- | Generate a root key from a corresponding seed.
-- The seed should be at least 16 bytes.
generateKeyFromSeed
    :: (SomeMnemonic, Maybe SomeMnemonic)
       -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> SharedKey 'RootK XPrv
generateKeyFromSeed :: (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> SharedKey 'RootK XPrv
generateKeyFromSeed = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> SharedKey 'RootK XPrv
forall (depth :: Depth).
(SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> SharedKey depth XPrv
unsafeGenerateKeyFromSeed

-- | Generate a new key from seed. Note that the @depth@ is left open so that
-- the caller gets to decide what type of key this is. This is mostly for
-- testing, in practice, seeds are used to represent root keys, and one should
-- use 'generateKeyFromSeed'.
unsafeGenerateKeyFromSeed
    :: (SomeMnemonic, Maybe SomeMnemonic)
        -- ^ The actual seed and its recovery / generation passphrase
    -> Passphrase "encryption"
    -> SharedKey depth XPrv
unsafeGenerateKeyFromSeed :: (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> SharedKey depth XPrv
unsafeGenerateKeyFromSeed (SomeMnemonic, Maybe SomeMnemonic)
mnemonics Passphrase "encryption"
pwd =
    XPrv -> SharedKey depth XPrv
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (XPrv -> SharedKey depth XPrv) -> XPrv -> SharedKey depth XPrv
forall a b. (a -> b) -> a -> b
$ (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> XPrv
unsafeGenerateKeyFromSeedShelley (SomeMnemonic, Maybe SomeMnemonic)
mnemonics Passphrase "encryption"
pwd

instance HardDerivation SharedKey where
    type AddressIndexDerivationType SharedKey = 'Soft

    deriveAccountPrivateKey :: Passphrase "encryption"
-> SharedKey 'RootK XPrv
-> Index 'Hardened 'AccountK
-> SharedKey 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwd (SharedKey XPrv
rootXPrv) Index 'Hardened 'AccountK
ix =
        XPrv -> SharedKey 'AccountK XPrv
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (XPrv -> SharedKey 'AccountK XPrv)
-> XPrv -> SharedKey 'AccountK XPrv
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'PurposeK
-> Passphrase "encryption"
-> XPrv
-> Index 'Hardened 'AccountK
-> XPrv
deriveAccountPrivateKeyShelley Index 'Hardened 'PurposeK
purposeCIP1854 Passphrase "encryption"
pwd XPrv
rootXPrv Index 'Hardened 'AccountK
ix

    deriveAddressPrivateKey :: Passphrase "encryption"
-> SharedKey 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType SharedKey) 'AddressK
-> SharedKey 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
pwd (SharedKey XPrv
accXPrv) Role
role Index (AddressIndexDerivationType SharedKey) 'AddressK
ix =
        XPrv -> SharedKey 'AddressK XPrv
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (XPrv -> SharedKey 'AddressK XPrv)
-> XPrv -> SharedKey 'AddressK XPrv
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption"
-> XPrv -> Role -> Index 'Soft 'AddressK -> XPrv
forall a (derivationType :: DerivationType) (level :: Depth).
Enum a =>
Passphrase "encryption"
-> XPrv -> a -> Index derivationType level -> XPrv
deriveAddressPrivateKeyShelley Passphrase "encryption"
pwd XPrv
accXPrv Role
role Index (AddressIndexDerivationType SharedKey) 'AddressK
Index 'Soft 'AddressK
ix

instance SoftDerivation SharedKey where
    deriveAddressPublicKey :: SharedKey 'AccountK XPub
-> Role -> Index 'Soft 'AddressK -> SharedKey 'AddressK XPub
deriveAddressPublicKey (SharedKey XPub
accXPub) Role
role Index 'Soft 'AddressK
ix =
        XPub -> SharedKey 'AddressK XPub
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (XPub -> SharedKey 'AddressK XPub)
-> XPub -> SharedKey 'AddressK XPub
forall a b. (a -> b) -> a -> b
$ XPub -> Role -> Index 'Soft 'AddressK -> XPub
forall a (derivationType :: DerivationType) (level :: Depth).
Enum a =>
XPub -> a -> Index derivationType level -> XPub
deriveAddressPublicKeyShelley XPub
accXPub Role
role Index 'Soft 'AddressK
ix

{-------------------------------------------------------------------------------
                            WalletKey implementation
-------------------------------------------------------------------------------}

instance WalletKey SharedKey where
    changePassphrase :: (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user")
-> SharedKey depth XPrv
-> SharedKey depth XPrv
changePassphrase (PassphraseScheme, Passphrase "user")
oldPwd (PassphraseScheme, Passphrase "user")
newPwd (SharedKey XPrv
prv) =
        XPrv -> SharedKey depth XPrv
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (XPrv -> SharedKey depth XPrv) -> XPrv -> SharedKey depth XPrv
forall a b. (a -> b) -> a -> b
$ (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user") -> XPrv -> XPrv
changePassphraseXPrv (PassphraseScheme, Passphrase "user")
oldPwd (PassphraseScheme, Passphrase "user")
newPwd XPrv
prv

    publicKey :: SharedKey depth XPrv -> SharedKey depth XPub
publicKey (SharedKey XPrv
prv) =
        XPub -> SharedKey depth XPub
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
toXPub XPrv
prv)

    digest :: SharedKey depth XPub -> Digest a
digest (SharedKey XPub
pub) =
        ByteString -> Digest a
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash (XPub -> ByteString
unXPub XPub
pub)

    getRawKey :: SharedKey depth raw -> raw
getRawKey =
        SharedKey depth raw -> raw
forall (depth :: Depth) raw. SharedKey depth raw -> raw
getKey

    liftRawKey :: raw -> SharedKey depth raw
liftRawKey =
        raw -> SharedKey depth raw
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey

    keyTypeDescriptor :: Proxy SharedKey -> String
keyTypeDescriptor Proxy SharedKey
_ =
        String
"sha"

{-------------------------------------------------------------------------------
                         Relationship Key / Address
-------------------------------------------------------------------------------}

instance GetPurpose SharedKey where
    getPurpose :: Index 'Hardened 'PurposeK
getPurpose = Index 'Hardened 'PurposeK
purposeCIP1854

{-------------------------------------------------------------------------------
                          Storing and retrieving keys
-------------------------------------------------------------------------------}

instance PersistPrivateKey (SharedKey 'RootK) where
    serializeXPrv :: (SharedKey 'RootK XPrv, PassphraseHash) -> (ByteString, ByteString)
serializeXPrv (SharedKey 'RootK XPrv
k, PassphraseHash
h) =
        ( ByteString -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
hex (ByteString -> ByteString)
-> (SharedKey 'RootK XPrv -> ByteString)
-> SharedKey 'RootK XPrv
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> ByteString
unXPrv (XPrv -> ByteString)
-> (SharedKey 'RootK XPrv -> XPrv)
-> SharedKey 'RootK XPrv
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedKey 'RootK XPrv -> XPrv
forall (depth :: Depth) raw. SharedKey depth raw -> raw
getKey (SharedKey 'RootK XPrv -> ByteString)
-> SharedKey 'RootK XPrv -> ByteString
forall a b. (a -> b) -> a -> b
$ SharedKey 'RootK XPrv
k
        , ScrubbedBytes -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
hex (ScrubbedBytes -> ByteString)
-> (PassphraseHash -> ScrubbedBytes)
-> PassphraseHash
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassphraseHash -> ScrubbedBytes
getPassphraseHash (PassphraseHash -> ByteString) -> PassphraseHash -> ByteString
forall a b. (a -> b) -> a -> b
$ PassphraseHash
h
        )

    unsafeDeserializeXPrv :: (ByteString, ByteString) -> (SharedKey 'RootK XPrv, PassphraseHash)
unsafeDeserializeXPrv (ByteString
k, ByteString
h) = (String -> (SharedKey 'RootK XPrv, PassphraseHash))
-> ((SharedKey 'RootK XPrv, PassphraseHash)
    -> (SharedKey 'RootK XPrv, PassphraseHash))
-> Either String (SharedKey 'RootK XPrv, PassphraseHash)
-> (SharedKey 'RootK XPrv, PassphraseHash)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (SharedKey 'RootK XPrv, PassphraseHash)
forall p a. p -> a
err (SharedKey 'RootK XPrv, PassphraseHash)
-> (SharedKey 'RootK XPrv, PassphraseHash)
forall a. a -> a
id (Either String (SharedKey 'RootK XPrv, PassphraseHash)
 -> (SharedKey 'RootK XPrv, PassphraseHash))
-> Either String (SharedKey 'RootK XPrv, PassphraseHash)
-> (SharedKey 'RootK XPrv, PassphraseHash)
forall a b. (a -> b) -> a -> b
$ (,)
        (SharedKey 'RootK XPrv
 -> PassphraseHash -> (SharedKey 'RootK XPrv, PassphraseHash))
-> Either String (SharedKey 'RootK XPrv)
-> Either
     String (PassphraseHash -> (SharedKey 'RootK XPrv, PassphraseHash))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPrv -> SharedKey 'RootK XPrv)
-> Either String XPrv -> Either String (SharedKey 'RootK XPrv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XPrv -> SharedKey 'RootK XPrv
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (ByteString -> Either String XPrv
xprvFromText ByteString
k)
        Either
  String (PassphraseHash -> (SharedKey 'RootK XPrv, PassphraseHash))
-> Either String PassphraseHash
-> Either String (SharedKey 'RootK XPrv, PassphraseHash)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ScrubbedBytes -> PassphraseHash)
-> Either String ScrubbedBytes -> Either String PassphraseHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScrubbedBytes -> PassphraseHash
PassphraseHash (ByteString -> Either String ScrubbedBytes
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex ByteString
h)
      where
        xprvFromText :: ByteString -> Either String XPrv
xprvFromText = ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
xprv (ByteString -> Either String XPrv)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String XPrv
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteArray ByteString => ByteString -> Either String ByteString
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex @ByteString
        err :: p -> a
err p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"unsafeDeserializeXPrv: unable to deserialize SharedKey"

instance PersistPublicKey (SharedKey depth) where
    serializeXPub :: SharedKey depth XPub -> ByteString
serializeXPub =
        ByteString -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
hex (ByteString -> ByteString)
-> (SharedKey depth XPub -> ByteString)
-> SharedKey depth XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
unXPub (XPub -> ByteString)
-> (SharedKey depth XPub -> XPub)
-> SharedKey depth XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedKey depth XPub -> XPub
forall (depth :: Depth) raw. SharedKey depth raw -> raw
getKey

    unsafeDeserializeXPub :: ByteString -> SharedKey depth XPub
unsafeDeserializeXPub =
        (String -> SharedKey depth XPub)
-> (XPub -> SharedKey depth XPub)
-> Either String XPub
-> SharedKey depth XPub
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> SharedKey depth XPub
forall p a. p -> a
err XPub -> SharedKey depth XPub
forall (depth :: Depth) key. key -> SharedKey depth key
SharedKey (Either String XPub -> SharedKey depth XPub)
-> (ByteString -> Either String XPub)
-> ByteString
-> SharedKey depth XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either String XPub
xpub (ByteString -> Either String XPub)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either String XPub
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteArray ByteString => ByteString -> Either String ByteString
forall bout. ByteArray bout => ByteString -> Either String bout
fromHex @ByteString)
      where
        err :: p -> a
err p
_ = String -> a
forall a. HasCallStack => String -> a
error String
"unsafeDeserializeXPub: unable to deserialize SharedKey"

instance MkKeyFingerprint SharedKey Address where
    paymentKeyFingerprint :: Address
-> Either
     (ErrMkKeyFingerprint SharedKey Address)
     (KeyFingerprint "payment" SharedKey)
paymentKeyFingerprint (Address ByteString
bytes) =
        KeyFingerprint "payment" SharedKey
-> Either
     (ErrMkKeyFingerprint SharedKey Address)
     (KeyFingerprint "payment" SharedKey)
forall a b. b -> Either a b
Right (KeyFingerprint "payment" SharedKey
 -> Either
      (ErrMkKeyFingerprint SharedKey Address)
      (KeyFingerprint "payment" SharedKey))
-> KeyFingerprint "payment" SharedKey
-> Either
     (ErrMkKeyFingerprint SharedKey Address)
     (KeyFingerprint "payment" SharedKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFingerprint "payment" SharedKey
forall k (s :: Symbol) (key :: k).
ByteString -> KeyFingerprint s key
KeyFingerprint (ByteString -> KeyFingerprint "payment" SharedKey)
-> ByteString -> KeyFingerprint "payment" SharedKey
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
hashSize (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
bytes

instance MkKeyFingerprint SharedKey (Proxy (n :: NetworkDiscriminant), SharedKey 'AddressK XPub) where
    paymentKeyFingerprint :: (Proxy n, SharedKey 'AddressK XPub)
-> Either
     (ErrMkKeyFingerprint SharedKey (Proxy n, SharedKey 'AddressK XPub))
     (KeyFingerprint "payment" SharedKey)
paymentKeyFingerprint (Proxy n
_, SharedKey 'AddressK XPub
paymentK) =
        KeyFingerprint "payment" SharedKey
-> Either
     (ErrMkKeyFingerprint SharedKey (Proxy n, SharedKey 'AddressK XPub))
     (KeyFingerprint "payment" SharedKey)
forall a b. b -> Either a b
Right (KeyFingerprint "payment" SharedKey
 -> Either
      (ErrMkKeyFingerprint SharedKey (Proxy n, SharedKey 'AddressK XPub))
      (KeyFingerprint "payment" SharedKey))
-> KeyFingerprint "payment" SharedKey
-> Either
     (ErrMkKeyFingerprint SharedKey (Proxy n, SharedKey 'AddressK XPub))
     (KeyFingerprint "payment" SharedKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFingerprint "payment" SharedKey
forall k (s :: Symbol) (key :: k).
ByteString -> KeyFingerprint s key
KeyFingerprint (ByteString -> KeyFingerprint "payment" SharedKey)
-> ByteString -> KeyFingerprint "payment" SharedKey
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
forall bin. ByteArrayAccess bin => bin -> ByteString
blake2b224 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
xpubPublicKey (XPub -> ByteString) -> XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ SharedKey 'AddressK XPub -> XPub
forall (depth :: Depth) raw. SharedKey depth raw -> raw
getKey SharedKey 'AddressK XPub
paymentK

instance BoundedAddressLength SharedKey where
    maxLengthAddressFor :: Proxy SharedKey -> Address
maxLengthAddressFor Proxy SharedKey
_ = ByteString -> Address
Address (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
57 Word8
0

{-------------------------------------------------------------------------------
                                 Internals
-------------------------------------------------------------------------------}

hashSize :: Int
hashSize :: Int
hashSize = Blake2b_224 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize Blake2b_224
Blake2b_224