cardano-addresses-4.0.1: lib/Cardano/Address/Style/Shelley.hs
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK prune #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-- |
-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect
-- License: Apache-2.0
module Cardano.Address.Style.Shelley
( -- $overview
-- * Shelley
Shelley
, getKey
, Role (..)
, roleFromIndex
, roleToIndex
, Credential (..)
, CredentialType (..)
, hashKey
-- * Key Derivation
-- $keyDerivation
, genMasterKeyFromXPrv
, genMasterKeyFromMnemonic
, deriveAccountPrivateKey
, deriveAddressPrivateKey
, deriveDelegationPrivateKey
, deriveDRepPrivateKey
, deriveCCColdPrivateKey
, deriveCCHotPrivateKey
, deriveAddressPublicKey
, derivePolicyPrivateKey
-- * Addresses
-- $addresses
, InspectAddress (..)
, AddressInfo (..)
, ReferenceInfo (..)
, eitherInspectAddress
, inspectAddress
, inspectShelleyAddress
, paymentAddress
, delegationAddress
, pointerAddress
, stakeAddress
, extendAddress
, ErrExtendAddress (..)
, ErrInspectAddressOnlyShelley (..)
, ErrInspectAddress (..)
, prettyErrInspectAddressOnlyShelley
, prettyErrInspectAddress
-- * Network Discrimination
, MkNetworkDiscriminantError (..)
, mkNetworkDiscriminant
, inspectNetworkDiscriminant
, shelleyMainnet
, shelleyTestnet
-- * Unsafe
, liftXPrv
, liftXPub
, liftPub
, unsafeFromRight
-- Internals
, minSeedLengthBytes
, genMasterKeyFromMnemonicShelley
, deriveAccountPrivateKeyShelley
, deriveAddressPrivateKeyShelley
, deriveAddressPublicKeyShelley
) where
import Prelude
import Cardano.Address
( Address (..)
, AddressDiscrimination (..)
, ChainPointer (..)
, HasNetworkDiscriminant (..)
, NetworkDiscriminant (..)
, NetworkTag (..)
, invariantNetworkTag
, invariantSize
, unsafeMkAddress
)
import Cardano.Address.Derivation
( Depth (..)
, DerivationScheme (..)
, DerivationType (..)
, Index (..)
, Pub
, XPrv
, XPub
, credentialHashSize
, deriveXPrv
, deriveXPub
, generateNew
, hashCredential
, indexFromWord32
, pubToBytes
, unsafeMkIndex
, xpubPublicKey
)
import Cardano.Address.Internal
( WithErrorMessage (..), orElse )
import Cardano.Address.KeyHash
( KeyHash (..), KeyRole (..) )
import Cardano.Address.Script
( Script, ScriptHash (..), toScriptHash )
import Cardano.Mnemonic
( SomeMnemonic, someMnemonicToBytes )
import Codec.Binary.Encoding
( AbstractEncoding (..), encode )
import Control.DeepSeq
( NFData )
import Control.Exception
( Exception, displayException )
import Control.Exception.Base
( assert )
import Control.Monad
( unless, when )
import Control.Monad.Catch
( MonadThrow, throwM )
import Data.Aeson
( ToJSON (..), (.=) )
import Data.Bifunctor
( bimap, first )
import Data.Binary.Get
( runGetOrFail )
import Data.Binary.Put
( putByteString, putWord8, runPut )
import Data.Bits
( shiftR, (.&.) )
import Data.ByteArray
( ScrubbedBytes )
import Data.ByteString
( ByteString )
import Data.Maybe
( fromMaybe, isNothing )
import Data.Typeable
( Typeable )
import Data.Word
( Word32, Word8 )
import Data.Word7
( getVariableLengthNat, putVariableLengthNat )
import Fmt
( Buildable, build, format, (+|), (|+) )
import GHC.Generics
( Generic )
import qualified Cardano.Address.Derivation as Internal
import qualified Cardano.Address.Style.Byron as Byron
import qualified Cardano.Address.Style.Icarus as Icarus
import qualified Cardano.Codec.Bech32.Prefixes as CIP5
import qualified Data.Aeson as Json
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
-- $overview
--
-- This module provides an implementation of:
--
-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Shelley 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.
@
let rootPrivateKey = Shelley 'RootK XPrv
let accountPubKey = Shelley 'AccountK XPub
let addressPubKey = Shelley 'PaymentK XPub
@
@since 2.0.0
-}
newtype Shelley (depth :: Depth) key = Shelley
{
getKey :: key
}
deriving stock (Generic, Show, Eq)
deriving instance (Functor (Shelley depth))
instance (NFData key) => NFData (Shelley depth key)
-- | Describe what the keys within an account are used for.
--
-- @since 3.0.0
data Role
= UTxOExternal
-- ^Used for public addresses sent to other parties for receiving money.
| UTxOInternal
-- ^Generated by wallet software to send change back to the wallet.
| Stake
-- ^Used for stake key(s) and delegation.
| DRep
-- ^Used for DRep key derivation.
| CCCold
-- ^Used for constitutional committee cold key derivation
| CCHot
-- ^Used for constitutional committee hot key derivation
deriving (Generic, Typeable, Show, Eq, Ord, Bounded)
instance NFData Role
roleFromIndex :: Index 'Soft depth -> Maybe Role
roleFromIndex ix = case indexToWord32 ix of
0 -> Just UTxOExternal
1 -> Just UTxOInternal
2 -> Just Stake
3 -> Just DRep
4 -> Just CCCold
5 -> Just CCHot
_ -> Nothing
roleToIndex :: Role -> Index 'Soft depth
roleToIndex = unsafeMkIndex . \case
UTxOExternal -> 0
UTxOInternal -> 1
Stake -> 2
DRep -> 3
CCCold -> 4
CCHot -> 5
--
-- 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 :: Shelley '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 Shelley where
type SecondFactor Shelley = ScrubbedBytes
genMasterKeyFromXPrv = liftXPrv
genMasterKeyFromMnemonic fstFactor sndFactor =
Shelley $ genMasterKeyFromMnemonicShelley fstFactor sndFactor
instance Internal.HardDerivation Shelley where
type AccountIndexDerivationType Shelley = 'Hardened
type AddressIndexDerivationType Shelley = 'Soft
type WithRole Shelley = Role
deriveAccountPrivateKey (Shelley rootXPrv) accIx =
Shelley $ deriveAccountPrivateKeyShelley rootXPrv accIx purposeIndex
deriveAddressPrivateKey (Shelley accXPrv) role addrIx =
Shelley $ deriveAddressPrivateKeyShelley accXPrv role addrIx
instance Internal.SoftDerivation Shelley where
deriveAddressPublicKey (Shelley accXPub) role addrIx =
Shelley $ deriveAddressPublicKeyShelley accXPub role addrIx
-- | Generate a root key from a corresponding mnemonic.
--
-- @since 2.0.0
genMasterKeyFromMnemonic
:: SomeMnemonic
-- ^ Some valid mnemonic sentence.
-> ScrubbedBytes
-- ^ An optional second-factor passphrase (or 'mempty')
-> Shelley 'RootK XPrv
genMasterKeyFromMnemonic =
Internal.genMasterKeyFromMnemonic
-- | Generate a root key from a corresponding root 'XPrv'
--
-- @since 2.0.0
genMasterKeyFromXPrv
:: XPrv -> Shelley 'RootK XPrv
genMasterKeyFromXPrv =
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 2.0.0
deriveAccountPrivateKey
:: Shelley 'RootK XPrv
-> Index 'Hardened 'AccountK
-> Shelley 'AccountK XPrv
deriveAccountPrivateKey =
Internal.deriveAccountPrivateKey
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives a policy private key from the given root private key.
--
-- @since 3.9.0
derivePolicyPrivateKey
:: Shelley 'RootK XPrv
-> Index 'Hardened 'PolicyK
-> Shelley 'PolicyK XPrv
derivePolicyPrivateKey (Shelley rootXPrv) policyIx =
Shelley $ deriveAccountPrivateKeyShelley rootXPrv policyIx policyPurposeIndex
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an address private key from the given account private key.
--
-- @since 2.0.0
deriveAddressPrivateKey
:: Shelley 'AccountK XPrv
-> Role
-> Index 'Soft 'PaymentK
-> Shelley 'PaymentK XPrv
deriveAddressPrivateKey =
Internal.deriveAddressPrivateKey
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derives an address public key from the given account public key.
--
-- @since 2.0.0
deriveAddressPublicKey
:: Shelley 'AccountK XPub
-> Role
-> Index 'Soft 'PaymentK
-> Shelley 'PaymentK XPub
deriveAddressPublicKey =
Internal.deriveAddressPublicKey
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derive a delegation key for a corresponding 'AccountK'. Note that wallet
-- software are by convention only using one delegation key per account, and always
-- the first account (with index 0').
--
-- Deriving delegation keys for something else than the initial account is not
-- recommended and can lead to incompatibility with existing wallet softwares
-- (Daedalus, Yoroi, Adalite...).
--
-- @since 2.0.0
deriveDelegationPrivateKey
:: Shelley 'AccountK XPrv
-> Shelley 'DelegationK XPrv
deriveDelegationPrivateKey accXPrv =
let (Shelley stakeXPrv) =
deriveAddressPrivateKey accXPrv Stake (minBound @(Index 'Soft _))
in Shelley stakeXPrv
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derive a DRep key for a corresponding 'AccountK'. Note that wallet
-- software are by convention only using one delegation key per account, and always
-- the first account (with index 0').
--
-- Deriving DRep keys for something else than the initial account is not
-- recommended and can lead to incompatibility with existing wallet softwares
-- (Daedalus, Yoroi, Adalite...).
--
deriveDRepPrivateKey
:: Shelley 'AccountK XPrv
-> Shelley 'DRepK XPrv
deriveDRepPrivateKey accXPrv =
let (Shelley drepXPrv) =
deriveAddressPrivateKey accXPrv DRep (minBound @(Index 'Soft _))
in Shelley drepXPrv
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derive a CCCold key for a corresponding 'AccountK'. Note that wallet
-- software are by convention only using one delegation key per account, and always
-- the first account (with index 0').
--
-- Deriving CCCold keys for something else than the initial account is not
-- recommended and can lead to incompatibility with existing wallet softwares
-- (Daedalus, Yoroi, Adalite...).
--
deriveCCColdPrivateKey
:: Shelley 'AccountK XPrv
-> Shelley 'CCColdK XPrv
deriveCCColdPrivateKey accXPrv =
let (Shelley ccColdXPrv) =
deriveAddressPrivateKey accXPrv CCCold (minBound @(Index 'Soft _))
in Shelley ccColdXPrv
-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock
--
-- | Derive a CCHot key for a corresponding 'AccountK'. Note that wallet
-- software are by convention only using one delegation key per account, and always
-- the first account (with index 0').
--
-- Deriving CCHot keys for something else than the initial account is not
-- recommended and can lead to incompatibility with existing wallet softwares
-- (Daedalus, Yoroi, Adalite...).
--
deriveCCHotPrivateKey
:: Shelley 'AccountK XPrv
-> Shelley 'CCHotK XPrv
deriveCCHotPrivateKey accXPrv =
let (Shelley ccHotXPrv) =
deriveAddressPrivateKey accXPrv CCHot (minBound @(Index 'Soft _))
in Shelley ccHotXPrv
--
-- Addresses
--
-- $addresses
--
-- ==== Generating a 'PaymentAddress' from public key credential
--
-- @
-- >>> import Cardano.Address ( bech32 )
-- >>> import Cardano.Address.Derivation ( toXPub )
-- >>> let (Right tag) = mkNetworkDiscriminant 1
-- >>> let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
-- >>> bech32 $ paymentAddress tag paymentCredential
-- >>> "addr1vxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdncxsce5t"
-- @
--
-- ==== Generating a 'PaymentAddress' from script credential
--
-- @
-- >>> import Cardano.Address.Script.Parser ( scriptFromString )
-- >>> import Cardano.Address.Script ( toScriptHash )
-- >>> import Codec.Binary.Encoding ( encode )
-- >>> import Data.Text.Encoding ( decodeUtf8 )
-- >>> let (Right tag) = mkNetworkDiscriminant 1
-- >>> let verKey1 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyreluzt36ms"
-- >>> let verKey2 = "script_vkh18srsxr3khll7vl3w9mqfu55n6wzxxlxj7qzr2mhnyrenxv223vj"
-- >>> let scriptStr = "all [" ++ verKey1 ++ ", " ++ verKey2 ++ "]"
-- >>> let (Right script) = scriptFromString scriptStr
-- >>> let infoSpendingScriptHash@(ScriptHash bytes) = toScriptHash script
-- >>> decodeUtf8 (encode EBase16 bytes)
-- "a015ae61075e25c3d9250bdcbc35c6557272127927ecf2a2d716e29f"
-- >>> bech32 $ paymentAddress tag (PaymentFromScriptHash infoSpendingScriptHash)
-- "addr1wxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98c9uxm83"
-- @
--
-- ==== Generating a 'DelegationAddress'
--
-- @
-- >>> let (Right tag) = mkNetworkDiscriminant 1
-- >>> let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
-- >>> let delegationCredential = DelegationFromExtendedKey $ (toXPub <$> stakeK)
-- >>> bech32 $ delegationAddress tag paymentCredential delegationCredential
-- "addr1qxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdn7nudck0fzve4346yytz3wpwv9yhlxt7jwuc7ytwx2vfkyqmkc5xa"
-- @
--
-- ==== Generating a 'PointerAddress'
--
-- @
-- >>> import Cardano.Address ( ChainPointer (..) )
-- >>> let (Right tag) = mkNetworkDiscriminant 1
-- >>> let ptr = ChainPointer 123 1 2
-- >>> let paymentCredential = PaymentFromExtendedKey $ (toXPub <$> addrK)
-- >>> bech32 $ pointerAddress tag paymentCredential ptr
-- "addr1gxpfffuj3zkp5g7ct6h4va89caxx9ayq2gvkyfvww48sdnmmqypqfcp5um"
-- @
--
-- ==== Generating a 'DelegationAddress' from using the same script credential in both payment and delegation
--
-- @
-- >>> bech32 $ delegationAddress tag (PaymentFromScriptHash infoSpendingScriptHash) (DelegationFromScript infoSpendingScriptHash)
-- "addr1xxspttnpqa0zts7ey59ae0p4ce2hyusj0yn7eu4z6utw98aqzkhxzp67yhpajfgtmj7rt3j4wfepy7f8ane294cku20swucnrl"
-- @
-- | Possible errors from inspecting a Shelley, Icarus, or Byron address.
--
-- @since 3.4.0
data ErrInspectAddress
= WrongInputSize Int -- ^ Unexpected size
| ErrShelley ErrInspectAddressOnlyShelley
| ErrIcarus Icarus.ErrInspectAddress
| ErrByron Byron.ErrInspectAddress
deriving (Generic, Show, Eq)
deriving ToJSON via WithErrorMessage ErrInspectAddress
instance Exception ErrInspectAddress where
displayException = prettyErrInspectAddress
-- | Possible errors from inspecting a Shelley address
--
-- @since 3.4.0
data ErrInspectAddressOnlyShelley
= PtrRetrieveError String -- ^ Human readable error of underlying operation
| UnknownType Word8 -- ^ Unknown value in address type field
deriving (Generic, Eq, Show)
deriving ToJSON via WithErrorMessage ErrInspectAddressOnlyShelley
instance Exception ErrInspectAddressOnlyShelley where
displayException = prettyErrInspectAddressOnlyShelley
-- | Pretty-print an 'ErrInspectAddressOnlyShelley'
--
-- @since 3.4.0
prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley = \case
PtrRetrieveError s ->
format "Failed to retrieve pointer (underlying errors was: {})" s
UnknownType t ->
format "Unknown address type {}" t
-- | Pretty-print an 'ErrInspectAddress'
--
-- @since 3.0.0
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress = \case
WrongInputSize i -> format "Wrong input size of {}" i
ErrShelley e -> "Invalid Shelley address: "
<> prettyErrInspectAddressOnlyShelley e
ErrIcarus e -> "Invalid Icarus address: "
<> Icarus.prettyErrInspectAddress e
ErrByron e -> "Invalid Byron address: "
<> Byron.prettyErrInspectAddress e
-- | Determines whether an 'Address' a Shelley address.
--
-- Throws 'AddrError' if it's not a valid Shelley address, or a ready-to-print
-- string giving details about the 'Address'.
--
-- @since 2.0.0
inspectShelleyAddress
:: MonadThrow m
=> Maybe XPub
-> Address
-> m Json.Value
inspectShelleyAddress = inspectAddress
{-# DEPRECATED inspectShelleyAddress "use qualified 'inspectAddress' instead." #-}
-- | Analyze an 'Address' to know whether it's a valid address for the Cardano
-- Shelley era. Shelley format addresses, as well as old-style Byron and Icarus
-- addresses can be parsed by this function.
--
-- Returns a JSON value containing details about the 'Address', or throws
-- 'ErrInspectAddress' if it's not a valid address.
--
-- @since 3.0.0
inspectAddress
:: MonadThrow m
=> Maybe XPub
-> Address
-> m Json.Value
inspectAddress mRootPub addr = either throwM (pure . toJSON) $
eitherInspectAddress mRootPub addr
-- | Determines whether an 'Address' is a valid address for the Cardano Shelley
-- era. Shelley format addresses, as well as old-style Byron and Icarus
-- addresses can be parsed by this function.
--
-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
-- not a valid address.
--
-- @since 3.4.0
eitherInspectAddress
:: Maybe XPub
-> Address
-> Either ErrInspectAddress InspectAddress
eitherInspectAddress mRootPub addr = unpackAddress addr >>= parseInfo
where
parseInfo :: AddressParts -> Either ErrInspectAddress InspectAddress
parseInfo parts = case addrType parts of
-- 1000: byron address
0b10000000 ->
(bimap ErrIcarus InspectAddressIcarus (Icarus.eitherInspectAddress addr))
`orElse`
(bimap ErrByron InspectAddressByron (Byron.eitherInspectAddress mRootPub addr))
-- Anything else: shelley address
_ -> bimap ErrShelley InspectAddressShelley (parseAddressInfoShelley parts)
-- | Returns either details about the 'Address', or
-- 'ErrInspectAddressOnlyShelley' if it's not a valid Shelley address.
parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley AddressParts{..} = case addrType of
-- 0000: base address: keyhash28,keyhash28
0b00000000 | addrRestLength == credentialHashSize + credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoSpendingKeyHash = Just addrHash1
, infoStakeKeyHash = Just addrHash2
}
-- 0001: base address: scripthash28,keyhash28
0b00010000 | addrRestLength == credentialHashSize + credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoSpendingScriptHash = Just addrHash1
, infoStakeKeyHash = Just addrHash2
}
-- 0010: base address: keyhash28,scripthash28
0b00100000 | addrRestLength == credentialHashSize + credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoSpendingKeyHash = Just addrHash1
, infoStakeScriptHash = Just addrHash2
}
-- 0011: base address: scripthash28,scripthash28
0b00110000 | addrRestLength == 2 * credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoSpendingScriptHash = Just addrHash1
, infoStakeScriptHash = Just addrHash2
}
-- 0100: pointer address: keyhash28, 3 variable length uint
0b01000000 | addrRestLength > credentialHashSize -> do
ptr <- getPtr addrHash2
pure addressInfo
{ infoStakeReference = Just $ ByPointer ptr
, infoSpendingKeyHash = Just addrHash1
}
-- 0101: pointer address: scripthash28, 3 variable length uint
0b01010000 | addrRestLength > credentialHashSize -> do
ptr <- getPtr addrHash2
pure addressInfo
{ infoStakeReference = Just $ ByPointer ptr
, infoSpendingScriptHash = Just addrHash1
}
-- 0110: enterprise address: keyhash28
0b01100000 | addrRestLength == credentialHashSize ->
Right addressInfo
{ infoStakeReference = Nothing
, infoSpendingKeyHash = Just addrHash1
}
-- 0111: enterprise address: scripthash28
0b01110000 | addrRestLength == credentialHashSize ->
Right addressInfo
{ infoStakeReference = Nothing
, infoSpendingScriptHash = Just addrHash1
}
-- 1110: reward account: keyhash28
0b11100000 | addrRestLength == credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoStakeKeyHash = Just addrHash1
}
-- 1111: reward account: scripthash28
0b11110000 | addrRestLength == credentialHashSize ->
Right addressInfo
{ infoStakeReference = Just ByValue
, infoStakeScriptHash = Just addrHash1
}
unknown -> Left (UnknownType unknown)
where
addressInfo = AddressInfo
{ infoNetworkTag = NetworkTag $ fromIntegral addrNetwork
, infoStakeReference = Nothing
, infoSpendingKeyHash = Nothing
, infoStakeKeyHash = Nothing
, infoSpendingScriptHash = Nothing
, infoStakeScriptHash = Nothing
, infoAddressType = shiftR (addrType .&. 0b11110000) 4
}
getPtr :: ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
getPtr source = case runGetOrFail get (BL.fromStrict source) of
Right ("", _, a) -> Right a
Right _ -> err "Unconsumed bytes after pointer"
Left (_, _, e) -> err e
where
get = ChainPointer
<$> getVariableLengthNat
<*> getVariableLengthNat
<*> getVariableLengthNat
err = Left . PtrRetrieveError
-- | The result of 'eitherInspectAddress'.
--
-- @since 3.4.0
data InspectAddress
= InspectAddressShelley AddressInfo
| InspectAddressIcarus Icarus.AddressInfo
| InspectAddressByron Byron.AddressInfo
deriving (Generic, Show, Eq)
instance ToJSON InspectAddress where
toJSON addr = combine (styleProp <> missingProp) (toJSON addr')
where
addr' = case addr of
InspectAddressShelley s -> toJSON s
InspectAddressIcarus i -> toJSON i
InspectAddressByron b -> toJSON b
styleProp = "address_style" .= Json.String styleName
styleName = case addr of
InspectAddressShelley _ -> "Shelley"
InspectAddressIcarus _ -> "Icarus"
InspectAddressByron _ -> "Byron"
missingProp = case addr of
InspectAddressShelley _ -> mempty
InspectAddressIcarus _ -> noStakeRef
InspectAddressByron _ -> noStakeRef
noStakeRef = "stake_reference" .= Json.String "none"
combine extra = \case
Json.Object props -> Json.Object (extra <> props)
otherValue -> otherValue -- not expected to happen
-- | An inspected Shelley address.
--
-- @since 3.4.0
data AddressInfo = AddressInfo
{ infoStakeReference :: !(Maybe ReferenceInfo)
, infoSpendingKeyHash :: !(Maybe ByteString)
, infoStakeKeyHash :: !(Maybe ByteString)
, infoSpendingScriptHash :: !(Maybe ByteString)
, infoStakeScriptHash :: !(Maybe ByteString)
, infoNetworkTag :: !NetworkTag
, infoAddressType :: !Word8
} deriving (Generic, Show, Eq)
-- | Info from 'Address' about how delegation keys are located.
--
-- @since 3.6.1
data ReferenceInfo
= ByValue
| ByPointer ChainPointer
deriving (Generic, Show, Eq)
instance ToJSON AddressInfo where
toJSON AddressInfo{..} = Json.object $
[ "network_tag" .= infoNetworkTag
, "stake_reference" .= Json.String (maybe "none" refName infoStakeReference)
, "address_type" .= toJSON @Word8 infoAddressType
]
++ maybe [] (\ptr -> ["pointer" .= ptr]) (infoStakeReference >>= getPointer)
++ jsonHash "spending_key_hash" CIP5.addr_vkh infoSpendingKeyHash
++ jsonHash "stake_key_hash" CIP5.stake_vkh infoStakeKeyHash
++ jsonHash "spending_shared_hash" CIP5.addr_shared_vkh infoSpendingScriptHash
++ jsonHash "stake_shared_hash" CIP5.stake_shared_vkh infoStakeScriptHash
++ jsonHash "stake_script_hash" CIP5.stake_vkh infoStakeScriptHash
where
getPointer ByValue = Nothing
getPointer (ByPointer ptr) = Just ptr
jsonHash _ _ Nothing = []
jsonHash key hrp (Just bs) =
[ key .= base16 bs , (key <> "_bech32") .= bech32With hrp bs ]
base16 = T.unpack . T.decodeUtf8 . encode EBase16
bech32With hrp = T.decodeUtf8 . encode (EBech32 hrp)
refName ByValue = "by value"
refName (ByPointer _) = "by pointer"
-- | Structure containing the result of 'unpackAddress', the constituent parts
-- of an address. Internal to this module.
data AddressParts = AddressParts
{ addrType :: Word8
, addrNetwork :: Word8
, addrHash1 :: ByteString
, addrHash2 :: ByteString
, addrRestLength :: Int
} deriving (Show)
-- | Split fields out of a Shelley encoded address.
unpackAddress :: Address -> Either ErrInspectAddress AddressParts
unpackAddress (unAddress -> bytes)
| BS.length bytes >= 1 + credentialHashSize = Right AddressParts{..}
| otherwise = Left $ WrongInputSize $ BS.length bytes
where
(fstByte, rest) = first BS.head $ BS.splitAt 1 bytes
addrType = fstByte .&. 0b11110000
addrNetwork = fstByte .&. 0b00001111
(addrHash1, addrHash2) = BS.splitAt credentialHashSize rest
addrRestLength = BS.length rest
-- | Shelley offers several ways to identify ownership of entities on chain.
--
-- This data-family has two instances, depending on whether the key is used for
-- payment or for delegation.
--
-- @since 3.0.0
data family Credential (purpose :: Depth)
data instance Credential 'PaymentK where
PaymentFromKey :: Shelley 'PaymentK Pub -> Credential 'PaymentK
PaymentFromExtendedKey :: Shelley 'PaymentK XPub -> Credential 'PaymentK
PaymentFromKeyHash :: KeyHash -> Credential 'PaymentK
PaymentFromScript :: Script KeyHash -> Credential 'PaymentK
PaymentFromScriptHash :: ScriptHash -> Credential 'PaymentK
deriving Show
data instance Credential 'DelegationK where
DelegationFromKey :: Shelley 'DelegationK Pub -> Credential 'DelegationK
DelegationFromExtendedKey :: Shelley 'DelegationK XPub -> Credential 'DelegationK
DelegationFromKeyHash :: KeyHash -> Credential 'DelegationK
DelegationFromScript :: Script KeyHash -> Credential 'DelegationK
DelegationFromScriptHash :: ScriptHash -> Credential 'DelegationK
DelegationFromPointer :: ChainPointer -> Credential 'DelegationK
deriving Show
-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
--
-- | Convert a payment credential (key or script) to a payment 'Address' valid
-- for the given network discrimination.
--
-- @since 2.0.0
paymentAddress
:: NetworkDiscriminant Shelley
-> Credential 'PaymentK
-> Address
paymentAddress discrimination = \case
PaymentFromKey keyPub ->
constructPayload
(EnterpriseAddress CredentialFromKey)
discrimination
(hashCredential . pubToBytes . getKey $ keyPub)
PaymentFromExtendedKey keyXPub ->
constructPayload
(EnterpriseAddress CredentialFromKey)
discrimination
(hashCredential . xpubPublicKey . getKey $ keyXPub)
PaymentFromKeyHash (KeyHash Payment verKeyHash) ->
constructPayload
(EnterpriseAddress CredentialFromKey)
discrimination
verKeyHash
PaymentFromKeyHash (KeyHash keyrole _) ->
error $ "Payment credential should be built from key hash having payment"
<> " role. Key hash with " <> show keyrole <> " was used."
PaymentFromScript script ->
let (ScriptHash bytes) = toScriptHash script
in constructPayload
(EnterpriseAddress CredentialFromScript)
discrimination
bytes
PaymentFromScriptHash (ScriptHash bytes) ->
constructPayload
(EnterpriseAddress CredentialFromScript)
discrimination
bytes
-- | Convert a payment credential (key or script) and a delegation credential (key or script)
-- to a delegation 'Address' valid for the given network discrimination.
-- Funds sent to this address will be delegated according to the delegation settings
-- attached to the delegation key.
--
-- @since 2.0.0
delegationAddress
:: NetworkDiscriminant Shelley
-> Credential 'PaymentK
-> Credential 'DelegationK
-> Address
delegationAddress discrimination paymentCredential stakeCredential =
unsafeFromRight $ extendAddress
(paymentAddress discrimination paymentCredential)
stakeCredential
-- | Convert a payment credential (key or script) and pointer to delegation certificate in blockchain to a
-- pointer 'Address' valid for the given network discrimination.
--
-- @since 3.0.0
pointerAddress
:: NetworkDiscriminant Shelley
-> Credential 'PaymentK
-> ChainPointer
-> Address
pointerAddress discrimination credential pointer =
unsafeFromRight $ extendAddress
(paymentAddress discrimination credential)
(DelegationFromPointer pointer)
-- | Convert a delegation credential (key or script) to a stake Address (aka reward account address)
-- for the given network discrimination.
--
-- @since 3.0.0
stakeAddress
:: NetworkDiscriminant Shelley
-> Credential 'DelegationK
-> Either ErrInvalidStakeAddress Address
stakeAddress discrimination = \case
DelegationFromKey keyPub ->
Right $ constructPayload
(RewardAccount CredentialFromKey)
discrimination
(hashCredential . pubToBytes . getKey $ keyPub)
DelegationFromExtendedKey keyXPub ->
Right $ constructPayload
(RewardAccount CredentialFromKey)
discrimination
(hashCredential . xpubPublicKey . getKey $ keyXPub)
DelegationFromKeyHash (KeyHash Delegation verKeyHash) ->
Right $ constructPayload
(RewardAccount CredentialFromKey)
discrimination
verKeyHash
DelegationFromKeyHash (KeyHash keyrole _) ->
Left $ ErrStakeAddressFromKeyHash keyrole
DelegationFromScript script ->
let (ScriptHash bytes) = toScriptHash script
in Right $ constructPayload
(RewardAccount CredentialFromScript)
discrimination
bytes
DelegationFromScriptHash (ScriptHash bytes) ->
Right $ constructPayload
(RewardAccount CredentialFromScript)
discrimination
bytes
DelegationFromPointer{} ->
Left ErrStakeAddressFromPointer
-- | Stake addresses can only be constructed from key or script hash. Trying to
-- create one from a pointer will result in the following error.
--
-- @since 3.0.0
data ErrInvalidStakeAddress
= ErrStakeAddressFromPointer
| ErrStakeAddressFromKeyHash KeyRole
deriving (Generic, Show, Eq)
-- | Extend an existing payment 'Address' to make it a delegation address.
--
-- @since 2.0.0
extendAddress
:: Address
-> Credential 'DelegationK
-> Either ErrExtendAddress Address
extendAddress addr infoStakeReference = do
when (isNothing (inspectAddress Nothing addr)) $
Left $ ErrInvalidAddressStyle "Given address isn't a Shelley address"
let bytes = unAddress addr
let (fstByte, rest) = first BS.head $ BS.splitAt 1 bytes
let paymentFirstByte = fstByte .&. 0b11110000
let extendableTypes = addressType <$>
[ EnterpriseAddress CredentialFromKey
, EnterpriseAddress CredentialFromScript
]
unless (paymentFirstByte `elem` extendableTypes) $ do
Left $ ErrInvalidAddressType "Only payment addresses can be extended"
case infoStakeReference of
-- base address: keyhash28,keyhash28 : 00000000 -> 0
-- base address: scripthash28,keyhash28 : 00010000 -> 16
DelegationFromKey delegationKey -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b00011111 = 0
-- 0b01110000 .&. 0b00011111 = 16
putWord8 $ fstByte .&. 0b00011111
putByteString rest
putByteString . hashCredential . pubToBytes . getKey $ delegationKey
-- base address: keyhash28,keyhash28 : 00000000 -> 0
-- base address: scripthash28,keyhash28 : 00010000 -> 16
DelegationFromExtendedKey delegationKey -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b00011111 = 0
-- 0b01110000 .&. 0b00011111 = 16
putWord8 $ fstByte .&. 0b00011111
putByteString rest
putByteString . hashCredential . xpubPublicKey . getKey $ delegationKey
DelegationFromKeyHash (KeyHash Delegation keyhash) -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b00011111 = 0
-- 0b01110000 .&. 0b00011111 = 16
putWord8 $ fstByte .&. 0b00011111
putByteString rest
putByteString keyhash
DelegationFromKeyHash (KeyHash keyrole _) -> do
Left $ ErrInvalidKeyHashType $
"Delegation part can only be constructed from delegation key hash. "
<> "Key hash of " <> show keyrole <> " was used."
-- base address: keyhash28,scripthash28 : 00100000 -> 32
-- base address: scripthash28,scripthash28 : 00110000 -> 48
DelegationFromScript script -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b00111111 = 32
-- 0b01110000 .&. 0b00111111 = 48
putWord8 $ fstByte .&. 0b00111111
putByteString rest
putByteString $ unScriptHash $ toScriptHash script
-- base address: keyhash28,scripthash28 : 00100000 -> 32
-- base address: scripthash28,scripthash28 : 00110000 -> 48
DelegationFromScriptHash (ScriptHash scriptBytes) -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b00111111 = 32
-- 0b01110000 .&. 0b00111111 = 48
putWord8 $ fstByte .&. 0b00111111
putByteString rest
putByteString scriptBytes
-- pointer address: keyhash28, 3 variable length uint : 01000000 -> 64
-- pointer address: scripthash28, 3 variable length uint : 01010000 -> 80
DelegationFromPointer pointer -> do
pure $ unsafeMkAddress $ BL.toStrict $ runPut $ do
-- 0b01100000 .&. 0b01011111 = 64
-- 0b01110000 .&. 0b01011111 = 80
putWord8 $ fstByte .&. 0b01011111
putByteString rest
putPointer pointer
where
putPointer (ChainPointer a b c) = do
putVariableLengthNat a
putVariableLengthNat b
putVariableLengthNat c
-- | Captures error occuring when trying to extend an invalid address.
--
-- @since 2.0.0
data ErrExtendAddress
= ErrInvalidAddressStyle String
| ErrInvalidAddressType String
| ErrInvalidKeyHashType String
deriving (Show)
--
-- Network Discriminant
--
instance HasNetworkDiscriminant Shelley where
type NetworkDiscriminant Shelley = NetworkTag
addressDiscrimination _ = RequiresNetworkTag
networkTag = id
-- | Error reported from trying to create a network discriminant from number
--
-- @since 2.0.0
newtype MkNetworkDiscriminantError
= ErrWrongNetworkTag Integer
-- ^ Wrong network tag.
deriving (Eq, Show)
instance Buildable MkNetworkDiscriminantError where
build (ErrWrongNetworkTag i) = "Invalid network tag "+|i|+". Must be between [0, 15]"
-- | Construct 'NetworkDiscriminant' for Cardano 'Shelley' from a number.
-- If the number is invalid, ie., not between 0 and 15, then
-- 'MkNetworkDiscriminantError' is thrown.
--
-- @since 2.0.0
mkNetworkDiscriminant
:: Integer
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
mkNetworkDiscriminant nTag
| nTag < 16 = Right $ NetworkTag $ fromIntegral nTag
| otherwise = Left $ ErrWrongNetworkTag nTag
-- | Retrieve the network discriminant of a given 'Address'.
-- If the 'Address' is malformed or, not a shelley address, returns Nothing.
--
-- @since 2.0.0
inspectNetworkDiscriminant
:: Address
-> Maybe (NetworkDiscriminant Shelley)
inspectNetworkDiscriminant addr = case eitherInspectAddress Nothing addr of
Right (InspectAddressShelley info) -> Just (infoNetworkTag info)
_ -> Nothing
-- | 'NetworkDicriminant' for Cardano MainNet & Shelley
--
-- @since 2.0.0
shelleyMainnet :: NetworkDiscriminant Shelley
shelleyMainnet = NetworkTag 1
-- | 'NetworkDicriminant' for Cardano Testnet & Shelley
--
-- @since 2.0.0
shelleyTestnet :: NetworkDiscriminant Shelley
shelleyTestnet = NetworkTag 0
--
-- Unsafe
--
-- | Unsafe backdoor for constructing an 'Shelley' 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 2.0.0
liftXPrv :: XPrv -> Shelley depth XPrv
liftXPrv = Shelley
-- | Unsafe backdoor for constructing an 'Shelley' 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 2.0.0
liftXPub :: XPub -> Shelley depth XPub
liftXPub = Shelley
-- | Unsafe backdoor for constructing an 'Shelley' key from a raw 'Pub'. 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.0.0
liftPub :: Pub -> Shelley depth Pub
liftPub = Shelley
-- Use with care when it is _safe_.
unsafeFromRight :: Either a c -> c
unsafeFromRight =
either (error "impossible: internally generated invalid address") id
--
-- Internal
--
-- Purpose is a constant set to 1852' (or 0x8000073c) following the BIP-44
-- extension for Cardano:
--
-- https://github.com/input-output-hk/implementation-decisions/blob/e2d1bed5e617f0907bc5e12cf1c3f3302a4a7c42/text/1852-hd-chimeric.md
--
-- It indicates that the subtree of this node is used according to this
-- specification.
--
-- Hardened derivation is used at this level.
purposeIndex :: Word32
purposeIndex = 0x8000073c
-- Policy purpose is a constant set to 1855' (or 0x8000073c) following the CIP-1855
-- https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855
--
-- It indicates that the subtree of this node is used according to this
-- specification.
--
-- Hardened derivation is used at this level.
policyPurposeIndex :: Word32
policyPurposeIndex = 0x8000073f
-- One master node (seed) can be used for unlimited number of independent
-- cryptocoins such as Bitcoin, Litecoin or Namecoin. However, sharing the
-- same space for various cryptocoins has some disadvantages.
--
-- This level creates a separate subtree for every cryptocoin, avoiding reusing
-- addresses across cryptocoins and improving privacy issues.
--
-- Coin type is a constant, set for each cryptocoin. For Cardano this constant
-- is set to 1815' (or 0x80000717). 1815 is the birthyear of our beloved Ada
-- Lovelace.
--
-- Hardened derivation is used at this level.
coinTypeIndex :: Word32
coinTypeIndex = 0x80000717
-- The minimum seed length for 'genMasterKeyFromMnemonic'.
minSeedLengthBytes :: Int
minSeedLengthBytes = 16
-- A sum-type for constructing addresses payment part.
data CredentialType = CredentialFromKey | CredentialFromScript
deriving (Show, Eq)
-- Different types of Shelley addresses.
data AddressType
= BaseAddress CredentialType CredentialType
| PointerAddress CredentialType
| EnterpriseAddress CredentialType
| RewardAccount CredentialType
| ByronAddress
deriving (Show, Eq)
addressType :: AddressType -> Word8
addressType = \case
ByronAddress -> 0b10000000
BaseAddress CredentialFromKey CredentialFromKey -> 0b00000000
BaseAddress CredentialFromScript CredentialFromKey -> 0b00010000
BaseAddress CredentialFromKey CredentialFromScript -> 0b00100000
BaseAddress CredentialFromScript CredentialFromScript -> 0b00110000
PointerAddress CredentialFromKey -> 0b01000000
PointerAddress CredentialFromScript -> 0b01010000
EnterpriseAddress CredentialFromKey -> 0b01100000
EnterpriseAddress CredentialFromScript -> 0b01110000
RewardAccount CredentialFromKey -> 0b11100000
RewardAccount CredentialFromScript -> 0b11110000
-- Helper to constructs appropriate address headers. Rest of the payload is left
-- to the caller as a raw 'ByteString'.
constructPayload
:: AddressType
-> NetworkDiscriminant Shelley
-> ByteString
-> Address
constructPayload addrType discrimination bytes = unsafeMkAddress $
invariantSize expectedLength $ BL.toStrict $ runPut $ do
putWord8 firstByte
putByteString bytes
where
firstByte =
let netTagLimit = 16
in addressType addrType + invariantNetworkTag netTagLimit (networkTag @Shelley discrimination)
expectedLength =
let headerSizeBytes = 1
in headerSizeBytes + credentialHashSize
--Shelley specific derivation and generation
genMasterKeyFromMnemonicShelley
:: BA.ByteArrayAccess sndFactor
=> SomeMnemonic
-> sndFactor
-> XPrv
genMasterKeyFromMnemonicShelley fstFactor =
generateNew seedValidated
where
seed = someMnemonicToBytes fstFactor
seedValidated = assert
(BA.length seed >= minSeedLengthBytes && BA.length seed <= 255)
seed
deriveAccountPrivateKeyShelley
:: XPrv
-> Index derivationType depth
-> Word32
-> XPrv
deriveAccountPrivateKeyShelley rootXPrv accIx purpose =
let
Just purposeIx =
indexFromWord32 @(Index 'Hardened _) purpose
Just coinTypeIx =
indexFromWord32 @(Index 'Hardened _) coinTypeIndex
purposeXPrv = -- lvl1 derivation; hardened derivation of purpose'
deriveXPrv DerivationScheme2 rootXPrv purposeIx
coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type'
deriveXPrv DerivationScheme2 purposeXPrv coinTypeIx
acctXPrv = -- lvl3 derivation; hardened derivation of account' index
deriveXPrv DerivationScheme2 coinTypeXPrv accIx
in
acctXPrv
deriveAddressPrivateKeyShelley
:: XPrv
-> Role
-> Index derivationType depth
-> XPrv
deriveAddressPrivateKeyShelley accXPrv role addrIx =
let
changeXPrv = -- lvl4 derivation; soft derivation of change chain
deriveXPrv DerivationScheme2 accXPrv (roleToIndex role)
addrXPrv = -- lvl5 derivation; soft derivation of address index
deriveXPrv DerivationScheme2 changeXPrv addrIx
in
addrXPrv
deriveAddressPublicKeyShelley
:: XPub
-> Role
-> Index derivationType depth
-> XPub
deriveAddressPublicKeyShelley accXPub role addrIx =
fromMaybe errWrongIndex $ do
changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain
deriveXPub DerivationScheme2 accXPub (roleToIndex role)
-- lvl5 derivation in bip44 is derivation of address chain
deriveXPub DerivationScheme2 changeXPub addrIx
where
errWrongIndex = error $
"deriveAddressPublicKey failed: was given an hardened (or too big) \
\index for soft path derivation ( " ++ show addrIx ++ "). This is \
\either a programmer error, or, we may have reached the maximum \
\number of addresses for a given wallet."
--
-- Internal
--
--- | Computes a 28-byte Blake2b224 digest of a Shelley 'XPub'.
---
--- @since 3.13.0
hashKey :: KeyRole -> Shelley key XPub -> KeyHash
hashKey cred = KeyHash cred . hashCredential . xpubPublicKey . getKey