{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0

module Cardano.Address.Style.Shared
    ( -- $overview

      -- * Shared
      Shared
    , getKey
    , liftXPrv
    , liftXPub
    , sharedWalletId

      -- * Key Derivation
      -- $keyDerivation
    , genMasterKeyFromXPrv
    , genMasterKeyFromMnemonic
    , deriveAccountPrivateKey
    , deriveAddressPrivateKey
    , deriveAddressPublicKey
    , deriveDelegationPrivateKey
    , deriveDelegationPublicKey
    , hashKey

    ) where

import Prelude

import Cardano.Address.Derivation
    ( Depth (..)
    , DerivationType (..)
    , Index (..)
    , XPrv
    , XPub
    , hashCredential
    , hashWalletId
    , xpubPublicKey
    )
import Cardano.Address.Script
    ( Cosigner, KeyHash (..), KeyRole, Script )
import Cardano.Address.Script.Parser
    ( scriptToText )
import Cardano.Address.Style.Shelley
    ( Role (..)
    , deriveAccountPrivateKeyShelley
    , deriveAddressPrivateKeyShelley
    , deriveAddressPublicKeyShelley
    , genMasterKeyFromMnemonicShelley
    )
import Cardano.Mnemonic
    ( SomeMnemonic )
import Control.DeepSeq
    ( NFData )
import Data.ByteArray
    ( ScrubbedBytes )
import Data.ByteString
    ( ByteString )
import Data.Coerce
    ( coerce )
import Data.Word
    ( Word32 )
import GHC.Generics
    ( Generic )

import qualified Cardano.Address.Derivation as Internal
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T


-- $overview
--
-- This module provides an implementation of:
--
-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shared master keys from mnemonic sentences
-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical hard derivation of parent to child keys
-- - 'Cardano.Address.Derivation.SoftDerivation': for hierarchical soft derivation of parent to child keys
--
-- - 'paymentAddress': for constructing payment addresses from a address public key or a script
-- - 'delegationAddress': for constructing delegation addresses from payment credential (public key or script) and stake credential (public key or script)
-- - 'pointerAddress': for constructing delegation addresses from payment credential (public key or script) and chain pointer
-- - 'stakeAddress': for constructing reward accounts from stake credential (public key or script)

-- | A cryptographic key for sequential-scheme address derivation, with
-- phantom-types to disambiguate key types. The derivation is mostly like Shelley, except the used purpose index
-- (here 1854H rather than Shelley's 1852H)
--
-- @
-- let rootPrivateKey = Shared 'RootK XPrv
-- let accountPubKey  = Shared 'AccountK XPub
-- let addressPubKey  = Shared 'PaymentK XPub
-- @
--
-- @since 3.4.0
newtype Shared (depth :: Depth) key = Shared
    { Shared depth key -> key
getKey :: key
        -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type.
        --
        -- @since 3.4.0
    }
    deriving stock ((forall x. Shared depth key -> Rep (Shared depth key) x)
-> (forall x. Rep (Shared depth key) x -> Shared depth key)
-> Generic (Shared depth key)
forall x. Rep (Shared depth key) x -> Shared depth key
forall x. Shared depth key -> Rep (Shared depth key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (depth :: Depth) key x.
Rep (Shared depth key) x -> Shared depth key
forall (depth :: Depth) key x.
Shared depth key -> Rep (Shared depth key) x
$cto :: forall (depth :: Depth) key x.
Rep (Shared depth key) x -> Shared depth key
$cfrom :: forall (depth :: Depth) key x.
Shared depth key -> Rep (Shared depth key) x
Generic, Int -> Shared depth key -> ShowS
[Shared depth key] -> ShowS
Shared depth key -> String
(Int -> Shared depth key -> ShowS)
-> (Shared depth key -> String)
-> ([Shared depth key] -> ShowS)
-> Show (Shared depth key)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (depth :: Depth) key.
Show key =>
Int -> Shared depth key -> ShowS
forall (depth :: Depth) key.
Show key =>
[Shared depth key] -> ShowS
forall (depth :: Depth) key. Show key => Shared depth key -> String
showList :: [Shared depth key] -> ShowS
$cshowList :: forall (depth :: Depth) key.
Show key =>
[Shared depth key] -> ShowS
show :: Shared depth key -> String
$cshow :: forall (depth :: Depth) key. Show key => Shared depth key -> String
showsPrec :: Int -> Shared depth key -> ShowS
$cshowsPrec :: forall (depth :: Depth) key.
Show key =>
Int -> Shared depth key -> ShowS
Show, Shared depth key -> Shared depth key -> Bool
(Shared depth key -> Shared depth key -> Bool)
-> (Shared depth key -> Shared depth key -> Bool)
-> Eq (Shared depth key)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (depth :: Depth) key.
Eq key =>
Shared depth key -> Shared depth key -> Bool
/= :: Shared depth key -> Shared depth key -> Bool
$c/= :: forall (depth :: Depth) key.
Eq key =>
Shared depth key -> Shared depth key -> Bool
== :: Shared depth key -> Shared depth key -> Bool
$c== :: forall (depth :: Depth) key.
Eq key =>
Shared depth key -> Shared depth key -> Bool
Eq)

deriving instance (Functor (Shared depth))
instance (NFData key) => NFData (Shared depth key)

--
-- Key Derivation
--
-- $keyDerivation
--
-- === Generating a root key from 'SomeMnemonic'
-- > :set -XOverloadedStrings
-- > :set -XTypeApplications
-- > :set -XDataKinds
-- > import Cardano.Mnemonic ( mkSomeMnemonic )
-- >
-- > let (Right mw) = mkSomeMnemonic @'[15] ["network","empty","cause","mean","expire","private","finger","accident","session","problem","absurd","banner","stage","void","what"]
-- > let sndFactor = mempty -- Or alternatively, a second factor mnemonic transformed to bytes via someMnemonicToBytes
-- > let rootK = genMasterKeyFromMnemonic mw sndFactor :: Shared 'RootK XPrv
--
-- === Deriving child keys
--
-- Let's consider the following 3rd, 4th and 5th derivation paths @0'\/0\/14@
--
-- > let Just accIx = indexFromWord32 0x80000000
-- > let acctK = deriveAccountPrivateKey rootK accIx
-- >
-- > let Just addIx = indexFromWord32 0x00000014
-- > let addrK = deriveAddressPrivateKey acctK UTxOExternal addIx
--
-- > let stakeK = deriveDelegationPrivateKey acctK

instance Internal.GenMasterKey Shared where
    type SecondFactor Shared = ScrubbedBytes

    genMasterKeyFromXPrv :: XPrv -> Shared 'RootK XPrv
genMasterKeyFromXPrv = XPrv -> Shared 'RootK XPrv
forall (depth :: Depth). XPrv -> Shared depth XPrv
liftXPrv
    genMasterKeyFromMnemonic :: SomeMnemonic -> SecondFactor Shared -> Shared 'RootK XPrv
genMasterKeyFromMnemonic SomeMnemonic
fstFactor SecondFactor Shared
sndFactor =
        XPrv -> Shared 'RootK XPrv
forall (depth :: Depth) key. key -> Shared depth key
Shared (XPrv -> Shared 'RootK XPrv) -> XPrv -> Shared 'RootK XPrv
forall a b. (a -> b) -> a -> b
$ SomeMnemonic -> ScrubbedBytes -> XPrv
forall sndFactor.
ByteArrayAccess sndFactor =>
SomeMnemonic -> sndFactor -> XPrv
genMasterKeyFromMnemonicShelley SomeMnemonic
fstFactor ScrubbedBytes
SecondFactor Shared
sndFactor

instance Internal.HardDerivation Shared where
    type AccountIndexDerivationType Shared = 'Hardened
    type AddressIndexDerivationType Shared = 'Soft
    type WithRole Shared = Role

    deriveAccountPrivateKey :: Shared 'RootK XPrv
-> Index (AccountIndexDerivationType Shared) 'AccountK
-> Shared 'AccountK XPrv
deriveAccountPrivateKey (Shared XPrv
rootXPrv) Index (AccountIndexDerivationType Shared) 'AccountK
accIx =
        XPrv -> Shared 'AccountK XPrv
forall (depth :: Depth) key. key -> Shared depth key
Shared (XPrv -> Shared 'AccountK XPrv) -> XPrv -> Shared 'AccountK XPrv
forall a b. (a -> b) -> a -> b
$ XPrv -> Index 'Hardened 'AccountK -> Word32 -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
XPrv -> Index derivationType depth -> Word32 -> XPrv
deriveAccountPrivateKeyShelley XPrv
rootXPrv Index (AccountIndexDerivationType Shared) 'AccountK
Index 'Hardened 'AccountK
accIx Word32
purposeIndex

    deriveAddressPrivateKey :: Shared 'AccountK XPrv
-> WithRole Shared
-> Index (AddressIndexDerivationType Shared) 'PaymentK
-> Shared 'PaymentK XPrv
deriveAddressPrivateKey (Shared XPrv
accXPrv) WithRole Shared
keyRole Index (AddressIndexDerivationType Shared) 'PaymentK
addrIx =
        XPrv -> Shared 'PaymentK XPrv
forall (depth :: Depth) key. key -> Shared depth key
Shared (XPrv -> Shared 'PaymentK XPrv) -> XPrv -> Shared 'PaymentK XPrv
forall a b. (a -> b) -> a -> b
$ XPrv -> Role -> Index 'Soft 'PaymentK -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
XPrv -> Role -> Index derivationType depth -> XPrv
deriveAddressPrivateKeyShelley XPrv
accXPrv WithRole Shared
Role
keyRole Index (AddressIndexDerivationType Shared) 'PaymentK
Index 'Soft 'PaymentK
addrIx

instance Internal.SoftDerivation Shared where
    deriveAddressPublicKey :: Shared 'AccountK XPub
-> WithRole Shared
-> Index 'Soft 'PaymentK
-> Shared 'PaymentK XPub
deriveAddressPublicKey (Shared XPub
accXPub) WithRole Shared
keyRole Index 'Soft 'PaymentK
addrIx =
        XPub -> Shared 'PaymentK XPub
forall (depth :: Depth) key. key -> Shared depth key
Shared (XPub -> Shared 'PaymentK XPub) -> XPub -> Shared 'PaymentK XPub
forall a b. (a -> b) -> a -> b
$ XPub -> Role -> Index 'Soft 'PaymentK -> XPub
forall (derivationType :: DerivationType) (depth :: Depth).
XPub -> Role -> Index derivationType depth -> XPub
deriveAddressPublicKeyShelley XPub
accXPub WithRole Shared
Role
keyRole Index 'Soft 'PaymentK
addrIx

-- | Generate a root key from a corresponding mnemonic.
--
-- @since 3.4.0
genMasterKeyFromMnemonic
    :: SomeMnemonic
        -- ^ Some valid mnemonic sentence.
    -> ScrubbedBytes
        -- ^ An optional second-factor passphrase (or 'mempty')
    -> Shared 'RootK XPrv
genMasterKeyFromMnemonic :: SomeMnemonic -> ScrubbedBytes -> Shared 'RootK XPrv
genMasterKeyFromMnemonic = SomeMnemonic -> ScrubbedBytes -> Shared 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
SomeMnemonic -> SecondFactor key -> key 'RootK XPrv
Internal.genMasterKeyFromMnemonic

-- | Generate a root key from a corresponding root 'XPrv'
--
-- @since 3.4.0
genMasterKeyFromXPrv :: XPrv -> Shared 'RootK XPrv
genMasterKeyFromXPrv :: XPrv -> Shared 'RootK XPrv
genMasterKeyFromXPrv = XPrv -> Shared 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
XPrv -> key 'RootK XPrv
Internal.genMasterKeyFromXPrv

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an account private key from the given root private key.
--
-- @since 3.4.0
deriveAccountPrivateKey
    :: Shared 'RootK XPrv
    -> Index 'Hardened 'AccountK
    -> Shared 'AccountK XPrv
deriveAccountPrivateKey :: Shared 'RootK XPrv
-> Index 'Hardened 'AccountK -> Shared 'AccountK XPrv
deriveAccountPrivateKey = Shared 'RootK XPrv
-> Index 'Hardened 'AccountK -> Shared 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'RootK XPrv
-> Index (AccountIndexDerivationType key) 'AccountK
-> key 'AccountK XPrv
Internal.deriveAccountPrivateKey

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives a multisig private key from the given account private key for payment credential.
--
-- @since 3.4.0
deriveAddressPrivateKey
    :: Shared 'AccountK XPrv
    -> Role
    -> Index 'Soft 'PaymentK
    -> Shared 'ScriptK XPrv
deriveAddressPrivateKey :: Shared 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPrv
deriveAddressPrivateKey = (Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPrv)
-> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPrv
coerce ((Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPrv)
 -> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPrv)
-> (Shared 'AccountK XPrv
    -> Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPrv)
-> Shared 'AccountK XPrv
-> Role
-> Index 'Soft 'PaymentK
-> Shared 'ScriptK XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shared 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'AccountK XPrv
-> WithRole key
-> Index (AddressIndexDerivationType key) 'PaymentK
-> key 'PaymentK XPrv
Internal.deriveAddressPrivateKey

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives a multisig private key from the given account private key for delegation credential.
--
-- @since 3.4.0
deriveDelegationPrivateKey
    :: Shared 'AccountK XPrv
    -> Index 'Soft 'PaymentK
    -> Shared 'ScriptK XPrv
deriveDelegationPrivateKey :: Shared 'AccountK XPrv
-> Index 'Soft 'PaymentK -> Shared 'ScriptK XPrv
deriveDelegationPrivateKey Shared 'AccountK XPrv
accPrv = Shared 'PaymentK XPrv -> Shared 'ScriptK XPrv
coerce (Shared 'PaymentK XPrv -> Shared 'ScriptK XPrv)
-> (Index 'Soft 'PaymentK -> Shared 'PaymentK XPrv)
-> Index 'Soft 'PaymentK
-> Shared 'ScriptK XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Shared 'AccountK XPrv
-> WithRole Shared
-> Index (AddressIndexDerivationType Shared) 'PaymentK
-> Shared 'PaymentK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'AccountK XPrv
-> WithRole key
-> Index (AddressIndexDerivationType key) 'PaymentK
-> key 'PaymentK XPrv
Internal.deriveAddressPrivateKey Shared 'AccountK XPrv
accPrv WithRole Shared
Role
Stake

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derives a multisig public key from the given account public key for payment credential.
--
-- @since 3.4.0
deriveAddressPublicKey
    :: Shared 'AccountK XPub
    -> Role
    -> Index 'Soft 'PaymentK
    -> Shared 'ScriptK XPub
deriveAddressPublicKey :: Shared 'AccountK XPub
-> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPub
deriveAddressPublicKey = (Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPub)
-> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPub
coerce ((Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPub)
 -> Role -> Index 'Soft 'PaymentK -> Shared 'ScriptK XPub)
-> (Shared 'AccountK XPub
    -> Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPub)
-> Shared 'AccountK XPub
-> Role
-> Index 'Soft 'PaymentK
-> Shared 'ScriptK XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shared 'AccountK XPub
-> Role -> Index 'Soft 'PaymentK -> Shared 'PaymentK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> WithRole key -> Index 'Soft 'PaymentK -> key 'PaymentK XPub
Internal.deriveAddressPublicKey

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derives a multisig public key from the given account public key for delegation credential.
--
-- @since 3.4.0
deriveDelegationPublicKey
    :: Shared 'AccountK XPub
    -> Index 'Soft 'PaymentK
    -> Shared 'ScriptK XPub
deriveDelegationPublicKey :: Shared 'AccountK XPub
-> Index 'Soft 'PaymentK -> Shared 'ScriptK XPub
deriveDelegationPublicKey Shared 'AccountK XPub
accPub = Shared 'PaymentK XPub -> Shared 'ScriptK XPub
coerce (Shared 'PaymentK XPub -> Shared 'ScriptK XPub)
-> (Index 'Soft 'PaymentK -> Shared 'PaymentK XPub)
-> Index 'Soft 'PaymentK
-> Shared 'ScriptK XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Shared 'AccountK XPub
-> WithRole Shared
-> Index 'Soft 'PaymentK
-> Shared 'PaymentK XPub
forall (key :: Depth -> * -> *).
SoftDerivation key =>
key 'AccountK XPub
-> WithRole key -> Index 'Soft 'PaymentK -> key 'PaymentK XPub
Internal.deriveAddressPublicKey Shared 'AccountK XPub
accPub WithRole Shared
Role
Stake

--
-- Unsafe
--

-- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPrv'. this is
-- unsafe because it lets the caller choose the actually derivation 'depth'.
--
-- This can be useful however when serializing / deserializing such a type, or to
-- speed up test code (and avoid having to do needless derivations from a master
-- key down to an address key for instance).
--
-- @since 3.4.0
liftXPrv :: XPrv -> Shared depth XPrv
liftXPrv :: XPrv -> Shared depth XPrv
liftXPrv = XPrv -> Shared depth XPrv
forall (depth :: Depth) key. key -> Shared depth key
Shared

-- | Unsafe backdoor for constructing an 'Shared' key from a raw 'XPub'. this is
-- unsafe because it lets the caller choose the actually derivation 'depth'.
--
-- This can be useful however when serializing / deserializing such a type, or to
-- speed up test code (and avoid having to do needless derivations from a master
-- key down to an address key for instance).
--
-- @since 3.4.0
liftXPub :: XPub -> Shared depth XPub
liftXPub :: XPub -> Shared depth XPub
liftXPub = XPub -> Shared depth XPub
forall (depth :: Depth) key. key -> Shared depth key
Shared


-- | Calculates wallet id of shared wallet
-- It takes raw bytes of account public kye (64-bytes),
-- spending script template, and
-- optionally staking script template.
--
-- @since 3.10.0
sharedWalletId
    :: ByteString
    -> Script Cosigner
    -> Maybe (Script Cosigner)
    -> ByteString
sharedWalletId :: ByteString
-> Script Cosigner -> Maybe (Script Cosigner) -> ByteString
sharedWalletId ByteString
bytes Script Cosigner
spending Maybe (Script Cosigner)
stakingM =
    if ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 then
        ByteString -> ByteString
hashWalletId (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString
bytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        Script Cosigner -> ByteString
serializeScriptTemplate Script Cosigner
spending ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
        ByteString
-> (Script Cosigner -> ByteString)
-> Maybe (Script Cosigner)
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty Script Cosigner -> ByteString
serializeScriptTemplate Maybe (Script Cosigner)
stakingM
    else
        String -> ByteString
forall a. HasCallStack => String -> a
error String
"Extended account public key is expected to have 64 bytes."
  where
    serializeScriptTemplate :: Script Cosigner -> ByteString
serializeScriptTemplate = Text -> ByteString
T.encodeUtf8 (Text -> ByteString)
-> (Script Cosigner -> Text) -> Script Cosigner -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script Cosigner -> Text
forall a. Show a => Script a -> Text
scriptToText

--
-- Internal
--

--- | Computes a 28-byte Blake2b224 digest of a Shared 'XPub'.
---
--- @since 3.4.0
hashKey :: KeyRole -> Shared key XPub -> KeyHash
hashKey :: KeyRole -> Shared key XPub -> KeyHash
hashKey KeyRole
cred = KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
cred (ByteString -> KeyHash)
-> (Shared key XPub -> ByteString) -> Shared key XPub -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shared key XPub -> ByteString) -> Shared key XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (Shared key XPub -> XPub) -> Shared key XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shared key XPub -> XPub
forall (depth :: Depth) key. Shared depth key -> key
getKey

-- Purpose is a constant set to 1854' (or 0x8000073e) following the
-- CIP-1854 Multi-signatures HD Wallets
--
-- Hardened derivation is used at this level.
purposeIndex :: Word32
purposeIndex :: Word32
purposeIndex = Word32
0x8000073e