{-# 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
    { forall (depth :: Depth) key. Shelley depth key -> key
getKey :: key
        -- ^ Extract the raw 'XPrv' or 'XPub' wrapped by this type.
        --
        -- @since 1.0.0
    }
    deriving stock ((forall x. Shelley depth key -> Rep (Shelley depth key) x)
-> (forall x. Rep (Shelley depth key) x -> Shelley depth key)
-> Generic (Shelley depth key)
forall x. Rep (Shelley depth key) x -> Shelley depth key
forall x. Shelley depth key -> Rep (Shelley 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 (Shelley depth key) x -> Shelley depth key
forall (depth :: Depth) key x.
Shelley depth key -> Rep (Shelley depth key) x
$cfrom :: forall (depth :: Depth) key x.
Shelley depth key -> Rep (Shelley depth key) x
from :: forall x. Shelley depth key -> Rep (Shelley depth key) x
$cto :: forall (depth :: Depth) key x.
Rep (Shelley depth key) x -> Shelley depth key
to :: forall x. Rep (Shelley depth key) x -> Shelley depth key
Generic, Int -> Shelley depth key -> [Char] -> [Char]
[Shelley depth key] -> [Char] -> [Char]
Shelley depth key -> [Char]
(Int -> Shelley depth key -> [Char] -> [Char])
-> (Shelley depth key -> [Char])
-> ([Shelley depth key] -> [Char] -> [Char])
-> Show (Shelley depth key)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall (depth :: Depth) key.
Show key =>
Int -> Shelley depth key -> [Char] -> [Char]
forall (depth :: Depth) key.
Show key =>
[Shelley depth key] -> [Char] -> [Char]
forall (depth :: Depth) key.
Show key =>
Shelley depth key -> [Char]
$cshowsPrec :: forall (depth :: Depth) key.
Show key =>
Int -> Shelley depth key -> [Char] -> [Char]
showsPrec :: Int -> Shelley depth key -> [Char] -> [Char]
$cshow :: forall (depth :: Depth) key.
Show key =>
Shelley depth key -> [Char]
show :: Shelley depth key -> [Char]
$cshowList :: forall (depth :: Depth) key.
Show key =>
[Shelley depth key] -> [Char] -> [Char]
showList :: [Shelley depth key] -> [Char] -> [Char]
Show, Shelley depth key -> Shelley depth key -> Bool
(Shelley depth key -> Shelley depth key -> Bool)
-> (Shelley depth key -> Shelley depth key -> Bool)
-> Eq (Shelley depth key)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (depth :: Depth) key.
Eq key =>
Shelley depth key -> Shelley depth key -> Bool
$c== :: forall (depth :: Depth) key.
Eq key =>
Shelley depth key -> Shelley depth key -> Bool
== :: Shelley depth key -> Shelley depth key -> Bool
$c/= :: forall (depth :: Depth) key.
Eq key =>
Shelley depth key -> Shelley depth key -> Bool
/= :: Shelley depth key -> Shelley depth key -> Bool
Eq)

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

-- | Describe what the keys within an account are used for.
--
-- - 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
--
-- @since 3.0.0
data Role
    = UTxOExternal
    | UTxOInternal
    | Stake
    | DRep
    | CCCold
    | CCHot
    deriving ((forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic, Typeable, Int -> Role -> [Char] -> [Char]
[Role] -> [Char] -> [Char]
Role -> [Char]
(Int -> Role -> [Char] -> [Char])
-> (Role -> [Char]) -> ([Role] -> [Char] -> [Char]) -> Show Role
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Role -> [Char] -> [Char]
showsPrec :: Int -> Role -> [Char] -> [Char]
$cshow :: Role -> [Char]
show :: Role -> [Char]
$cshowList :: [Role] -> [Char] -> [Char]
showList :: [Role] -> [Char] -> [Char]
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, Eq Role
Eq Role =>
(Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Role -> Role -> Ordering
compare :: Role -> Role -> Ordering
$c< :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
>= :: Role -> Role -> Bool
$cmax :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
min :: Role -> Role -> Role
Ord, Role
Role -> Role -> Bounded Role
forall a. a -> a -> Bounded a
$cminBound :: Role
minBound :: Role
$cmaxBound :: Role
maxBound :: Role
Bounded)

instance NFData Role

roleFromIndex :: Index 'Soft depth -> Maybe Role
roleFromIndex :: forall (depth :: Depth). Index 'Soft depth -> Maybe Role
roleFromIndex Index 'Soft depth
ix = case Index 'Soft depth -> Word32
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Word32
indexToWord32 Index 'Soft depth
ix of
    Word32
0 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
UTxOExternal
    Word32
1 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
UTxOInternal
    Word32
2 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
Stake
    Word32
3 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
DRep
    Word32
4 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
CCCold
    Word32
5 -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
CCHot
    Word32
_ -> Maybe Role
forall a. Maybe a
Nothing

roleToIndex :: Role -> Index 'Soft depth
roleToIndex :: forall (depth :: Depth). Role -> Index 'Soft depth
roleToIndex = Word32 -> Index 'Soft depth
forall (ty :: DerivationType) (depth :: Depth).
Word32 -> Index ty depth
unsafeMkIndex (Word32 -> Index 'Soft depth)
-> (Role -> Word32) -> Role -> Index 'Soft depth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Role
UTxOExternal -> Word32
0
    Role
UTxOInternal -> Word32
1
    Role
Stake -> Word32
2
    Role
DRep -> Word32
3
    Role
CCCold -> Word32
4
    Role
CCHot -> Word32
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 :: XPrv -> Shelley 'RootK XPrv
genMasterKeyFromXPrv = XPrv -> Shelley 'RootK XPrv
forall (depth :: Depth). XPrv -> Shelley depth XPrv
liftXPrv
    genMasterKeyFromMnemonic :: SomeMnemonic -> SecondFactor Shelley -> Shelley 'RootK XPrv
genMasterKeyFromMnemonic SomeMnemonic
fstFactor SecondFactor Shelley
sndFactor =
        XPrv -> Shelley 'RootK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley (XPrv -> Shelley 'RootK XPrv) -> XPrv -> Shelley 'RootK XPrv
forall a b. (a -> b) -> a -> b
$ SomeMnemonic -> ScrubbedBytes -> XPrv
forall sndFactor.
ByteArrayAccess sndFactor =>
SomeMnemonic -> sndFactor -> XPrv
genMasterKeyFromMnemonicShelley SomeMnemonic
fstFactor ScrubbedBytes
SecondFactor Shelley
sndFactor

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

    deriveAccountPrivateKey :: Shelley 'RootK XPrv
-> Index (AccountIndexDerivationType Shelley) 'AccountK
-> Shelley 'AccountK XPrv
deriveAccountPrivateKey (Shelley XPrv
rootXPrv) Index (AccountIndexDerivationType Shelley) 'AccountK
accIx =
        XPrv -> Shelley 'AccountK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley (XPrv -> Shelley 'AccountK XPrv) -> XPrv -> Shelley '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 Shelley) 'AccountK
Index 'Hardened 'AccountK
accIx Word32
purposeIndex

    deriveAddressPrivateKey :: Shelley 'AccountK XPrv
-> WithRole Shelley
-> Index (AddressIndexDerivationType Shelley) 'PaymentK
-> Shelley 'PaymentK XPrv
deriveAddressPrivateKey (Shelley XPrv
accXPrv) WithRole Shelley
role Index (AddressIndexDerivationType Shelley) 'PaymentK
addrIx =
        XPrv -> Shelley 'PaymentK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley (XPrv -> Shelley 'PaymentK XPrv) -> XPrv -> Shelley '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 Shelley
Role
role Index (AddressIndexDerivationType Shelley) 'PaymentK
Index 'Soft 'PaymentK
addrIx

instance Internal.SoftDerivation Shelley where
    deriveAddressPublicKey :: Shelley 'AccountK XPub
-> WithRole Shelley
-> Index 'Soft 'PaymentK
-> Shelley 'PaymentK XPub
deriveAddressPublicKey (Shelley XPub
accXPub) WithRole Shelley
role Index 'Soft 'PaymentK
addrIx =
        XPub -> Shelley 'PaymentK XPub
forall (depth :: Depth) key. key -> Shelley depth key
Shelley (XPub -> Shelley 'PaymentK XPub) -> XPub -> Shelley '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 Shelley
Role
role Index 'Soft 'PaymentK
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 :: SomeMnemonic -> ScrubbedBytes -> Shelley 'RootK XPrv
genMasterKeyFromMnemonic =
    SomeMnemonic -> ScrubbedBytes -> Shelley 'RootK XPrv
SomeMnemonic -> SecondFactor Shelley -> Shelley '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 2.0.0
genMasterKeyFromXPrv
    :: XPrv -> Shelley 'RootK XPrv
genMasterKeyFromXPrv :: XPrv -> Shelley 'RootK XPrv
genMasterKeyFromXPrv =
    XPrv -> Shelley '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 2.0.0
deriveAccountPrivateKey
    :: Shelley 'RootK XPrv
    -> Index 'Hardened 'AccountK
    -> Shelley 'AccountK XPrv
deriveAccountPrivateKey :: Shelley 'RootK XPrv
-> Index 'Hardened 'AccountK -> Shelley 'AccountK XPrv
deriveAccountPrivateKey =
    Shelley 'RootK XPrv
-> Index (AccountIndexDerivationType Shelley) 'AccountK
-> Shelley 'AccountK XPrv
Shelley 'RootK XPrv
-> Index 'Hardened 'AccountK -> Shelley '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 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 'RootK XPrv
-> Index 'Hardened 'PolicyK -> Shelley 'PolicyK XPrv
derivePolicyPrivateKey (Shelley XPrv
rootXPrv) Index 'Hardened 'PolicyK
policyIx =
    XPrv -> Shelley 'PolicyK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley (XPrv -> Shelley 'PolicyK XPrv) -> XPrv -> Shelley 'PolicyK XPrv
forall a b. (a -> b) -> a -> b
$ XPrv -> Index 'Hardened 'PolicyK -> Word32 -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
XPrv -> Index derivationType depth -> Word32 -> XPrv
deriveAccountPrivateKeyShelley XPrv
rootXPrv Index 'Hardened 'PolicyK
policyIx Word32
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 :: Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPrv
deriveAddressPrivateKey =
    Shelley 'AccountK XPrv
-> WithRole Shelley
-> Index (AddressIndexDerivationType Shelley) 'PaymentK
-> Shelley 'PaymentK XPrv
Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley '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 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 :: Shelley 'AccountK XPub
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPub
deriveAddressPublicKey =
    Shelley 'AccountK XPub
-> WithRole Shelley
-> Index 'Soft 'PaymentK
-> Shelley 'PaymentK XPub
Shelley 'AccountK XPub
-> Role -> Index 'Soft 'PaymentK -> Shelley '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
--
-- | 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 :: Shelley 'AccountK XPrv -> Shelley 'DelegationK XPrv
deriveDelegationPrivateKey Shelley 'AccountK XPrv
accXPrv =
    let (Shelley XPrv
stakeXPrv) =
            Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accXPrv Role
Stake (forall a. Bounded a => a
minBound @(Index 'Soft _))
    in XPrv -> Shelley 'DelegationK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley XPrv
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 :: Shelley 'AccountK XPrv -> Shelley 'DRepK XPrv
deriveDRepPrivateKey Shelley 'AccountK XPrv
accXPrv =
    let (Shelley XPrv
drepXPrv) =
            Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accXPrv Role
DRep (forall a. Bounded a => a
minBound @(Index 'Soft _))
    in XPrv -> Shelley 'DRepK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley XPrv
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 :: Shelley 'AccountK XPrv -> Shelley 'CCColdK XPrv
deriveCCColdPrivateKey Shelley 'AccountK XPrv
accXPrv =
    let (Shelley XPrv
ccColdXPrv) =
            Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accXPrv Role
CCCold (forall a. Bounded a => a
minBound @(Index 'Soft _))
    in XPrv -> Shelley 'CCColdK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley XPrv
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 :: Shelley 'AccountK XPrv -> Shelley 'CCHotK XPrv
deriveCCHotPrivateKey Shelley 'AccountK XPrv
accXPrv =
    let (Shelley XPrv
ccHotXPrv) =
            Shelley 'AccountK XPrv
-> Role -> Index 'Soft 'PaymentK -> Shelley 'PaymentK XPrv
deriveAddressPrivateKey Shelley 'AccountK XPrv
accXPrv Role
CCHot (forall a. Bounded a => a
minBound @(Index 'Soft _))
    in XPrv -> Shelley 'CCHotK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley XPrv
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 ((forall x. ErrInspectAddress -> Rep ErrInspectAddress x)
-> (forall x. Rep ErrInspectAddress x -> ErrInspectAddress)
-> Generic ErrInspectAddress
forall x. Rep ErrInspectAddress x -> ErrInspectAddress
forall x. ErrInspectAddress -> Rep ErrInspectAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrInspectAddress -> Rep ErrInspectAddress x
from :: forall x. ErrInspectAddress -> Rep ErrInspectAddress x
$cto :: forall x. Rep ErrInspectAddress x -> ErrInspectAddress
to :: forall x. Rep ErrInspectAddress x -> ErrInspectAddress
Generic, Int -> ErrInspectAddress -> [Char] -> [Char]
[ErrInspectAddress] -> [Char] -> [Char]
ErrInspectAddress -> [Char]
(Int -> ErrInspectAddress -> [Char] -> [Char])
-> (ErrInspectAddress -> [Char])
-> ([ErrInspectAddress] -> [Char] -> [Char])
-> Show ErrInspectAddress
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ErrInspectAddress -> [Char] -> [Char]
showsPrec :: Int -> ErrInspectAddress -> [Char] -> [Char]
$cshow :: ErrInspectAddress -> [Char]
show :: ErrInspectAddress -> [Char]
$cshowList :: [ErrInspectAddress] -> [Char] -> [Char]
showList :: [ErrInspectAddress] -> [Char] -> [Char]
Show, ErrInspectAddress -> ErrInspectAddress -> Bool
(ErrInspectAddress -> ErrInspectAddress -> Bool)
-> (ErrInspectAddress -> ErrInspectAddress -> Bool)
-> Eq ErrInspectAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrInspectAddress -> ErrInspectAddress -> Bool
== :: ErrInspectAddress -> ErrInspectAddress -> Bool
$c/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
Eq)
    deriving [ErrInspectAddress] -> Value
[ErrInspectAddress] -> Encoding
ErrInspectAddress -> Bool
ErrInspectAddress -> Value
ErrInspectAddress -> Encoding
(ErrInspectAddress -> Value)
-> (ErrInspectAddress -> Encoding)
-> ([ErrInspectAddress] -> Value)
-> ([ErrInspectAddress] -> Encoding)
-> (ErrInspectAddress -> Bool)
-> ToJSON ErrInspectAddress
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ErrInspectAddress -> Value
toJSON :: ErrInspectAddress -> Value
$ctoEncoding :: ErrInspectAddress -> Encoding
toEncoding :: ErrInspectAddress -> Encoding
$ctoJSONList :: [ErrInspectAddress] -> Value
toJSONList :: [ErrInspectAddress] -> Value
$ctoEncodingList :: [ErrInspectAddress] -> Encoding
toEncodingList :: [ErrInspectAddress] -> Encoding
$comitField :: ErrInspectAddress -> Bool
omitField :: ErrInspectAddress -> Bool
ToJSON via WithErrorMessage ErrInspectAddress

instance Exception ErrInspectAddress where
    displayException :: ErrInspectAddress -> [Char]
displayException = ErrInspectAddress -> [Char]
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 ((forall x.
 ErrInspectAddressOnlyShelley -> Rep ErrInspectAddressOnlyShelley x)
-> (forall x.
    Rep ErrInspectAddressOnlyShelley x -> ErrInspectAddressOnlyShelley)
-> Generic ErrInspectAddressOnlyShelley
forall x.
Rep ErrInspectAddressOnlyShelley x -> ErrInspectAddressOnlyShelley
forall x.
ErrInspectAddressOnlyShelley -> Rep ErrInspectAddressOnlyShelley x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ErrInspectAddressOnlyShelley -> Rep ErrInspectAddressOnlyShelley x
from :: forall x.
ErrInspectAddressOnlyShelley -> Rep ErrInspectAddressOnlyShelley x
$cto :: forall x.
Rep ErrInspectAddressOnlyShelley x -> ErrInspectAddressOnlyShelley
to :: forall x.
Rep ErrInspectAddressOnlyShelley x -> ErrInspectAddressOnlyShelley
Generic, ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
(ErrInspectAddressOnlyShelley
 -> ErrInspectAddressOnlyShelley -> Bool)
-> (ErrInspectAddressOnlyShelley
    -> ErrInspectAddressOnlyShelley -> Bool)
-> Eq ErrInspectAddressOnlyShelley
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
== :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
$c/= :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
/= :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
Eq, Int -> ErrInspectAddressOnlyShelley -> [Char] -> [Char]
[ErrInspectAddressOnlyShelley] -> [Char] -> [Char]
ErrInspectAddressOnlyShelley -> [Char]
(Int -> ErrInspectAddressOnlyShelley -> [Char] -> [Char])
-> (ErrInspectAddressOnlyShelley -> [Char])
-> ([ErrInspectAddressOnlyShelley] -> [Char] -> [Char])
-> Show ErrInspectAddressOnlyShelley
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ErrInspectAddressOnlyShelley -> [Char] -> [Char]
showsPrec :: Int -> ErrInspectAddressOnlyShelley -> [Char] -> [Char]
$cshow :: ErrInspectAddressOnlyShelley -> [Char]
show :: ErrInspectAddressOnlyShelley -> [Char]
$cshowList :: [ErrInspectAddressOnlyShelley] -> [Char] -> [Char]
showList :: [ErrInspectAddressOnlyShelley] -> [Char] -> [Char]
Show)
    deriving [ErrInspectAddressOnlyShelley] -> Value
[ErrInspectAddressOnlyShelley] -> Encoding
ErrInspectAddressOnlyShelley -> Bool
ErrInspectAddressOnlyShelley -> Value
ErrInspectAddressOnlyShelley -> Encoding
(ErrInspectAddressOnlyShelley -> Value)
-> (ErrInspectAddressOnlyShelley -> Encoding)
-> ([ErrInspectAddressOnlyShelley] -> Value)
-> ([ErrInspectAddressOnlyShelley] -> Encoding)
-> (ErrInspectAddressOnlyShelley -> Bool)
-> ToJSON ErrInspectAddressOnlyShelley
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ErrInspectAddressOnlyShelley -> Value
toJSON :: ErrInspectAddressOnlyShelley -> Value
$ctoEncoding :: ErrInspectAddressOnlyShelley -> Encoding
toEncoding :: ErrInspectAddressOnlyShelley -> Encoding
$ctoJSONList :: [ErrInspectAddressOnlyShelley] -> Value
toJSONList :: [ErrInspectAddressOnlyShelley] -> Value
$ctoEncodingList :: [ErrInspectAddressOnlyShelley] -> Encoding
toEncodingList :: [ErrInspectAddressOnlyShelley] -> Encoding
$comitField :: ErrInspectAddressOnlyShelley -> Bool
omitField :: ErrInspectAddressOnlyShelley -> Bool
ToJSON via WithErrorMessage ErrInspectAddressOnlyShelley

instance Exception ErrInspectAddressOnlyShelley where
    displayException :: ErrInspectAddressOnlyShelley -> [Char]
displayException = ErrInspectAddressOnlyShelley -> [Char]
prettyErrInspectAddressOnlyShelley

-- | Pretty-print an 'ErrInspectAddressOnlyShelley'
--
-- @since 3.4.0
prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> [Char]
prettyErrInspectAddressOnlyShelley = \case
    PtrRetrieveError [Char]
s ->
        Format -> [Char] -> [Char]
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Failed to retrieve pointer (underlying errors was: {})" [Char]
s
    UnknownType Word8
t ->
        Format -> Word8 -> [Char]
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Unknown address type {}" Word8
t

-- | Pretty-print an 'ErrInspectAddress'
--
-- @since 3.0.0
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress :: ErrInspectAddress -> [Char]
prettyErrInspectAddress = \case
    WrongInputSize Int
i -> Format -> Int -> [Char]
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Wrong input size of {}" Int
i
    ErrShelley ErrInspectAddressOnlyShelley
e -> [Char]
"Invalid Shelley address: "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddressOnlyShelley -> [Char]
prettyErrInspectAddressOnlyShelley ErrInspectAddressOnlyShelley
e
    ErrIcarus ErrInspectAddress
e -> [Char]
"Invalid Icarus address: "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddress -> [Char]
Icarus.prettyErrInspectAddress ErrInspectAddress
e
    ErrByron ErrInspectAddress
e -> [Char]
"Invalid Byron address: "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddress -> [Char]
Byron.prettyErrInspectAddress ErrInspectAddress
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 :: forall (m :: * -> *).
MonadThrow m =>
Maybe XPub -> Address -> m Value
inspectShelleyAddress = Maybe XPub -> Address -> m Value
forall (m :: * -> *).
MonadThrow m =>
Maybe XPub -> Address -> m Value
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 :: forall (m :: * -> *).
MonadThrow m =>
Maybe XPub -> Address -> m Value
inspectAddress Maybe XPub
mRootPub Address
addr = (ErrInspectAddress -> m Value)
-> (InspectAddress -> m Value)
-> Either ErrInspectAddress InspectAddress
-> m Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrInspectAddress -> m Value
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (Value -> m Value
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value)
-> (InspectAddress -> Value) -> InspectAddress -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InspectAddress -> Value
forall a. ToJSON a => a -> Value
toJSON) (Either ErrInspectAddress InspectAddress -> m Value)
-> Either ErrInspectAddress InspectAddress -> m Value
forall a b. (a -> b) -> a -> b
$
    Maybe XPub -> Address -> Either ErrInspectAddress InspectAddress
eitherInspectAddress Maybe XPub
mRootPub Address
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 :: Maybe XPub -> Address -> Either ErrInspectAddress InspectAddress
eitherInspectAddress Maybe XPub
mRootPub Address
addr = Address -> Either ErrInspectAddress AddressParts
unpackAddress Address
addr Either ErrInspectAddress AddressParts
-> (AddressParts -> Either ErrInspectAddress InspectAddress)
-> Either ErrInspectAddress InspectAddress
forall a b.
Either ErrInspectAddress a
-> (a -> Either ErrInspectAddress b) -> Either ErrInspectAddress b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AddressParts -> Either ErrInspectAddress InspectAddress
parseInfo
  where
    parseInfo :: AddressParts -> Either ErrInspectAddress InspectAddress
    parseInfo :: AddressParts -> Either ErrInspectAddress InspectAddress
parseInfo AddressParts
parts = case AddressParts -> Word8
addrType AddressParts
parts of
        -- 1000: byron address
        Word8
0b10000000 ->
            ((ErrInspectAddress -> ErrInspectAddress)
-> (AddressInfo -> InspectAddress)
-> Either ErrInspectAddress AddressInfo
-> Either ErrInspectAddress InspectAddress
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ErrInspectAddress -> ErrInspectAddress
ErrIcarus AddressInfo -> InspectAddress
InspectAddressIcarus (Address -> Either ErrInspectAddress AddressInfo
Icarus.eitherInspectAddress Address
addr))
            Either ErrInspectAddress InspectAddress
-> Either ErrInspectAddress InspectAddress
-> Either ErrInspectAddress InspectAddress
forall e a. Either e a -> Either e a -> Either e a
`orElse`
            ((ErrInspectAddress -> ErrInspectAddress)
-> (AddressInfo -> InspectAddress)
-> Either ErrInspectAddress AddressInfo
-> Either ErrInspectAddress InspectAddress
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ErrInspectAddress -> ErrInspectAddress
ErrByron AddressInfo -> InspectAddress
InspectAddressByron (Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
Byron.eitherInspectAddress Maybe XPub
mRootPub Address
addr))
        -- Anything else: shelley address
        Word8
_ -> (ErrInspectAddressOnlyShelley -> ErrInspectAddress)
-> (AddressInfo -> InspectAddress)
-> Either ErrInspectAddressOnlyShelley AddressInfo
-> Either ErrInspectAddress InspectAddress
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ErrInspectAddressOnlyShelley -> ErrInspectAddress
ErrShelley AddressInfo -> InspectAddress
InspectAddressShelley (AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley AddressParts
parts)

-- | Returns either details about the 'Address', or
-- 'ErrInspectAddressOnlyShelley' if it's not a valid Shelley address.
parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley AddressParts{Int
Word8
ByteString
$sel:addrType:AddressParts :: AddressParts -> Word8
addrType :: Word8
addrNetwork :: Word8
addrHash1 :: ByteString
addrHash2 :: ByteString
addrRestLength :: Int
$sel:addrNetwork:AddressParts :: AddressParts -> Word8
$sel:addrHash1:AddressParts :: AddressParts -> ByteString
$sel:addrHash2:AddressParts :: AddressParts -> ByteString
$sel:addrRestLength:AddressParts :: AddressParts -> Int
..} = case Word8
addrType of
    -- 0000: base address: keyhash28,keyhash28
    Word8
0b00000000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoSpendingKeyHash = Just addrHash1
            , infoStakeKeyHash = Just addrHash2
            }
    -- 0001: base address: scripthash28,keyhash28
    Word8
0b00010000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoSpendingScriptHash = Just addrHash1
            , infoStakeKeyHash = Just addrHash2
            }
    -- 0010: base address: keyhash28,scripthash28
    Word8
0b00100000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoSpendingKeyHash = Just addrHash1
            , infoStakeScriptHash = Just addrHash2
            }
    -- 0011: base address: scripthash28,scripthash28
    Word8
0b00110000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoSpendingScriptHash = Just addrHash1
            , infoStakeScriptHash = Just addrHash2
            }
    -- 0100: pointer address: keyhash28, 3 variable length uint
    Word8
0b01000000 | Int
addrRestLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
credentialHashSize -> do
        ChainPointer
ptr <- ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
getPtr ByteString
addrHash2
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a. a -> Either ErrInspectAddressOnlyShelley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressInfo
addressInfo
            { infoStakeReference = Just $ ByPointer ptr
            , infoSpendingKeyHash = Just addrHash1
            }
    -- 0101: pointer address: scripthash28, 3 variable length uint
    Word8
0b01010000 | Int
addrRestLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
credentialHashSize -> do
        ChainPointer
ptr <- ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
getPtr ByteString
addrHash2
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a. a -> Either ErrInspectAddressOnlyShelley a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressInfo
addressInfo
            { infoStakeReference = Just $ ByPointer ptr
            , infoSpendingScriptHash = Just addrHash1
            }
    -- 0110: enterprise address: keyhash28
    Word8
0b01100000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Nothing
            , infoSpendingKeyHash = Just addrHash1
            }
    -- 0111: enterprise address: scripthash28
    Word8
0b01110000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Nothing
            , infoSpendingScriptHash = Just addrHash1
            }
    -- 1110: reward account: keyhash28
    Word8
0b11100000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoStakeKeyHash = Just addrHash1
            }
    -- 1111: reward account: scripthash28
    Word8
0b11110000 | Int
addrRestLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
credentialHashSize ->
        AddressInfo -> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. b -> Either a b
Right AddressInfo
addressInfo
            { infoStakeReference = Just ByValue
            , infoStakeScriptHash = Just addrHash1
            }
    Word8
unknown -> ErrInspectAddressOnlyShelley
-> Either ErrInspectAddressOnlyShelley AddressInfo
forall a b. a -> Either a b
Left (Word8 -> ErrInspectAddressOnlyShelley
UnknownType Word8
unknown)

  where
    addressInfo :: AddressInfo
addressInfo = AddressInfo
        { $sel:infoNetworkTag:AddressInfo :: NetworkTag
infoNetworkTag = Word32 -> NetworkTag
NetworkTag (Word32 -> NetworkTag) -> Word32 -> NetworkTag
forall a b. (a -> b) -> a -> b
$ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
addrNetwork
        , $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = Maybe ReferenceInfo
forall a. Maybe a
Nothing
        , $sel:infoSpendingKeyHash:AddressInfo :: Maybe ByteString
infoSpendingKeyHash = Maybe ByteString
forall a. Maybe a
Nothing
        , $sel:infoStakeKeyHash:AddressInfo :: Maybe ByteString
infoStakeKeyHash = Maybe ByteString
forall a. Maybe a
Nothing
        , $sel:infoSpendingScriptHash:AddressInfo :: Maybe ByteString
infoSpendingScriptHash = Maybe ByteString
forall a. Maybe a
Nothing
        , $sel:infoStakeScriptHash:AddressInfo :: Maybe ByteString
infoStakeScriptHash = Maybe ByteString
forall a. Maybe a
Nothing
        , $sel:infoAddressType:AddressInfo :: Word8
infoAddressType = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftR (Word8
addrType Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000) Int
4
        }

    getPtr :: ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
    getPtr :: ByteString -> Either ErrInspectAddressOnlyShelley ChainPointer
getPtr ByteString
source = case Get ChainPointer
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char])
     (ByteString, ByteOffset, ChainPointer)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
