{-# 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 #-}
module Cardano.Address.Style.Shelley
(
Shelley
, getKey
, Role (..)
, roleFromIndex
, roleToIndex
, Credential (..)
, CredentialType (..)
, genMasterKeyFromXPrv
, genMasterKeyFromMnemonic
, deriveAccountPrivateKey
, deriveAddressPrivateKey
, deriveDelegationPrivateKey
, deriveAddressPublicKey
, derivePolicyPrivateKey
, InspectAddress (..)
, AddressInfo (..)
, ReferenceInfo (..)
, eitherInspectAddress
, inspectAddress
, inspectShelleyAddress
, paymentAddress
, delegationAddress
, pointerAddress
, stakeAddress
, extendAddress
, ErrExtendAddress (..)
, ErrInspectAddressOnlyShelley (..)
, ErrInspectAddress (..)
, prettyErrInspectAddressOnlyShelley
, prettyErrInspectAddress
, MkNetworkDiscriminantError (..)
, mkNetworkDiscriminant
, inspectNetworkDiscriminant
, shelleyMainnet
, shelleyTestnet
, liftXPrv
, liftXPub
, unsafeFromRight
, minSeedLengthBytes
, genMasterKeyFromMnemonicShelley
, deriveAccountPrivateKeyShelley
, deriveAddressPrivateKeyShelley
, deriveAddressPublicKeyShelley
) where
import Prelude
import Cardano.Address
( Address (..)
, AddressDiscrimination (..)
, ChainPointer (..)
, NetworkDiscriminant (..)
, NetworkTag (..)
, invariantNetworkTag
, invariantSize
, unsafeMkAddress
)
import Cardano.Address.Derivation
( Depth (..)
, DerivationScheme (..)
, DerivationType (..)
, Index (..)
, XPrv
, XPub
, credentialHashSize
, deriveXPrv
, deriveXPub
, generateNew
, hashCredential
, indexFromWord32
, unsafeMkIndex
, xpubPublicKey
)
import Cardano.Address.Internal
( WithErrorMessage (..), orElse )
import Cardano.Address.Script
( KeyHash (..), KeyRole (..), ScriptHash (..) )
import Cardano.Mnemonic
( SomeMnemonic, someMnemonicToBytes )
import Codec.Binary.Encoding
( AbstractEncoding (..), encode )
import Control.Applicative
( Alternative )
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
newtype Shelley (depth :: Depth) key = Shelley
{ Shelley depth key -> key
getKey :: key
}
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
$cto :: forall (depth :: Depth) key x.
Rep (Shelley depth key) x -> Shelley depth key
$cfrom :: forall (depth :: Depth) key x.
Shelley depth key -> Rep (Shelley depth key) x
Generic, Int -> Shelley depth key -> ShowS
[Shelley depth key] -> ShowS
Shelley depth key -> String
(Int -> Shelley depth key -> ShowS)
-> (Shelley depth key -> String)
-> ([Shelley depth key] -> ShowS)
-> Show (Shelley depth key)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (depth :: Depth) key.
Show key =>
Int -> Shelley depth key -> ShowS
forall (depth :: Depth) key.
Show key =>
[Shelley depth key] -> ShowS
forall (depth :: Depth) key.
Show key =>
Shelley depth key -> String
showList :: [Shelley depth key] -> ShowS
$cshowList :: forall (depth :: Depth) key.
Show key =>
[Shelley depth key] -> ShowS
show :: Shelley depth key -> String
$cshow :: forall (depth :: Depth) key.
Show key =>
Shelley depth key -> String
showsPrec :: Int -> Shelley depth key -> ShowS
$cshowsPrec :: forall (depth :: Depth) key.
Show key =>
Int -> Shelley depth key -> ShowS
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
/= :: 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
Eq)
deriving instance (Functor (Shelley depth))
instance (NFData key) => NFData (Shelley depth key)
data Role
= UTxOExternal
| UTxOInternal
| Stake
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
$cto :: forall x. Rep Role x -> Role
$cfrom :: forall x. Role -> Rep Role x
Generic, Typeable, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: 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
min :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmax :: Role -> Role -> Role
>= :: Role -> Role -> Bool
$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
compare :: Role -> Role -> Ordering
$ccompare :: Role -> Role -> Ordering
$cp1Ord :: Eq Role
Ord, Role
Role -> Role -> Bounded Role
forall a. a -> a -> Bounded a
maxBound :: Role
$cmaxBound :: Role
minBound :: Role
$cminBound :: Role
Bounded)
instance NFData Role
roleFromIndex :: Index 'Soft depth -> Maybe Role
roleFromIndex :: 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
_ -> Maybe Role
forall a. Maybe a
Nothing
roleToIndex :: Role -> Index 'Soft depth
roleToIndex :: 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
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
genMasterKeyFromMnemonic
:: SomeMnemonic
-> ScrubbedBytes
-> Shelley 'RootK XPrv
genMasterKeyFromMnemonic :: SomeMnemonic -> ScrubbedBytes -> Shelley 'RootK XPrv
genMasterKeyFromMnemonic =
SomeMnemonic -> ScrubbedBytes -> Shelley 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
SomeMnemonic -> SecondFactor key -> key 'RootK XPrv
Internal.genMasterKeyFromMnemonic
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
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 'Hardened 'AccountK -> Shelley 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'RootK XPrv
-> Index (AccountIndexDerivationType key) 'AccountK
-> key 'AccountK XPrv
Internal.deriveAccountPrivateKey
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
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
-> 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
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
-> 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
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 (Bounded (Index 'Soft 'PaymentK) => Index 'Soft 'PaymentK
forall a. Bounded a => a
minBound @(Index 'Soft _))
in XPrv -> Shelley 'DelegationK XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley XPrv
stakeXPrv
data ErrInspectAddress
= WrongInputSize Int
| 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
$cto :: forall x. Rep ErrInspectAddress x -> ErrInspectAddress
$cfrom :: forall x. ErrInspectAddress -> Rep ErrInspectAddress x
Generic, Int -> ErrInspectAddress -> ShowS
[ErrInspectAddress] -> ShowS
ErrInspectAddress -> String
(Int -> ErrInspectAddress -> ShowS)
-> (ErrInspectAddress -> String)
-> ([ErrInspectAddress] -> ShowS)
-> Show ErrInspectAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrInspectAddress] -> ShowS
$cshowList :: [ErrInspectAddress] -> ShowS
show :: ErrInspectAddress -> String
$cshow :: ErrInspectAddress -> String
showsPrec :: Int -> ErrInspectAddress -> ShowS
$cshowsPrec :: Int -> ErrInspectAddress -> ShowS
Show, ErrInspectAddress -> ErrInspectAddress -> Bool
(ErrInspectAddress -> ErrInspectAddress -> Bool)
-> (ErrInspectAddress -> ErrInspectAddress -> Bool)
-> Eq ErrInspectAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
$c/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
== :: ErrInspectAddress -> ErrInspectAddress -> Bool
$c== :: ErrInspectAddress -> ErrInspectAddress -> Bool
Eq)
deriving [ErrInspectAddress] -> Encoding
[ErrInspectAddress] -> Value
ErrInspectAddress -> Encoding
ErrInspectAddress -> Value
(ErrInspectAddress -> Value)
-> (ErrInspectAddress -> Encoding)
-> ([ErrInspectAddress] -> Value)
-> ([ErrInspectAddress] -> Encoding)
-> ToJSON ErrInspectAddress
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ErrInspectAddress] -> Encoding
$ctoEncodingList :: [ErrInspectAddress] -> Encoding
toJSONList :: [ErrInspectAddress] -> Value
$ctoJSONList :: [ErrInspectAddress] -> Value
toEncoding :: ErrInspectAddress -> Encoding
$ctoEncoding :: ErrInspectAddress -> Encoding
toJSON :: ErrInspectAddress -> Value
$ctoJSON :: ErrInspectAddress -> Value
ToJSON via WithErrorMessage ErrInspectAddress
instance Exception ErrInspectAddress where
displayException :: ErrInspectAddress -> String
displayException = ErrInspectAddress -> String
prettyErrInspectAddress
data ErrInspectAddressOnlyShelley
= PtrRetrieveError String
| UnknownType Word8
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
$cto :: forall x.
Rep ErrInspectAddressOnlyShelley x -> ErrInspectAddressOnlyShelley
$cfrom :: forall x.
ErrInspectAddressOnlyShelley -> Rep ErrInspectAddressOnlyShelley x
Generic, ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
(ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool)
-> (ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool)
-> Eq ErrInspectAddressOnlyShelley
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
$c/= :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
== :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
$c== :: ErrInspectAddressOnlyShelley
-> ErrInspectAddressOnlyShelley -> Bool
Eq, Int -> ErrInspectAddressOnlyShelley -> ShowS
[ErrInspectAddressOnlyShelley] -> ShowS
ErrInspectAddressOnlyShelley -> String
(Int -> ErrInspectAddressOnlyShelley -> ShowS)
-> (ErrInspectAddressOnlyShelley -> String)
-> ([ErrInspectAddressOnlyShelley] -> ShowS)
-> Show ErrInspectAddressOnlyShelley
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrInspectAddressOnlyShelley] -> ShowS
$cshowList :: [ErrInspectAddressOnlyShelley] -> ShowS
show :: ErrInspectAddressOnlyShelley -> String
$cshow :: ErrInspectAddressOnlyShelley -> String
showsPrec :: Int -> ErrInspectAddressOnlyShelley -> ShowS
$cshowsPrec :: Int -> ErrInspectAddressOnlyShelley -> ShowS
Show)
deriving [ErrInspectAddressOnlyShelley] -> Encoding
[ErrInspectAddressOnlyShelley] -> Value
ErrInspectAddressOnlyShelley -> Encoding
ErrInspectAddressOnlyShelley -> Value
(ErrInspectAddressOnlyShelley -> Value)
-> (ErrInspectAddressOnlyShelley -> Encoding)
-> ([ErrInspectAddressOnlyShelley] -> Value)
-> ([ErrInspectAddressOnlyShelley] -> Encoding)
-> ToJSON ErrInspectAddressOnlyShelley
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ErrInspectAddressOnlyShelley] -> Encoding
$ctoEncodingList :: [ErrInspectAddressOnlyShelley] -> Encoding
toJSONList :: [ErrInspectAddressOnlyShelley] -> Value
$ctoJSONList :: [ErrInspectAddressOnlyShelley] -> Value
toEncoding :: ErrInspectAddressOnlyShelley -> Encoding
$ctoEncoding :: ErrInspectAddressOnlyShelley -> Encoding
toJSON :: ErrInspectAddressOnlyShelley -> Value
$ctoJSON :: ErrInspectAddressOnlyShelley -> Value
ToJSON via WithErrorMessage ErrInspectAddressOnlyShelley
instance Exception ErrInspectAddressOnlyShelley where
displayException :: ErrInspectAddressOnlyShelley -> String
displayException = ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley
prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley :: ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley = \case
PtrRetrieveError String
s ->
Format -> ShowS
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Failed to retrieve pointer (underlying errors was: {})" String
s
UnknownType Word8
t ->
Format -> Word8 -> String
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Unknown address type {}" Word8
t
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress = \case
WrongInputSize Int
i -> Format -> Int -> String
forall r. (HasCallStack, FormatType r) => Format -> r
format Format
"Wrong input size of {}" Int
i
ErrShelley ErrInspectAddressOnlyShelley
e -> String
"Invalid Shelley address: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddressOnlyShelley -> String
prettyErrInspectAddressOnlyShelley ErrInspectAddressOnlyShelley
e
ErrIcarus ErrInspectAddress
e -> String
"Invalid Icarus address: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddress -> String
Icarus.prettyErrInspectAddress ErrInspectAddress
e
ErrByron ErrInspectAddress
e -> String
"Invalid Byron address: "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ErrInspectAddress -> String
Byron.prettyErrInspectAddress ErrInspectAddress
e
inspectShelleyAddress
:: (Alternative m, MonadThrow m)
=> Maybe XPub
-> Address
-> m Json.Value
inspectShelleyAddress :: Maybe XPub -> Address -> m Value
inspectShelleyAddress = Maybe XPub -> Address -> m Value
forall (m :: * -> *).
(Alternative m, MonadThrow m) =>
Maybe XPub -> Address -> m Value
inspectAddress
{-# DEPRECATED inspectShelleyAddress "use qualified 'inspectAddress' instead." #-}
inspectAddress
:: (Alternative m, MonadThrow m)
=> Maybe XPub
-> Address
-> m Json.Value
inspectAddress :: 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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Value -> m Value
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
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 (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
Word8
0b10000000 ->
((ErrInspectAddress -> ErrInspectAddress)
-> (AddressInfo -> InspectAddress)
-> Either ErrInspectAddress AddressInfo
-> Either ErrInspectAddress InspectAddress
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 (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))
Word8
_ -> (ErrInspectAddressOnlyShelley -> ErrInspectAddress)
-> (AddressInfo -> InspectAddress)
-> Either ErrInspectAddressOnlyShelley AddressInfo
-> Either ErrInspectAddress InspectAddress
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)
parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley :: AddressParts -> Either ErrInspectAddressOnlyShelley AddressInfo
parseAddressInfoShelley AddressParts{Int
Word8
ByteString
$sel:addrRestLength:AddressParts :: AddressParts -> Int
$sel:addrHash2:AddressParts :: AddressParts -> ByteString
$sel:addrHash1:AddressParts :: AddressParts -> ByteString
$sel:addrNetwork:AddressParts :: AddressParts -> Word8
addrRestLength :: Int
addrHash2 :: ByteString
addrHash1 :: ByteString
addrNetwork :: Word8
addrType :: Word8
$sel:addrType:AddressParts :: AddressParts -> Word8
..} = case Word8
addrType of
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoSpendingKeyHash:AddressInfo :: Maybe ByteString
infoSpendingKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
, $sel:infoStakeKeyHash:AddressInfo :: Maybe ByteString
infoStakeKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash2
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
, $sel:infoStakeKeyHash:AddressInfo :: Maybe ByteString
infoStakeKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash2
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoSpendingKeyHash:AddressInfo :: Maybe ByteString
infoSpendingKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
, $sel:infoStakeScriptHash:AddressInfo :: Maybe ByteString
infoStakeScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash2
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
, $sel:infoStakeScriptHash:AddressInfo :: Maybe ByteString
infoStakeScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash2
}
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 (f :: * -> *) a. Applicative f => a -> f a
pure AddressInfo
addressInfo
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just (ReferenceInfo -> Maybe ReferenceInfo)
-> ReferenceInfo -> Maybe ReferenceInfo
forall a b. (a -> b) -> a -> b
$ ChainPointer -> ReferenceInfo
ByPointer ChainPointer
ptr
, $sel:infoSpendingKeyHash:AddressInfo :: Maybe ByteString
infoSpendingKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
}
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 (f :: * -> *) a. Applicative f => a -> f a
pure AddressInfo
addressInfo
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just (ReferenceInfo -> Maybe ReferenceInfo)
-> ReferenceInfo -> Maybe ReferenceInfo
forall a b. (a -> b) -> a -> b
$ ChainPointer -> ReferenceInfo
ByPointer ChainPointer
ptr
, $sel:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = Maybe ReferenceInfo
forall a. Maybe a
Nothing
, $sel:infoSpendingKeyHash:AddressInfo :: Maybe ByteString
infoSpendingKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = Maybe ReferenceInfo
forall a. Maybe a
Nothing
, $sel:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoStakeKeyHash:AddressInfo :: Maybe ByteString
infoStakeKeyHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
addrHash1
}
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
{ $sel:infoStakeReference:AddressInfo :: Maybe ReferenceInfo
infoStakeReference = ReferenceInfo -> Maybe ReferenceInfo
forall a. a -> Maybe a
Just ReferenceInfo
ByValue
, $sel:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
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 :: Maybe ReferenceInfo
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> NetworkTag
-> Word8
-> 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:infoScriptHash:AddressInfo :: Maybe ByteString
infoScriptHash = 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, String)
(ByteString, ByteOffset, ChainPointer)
forall a.
Get a
-> ByteString
-> Either
(ByteString, ByteOffset, String) (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)
_ -> String -> Either ErrInspectAddressOnlyShelley ChainPointer
forall b. String -> Either ErrInspectAddressOnlyShelley b
err String
"Unconsumed bytes after pointer"
Left (ByteString
_, ByteOffset
_, String
e) -> String -> Either ErrInspectAddressOnlyShelley ChainPointer
forall b. String -> Either ErrInspectAddressOnlyShelley b
err String
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Natural
getVariableLengthNat
Get (Natural -> ChainPointer) -> Get Natural -> Get ChainPointer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Natural
getVariableLengthNat
err :: String -> Either ErrInspectAddressOnlyShelley b
err = ErrInspectAddressOnlyShelley
-> Either ErrInspectAddressOnlyShelley b
forall a b. a -> Either a b
Left (ErrInspectAddressOnlyShelley
-> Either ErrInspectAddressOnlyShelley b)
-> (String -> ErrInspectAddressOnlyShelley)
-> String
-> Either ErrInspectAddressOnlyShelley b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrInspectAddressOnlyShelley
PtrRetrieveError
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
$cto :: forall x. Rep InspectAddress x -> InspectAddress
$cfrom :: forall x. InspectAddress -> Rep InspectAddress x
Generic, Int -> InspectAddress -> ShowS
[InspectAddress] -> ShowS
InspectAddress -> String
(Int -> InspectAddress -> ShowS)
-> (InspectAddress -> String)
-> ([InspectAddress] -> ShowS)
-> Show InspectAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InspectAddress] -> ShowS
$cshowList :: [InspectAddress] -> ShowS
show :: InspectAddress -> String
$cshow :: InspectAddress -> String
showsPrec :: Int -> InspectAddress -> ShowS
$cshowsPrec :: Int -> InspectAddress -> ShowS
Show, InspectAddress -> InspectAddress -> Bool
(InspectAddress -> InspectAddress -> Bool)
-> (InspectAddress -> InspectAddress -> Bool) -> Eq InspectAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InspectAddress -> InspectAddress -> Bool
$c/= :: InspectAddress -> InspectAddress -> Bool
== :: InspectAddress -> InspectAddress -> Bool
$c== :: 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 kv v. (KeyValue 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 kv v. (KeyValue 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
data AddressInfo = AddressInfo
{ AddressInfo -> Maybe ReferenceInfo
infoStakeReference :: !(Maybe ReferenceInfo)
, AddressInfo -> Maybe ByteString
infoSpendingKeyHash :: !(Maybe ByteString)
, AddressInfo -> Maybe ByteString
infoStakeKeyHash :: !(Maybe ByteString)
, AddressInfo -> Maybe ByteString
infoScriptHash :: !(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
$cto :: forall x. Rep AddressInfo x -> AddressInfo
$cfrom :: forall x. AddressInfo -> Rep AddressInfo x
Generic, Int -> AddressInfo -> ShowS
[AddressInfo] -> ShowS
AddressInfo -> String
(Int -> AddressInfo -> ShowS)
-> (AddressInfo -> String)
-> ([AddressInfo] -> ShowS)
-> Show AddressInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressInfo] -> ShowS
$cshowList :: [AddressInfo] -> ShowS
show :: AddressInfo -> String
$cshow :: AddressInfo -> String
showsPrec :: Int -> AddressInfo -> ShowS
$cshowsPrec :: Int -> AddressInfo -> ShowS
Show, AddressInfo -> AddressInfo -> Bool
(AddressInfo -> AddressInfo -> Bool)
-> (AddressInfo -> AddressInfo -> Bool) -> Eq AddressInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressInfo -> AddressInfo -> Bool
$c/= :: AddressInfo -> AddressInfo -> Bool
== :: AddressInfo -> AddressInfo -> Bool
$c== :: AddressInfo -> AddressInfo -> Bool
Eq)
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
$cto :: forall x. Rep ReferenceInfo x -> ReferenceInfo
$cfrom :: forall x. ReferenceInfo -> Rep ReferenceInfo x
Generic, Int -> ReferenceInfo -> ShowS
[ReferenceInfo] -> ShowS
ReferenceInfo -> String
(Int -> ReferenceInfo -> ShowS)
-> (ReferenceInfo -> String)
-> ([ReferenceInfo] -> ShowS)
-> Show ReferenceInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceInfo] -> ShowS
$cshowList :: [ReferenceInfo] -> ShowS
show :: ReferenceInfo -> String
$cshow :: ReferenceInfo -> String
showsPrec :: Int -> ReferenceInfo -> ShowS
$cshowsPrec :: Int -> ReferenceInfo -> ShowS
Show, ReferenceInfo -> ReferenceInfo -> Bool
(ReferenceInfo -> ReferenceInfo -> Bool)
-> (ReferenceInfo -> ReferenceInfo -> Bool) -> Eq ReferenceInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceInfo -> ReferenceInfo -> Bool
$c/= :: ReferenceInfo -> ReferenceInfo -> Bool
== :: ReferenceInfo -> ReferenceInfo -> Bool
$c== :: ReferenceInfo -> ReferenceInfo -> Bool
Eq)
instance ToJSON AddressInfo where
toJSON :: AddressInfo -> Value
toJSON AddressInfo{Maybe ByteString
Maybe ReferenceInfo
Word8
NetworkTag
infoAddressType :: Word8
infoNetworkTag :: NetworkTag
infoStakeScriptHash :: Maybe ByteString
infoScriptHash :: Maybe ByteString
infoStakeKeyHash :: Maybe ByteString
infoSpendingKeyHash :: Maybe ByteString
infoStakeReference :: Maybe ReferenceInfo
$sel:infoAddressType:AddressInfo :: AddressInfo -> Word8
$sel:infoNetworkTag:AddressInfo :: AddressInfo -> NetworkTag
$sel:infoStakeScriptHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoScriptHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoStakeKeyHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoSpendingKeyHash:AddressInfo :: AddressInfo -> Maybe ByteString
$sel:infoStakeReference:AddressInfo :: AddressInfo -> Maybe ReferenceInfo
..} = [Pair] -> Value
Json.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Key
"network_tag" Key -> NetworkTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NetworkTag
infoNetworkTag
, Key
"stake_reference" Key -> Value -> Pair
forall kv v. (KeyValue 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 p. IsString p => ReferenceInfo -> p
refName Maybe ReferenceInfo
infoStakeReference)
, Key
"address_type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word8 -> Value
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 kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChainPointer
ptr]) (Maybe ReferenceInfo
infoStakeReference Maybe ReferenceInfo
-> (ReferenceInfo -> Maybe ChainPointer) -> Maybe ChainPointer
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 a.
KeyValue 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 a.
KeyValue 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 a.
KeyValue a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"spending_shared_hash" HumanReadablePart
CIP5.addr_shared_vkh Maybe ByteString
infoScriptHash
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall a.
KeyValue a =>
Key -> HumanReadablePart -> Maybe ByteString -> [a]
jsonHash Key
"stake_shared_hash" HumanReadablePart
CIP5.stake_shared_vkh Maybe ByteString
infoScriptHash
[Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key -> HumanReadablePart -> Maybe ByteString -> [Pair]
forall a.
KeyValue 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 -> String -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
base16 ByteString
bs , (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
"_bech32") Key -> Text -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HumanReadablePart -> ByteString -> Text
bech32With HumanReadablePart
hrp ByteString
bs ]
base16 :: ByteString -> String
base16 = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
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 -> p
refName ReferenceInfo
ByValue = p
"by value"
refName (ByPointer ChainPointer
_) = p
"by pointer"
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 -> ShowS
[AddressParts] -> ShowS
AddressParts -> String
(Int -> AddressParts -> ShowS)
-> (AddressParts -> String)
-> ([AddressParts] -> ShowS)
-> Show AddressParts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressParts] -> ShowS
$cshowList :: [AddressParts] -> ShowS
show :: AddressParts -> String
$cshow :: AddressParts -> String
showsPrec :: Int -> AddressParts -> ShowS
$cshowsPrec :: Int -> AddressParts -> ShowS
Show)
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 :: Word8 -> Word8 -> ByteString -> ByteString -> Int -> AddressParts
AddressParts{Int
Word8
ByteString
addrRestLength :: Int
addrHash2 :: ByteString
addrHash1 :: ByteString
addrNetwork :: Word8
addrType :: Word8
$sel:addrRestLength:AddressParts :: Int
$sel:addrHash2:AddressParts :: ByteString
$sel:addrHash1:AddressParts :: ByteString
$sel:addrNetwork:AddressParts :: Word8
$sel:addrType:AddressParts :: Word8
..}
| 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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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
data family Credential (purpose :: Depth)
data instance Credential 'PaymentK where
PaymentFromKey :: Shelley 'PaymentK XPub -> Credential 'PaymentK
PaymentFromKeyHash :: KeyHash -> Credential 'PaymentK
PaymentFromScript :: ScriptHash -> Credential 'PaymentK
deriving Int -> Credential 'PaymentK -> ShowS
[Credential 'PaymentK] -> ShowS
Credential 'PaymentK -> String
(Int -> Credential 'PaymentK -> ShowS)
-> (Credential 'PaymentK -> String)
-> ([Credential 'PaymentK] -> ShowS)
-> Show (Credential 'PaymentK)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential 'PaymentK] -> ShowS
$cshowList :: [Credential 'PaymentK] -> ShowS
show :: Credential 'PaymentK -> String
$cshow :: Credential 'PaymentK -> String
showsPrec :: Int -> Credential 'PaymentK -> ShowS
$cshowsPrec :: Int -> Credential 'PaymentK -> ShowS
Show
data instance Credential 'DelegationK where
DelegationFromKey :: Shelley 'DelegationK XPub -> Credential 'DelegationK
DelegationFromKeyHash :: KeyHash -> Credential 'DelegationK
DelegationFromScript :: ScriptHash -> Credential 'DelegationK
DelegationFromPointer :: ChainPointer -> Credential 'DelegationK
deriving Int -> Credential 'DelegationK -> ShowS
[Credential 'DelegationK] -> ShowS
Credential 'DelegationK -> String
(Int -> Credential 'DelegationK -> ShowS)
-> (Credential 'DelegationK -> String)
-> ([Credential 'DelegationK] -> ShowS)
-> Show (Credential 'DelegationK)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credential 'DelegationK] -> ShowS
$cshowList :: [Credential 'DelegationK] -> ShowS
show :: Credential 'DelegationK -> String
$cshow :: Credential 'DelegationK -> String
showsPrec :: Int -> Credential 'DelegationK -> ShowS
$cshowsPrec :: Int -> Credential 'DelegationK -> ShowS
Show
paymentAddress
:: NetworkDiscriminant Shelley
-> Credential 'PaymentK
-> Address
paymentAddress :: NetworkDiscriminant Shelley -> Credential 'PaymentK -> Address
paymentAddress NetworkDiscriminant Shelley
discrimination = \case
PaymentFromKey keyPub ->
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
keyPub)
PaymentFromKeyHash (KeyHash Payment verKeyHash) ->
AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
(CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromKey)
NetworkDiscriminant Shelley
discrimination
ByteString
verKeyHash
PaymentFromKeyHash (KeyHash keyrole _) ->
String -> Address
forall a. HasCallStack => String -> a
error (String -> Address) -> String -> Address
forall a b. (a -> b) -> a -> b
$ String
"Payment credential should be built from key hash having payment"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" role. Key hash with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyRole -> String
forall a. Show a => a -> String
show KeyRole
keyrole String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was used."
PaymentFromScript (ScriptHash bytes) ->
AddressType -> NetworkDiscriminant Shelley -> ByteString -> Address
constructPayload
(CredentialType -> AddressType
EnterpriseAddress CredentialType
CredentialFromScript)
NetworkDiscriminant Shelley
discrimination
ByteString
bytes
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
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)
stakeAddress
:: NetworkDiscriminant Shelley
-> Credential 'DelegationK
-> Either ErrInvalidStakeAddress Address
stakeAddress :: NetworkDiscriminant Shelley
-> Credential 'DelegationK -> Either ErrInvalidStakeAddress Address
stakeAddress NetworkDiscriminant Shelley
discrimination = \case
DelegationFromKey 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 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
keyPub)
DelegationFromKeyHash (KeyHash Delegation 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 _) ->
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 (ScriptHash 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
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
$cto :: forall x. Rep ErrInvalidStakeAddress x -> ErrInvalidStakeAddress
$cfrom :: forall x. ErrInvalidStakeAddress -> Rep ErrInvalidStakeAddress x
Generic, Int -> ErrInvalidStakeAddress -> ShowS
[ErrInvalidStakeAddress] -> ShowS
ErrInvalidStakeAddress -> String
(Int -> ErrInvalidStakeAddress -> ShowS)
-> (ErrInvalidStakeAddress -> String)
-> ([ErrInvalidStakeAddress] -> ShowS)
-> Show ErrInvalidStakeAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrInvalidStakeAddress] -> ShowS
$cshowList :: [ErrInvalidStakeAddress] -> ShowS
show :: ErrInvalidStakeAddress -> String
$cshow :: ErrInvalidStakeAddress -> String
showsPrec :: Int -> ErrInvalidStakeAddress -> ShowS
$cshowsPrec :: Int -> ErrInvalidStakeAddress -> ShowS
Show, ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
(ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool)
-> (ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool)
-> Eq ErrInvalidStakeAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
$c/= :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
== :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
$c== :: ErrInvalidStakeAddress -> ErrInvalidStakeAddress -> Bool
Eq)
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 :: * -> *).
(Alternative 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
$ String -> ErrExtendAddress
ErrInvalidAddressStyle String
"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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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 (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
$ String -> ErrExtendAddress
ErrInvalidAddressType String
"Only payment addresses can be extended"
case Credential 'DelegationK
infoStakeReference of
DelegationFromKey delegationKey -> do
Address -> Either ErrExtendAddress Address
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
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 Delegation keyhash) -> do
Address -> Either ErrExtendAddress Address
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
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 _) -> 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
$ String -> ErrExtendAddress
ErrInvalidKeyHashType (String -> ErrExtendAddress) -> String -> ErrExtendAddress
forall a b. (a -> b) -> a -> b
$
String
"Delegation part can only be constructed from delegation key hash. "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"Key hash of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyRole -> String
forall a. Show a => a -> String
show KeyRole
keyrole String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was used."
DelegationFromScript (ScriptHash scriptBytes) -> do
Address -> Either ErrExtendAddress Address
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
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
DelegationFromPointer pointer -> do
Address -> Either ErrExtendAddress Address
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
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
data ErrExtendAddress
= ErrInvalidAddressStyle String
| ErrInvalidAddressType String
| ErrInvalidKeyHashType String
deriving (Int -> ErrExtendAddress -> ShowS
[ErrExtendAddress] -> ShowS
ErrExtendAddress -> String
(Int -> ErrExtendAddress -> ShowS)
-> (ErrExtendAddress -> String)
-> ([ErrExtendAddress] -> ShowS)
-> Show ErrExtendAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrExtendAddress] -> ShowS
$cshowList :: [ErrExtendAddress] -> ShowS
show :: ErrExtendAddress -> String
$cshow :: ErrExtendAddress -> String
showsPrec :: Int -> ErrExtendAddress -> ShowS
$cshowsPrec :: Int -> ErrExtendAddress -> ShowS
Show)
instance HasNetworkDiscriminant Shelley where
type NetworkDiscriminant Shelley = NetworkTag
addressDiscrimination :: NetworkDiscriminant Shelley -> AddressDiscrimination
addressDiscrimination NetworkDiscriminant Shelley
_ = AddressDiscrimination
RequiresNetworkTag
networkTag :: NetworkDiscriminant Shelley -> NetworkTag
networkTag = NetworkDiscriminant Shelley -> NetworkTag
forall a. a -> a
id
newtype MkNetworkDiscriminantError
= ErrWrongNetworkTag Integer
deriving (MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
(MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool)
-> (MkNetworkDiscriminantError
-> MkNetworkDiscriminantError -> Bool)
-> Eq MkNetworkDiscriminantError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
$c/= :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
== :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
$c== :: MkNetworkDiscriminantError -> MkNetworkDiscriminantError -> Bool
Eq, Int -> MkNetworkDiscriminantError -> ShowS
[MkNetworkDiscriminantError] -> ShowS
MkNetworkDiscriminantError -> String
(Int -> MkNetworkDiscriminantError -> ShowS)
-> (MkNetworkDiscriminantError -> String)
-> ([MkNetworkDiscriminantError] -> ShowS)
-> Show MkNetworkDiscriminantError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkNetworkDiscriminantError] -> ShowS
$cshowList :: [MkNetworkDiscriminantError] -> ShowS
show :: MkNetworkDiscriminantError -> String
$cshow :: MkNetworkDiscriminantError -> String
showsPrec :: Int -> MkNetworkDiscriminantError -> ShowS
$cshowsPrec :: Int -> MkNetworkDiscriminantError -> ShowS
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]"
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 = NetworkTag -> Either MkNetworkDiscriminantError NetworkTag
forall a b. b -> Either a b
Right (NetworkTag -> Either MkNetworkDiscriminantError NetworkTag)
-> NetworkTag -> Either MkNetworkDiscriminantError NetworkTag
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 NetworkTag
forall a b. a -> Either a b
Left (MkNetworkDiscriminantError
-> Either MkNetworkDiscriminantError NetworkTag)
-> MkNetworkDiscriminantError
-> Either MkNetworkDiscriminantError NetworkTag
forall a b. (a -> b) -> a -> b
$ Integer -> MkNetworkDiscriminantError
ErrWrongNetworkTag Integer
nTag
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 (NetworkDiscriminant Shelley)
forall a. Maybe a
Nothing
shelleyMainnet :: NetworkDiscriminant Shelley
shelleyMainnet :: NetworkDiscriminant Shelley
shelleyMainnet = Word32 -> NetworkTag
NetworkTag Word32
1
shelleyTestnet :: NetworkDiscriminant Shelley
shelleyTestnet :: NetworkDiscriminant Shelley
shelleyTestnet = Word32 -> NetworkTag
NetworkTag Word32
0
liftXPrv :: XPrv -> Shelley depth XPrv
liftXPrv :: XPrv -> Shelley depth XPrv
liftXPrv = XPrv -> Shelley depth XPrv
forall (depth :: Depth) key. key -> Shelley depth key
Shelley
liftXPub :: XPub -> Shelley depth XPub
liftXPub :: XPub -> Shelley depth XPub
liftXPub = XPub -> Shelley depth XPub
forall (depth :: Depth) key. key -> Shelley depth key
Shelley
unsafeFromRight :: Either a c -> c
unsafeFromRight :: 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 (String -> a -> c
forall a. HasCallStack => String -> a
error String
"impossible: internally generated invalid address") c -> c
forall a. a -> a
id
purposeIndex :: Word32
purposeIndex :: Word32
purposeIndex = Word32
0x8000073c
policyPurposeIndex :: Word32
policyPurposeIndex :: Word32
policyPurposeIndex = Word32
0x8000073f
coinTypeIndex :: Word32
coinTypeIndex :: Word32
coinTypeIndex = Word32
0x80000717
minSeedLengthBytes :: Int
minSeedLengthBytes :: Int
minSeedLengthBytes = Int
16
data CredentialType = CredentialFromKey | CredentialFromScript
deriving (Int -> CredentialType -> ShowS
[CredentialType] -> ShowS
CredentialType -> String
(Int -> CredentialType -> ShowS)
-> (CredentialType -> String)
-> ([CredentialType] -> ShowS)
-> Show CredentialType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialType] -> ShowS
$cshowList :: [CredentialType] -> ShowS
show :: CredentialType -> String
$cshow :: CredentialType -> String
showsPrec :: Int -> CredentialType -> ShowS
$cshowsPrec :: Int -> CredentialType -> ShowS
Show, CredentialType -> CredentialType -> Bool
(CredentialType -> CredentialType -> Bool)
-> (CredentialType -> CredentialType -> Bool) -> Eq CredentialType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialType -> CredentialType -> Bool
$c/= :: CredentialType -> CredentialType -> Bool
== :: CredentialType -> CredentialType -> Bool
$c== :: CredentialType -> CredentialType -> Bool
Eq)
data AddressType
= BaseAddress CredentialType CredentialType
| PointerAddress CredentialType
| EnterpriseAddress CredentialType
| RewardAccount CredentialType
| ByronAddress
deriving (Int -> AddressType -> ShowS
[AddressType] -> ShowS
AddressType -> String
(Int -> AddressType -> ShowS)
-> (AddressType -> String)
-> ([AddressType] -> ShowS)
-> Show AddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressType] -> ShowS
$cshowList :: [AddressType] -> ShowS
show :: AddressType -> String
$cshow :: AddressType -> String
showsPrec :: Int -> AddressType -> ShowS
$cshowsPrec :: Int -> AddressType -> ShowS
Show, AddressType -> AddressType -> Bool
(AddressType -> AddressType -> Bool)
-> (AddressType -> AddressType -> Bool) -> Eq AddressType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressType -> AddressType -> Bool
$c/= :: AddressType -> AddressType -> Bool
== :: AddressType -> AddressType -> Bool
$c== :: 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
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 (NetworkDiscriminant Shelley -> NetworkTag
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
genMasterKeyFromMnemonicShelley
:: BA.ByteArrayAccess sndFactor
=> SomeMnemonic
-> sndFactor
-> XPrv
genMasterKeyFromMnemonicShelley :: 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 :: XPrv -> Index derivationType depth -> Word32 -> XPrv
deriveAccountPrivateKeyShelley XPrv
rootXPrv Index derivationType depth
accIx Word32
purpose =
let
Just Index 'Hardened Any
purposeIx =
Word32 -> Maybe (Index 'Hardened Any)
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 =
Word32 -> Maybe (Index 'Hardened depth)
forall ix (derivationType :: DerivationType) (depth :: Depth).
(ix ~ Index derivationType depth, Bounded ix) =>
Word32 -> Maybe ix
indexFromWord32 @(Index 'Hardened _) Word32
coinTypeIndex
purposeXPrv :: XPrv
purposeXPrv =
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 =
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 =
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 :: XPrv -> Role -> Index derivationType depth -> XPrv
deriveAddressPrivateKeyShelley XPrv
accXPrv Role
role Index derivationType depth
addrIx =
let
changeXPrv :: XPrv
changeXPrv =
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 =
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 :: 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 <-
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)
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 = String -> XPub
forall a. HasCallStack => String -> a
error (String -> XPub) -> String -> XPub
forall a b. (a -> b) -> a -> b
$
String
"deriveAddressPublicKey failed: was given an hardened (or too big) \
\index for soft path derivation ( " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Index derivationType depth -> String
forall a. Show a => a -> String
show Index derivationType depth
addrIx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"). This is \
\either a programmer error, or, we may have reached the maximum \
\number of addresses for a given wallet."