runGetOrFail Get ChainPointer
get (ByteString -> ByteString
BL.fromStrict ByteString
source) of
        Right (ByteString
"", ByteOffset
_, ChainPointer
a) -> ChainPointer -> Either ErrInspectAddressOnlyShelley ChainPointer
forall a b. b -> Either a b
Right ChainPointer
a
        Right (ByteString, ByteOffset, ChainPointer)
_ -> [Char] -> Either ErrInspectAddressOnlyShelley ChainPointer
forall {b}. [Char] -> Either ErrInspectAddressOnlyShelley b
err [Char]
"Unconsumed bytes after pointer"
        Left (ByteString
_, ByteOffset
_, [Char]
e) -> [Char] -> Either ErrInspectAddressOnlyShelley ChainPointer
forall {b}. [Char] -> Either ErrInspectAddressOnlyShelley b
err [Char]
e
      where
        get :: Get ChainPointer
get = Natural -> Natural -> Natural -> ChainPointer
ChainPointer
            (Natural -> Natural -> Natural -> ChainPointer)
-> Get Natural -> Get (Natural -> Natural -> ChainPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Natural
getVariableLengthNat
            Get (Natural -> Natural -> ChainPointer)
-> Get Natural -> Get (Natural -> ChainPointer)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Natural
getVariableLengthNat
            Get (Natural -> ChainPointer) -> Get Natural -> Get ChainPointer
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Natural
getVariableLengthNat
        err :: [Char] -> Either ErrInspectAddressOnlyShelley b
err = ErrInspectAddressOnlyShelley
-> Either ErrInspectAddressOnlyShelley b
forall a b. a -> Either a b
Left (ErrInspectAddressOnlyShelley
 -> Either ErrInspectAddressOnlyShelley b)
-> ([Char] -> ErrInspectAddressOnlyShelley)
-> [Char]
-> Either ErrInspectAddressOnlyShelley b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ErrInspectAddressOnlyShelley
PtrRetrieveError

-- | The result of 'eitherInspectAddress'.
--
-- @since 3.4.0
data InspectAddress
    = InspectAddressShelley AddressInfo
    | InspectAddressIcarus Icarus.AddressInfo
    | InspectAddressByron Byron.AddressInfo
    deriving ((forall x. InspectAddress -> Rep InspectAddress x)
-> (forall x. Rep InspectAddress x -> InspectAddress)
-> Generic InspectAddress
forall x. Rep InspectAddress x -> InspectAddress
forall x. InspectAddress -> Rep InspectAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InspectAddress -> Rep InspectAddress x
from :: forall x. InspectAddress -> Rep InspectAddress x
$cto :: forall x. Rep InspectAddress x -> InspectAddress
to :: forall x. Rep InspectAddress x -> InspectAddress
Generic, Int -> InspectAddress -> [Char] -> [Char]
[InspectAddress] -> [Char] -> [Char]
InspectAddress -> [Char]
(Int -> InspectAddress -> [Char] -> [Char])
-> (InspectAddress -> [Char])
-> ([InspectAddress] -> [Char] -> [Char])
-> Show InspectAddress
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> InspectAddress -> [Char] -> [Char]
showsPrec :: Int -> InspectAddress -> [Char] -> [Char]
$cshow :: InspectAddress -> [Char]
show :: InspectAddress -> [Char]
$cshowList :: [InspectAddress] -> [Char] -> [Char]
showList :: [InspectAddress] -> [Char] -> [Char]
Show, InspectAddress -> InspectAddress -> Bool
(InspectAddress -> InspectAddress -> Bool)
-> (InspectAddress -> InspectAddress -> Bool) -> Eq InspectAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InspectAddress -> InspectAddress -> Bool
== :: InspectAddress -> InspectAddress -> Bool
$c/= :: InspectAddress -> InspectAddress -> Bool
/= :: InspectAddress -> InspectAddress -> Bool
Eq)

instance ToJSON InspectAddress where
    toJSON :: InspectAddress -> Value
toJSON InspectAddress
addr = Object -> Value -> Value
combine (Object
styleProp Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
missingProp) (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
addr')
      where
        addr' :: Value
addr' = case InspectAddress
addr of
          InspectAddressShelley AddressInfo
s -> AddressInfo -> Value
forall a. ToJSON a => a -> Value
toJSON AddressInfo
s
          InspectAddressIcarus AddressInfo
i -> AddressInfo -> Value
forall a. ToJSON a => a -> Value
toJSON AddressInfo
i
          InspectAddressByron AddressInfo
b -> AddressInfo -> Value
forall a. ToJSON a => a -> Value
toJSON AddressInfo
b

        styleProp :: Object
styleProp = Key
"address_style" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Json.String Text
styleName
        styleName :: Text
styleName = case InspectAddress
addr of
            InspectAddressShelley AddressInfo
_ -> Text
"Shelley"
            InspectAddressIcarus AddressInfo
_ -> Text
"Icarus"
            InspectAddressByron AddressInfo
_ -> Text
"Byron"
        missingProp :: Object
missingProp = case InspectAddress
addr of
            InspectAddressShelley AddressInfo
_ -> Object
forall a. Monoid a => a
mempty
            InspectAddressIcarus AddressInfo
_ -> Object
noStakeRef
            InspectAddressByron AddressInfo
_ -> Object
noStakeRef
        noStakeRef :: Object
noStakeRef = Key
"stake_reference" Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Json.String Text
"none"

        combine :: Object -> Value -> Value
combine Object
extra = \case
            Json.Object Object
props -> Object -> Value
Json.Object (Object
extra Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
props)
            Value
otherValue -> Value
otherValue -- not expected to happen

-- | An inspected Shelley address.
--
-- @since 3.4.0
data AddressInfo = AddressInfo
    { AddressInfo -> Maybe ReferenceInfo
infoStakeReference     :: !(Maybe ReferenceInfo)
    , AddressInfo -> Maybe ByteString
infoSpendingKeyHash    :: !(Maybe ByteString)
    , AddressInfo -> Maybe ByteString
infoStakeKeyHash       :: !(Maybe ByteString)
    , AddressInfo -> Maybe ByteString
infoSpendingScriptHash :: !(Maybe ByteString)
    , AddressInfo -> Maybe ByteString
infoStakeScriptHash    :: !(Maybe ByteString)
    , AddressInfo -> NetworkTag
infoNetworkTag         :: !NetworkTag
    , AddressInfo -> Word8
infoAddressType        :: !Word8
    } deriving ((forall x. AddressInfo -> Rep AddressInfo x)
-> (forall x. Rep AddressInfo x -> AddressInfo)
-> Generic AddressInfo
forall x. Rep AddressInfo x -> AddressInfo
forall x. AddressInfo -> Rep AddressInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddressInfo -> Rep AddressInfo x
from :: forall x. AddressInfo -> Rep AddressInfo x
$cto :: forall x. Rep AddressInfo x -> AddressInfo
to :: forall x. Rep AddressInfo x -> AddressInfo
Generic, Int -> AddressInfo -> [Char] -> [Char]
[AddressInfo] -> [Char] -> [Char]
AddressInfo -> [Char]
(Int -> AddressInfo -> [Char] -> [Char])
-> (AddressInfo -> [Char])
-> ([AddressInfo] -> [Char] -> [Char])
-> Show AddressInfo
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AddressInfo -> [Char] -> [Char]
showsPrec :: Int -> AddressInfo -> [Char] -> [Char]
$cshow :: AddressInfo -> [Char]
show :: AddressInfo -> [Char]
$cshowList :: [AddressInfo] -> [Char] -> [Char]
showList :: [AddressInfo] -> [Char] -> [Char]
Show, AddressInfo -> AddressInfo -> Bool
(AddressInfo -> AddressInfo -> Bool)
-> (AddressInfo -> AddressInfo -> Bool) -> Eq AddressInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressInfo -> AddressInfo -> Bool
== :: AddressInfo -> AddressInfo -> Bool
$c/= :: AddressInfo -> AddressInfo -> Bool
/= :: AddressInfo -> AddressInfo -> Bool
Eq)

-- | Info from 'Address' about how delegation keys are located.
--
-- @since 3.6.1
data ReferenceInfo
    = ByValue
    | ByPointer ChainPointer
    deriving ((forall x. ReferenceInfo -> Rep ReferenceInfo x)
-> (forall x. Rep ReferenceInfo x -> ReferenceInfo)
-> Generic ReferenceInfo
forall x. Rep ReferenceInfo x -> ReferenceInfo
forall x. ReferenceInfo -> Rep ReferenceInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReferenceInfo -> Rep ReferenceInfo x
from :: forall x. ReferenceInfo -> Rep ReferenceInfo x
$cto :: forall x. Rep ReferenceInfo x -> ReferenceInfo
to :: forall x. Rep ReferenceInfo x -> ReferenceInfo
Generic, Int -> ReferenceInfo -> [Char] -> [Char]
[ReferenceInfo] -> [Char] -> [Char]
ReferenceInfo -> [Char]
(Int -> ReferenceInfo -> [Char] -> [Char])
-> (ReferenceInfo -> [Char])
-> ([ReferenceInfo] -> [Char] -> [Char])
-> Show ReferenceInfo
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ReferenceInfo -> [Char] -> [Char]
showsPrec :: Int -> ReferenceInfo -> [Char] -> [Char]
$cshow :: ReferenceInfo -> [Char]
show :: ReferenceInfo -> [Char]
$cshowList :: [ReferenceInfo] -> [Char] -> [Char]
showList :: [ReferenceInfo] -> [Char] -> [Char]
Show, ReferenceInfo -> ReferenceInfo -> Bool
(ReferenceInfo -> ReferenceInfo -> Bool)
-> (ReferenceInfo -> ReferenceInfo -> Bool) -> Eq ReferenceInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReferenceInfo -> ReferenceInfo -> Bool
== :: ReferenceInfo -> ReferenceInfo -> Bool
$c/= :: ReferenceInfo -> ReferenceInfo -> Bool
/= :: ReferenceInfo -> ReferenceInfo -> Bool
Eq)

instance ToJSON AddressInfo where
    toJSON :: AddressInfo -> Value
toJSON AddressInfo{Maybe ByteString
Maybe ReferenceInfo
Word8
NetworkTag
$sel:infoStakeReference:AddressInfo :: AddressInfo -> Maybe ReferenceInfo
$sel:infoSpendingKeyHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoStakeKeyHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoSpendingScriptHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoStakeScriptHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoNetworkTag:AddressInfo :: AddressInfo -> NetworkTag
$sel:infoAddressType:AddressInfo :: AddressInfo -> Word8
infoStakeReference :: Maybe ReferenceInfo
infoSpendingKeyHash :: Maybe ByteString
infoStakeKeyHash :: Maybe ByteString
infoSpendingScriptHash :: Maybe ByteString
infoStakeScriptHash :: Maybe ByteString
infoNetworkTag :: NetworkTag
infoAddressType :: Word8
..} = [Pair] -> Value
Json.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"network_tag" Key -> NetworkTag -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTag
infoNetworkTag
        , Key
"stake_reference" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
Json.String (Text -> (ReferenceInfo -> Text) -> Maybe ReferenceInfo -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" ReferenceInfo -> Text
forall {a}. IsString a => ReferenceInfo -> a
refName Maybe ReferenceInfo
infoStakeReference)
        , Key
"address_type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON @Word8 Word8
infoAddressType
        ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair] -> (ChainPointer -> [Pair]) -> Maybe ChainPointer -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ChainPointer
ptr -> [Key
"pointer" Key -> ChainPointer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ChainPointer
ptr]) (Maybe ReferenceInfo
infoStakeReference Maybe ReferenceInfo
-> (ReferenceInfo -> Maybe ChainPointer) -> Maybe ChainPointer
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReferenceInfo -> Maybe ChainPointer
getPointer)
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall {e} {a}.
KeyValue e a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"spending_key_hash" HumanReadablePart
CIP5.addr_vkh Maybe ByteString
infoSpendingKeyHash
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall {e} {a}.
KeyValue e a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"stake_key_hash" HumanReadablePart
CIP5.stake_vkh Maybe ByteString
infoStakeKeyHash
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall {e} {a}.
KeyValue e a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"spending_shared_hash" HumanReadablePart
CIP5.addr_shared_vkh Maybe ByteString
infoSpendingScriptHash
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall {e} {a}.
KeyValue e a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"stake_shared_hash" HumanReadablePart
CIP5.stake_shared_vkh Maybe ByteString
infoStakeScriptHash
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall {e} {a}.
KeyValue e a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"stake_script_hash" HumanReadablePart
CIP5.stake_vkh Maybe ByteString
infoStakeScriptHash
      where
        getPointer :: ReferenceInfo -> Maybe ChainPointer
getPointer ReferenceInfo
ByValue = Maybe ChainPointer
forall a. Maybe a
Nothing
        getPointer (ByPointer ChainPointer
ptr) = ChainPointer -> Maybe ChainPointer
forall a. a -> Maybe a
Just ChainPointer
ptr

        jsonHash :: Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
_ HumanReadablePart
_ Maybe ByteString
Nothing = []
        jsonHash Key
key HumanReadablePart
hrp (Just ByteString
bs) =
            [ Key
key Key -> [Char] -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> [Char]
base16 ByteString
bs , (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_bech32") Key -> Text -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HumanReadablePart -> ByteString -> Text
bech32With HumanReadablePart
hrp ByteString
bs ]

        base16 :: ByteString -> [Char]
base16 = Text -> [Char]
T.unpack (Text -> [Char]) -> (ByteString -> Text) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16
        bech32With :: HumanReadablePart -> ByteString -> Text
bech32With HumanReadablePart
hrp = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
hrp)

        refName :: ReferenceInfo -> a
refName ReferenceInfo
ByValue = a
"by value"
        refName (ByPointer ChainPointer
_) = a
"by pointer"

-- | Structure containing the result of 'unpackAddress', the constituent parts
-- of an address. Internal to this module.
data AddressParts = AddressParts
    { AddressParts -> Word8
addrType :: Word8
    , AddressParts -> Word8
addrNetwork :: Word8
    , AddressParts -> ByteString
addrHash1 :: ByteString
    , AddressParts -> ByteString
addrHash2 :: ByteString
    , AddressParts -> Int
addrRestLength :: Int
    } deriving (Int -> AddressParts -> [Char] -> [Char]
[AddressParts] -> [Char] -> [Char]
AddressParts -> [Char]
(Int -> AddressParts -> [Char] -> [Char])
-> (AddressParts -> [Char])
-> ([AddressParts] -> [Char] -> [Char])
-> Show AddressParts
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AddressParts -> [Char] -> [Char]
showsPrec :: Int -> AddressParts -> [Char] -> [Char]
$cshow :: AddressParts -> [Char]
show :: AddressParts -> [Char]
$cshowList :: [AddressParts] -> [Char] -> [Char]
showList :: [AddressParts] -> [Char] -> [Char]
Show)

-- | Split fields out of a Shelley encoded address.
unpackAddress :: Address -> Either ErrInspectAddress AddressParts
unpackAddress :: Address -> Either ErrInspectAddress AddressParts
unpackAddress (Address -> ByteString
unAddress -> ByteString
bytes)
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
credentialHashSize = AddressParts -> Either ErrInspectAddress AddressParts
forall a b. b -> Either a b
Right AddressParts{Int
Word8
ByteString
$sel:addrType:AddressParts :: Word8
$sel:addrNetwork:AddressParts :: Word8
$sel:addrHash1:AddressParts :: ByteString
$sel:addrHash2:AddressParts :: ByteString
$sel:addrRestLength:AddressParts :: Int
addrType :: Word8
addrNetwork :: Word8
addrHash1 :: ByteString
addrHash2 :: ByteString
addrRestLength :: Int
..}
    | Bool
otherwise = ErrInspectAddress -> Either ErrInspectAddress AddressParts
forall a b. a -> Either a b
Left (ErrInspectAddress -> Either ErrInspectAddress AddressParts)
-> ErrInspectAddress -> Either ErrInspectAddress AddressParts
forall a b. (a -> b) -> a -> b
$ Int -> ErrInspectAddress
WrongInputSize (Int -> ErrInspectAddress) -> Int -> ErrInspectAddress
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bytes
  where
    (Word8
fstByte, ByteString
rest) = (ByteString -> Word8)
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ((ByteString, ByteString) -> (Word8, ByteString))
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes
    addrType :: Word8
addrType = Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000
    addrNetwork :: Word8
addrNetwork = Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00001111
    (ByteString
addrHash1, ByteString
addrHash2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
credentialHashSize ByteString
rest
    addrRestLength :: Int
addrRestLength = ByteString -> Int
BS.length ByteString
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 Int -> Credential 'PaymentK -> [Char] -> [Char]
[Credential 'PaymentK] -> [Char] -> [Char]
Credential 'PaymentK -> [Char]
(Int -> Credential 'PaymentK -> [Char] -> [Char])
-> (Credential 'PaymentK -> [Char])
-> ([Credential 'PaymentK] -> [Char] -> [Char])
-> Show (Credential 'PaymentK)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Credential 'PaymentK -> [Char] -> [Char]
showsPrec :: Int -> Credential 'PaymentK -> [Char] -> [Char]
$cshow :: Credential 'PaymentK -> [Char]
show :: Credential 'PaymentK -> [Char]
$cshowList :: [Credential 'PaymentK] -> [Char] -> [Char]
showList :: [Credential 'PaymentK] -> [Char] -> [Char]
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 Int -> Credential 'DelegationK -> [Char] -> [Char]
[Credential 'DelegationK] -> [Char] -> [Char]
Credential 'DelegationK -> [Char]
(Int -> Credential 'DelegationK -> [Char] -> [Char])
-> (Credential 'DelegationK -> [Char])
-> ([Credential 'DelegationK] -> [Char] -> [Char])
-> Show (Credential 'DelegationK)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Credential 'DelegationK -> [Char] -> [Char]
showsPrec :: Int -> Credential 'DelegationK -> [Char] -> [Char]
$cshow :: Credential 'DelegationK -> [Char]
show :: Credential 'DelegationK -> [Char]
$cshowList :: [Credential 'DelegationK] -> [Char] -> [Char]
showList :: [Credential 'DelegationK] -> [Char] -> [Char]
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 :: NetworkDiscriminant Shelley -> Credential 'PaymentK -> Address
paymentAddress NetworkDiscriminant Shelley
discrimination = \case
    PaymentFromKey Shelley 'PaymentK Pub
keyPub ->
        AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            (ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'PaymentK Pub -> ByteString)
-> Shelley 'PaymentK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
pubToBytes (Pub -> ByteString)
-> (Shelley 'PaymentK Pub -> Pub)
-> Shelley 'PaymentK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'PaymentK Pub -> Pub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'PaymentK Pub -> ByteString)
-> Shelley 'PaymentK Pub -> ByteString
forall a b. (a -> b) -> a -> b
$ Shelley 'PaymentK Pub
keyPub)
    PaymentFromExtendedKey Shelley 'PaymentK XPub
keyXPub ->
        AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            (ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'PaymentK XPub -> ByteString)
-> Shelley 'PaymentK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (Shelley 'PaymentK XPub -> XPub)
-> Shelley 'PaymentK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'PaymentK XPub -> XPub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'PaymentK XPub -> ByteString)
-> Shelley 'PaymentK XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ Shelley 'PaymentK XPub
keyXPub)
    PaymentFromKeyHash (KeyHash KeyRole
Payment ByteString
verKeyHash) ->
        AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            ByteString
verKeyHash
    PaymentFromKeyHash (KeyHash KeyRole
keyrole ByteString
_) ->
        [Char] -> Address
forall a. HasCallStack => [Char] -> a
error ([Char] -> Address) -> [Char] -> Address
forall a b. (a -> b) -> a -> b
$ [Char]
"Payment credential should be built from key hash having payment"
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" role. Key hash with " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> KeyRole -> [Char]
forall a. Show a => a -> [Char]
show KeyRole
keyrole [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was used."
    PaymentFromScript Script KeyHash
script ->
        let (ScriptHash ByteString
bytes) = Script KeyHash -> ScriptHash
toScriptHash Script KeyHash
script
        in AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
           (CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromScript)
           NetworkDiscriminant Shelley
discrimination
           ByteString
bytes
    PaymentFromScriptHash (ScriptHash ByteString
bytes) ->
        AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromScript)
            NetworkDiscriminant Shelley
discrimination
            ByteString
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 :: NetworkDiscriminant Shelley
-> Credential 'PaymentK -> Credential 'DelegationK -> Address
delegationAddress NetworkDiscriminant Shelley
discrimination Credential 'PaymentK
paymentCredential Credential 'DelegationK
stakeCredential =
    Either ErrExtendAddress Address -> Address
forall a c. Either a c -> c
unsafeFromRight (Either ErrExtendAddress Address -> Address)
-> Either ErrExtendAddress Address -> Address
forall a b. (a -> b) -> a -> b
$ Address
-> Credential 'DelegationK -> Either ErrExtendAddress Address
extendAddress
        (NetworkDiscriminant Shelley -> Credential 'PaymentK -> Address
paymentAddress NetworkDiscriminant Shelley
discrimination Credential 'PaymentK
paymentCredential)
        Credential 'DelegationK
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 :: NetworkDiscriminant Shelley
-> Credential 'PaymentK -> ChainPointer -> Address
pointerAddress NetworkDiscriminant Shelley
discrimination Credential 'PaymentK
credential ChainPointer
pointer =
    Either ErrExtendAddress Address -> Address
forall a c. Either a c -> c
unsafeFromRight (Either ErrExtendAddress Address -> Address)
-> Either ErrExtendAddress Address -> Address
forall a b. (a -> b) -> a -> b
$ Address
-> Credential 'DelegationK -> Either ErrExtendAddress Address
extendAddress
        (NetworkDiscriminant Shelley -> Credential 'PaymentK -> Address
paymentAddress NetworkDiscriminant Shelley
discrimination Credential 'PaymentK
credential)
        (ChainPointer -> Credential 'DelegationK
DelegationFromPointer ChainPointer
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 :: NetworkDiscriminant Shelley
-> Credential 'DelegationK -> Either ErrInvalidStakeAddress Address
stakeAddress NetworkDiscriminant Shelley
discrimination = \case
    DelegationFromKey Shelley 'DelegationK Pub
keyPub ->
        Address -> Either ErrInvalidStakeAddress Address
forall a b. b -> Either a b
Right (Address -> Either ErrInvalidStakeAddress Address)
-> Address -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
RewardAccount CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            (ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'DelegationK Pub -> ByteString)
-> Shelley 'DelegationK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
pubToBytes (Pub -> ByteString)
-> (Shelley 'DelegationK Pub -> Pub)
-> Shelley 'DelegationK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'DelegationK Pub -> Pub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'DelegationK Pub -> ByteString)
-> Shelley 'DelegationK Pub -> ByteString
forall a b. (a -> b) -> a -> b
$ Shelley 'DelegationK Pub
keyPub)

    DelegationFromExtendedKey Shelley 'DelegationK XPub
keyXPub ->
        Address -> Either ErrInvalidStakeAddress Address
forall a b. b -> Either a b
Right (Address -> Either ErrInvalidStakeAddress Address)
-> Address -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
RewardAccount CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            (ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'DelegationK XPub -> ByteString)
-> Shelley 'DelegationK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (Shelley 'DelegationK XPub -> XPub)
-> Shelley 'DelegationK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'DelegationK XPub -> XPub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'DelegationK XPub -> ByteString)
-> Shelley 'DelegationK XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ Shelley 'DelegationK XPub
keyXPub)

    DelegationFromKeyHash (KeyHash KeyRole
Delegation ByteString
verKeyHash) ->
        Address -> Either ErrInvalidStakeAddress Address
forall a b. b -> Either a b
Right (Address -> Either ErrInvalidStakeAddress Address)
-> Address -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
RewardAccount CredentialType
CredentialFromKey)
            NetworkDiscriminant Shelley
discrimination
            ByteString
verKeyHash

    DelegationFromKeyHash (KeyHash KeyRole
keyrole ByteString
_) ->
        ErrInvalidStakeAddress -> Either ErrInvalidStakeAddress Address
forall a b. a -> Either a b
Left (ErrInvalidStakeAddress -> Either ErrInvalidStakeAddress Address)
-> ErrInvalidStakeAddress -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ KeyRole -> ErrInvalidStakeAddress
ErrStakeAddressFromKeyHash KeyRole
keyrole

    DelegationFromScript Script KeyHash
script ->
        let (ScriptHash ByteString
bytes) = Script KeyHash -> ScriptHash
toScriptHash Script KeyHash
script
        in Address -> Either ErrInvalidStakeAddress Address
forall a b. b -> Either a b
Right (Address -> Either ErrInvalidStakeAddress Address)
-> Address -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
RewardAccount CredentialType
CredentialFromScript)
            NetworkDiscriminant Shelley
discrimination
            ByteString
bytes

    DelegationFromScriptHash (ScriptHash ByteString
bytes) ->
        Address -> Either ErrInvalidStakeAddress Address
forall a b. b -> Either a b
Right (Address -> Either ErrInvalidStakeAddress Address)
-> Address -> Either ErrInvalidStakeAddress Address
forall a b. (a -> b) -> a -> b
$ AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
            (CredentialType -> AddressType
RewardAccount CredentialType
CredentialFromScript)
            NetworkDiscriminant Shelley
discrimination
            ByteString
bytes

    DelegationFromPointer{} ->
        ErrInvalidStakeAddress -> Either ErrInvalidStakeAddress Address
forall a b. a -> Either a b
Left ErrInvalidStakeAddress
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 ((forall x. ErrInvalidStakeAddress -> Rep ErrInvalidStakeAddress x)
-> (forall x.
    Rep ErrInvalidStakeAddress x -> ErrInvalidStakeAddress)
-> Generic ErrInvalidStakeAddress
forall x. Rep ErrInvalidStakeAddress x -> ErrInvalidStakeAddress
forall x. ErrInvalidStakeAddress -> Rep ErrInvalidStakeAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ErrInvalidStakeAddress -> Rep ErrInvalidStakeAddress x
from :: forall x. ErrInvalidStakeAddress -> Rep ErrInvalidStakeAddress x
$cto :: forall x. Rep ErrInvalidStakeAddress x -> ErrInvalidStakeAddress
to :: forall x. Rep ErrInvalidStakeAddress x -> ErrInvalidStakeAddress
Generic, Int -> ErrInvalidStakeAddress -> [Char] -> [Char]
[ErrInvalidStakeAddress] -> [Char] -> [Char]
ErrInvalidStakeAddress -> [Char]
(Int -> ErrInvalidStakeAddress -> [Char] -> [Char])
-> (ErrInvalidStakeAddress -> [Char])
-> ([ErrInvalidStakeAddress] -> [Char] -> [Char])
-> Show ErrInvalidStakeAddress
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ErrInvalidStakeAddress -> [Char] -> [Char]
showsPrec :: Int -> ErrInvalidStakeAddress -> [Char] -> [Char]
$cshow :: ErrInvalidStakeAddress -> [Char]
show :: ErrInvalidStakeAddress -> [Char]
$cshowList :: [ErrInvalidStakeAddress] -> [Char] -> [Char]
showList :: [ErrInvalidStakeAddress] -> [Char] -> [Char]
Show, ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
(ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool)
-> (ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool)
-> Eq ErrInvalidStakeAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
== :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
$c/= :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
/= :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
Eq)

-- | Extend an existing payment 'Address' to make it a delegation address.
--
-- @since 2.0.0
extendAddress
    :: Address
    -> Credential 'DelegationK
    -> Either ErrExtendAddress Address
extendAddress :: Address
-> Credential 'DelegationK -> Either ErrExtendAddress Address
extendAddress Address
addr Credential 'DelegationK
infoStakeReference = do
    Bool -> Either ErrExtendAddress () -> Either ErrExtendAddress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe XPub -> Address -> Maybe Value
forall (m :: * -> *).
MonadThrow m =>
Maybe XPub -> Address -> m Value
inspectAddress Maybe XPub
forall a. Maybe a
Nothing Address
addr)) (Either ErrExtendAddress () -> Either ErrExtendAddress ())
-> Either ErrExtendAddress () -> Either ErrExtendAddress ()
forall a b. (a -> b) -> a -> b
$
        ErrExtendAddress -> Either ErrExtendAddress ()
forall a b. a -> Either a b
Left (ErrExtendAddress -> Either ErrExtendAddress ())
-> ErrExtendAddress -> Either ErrExtendAddress ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrExtendAddress
ErrInvalidAddressStyle [Char]
"Given address isn't a Shelley address"

    let bytes :: ByteString
bytes = Address -> ByteString
unAddress Address
addr
    let (Word8
fstByte, ByteString
rest) = (ByteString -> Word8)
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ((ByteString, ByteString) -> (Word8, ByteString))
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes

    let paymentFirstByte :: Word8
paymentFirstByte = Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000
    let extendableTypes :: [Word8]
extendableTypes = AddressType -> Word8
addressType (AddressType -> Word8) -> [AddressType] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            [ CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromKey
            , CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromScript
            ]
    Bool -> Either ErrExtendAddress () -> Either ErrExtendAddress ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
paymentFirstByte Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
extendableTypes) (Either ErrExtendAddress () -> Either ErrExtendAddress ())
-> Either ErrExtendAddress () -> Either ErrExtendAddress ()
forall a b. (a -> b) -> a -> b
$ do
        ErrExtendAddress -> Either ErrExtendAddress ()
forall a b. a -> Either a b
Left (ErrExtendAddress -> Either ErrExtendAddress ())
-> ErrExtendAddress -> Either ErrExtendAddress ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrExtendAddress
ErrInvalidAddressType [Char]
"Only payment addresses can be extended"

    case Credential 'DelegationK
infoStakeReference of
        -- base address: keyhash28,keyhash28    : 00000000 -> 0
        -- base address: scripthash28,keyhash28 : 00010000 -> 16
        DelegationFromKey Shelley 'DelegationK Pub
delegationKey -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b00011111 = 0
                -- 0b01110000 .&. 0b00011111 = 16
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111
                ByteString -> Put
putByteString ByteString
rest
                ByteString -> Put
putByteString (ByteString -> Put)
-> (Shelley 'DelegationK Pub -> ByteString)
-> Shelley 'DelegationK Pub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'DelegationK Pub -> ByteString)
-> Shelley 'DelegationK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
pubToBytes (Pub -> ByteString)
-> (Shelley 'DelegationK Pub -> Pub)
-> Shelley 'DelegationK Pub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'DelegationK Pub -> Pub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'DelegationK Pub -> Put)
-> Shelley 'DelegationK Pub -> Put
forall a b. (a -> b) -> a -> b
$ Shelley 'DelegationK Pub
delegationKey

        -- base address: keyhash28,keyhash28    : 00000000 -> 0
        -- base address: scripthash28,keyhash28 : 00010000 -> 16
        DelegationFromExtendedKey Shelley 'DelegationK XPub
delegationKey -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b00011111 = 0
                -- 0b01110000 .&. 0b00011111 = 16
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111
                ByteString -> Put
putByteString ByteString
rest
                ByteString -> Put
putByteString (ByteString -> Put)
-> (Shelley 'DelegationK XPub -> ByteString)
-> Shelley 'DelegationK XPub
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley 'DelegationK XPub -> ByteString)
-> Shelley 'DelegationK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (Shelley 'DelegationK XPub -> XPub)
-> Shelley 'DelegationK XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley 'DelegationK XPub -> XPub
forall (depth :: Depth) key. Shelley depth key -> key
getKey (Shelley 'DelegationK XPub -> Put)
-> Shelley 'DelegationK XPub -> Put
forall a b. (a -> b) -> a -> b
$ Shelley 'DelegationK XPub
delegationKey
        DelegationFromKeyHash (KeyHash KeyRole
Delegation ByteString
keyhash) -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b00011111 = 0
                -- 0b01110000 .&. 0b00011111 = 16
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00011111
                ByteString -> Put
putByteString ByteString
rest
                ByteString -> Put
putByteString ByteString
keyhash
        DelegationFromKeyHash (KeyHash KeyRole
keyrole ByteString
_) -> do
            ErrExtendAddress -> Either ErrExtendAddress Address
forall a b. a -> Either a b
Left (ErrExtendAddress -> Either ErrExtendAddress Address)
-> ErrExtendAddress -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ [Char] -> ErrExtendAddress
ErrInvalidKeyHashType ([Char] -> ErrExtendAddress) -> [Char] -> ErrExtendAddress
forall a b. (a -> b) -> a -> b
$
                [Char]
"Delegation part can only be constructed from delegation key hash. "
                [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"Key hash of " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> KeyRole -> [Char]
forall a. Show a => a -> [Char]
show KeyRole
keyrole [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" was used."

        -- base address: keyhash28,scripthash28    : 00100000 -> 32
        -- base address: scripthash28,scripthash28 : 00110000 -> 48
        DelegationFromScript Script KeyHash
script -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b00111111 = 32
                -- 0b01110000 .&. 0b00111111 = 48
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111
                ByteString -> Put
putByteString ByteString
rest
                ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ScriptHash -> ByteString
unScriptHash (ScriptHash -> ByteString) -> ScriptHash -> ByteString
forall a b. (a -> b) -> a -> b
$ Script KeyHash -> ScriptHash
toScriptHash Script KeyHash
script

        -- base address: keyhash28,scripthash28    : 00100000 -> 32
        -- base address: scripthash28,scripthash28 : 00110000 -> 48
        DelegationFromScriptHash (ScriptHash ByteString
scriptBytes) -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b00111111 = 32
                -- 0b01110000 .&. 0b00111111 = 48
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111
                ByteString -> Put
putByteString ByteString
rest
                ByteString -> Put
putByteString ByteString
scriptBytes

        -- pointer address: keyhash28, 3 variable length uint    : 01000000 -> 64
        -- pointer address: scripthash28, 3 variable length uint : 01010000 -> 80
        DelegationFromPointer ChainPointer
pointer -> do
            Address -> Either ErrExtendAddress Address
forall a. a -> Either ErrExtendAddress a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> Either ErrExtendAddress Address)
-> Address -> Either ErrExtendAddress Address
forall a b. (a -> b) -> a -> b
$ ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                -- 0b01100000 .&. 0b01011111 = 64
                -- 0b01110000 .&. 0b01011111 = 80
                Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word8
fstByte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b01011111
                ByteString -> Put
putByteString ByteString
rest
                ChainPointer -> Put
putPointer ChainPointer
pointer
  where
    putPointer :: ChainPointer -> Put
putPointer (ChainPointer Natural
a Natural
b Natural
c) = do
        Natural -> Put
putVariableLengthNat Natural
a
        Natural -> Put
putVariableLengthNat Natural
b
        Natural -> Put
putVariableLengthNat Natural
c

-- | Captures error occuring when trying to extend an invalid address.
--
-- @since 2.0.0
data ErrExtendAddress
    = ErrInvalidAddressStyle String
    | ErrInvalidAddressType String
    | ErrInvalidKeyHashType String
    deriving (Int -> ErrExtendAddress -> [Char] -> [Char]
[ErrExtendAddress] -> [Char] -> [Char]
ErrExtendAddress -> [Char]
(Int -> ErrExtendAddress -> [Char] -> [Char])
-> (ErrExtendAddress -> [Char])
-> ([ErrExtendAddress] -> [Char] -> [Char])
-> Show ErrExtendAddress
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ErrExtendAddress -> [Char] -> [Char]
showsPrec :: Int -> ErrExtendAddress -> [Char] -> [Char]
$cshow :: ErrExtendAddress -> [Char]
show :: ErrExtendAddress -> [Char]
$cshowList :: [ErrExtendAddress] -> [Char] -> [Char]
showList :: [ErrExtendAddress] -> [Char] -> [Char]
Show)

--
-- Network Discriminant
--

instance HasNetworkDiscriminant Shelley where
    type NetworkDiscriminant Shelley = NetworkTag
    addressDiscrimination :: NetworkDiscriminant Shelley -> AddressDiscrimination
addressDiscrimination NetworkDiscriminant Shelley
_ = AddressDiscrimination
RequiresNetworkTag
    networkTag :: NetworkDiscriminant Shelley -> NetworkTag
networkTag = NetworkTag -> NetworkTag
NetworkDiscriminant Shelley -> NetworkTag
forall a. a -> a
id

-- | Error reported from trying to create a network discriminant from number
--
-- @since 2.0.0
newtype MkNetworkDiscriminantError
    = ErrWrongNetworkTag Integer
      -- ^ Wrong network tag.
    deriving (MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
(MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool)
-> (MkNetworkDiscriminantError
    -> MkNetworkDiscriminantError -> Bool)
-> Eq MkNetworkDiscriminantError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
== :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
$c/= :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
/= :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
Eq, Int -> MkNetworkDiscriminantError -> [Char] -> [Char]
[MkNetworkDiscriminantError] -> [Char] -> [Char]
MkNetworkDiscriminantError -> [Char]
(Int -> MkNetworkDiscriminantError -> [Char] -> [Char])
-> (MkNetworkDiscriminantError -> [Char])
-> ([MkNetworkDiscriminantError] -> [Char] -> [Char])
-> Show MkNetworkDiscriminantError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> MkNetworkDiscriminantError -> [Char] -> [Char]
showsPrec :: Int -> MkNetworkDiscriminantError -> [Char] -> [Char]
$cshow :: MkNetworkDiscriminantError -> [Char]
show :: MkNetworkDiscriminantError -> [Char]
$cshowList :: [MkNetworkDiscriminantError] -> [Char] -> [Char]
showList :: [MkNetworkDiscriminantError] -> [Char] -> [Char]
Show)

instance Buildable MkNetworkDiscriminantError where
  build :: MkNetworkDiscriminantError -> Builder
build (ErrWrongNetworkTag Integer
i) = Builder
"Invalid network tag "Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Integer
iInteger -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+Builder
". 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 :: Integer
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
mkNetworkDiscriminant Integer
nTag
    | Integer
nTag Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
16 =  NetworkDiscriminant Shelley
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
forall a b. b -> Either a b
Right (NetworkDiscriminant Shelley
 -> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley))
-> NetworkDiscriminant Shelley
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkTag
NetworkTag (Word32 -> NetworkTag) -> Word32 -> NetworkTag
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nTag
    | Bool
otherwise = MkNetworkDiscriminantError
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
forall a b. a -> Either a b
Left (MkNetworkDiscriminantError
 -> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley))
-> MkNetworkDiscriminantError
-> Either MkNetworkDiscriminantError (NetworkDiscriminant Shelley)
forall a b. (a -> b) -> a -> b
$ Integer -> MkNetworkDiscriminantError
ErrWrongNetworkTag Integer
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 :: Address -> Maybe (NetworkDiscriminant Shelley)
inspectNetworkDiscriminant Address
addr = case Maybe XPub -> Address -> Either ErrInspectAddress InspectAddress
eitherInspectAddress Maybe XPub
forall a. Maybe a
Nothing Address
addr of
    Right (InspectAddressShelley AddressInfo
info) -> NetworkTag -> Maybe NetworkTag
forall a. a -> Maybe a
Just (AddressInfo -> NetworkTag
infoNetworkTag AddressInfo
info)
    Either ErrInspectAddress InspectAddress
_ -> Maybe NetworkTag
Maybe (NetworkDiscriminant Shelley)
forall a. Maybe a
Nothing

-- | 'NetworkDicriminant' for Cardano MainNet & Shelley
--
-- @since 2.0.0
shelleyMainnet :: NetworkDiscriminant Shelley
shelleyMainnet :: NetworkDiscriminant Shelley
shelleyMainnet = Word32 -> NetworkTag
NetworkTag Word32
1

-- | 'NetworkDicriminant' for Cardano Testnet & Shelley
--
-- @since 2.0.0
shelleyTestnet :: NetworkDiscriminant Shelley
shelleyTestnet :: NetworkDiscriminant Shelley
shelleyTestnet = Word32 -> NetworkTag
NetworkTag Word32
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 :: forall (depth :: Depth). XPrv -> Shelley depth XPrv
liftXPrv = XPrv -> Shelley depth XPrv
forall (depth :: Depth) key. key -> Shelley depth key
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 :: forall (depth :: Depth). XPub -> Shelley depth XPub
liftXPub = XPub -> Shelley depth XPub
forall (depth :: Depth) key. key -> Shelley depth key
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 :: forall (depth :: Depth). Pub -> Shelley depth Pub
liftPub = Pub -> Shelley depth Pub
forall (depth :: Depth) key. key -> Shelley depth key
Shelley

-- Use with care when it is _safe_.
unsafeFromRight :: Either a c -> c
unsafeFromRight :: forall a c. Either a c -> c
unsafeFromRight =
    (a -> c) -> (c -> c) -> Either a c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> a -> c
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: internally generated invalid address") c -> c
forall a. a -> a
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 :: Word32
purposeIndex = Word32
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 :: Word32
policyPurposeIndex = Word32
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 :: Word32
coinTypeIndex = Word32
0x80000717

-- The minimum seed length for 'genMasterKeyFromMnemonic'.
minSeedLengthBytes :: Int
minSeedLengthBytes :: Int
minSeedLengthBytes = Int
16

-- A sum-type for constructing addresses payment part.
data CredentialType = CredentialFromKey | CredentialFromScript
    deriving (Int -> CredentialType -> [Char] -> [Char]
[CredentialType] -> [Char] -> [Char]
CredentialType -> [Char]
(Int -> CredentialType -> [Char] -> [Char])
-> (CredentialType -> [Char])
-> ([CredentialType] -> [Char] -> [Char])
-> Show CredentialType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> CredentialType -> [Char] -> [Char]
showsPrec :: Int -> CredentialType -> [Char] -> [Char]
$cshow :: CredentialType -> [Char]
show :: CredentialType -> [Char]
$cshowList :: [CredentialType] -> [Char] -> [Char]
showList :: [CredentialType] -> [Char] -> [Char]
Show, CredentialType -> CredentialType -> Bool
(CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool) -> Eq CredentialType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CredentialType -> CredentialType -> Bool
== :: CredentialType -> CredentialType -> Bool
$c/= :: CredentialType -> CredentialType -> Bool
/= :: CredentialType -> CredentialType -> Bool
Eq)

-- Different types of Shelley addresses.
data AddressType
    = BaseAddress CredentialType CredentialType
    | PointerAddress CredentialType
    | EnterpriseAddress CredentialType
    | RewardAccount CredentialType
    | ByronAddress
    deriving (Int -> AddressType -> [Char] -> [Char]
[AddressType] -> [Char] -> [Char]
AddressType -> [Char]
(Int -> AddressType -> [Char] -> [Char])
-> (AddressType -> [Char])
-> ([AddressType] -> [Char] -> [Char])
-> Show AddressType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> AddressType -> [Char] -> [Char]
showsPrec :: Int -> AddressType -> [Char] -> [Char]
$cshow :: AddressType -> [Char]
show :: AddressType -> [Char]
$cshowList :: [AddressType] -> [Char] -> [Char]
showList :: [AddressType] -> [Char] -> [Char]
Show, AddressType -> AddressType -> Bool
(AddressType -> AddressType -> Bool)
-> (AddressType -> AddressType -> Bool) -> Eq AddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddressType -> AddressType -> Bool
== :: AddressType -> AddressType -> Bool
$c/= :: AddressType -> AddressType -> Bool
/= :: AddressType -> AddressType -> Bool
Eq)

addressType :: AddressType -> Word8
addressType :: AddressType -> Word8
addressType = \case
    AddressType
ByronAddress                                                -> Word8
0b10000000
    BaseAddress       CredentialType
CredentialFromKey    CredentialType
CredentialFromKey    -> Word8
0b00000000
    BaseAddress       CredentialType
CredentialFromScript CredentialType
CredentialFromKey    -> Word8
0b00010000
    BaseAddress       CredentialType
CredentialFromKey    CredentialType
CredentialFromScript -> Word8
0b00100000
    BaseAddress       CredentialType
CredentialFromScript CredentialType
CredentialFromScript -> Word8
0b00110000
    PointerAddress    CredentialType
CredentialFromKey                         -> Word8
0b01000000
    PointerAddress    CredentialType
CredentialFromScript                      -> Word8
0b01010000
    EnterpriseAddress CredentialType
CredentialFromKey                         -> Word8
0b01100000
    EnterpriseAddress CredentialType
CredentialFromScript                      -> Word8
0b01110000
    RewardAccount                          CredentialType
CredentialFromKey    -> Word8
0b11100000
    RewardAccount                          CredentialType
CredentialFromScript -> Word8
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 :: AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload AddressType
addrType NetworkDiscriminant Shelley
discrimination ByteString
bytes = ByteString -> Address
unsafeMkAddress (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$
    HasCallStack => Int -> ByteString -> ByteString
Int -> ByteString -> ByteString
invariantSize Int
expectedLength (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        Word8 -> Put
putWord8 Word8
firstByte
        ByteString -> Put
putByteString ByteString
bytes
  where
    firstByte :: Word8
firstByte =
        let netTagLimit :: Word32
netTagLimit = Word32
16
        in AddressType -> Word8
addressType AddressType
addrType Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ HasCallStack => Word32 -> NetworkTag -> Word8
Word32 -> NetworkTag -> Word8
invariantNetworkTag Word32
netTagLimit (forall (key :: Depth -> * -> *).
HasNetworkDiscriminant key =>
NetworkDiscriminant key -> NetworkTag
networkTag @Shelley NetworkDiscriminant Shelley
discrimination)
    expectedLength :: Int
expectedLength =
        let headerSizeBytes :: Int
headerSizeBytes = Int
1
        in Int
headerSizeBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
credentialHashSize

--Shelley specific derivation and generation
genMasterKeyFromMnemonicShelley
    :: BA.ByteArrayAccess sndFactor
    => SomeMnemonic
    -> sndFactor
    -> XPrv
genMasterKeyFromMnemonicShelley :: forall sndFactor.
ByteArrayAccess sndFactor =>
SomeMnemonic -> sndFactor -> XPrv
genMasterKeyFromMnemonicShelley SomeMnemonic
fstFactor =
    ScrubbedBytes -> sndFactor -> XPrv
forall seed sndFactor.
(ByteArrayAccess seed, ByteArrayAccess sndFactor) =>
seed -> sndFactor -> XPrv
generateNew ScrubbedBytes
seedValidated
    where
        seed :: ScrubbedBytes
seed  = SomeMnemonic -> ScrubbedBytes
someMnemonicToBytes SomeMnemonic
fstFactor
        seedValidated :: ScrubbedBytes
seedValidated = Bool -> ScrubbedBytes -> ScrubbedBytes
forall a. HasCallStack => Bool -> a -> a
assert
            (ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
seed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minSeedLengthBytes Bool -> Bool -> Bool
&& ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
seed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255)
            ScrubbedBytes
seed

deriveAccountPrivateKeyShelley
    :: XPrv
    -> Index derivationType depth
    -> Word32
    -> XPrv
deriveAccountPrivateKeyShelley :: forall (derivationType :: DerivationType) (depth :: Depth).
XPrv -> Index derivationType depth -> Word32 -> XPrv
deriveAccountPrivateKeyShelley XPrv
rootXPrv Index derivationType depth
accIx Word32
purpose =
    let
        Just Index 'Hardened Any
purposeIx =
            forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Hardened _) Word32
purpose
        Just Index 'Hardened depth
coinTypeIx =
            forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Hardened _) Word32
coinTypeIndex
        purposeXPrv :: XPrv
purposeXPrv = -- lvl1 derivation; hardened derivation of purpose'
            DerivationScheme -> XPrv -> Index 'Hardened Any -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 XPrv
rootXPrv Index 'Hardened Any
purposeIx
        coinTypeXPrv :: XPrv
coinTypeXPrv = -- lvl2 derivation; hardened derivation of coin_type'
            DerivationScheme -> XPrv -> Index 'Hardened Any -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 XPrv
purposeXPrv Index 'Hardened Any
forall {depth :: Depth}. Index 'Hardened depth
coinTypeIx
        acctXPrv :: XPrv
acctXPrv = -- lvl3 derivation; hardened derivation of account' index
            DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 XPrv
coinTypeXPrv Index derivationType depth
accIx
    in
        XPrv
acctXPrv

deriveAddressPrivateKeyShelley
    :: XPrv
    -> Role
    -> Index derivationType depth
    -> XPrv
deriveAddressPrivateKeyShelley :: forall (derivationType :: DerivationType) (depth :: Depth).
XPrv -> Role -> Index derivationType depth -> XPrv
deriveAddressPrivateKeyShelley XPrv
accXPrv Role
role Index derivationType depth
addrIx =
    let
        changeXPrv :: XPrv
changeXPrv = -- lvl4 derivation; soft derivation of change chain
            DerivationScheme -> XPrv -> Index 'Soft Any -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 XPrv
accXPrv (Role -> Index 'Soft Any
forall (depth :: Depth). Role -> Index 'Soft depth
roleToIndex Role
role)
        addrXPrv :: XPrv
addrXPrv = -- lvl5 derivation; soft derivation of address index
            DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme2 XPrv
changeXPrv Index derivationType depth
addrIx
    in
        XPrv
addrXPrv

deriveAddressPublicKeyShelley
    :: XPub
    -> Role
    -> Index derivationType depth
    -> XPub
deriveAddressPublicKeyShelley :: forall (derivationType :: DerivationType) (depth :: Depth).
XPub -> Role -> Index derivationType depth -> XPub
deriveAddressPublicKeyShelley XPub
accXPub Role
role Index derivationType depth
addrIx =
    XPub -> Maybe XPub -> XPub
forall a. a -> Maybe a -> a
fromMaybe XPub
errWrongIndex (Maybe XPub -> XPub) -> Maybe XPub -> XPub
forall a b. (a -> b) -> a -> b
$ do
        XPub
changeXPub <- -- lvl4 derivation in bip44 is derivation of change chain
            DerivationScheme -> XPub -> Index 'Soft Any -> Maybe XPub
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme
-> XPub -> Index derivationType depth -> Maybe XPub
deriveXPub DerivationScheme
DerivationScheme2 XPub
accXPub (Role -> Index 'Soft Any
forall (depth :: Depth). Role -> Index 'Soft depth
roleToIndex Role
role)
        -- lvl5 derivation in bip44 is derivation of address chain
        DerivationScheme
-> XPub -> Index derivationType depth -> Maybe XPub
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme
-> XPub -> Index derivationType depth -> Maybe XPub
deriveXPub DerivationScheme
DerivationScheme2 XPub
changeXPub Index derivationType depth
addrIx
  where
      errWrongIndex :: XPub
errWrongIndex = [Char] -> XPub
forall a. HasCallStack => [Char] -> a
error ([Char] -> XPub) -> [Char] -> XPub
forall a b. (a -> b) -> a -> b
$
          [Char]
"deriveAddressPublicKey failed: was given an hardened (or too big) \
          \index for soft path derivation ( " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Index derivationType depth -> [Char]
forall a. Show a => a -> [Char]
show Index derivationType depth
addrIx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"). 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 :: forall (key :: Depth). KeyRole -> Shelley key XPub -> KeyHash
hashKey KeyRole
cred = KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
cred (ByteString -> KeyHash)
-> (Shelley key XPub -> ByteString) -> Shelley key XPub -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hashCredential (ByteString -> ByteString)
-> (Shelley key XPub -> ByteString)
-> Shelley key XPub
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (Shelley key XPub -> XPub) -> Shelley key XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shelley key XPub -> XPub
forall (depth :: Depth) key. Shelley depth key -> key
getKey