{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Cardano.Ledger.Address (
serialiseAddr,
Addr (..),
addrPtrNormalize,
BootstrapAddress (..),
bootstrapAddressAttrsSize,
isBootstrapRedeemer,
getNetwork,
RewardAccount (..),
rewardAccountCredentialL,
rewardAccountNetworkL,
serialiseRewardAccount,
deserialiseRewardAccount,
bootstrapKeyHash,
putAddr,
putCredential,
putPtr,
putRewardAccount,
putVariableLengthWord64,
Word7 (..),
toWord7,
fromBoostrapCompactAddress,
compactAddr,
decompactAddr,
CompactAddr,
unCompactAddr,
isPayCredScriptCompactAddr,
isBootstrapCompactAddr,
decodeAddr,
decodeAddrEither,
decodeAddrStateT,
decodeAddrStateLenientT,
fromCborAddr,
fromCborBothAddr,
fromCborCompactAddr,
fromCborBackwardsBothAddr,
decodeRewardAccount,
fromCborRewardAccount,
Withdrawals (..),
)
where
import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Crypto.Hash.Class as Hash
import qualified Cardano.Crypto.Hashing as Byron
import Cardano.Ledger.BaseTypes (
CertIx (..),
Network (..),
SlotNo (..),
TxIx (..),
byronProtVer,
natVersion,
networkToWord8,
)
import Cardano.Ledger.Binary (
DecCBOR (..),
Decoder,
EncCBOR (..),
decodeFull',
ifDecoderVersionAtLeast,
serialize,
)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (
Credential (..),
PaymentCredential,
Ptr (..),
StakeReference (..),
normalizePtr,
)
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Cardano.Prelude (unsafeShortByteStringIndex)
import Control.DeepSeq (NFData)
import Control.Monad (guard, unless, when)
import Control.Monad.Trans.Fail (runFail)
import Control.Monad.Trans.State.Strict (StateT, evalStateT, get, modify', state)
import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.Aeson.Key as Aeson (fromText)
import qualified Data.Aeson.Types as Aeson
import Data.Binary (Put)
import qualified Data.Binary as B
import qualified Data.Binary.Put as B
import Data.Bits (Bits (clearBit, setBit, shiftL, shiftR, testBit, (.&.), (.|.)))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short as SBS (ShortByteString, fromShort, index, length, toShort)
import qualified Data.ByteString.Unsafe as BS (unsafeDrop, unsafeIndex, unsafeTake)
import Data.Default (Default (..))
import Data.Function (fix)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text.Encoding as Text
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Generics (Generic)
import GHC.Show (intToDigit)
import GHC.Stack (HasCallStack)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
import Numeric (showIntAtBase)
import Quiet (Quiet (Quiet))
serialiseAddr :: Addr -> ByteString
serialiseAddr :: Addr -> ByteString
serialiseAddr = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Put
putAddr
{-# INLINE serialiseAddr #-}
serialiseRewardAccount :: RewardAccount -> ByteString
serialiseRewardAccount :: RewardAccount -> ByteString
serialiseRewardAccount = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Put
putRewardAccount
deserialiseRewardAccount :: ByteString -> Maybe RewardAccount
deserialiseRewardAccount :: ByteString -> Maybe RewardAccount
deserialiseRewardAccount = forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m RewardAccount
decodeRewardAccount
data Addr
= Addr Network PaymentCredential StakeReference
| AddrBootstrap BootstrapAddress
deriving (Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Addr] -> ShowS
$cshowList :: [Addr] -> ShowS
show :: Addr -> String
$cshow :: Addr -> String
showsPrec :: Int -> Addr -> ShowS
$cshowsPrec :: Int -> Addr -> ShowS
Show, Addr -> Addr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c== :: Addr -> Addr -> Bool
Eq, forall x. Rep Addr x -> Addr
forall x. Addr -> Rep Addr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Addr x -> Addr
$cfrom :: forall x. Addr -> Rep Addr x
Generic, Addr -> ()
forall a. (a -> ()) -> NFData a
rnf :: Addr -> ()
$crnf :: Addr -> ()
NFData, Eq Addr
Addr -> Addr -> Bool
Addr -> Addr -> Ordering
Addr -> Addr -> Addr
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 :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmax :: Addr -> Addr -> Addr
>= :: Addr -> Addr -> Bool
$c>= :: Addr -> Addr -> Bool
> :: Addr -> Addr -> Bool
$c> :: Addr -> Addr -> Bool
<= :: Addr -> Addr -> Bool
$c<= :: Addr -> Addr -> Bool
< :: Addr -> Addr -> Bool
$c< :: Addr -> Addr -> Bool
compare :: Addr -> Addr -> Ordering
$ccompare :: Addr -> Addr -> Ordering
Ord)
getNetwork :: Addr -> Network
getNetwork :: Addr -> Network
getNetwork (Addr Network
n PaymentCredential
_ StakeReference
_) = Network
n
getNetwork (AddrBootstrap (BootstrapAddress Address
byronAddr)) =
case AddrAttributes -> NetworkMagic
Byron.aaNetworkMagic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. Attributes h -> h
Byron.attrData forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Attributes AddrAttributes
Byron.addrAttributes forall a b. (a -> b) -> a -> b
$ Address
byronAddr of
NetworkMagic
Byron.NetworkMainOrStage -> Network
Mainnet
Byron.NetworkTestnet Word32
_ -> Network
Testnet
instance NoThunks Addr
addrPtrNormalize :: Addr -> Addr
addrPtrNormalize :: Addr -> Addr
addrPtrNormalize = \case
Addr Network
n PaymentCredential
cred (StakeRefPtr Ptr
ptr) -> Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
n PaymentCredential
cred (Ptr -> StakeReference
StakeRefPtr (Ptr -> Ptr
normalizePtr Ptr
ptr))
Addr
addr -> Addr
addr
data RewardAccount = RewardAccount
{ RewardAccount -> Network
raNetwork :: !Network
, RewardAccount -> Credential 'Staking
raCredential :: !(Credential 'Staking)
}
deriving (Int -> RewardAccount -> ShowS
[RewardAccount] -> ShowS
RewardAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardAccount] -> ShowS
$cshowList :: [RewardAccount] -> ShowS
show :: RewardAccount -> String
$cshow :: RewardAccount -> String
showsPrec :: Int -> RewardAccount -> ShowS
$cshowsPrec :: Int -> RewardAccount -> ShowS
Show, RewardAccount -> RewardAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardAccount -> RewardAccount -> Bool
$c/= :: RewardAccount -> RewardAccount -> Bool
== :: RewardAccount -> RewardAccount -> Bool
$c== :: RewardAccount -> RewardAccount -> Bool
Eq, forall x. Rep RewardAccount x -> RewardAccount
forall x. RewardAccount -> Rep RewardAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RewardAccount x -> RewardAccount
$cfrom :: forall x. RewardAccount -> Rep RewardAccount x
Generic, Eq RewardAccount
RewardAccount -> RewardAccount -> Bool
RewardAccount -> RewardAccount -> Ordering
RewardAccount -> RewardAccount -> RewardAccount
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 :: RewardAccount -> RewardAccount -> RewardAccount
$cmin :: RewardAccount -> RewardAccount -> RewardAccount
max :: RewardAccount -> RewardAccount -> RewardAccount
$cmax :: RewardAccount -> RewardAccount -> RewardAccount
>= :: RewardAccount -> RewardAccount -> Bool
$c>= :: RewardAccount -> RewardAccount -> Bool
> :: RewardAccount -> RewardAccount -> Bool
$c> :: RewardAccount -> RewardAccount -> Bool
<= :: RewardAccount -> RewardAccount -> Bool
$c<= :: RewardAccount -> RewardAccount -> Bool
< :: RewardAccount -> RewardAccount -> Bool
$c< :: RewardAccount -> RewardAccount -> Bool
compare :: RewardAccount -> RewardAccount -> Ordering
$ccompare :: RewardAccount -> RewardAccount -> Ordering
Ord, RewardAccount -> ()
forall a. (a -> ()) -> NFData a
rnf :: RewardAccount -> ()
$crnf :: RewardAccount -> ()
NFData, ToJSONKeyFunction [RewardAccount]
ToJSONKeyFunction RewardAccount
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [RewardAccount]
$ctoJSONKeyList :: ToJSONKeyFunction [RewardAccount]
toJSONKey :: ToJSONKeyFunction RewardAccount
$ctoJSONKey :: ToJSONKeyFunction RewardAccount
ToJSONKey, FromJSONKeyFunction [RewardAccount]
FromJSONKeyFunction RewardAccount
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [RewardAccount]
$cfromJSONKeyList :: FromJSONKeyFunction [RewardAccount]
fromJSONKey :: FromJSONKeyFunction RewardAccount
$cfromJSONKey :: FromJSONKeyFunction RewardAccount
FromJSONKey)
rewardAccountCredentialL :: Lens' RewardAccount (Credential 'Staking)
rewardAccountCredentialL :: Lens' RewardAccount (Credential 'Staking)
rewardAccountCredentialL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RewardAccount -> Credential 'Staking
raCredential forall a b. (a -> b) -> a -> b
$ \RewardAccount
x Credential 'Staking
y -> RewardAccount
x {raCredential :: Credential 'Staking
raCredential = Credential 'Staking
y}
rewardAccountNetworkL :: Lens' RewardAccount Network
rewardAccountNetworkL :: Lens' RewardAccount Network
rewardAccountNetworkL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RewardAccount -> Network
raNetwork forall a b. (a -> b) -> a -> b
$ \RewardAccount
x Network
y -> RewardAccount
x {raNetwork :: Network
raNetwork = Network
y}
instance Default RewardAccount where
def :: RewardAccount
def = Network -> Credential 'Staking -> RewardAccount
RewardAccount forall a. Default a => a
def forall a. Default a => a
def
instance ToJSON RewardAccount where
toJSON :: RewardAccount -> Value
toJSON RewardAccount
ra =
[Pair] -> Value
Aeson.object
[ Key
"network" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RewardAccount -> Network
raNetwork RewardAccount
ra
, Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RewardAccount -> Credential 'Staking
raCredential RewardAccount
ra
]
instance FromJSON RewardAccount where
parseJSON :: Value -> Parser RewardAccount
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"RewardAccount" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
Network -> Credential 'Staking -> RewardAccount
RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"network"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"credential"
instance NoThunks RewardAccount
instance ToJSONKey Addr where
toJSONKey :: ToJSONKeyFunction Addr
toJSONKey = forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText (Text -> Key
Aeson.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Text
addrToText) (forall a. Text -> Encoding' a
Aeson.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Text
addrToText)
instance FromJSONKey Addr where
fromJSONKey :: FromJSONKeyFunction Addr
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser Addr
parseAddr
instance ToJSON Addr where
toJSON :: Addr -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Text
addrToText
instance FromJSON Addr where
parseJSON :: Value -> Parser Addr
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"address" Text -> Parser Addr
parseAddr
addrToText :: Addr -> Text
addrToText :: Addr -> Text
addrToText = ByteString -> Text
Text.decodeLatin1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> ByteString
serialiseAddr
parseAddr :: Text -> Aeson.Parser Addr
parseAddr :: Text -> Parser Addr
parseAddr Text
t = do
ByteString
bytes <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
badHex forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString
B16.decode (Text -> ByteString
Text.encodeUtf8 Text
t))
forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr ByteString
bytes
where
badHex :: a -> m a
badHex a
h = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Addresses are expected in hex encoding for now: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
h
byron :: Int
byron :: Int
byron = Int
7
notBaseAddr :: Int
notBaseAddr :: Int
notBaseAddr = Int
6
isEnterpriseAddr :: Int
isEnterpriseAddr :: Int
isEnterpriseAddr = Int
5
stakeCredIsScript :: Int
stakeCredIsScript :: Int
stakeCredIsScript = Int
5
payCredIsScript :: Int
payCredIsScript :: Int
payCredIsScript = Int
4
putAddr :: Addr -> Put
putAddr :: Addr -> Put
putAddr (AddrBootstrap (BootstrapAddress Address
byronAddr)) =
ByteString -> Put
B.putLazyByteString (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer Address
byronAddr)
putAddr (Addr Network
network PaymentCredential
pc StakeReference
sr) =
let setPayCredBit :: Word8 -> Word8
setPayCredBit = case PaymentCredential
pc of
ScriptHashObj ScriptHash
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
KeyHashObj KeyHash 'Payment
_ -> forall a. a -> a
id
netId :: Word8
netId = Network -> Word8
networkToWord8 Network
network
in case StakeReference
sr of
StakeRefBase Credential 'Staking
sc -> do
let setStakeCredBit :: Word8 -> Word8
setStakeCredBit = case Credential 'Staking
sc of
ScriptHashObj ScriptHash
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
stakeCredIsScript
KeyHashObj KeyHash 'Staking
_ -> forall a. a -> a
id
header :: Word8
header = Word8 -> Word8
setStakeCredBit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
setPayCredBit forall a b. (a -> b) -> a -> b
$ Word8
netId
Word8 -> Put
B.putWord8 Word8
header
forall (kr :: KeyRole). Credential kr -> Put
putCredential PaymentCredential
pc
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential 'Staking
sc
StakeRefPtr Ptr
ptr -> do
let header :: Word8
header = Word8 -> Word8
setPayCredBit forall a b. (a -> b) -> a -> b
$ Word8
netId forall a. Bits a => a -> Int -> a
`setBit` Int
notBaseAddr
Word8 -> Put
B.putWord8 Word8
header
forall (kr :: KeyRole). Credential kr -> Put
putCredential PaymentCredential
pc
Ptr -> Put
putPtr Ptr
ptr
StakeReference
StakeRefNull -> do
let header :: Word8
header = Word8 -> Word8
setPayCredBit forall a b. (a -> b) -> a -> b
$ Word8
netId forall a. Bits a => a -> Int -> a
`setBit` Int
isEnterpriseAddr forall a. Bits a => a -> Int -> a
`setBit` Int
notBaseAddr
Word8 -> Put
B.putWord8 Word8
header
forall (kr :: KeyRole). Credential kr -> Put
putCredential PaymentCredential
pc
{-# INLINE putAddr #-}
putRewardAccount :: RewardAccount -> Put
putRewardAccount :: RewardAccount -> Put
putRewardAccount (RewardAccount Network
network Credential 'Staking
cred) = do
let setPayCredBit :: Word8 -> Word8
setPayCredBit = case Credential 'Staking
cred of
ScriptHashObj ScriptHash
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
KeyHashObj KeyHash 'Staking
_ -> forall a. a -> a
id
netId :: Word8
netId = Network -> Word8
networkToWord8 Network
network
rewardAccountPrefix :: Word8
rewardAccountPrefix = Word8
0xE0
header :: Word8
header = Word8 -> Word8
setPayCredBit (Word8
netId forall a. Bits a => a -> a -> a
.|. Word8
rewardAccountPrefix)
Word8 -> Put
B.putWord8 Word8
header
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential 'Staking
cred
{-# INLINE putRewardAccount #-}
putHash :: Hash.Hash h a -> Put
putHash :: forall h a. Hash h a -> Put
putHash = ByteString -> Put
B.putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> ByteString
Hash.hashToBytes
{-# INLINE putHash #-}
putCredential :: Credential kr -> Put
putCredential :: forall (kr :: KeyRole). Credential kr -> Put
putCredential (ScriptHashObj (ScriptHash Hash ADDRHASH EraIndependentScript
h)) = forall h a. Hash h a -> Put
putHash Hash ADDRHASH EraIndependentScript
h
putCredential (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)) = forall h a. Hash h a -> Put
putHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h
{-# INLINE putCredential #-}
bootstrapAddressAttrsSize :: BootstrapAddress -> Int
(BootstrapAddress Address
addr) =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 HDAddressPayload -> Int
payloadLen Maybe HDAddressPayload
derivationPath forall a. Num a => a -> a -> a
+ forall a. Attributes a -> Int
Byron.unknownAttributesLength Attributes AddrAttributes
attrs
where
payloadLen :: HDAddressPayload -> Int
payloadLen = ByteString -> Int
BS.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. HDAddressPayload -> ByteString
Byron.getHDAddressPayload
derivationPath :: Maybe HDAddressPayload
derivationPath = AddrAttributes -> Maybe HDAddressPayload
Byron.aaVKDerivationPath (forall h. Attributes h -> h
Byron.attrData Attributes AddrAttributes
attrs)
attrs :: Attributes AddrAttributes
attrs = Address -> Attributes AddrAttributes
Byron.addrAttributes Address
addr
isBootstrapRedeemer :: BootstrapAddress -> Bool
isBootstrapRedeemer :: BootstrapAddress -> Bool
isBootstrapRedeemer (BootstrapAddress (Byron.Address AddressHash Address'
_ Attributes AddrAttributes
_ AddrType
Byron.ATRedeem)) = Bool
True
isBootstrapRedeemer BootstrapAddress
_ = Bool
False
putPtr :: Ptr -> Put
putPtr :: Ptr -> Put
putPtr (Ptr (SlotNo Word64
slot) (TxIx Word64
txIx) (CertIx Word64
certIx)) = do
Word64 -> Put
putVariableLengthWord64 Word64
slot
Word64 -> Put
putVariableLengthWord64 Word64
txIx
Word64 -> Put
putVariableLengthWord64 Word64
certIx
newtype Word7 = Word7 Word8
deriving (Word7 -> Word7 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word7 -> Word7 -> Bool
$c/= :: Word7 -> Word7 -> Bool
== :: Word7 -> Word7 -> Bool
$c== :: Word7 -> Word7 -> Bool
Eq, Int -> Word7 -> ShowS
[Word7] -> ShowS
Word7 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word7] -> ShowS
$cshowList :: [Word7] -> ShowS
show :: Word7 -> String
$cshow :: Word7 -> String
showsPrec :: Int -> Word7 -> ShowS
$cshowsPrec :: Int -> Word7 -> ShowS
Show)
toWord7 :: Word8 -> Word7
toWord7 :: Word8 -> Word7
toWord7 Word8
x = Word8 -> Word7
Word7 (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0x7F)
putWord7s :: [Word7] -> Put
putWord7s :: [Word7] -> Put
putWord7s [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
putWord7s [Word7 Word8
x] = Word8 -> Put
B.putWord8 Word8
x
putWord7s (Word7 Word8
x : [Word7]
xs) = Word8 -> Put
B.putWord8 (Word8
x forall a. Bits a => a -> a -> a
.|. Word8
0x80) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Word7] -> Put
putWord7s [Word7]
xs
word64ToWord7s :: Word64 -> [Word7]
word64ToWord7s :: Word64 -> [Word7]
word64ToWord7s = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> [Word7]
go
where
go :: Word64 -> [Word7]
go :: Word64 -> [Word7]
go Word64
n
| Word64
n forall a. Ord a => a -> a -> Bool
> Word64
0x7F = (Word8 -> Word7
toWord7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word64
n forall a. a -> [a] -> [a]
: Word64 -> [Word7]
go (forall a. Bits a => a -> Int -> a
shiftR Word64
n Int
7)
| Bool
otherwise = [Word8 -> Word7
Word7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
n]
putVariableLengthWord64 :: Word64 -> Put
putVariableLengthWord64 :: Word64 -> Put
putVariableLengthWord64 = [Word7] -> Put
putWord7s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> [Word7]
word64ToWord7s
instance EncCBOR Addr where
encCBOR :: Addr -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Put
putAddr
{-# INLINE encCBOR #-}
instance DecCBOR Addr where
decCBOR :: forall s. Decoder s Addr
decCBOR = forall s. Decoder s Addr
fromCborAddr
{-# INLINE decCBOR #-}
instance EncCBOR RewardAccount where
encCBOR :: RewardAccount -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Put
putRewardAccount
{-# INLINE encCBOR #-}
instance DecCBOR RewardAccount where
decCBOR :: forall s. Decoder s RewardAccount
decCBOR = forall s. Decoder s RewardAccount
fromCborRewardAccount
{-# INLINE decCBOR #-}
newtype BootstrapAddress = BootstrapAddress
{ BootstrapAddress -> Address
unBootstrapAddress :: Byron.Address
}
deriving (BootstrapAddress -> BootstrapAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapAddress -> BootstrapAddress -> Bool
$c/= :: BootstrapAddress -> BootstrapAddress -> Bool
== :: BootstrapAddress -> BootstrapAddress -> Bool
$c== :: BootstrapAddress -> BootstrapAddress -> Bool
Eq, forall x. Rep BootstrapAddress x -> BootstrapAddress
forall x. BootstrapAddress -> Rep BootstrapAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BootstrapAddress x -> BootstrapAddress
$cfrom :: forall x. BootstrapAddress -> Rep BootstrapAddress x
Generic)
deriving newtype (BootstrapAddress -> ()
forall a. (a -> ()) -> NFData a
rnf :: BootstrapAddress -> ()
$crnf :: BootstrapAddress -> ()
NFData, Eq BootstrapAddress
BootstrapAddress -> BootstrapAddress -> Bool
BootstrapAddress -> BootstrapAddress -> Ordering
BootstrapAddress -> BootstrapAddress -> BootstrapAddress
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 :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
$cmin :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
max :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
$cmax :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
>= :: BootstrapAddress -> BootstrapAddress -> Bool
$c>= :: BootstrapAddress -> BootstrapAddress -> Bool
> :: BootstrapAddress -> BootstrapAddress -> Bool
$c> :: BootstrapAddress -> BootstrapAddress -> Bool
<= :: BootstrapAddress -> BootstrapAddress -> Bool
$c<= :: BootstrapAddress -> BootstrapAddress -> Bool
< :: BootstrapAddress -> BootstrapAddress -> Bool
$c< :: BootstrapAddress -> BootstrapAddress -> Bool
compare :: BootstrapAddress -> BootstrapAddress -> Ordering
$ccompare :: BootstrapAddress -> BootstrapAddress -> Ordering
Ord)
deriving (Int -> BootstrapAddress -> ShowS
[BootstrapAddress] -> ShowS
BootstrapAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapAddress] -> ShowS
$cshowList :: [BootstrapAddress] -> ShowS
show :: BootstrapAddress -> String
$cshow :: BootstrapAddress -> String
showsPrec :: Int -> BootstrapAddress -> ShowS
$cshowsPrec :: Int -> BootstrapAddress -> ShowS
Show) via Quiet BootstrapAddress
instance NoThunks BootstrapAddress
bootstrapKeyHash ::
BootstrapAddress ->
KeyHash 'Payment
bootstrapKeyHash :: BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash (BootstrapAddress Address
byronAddress) =
let root :: AddressHash Address'
root = Address -> AddressHash Address'
Byron.addrRoot Address
byronAddress
bytes :: ByteString
bytes = forall algo a. AbstractHash algo a -> ByteString
Byron.abstractHashToBytes AddressHash Address'
root
!hash :: Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"bootstrapKeyHash: incorrect hash length") forall a b. (a -> b) -> a -> b
$
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
bytes
in forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash
newtype CompactAddr = UnsafeCompactAddr ShortByteString
deriving stock (CompactAddr -> CompactAddr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactAddr -> CompactAddr -> Bool
$c/= :: CompactAddr -> CompactAddr -> Bool
== :: CompactAddr -> CompactAddr -> Bool
$c== :: CompactAddr -> CompactAddr -> Bool
Eq, forall x. Rep CompactAddr x -> CompactAddr
forall x. CompactAddr -> Rep CompactAddr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompactAddr x -> CompactAddr
$cfrom :: forall x. CompactAddr -> Rep CompactAddr x
Generic, Eq CompactAddr
CompactAddr -> CompactAddr -> Bool
CompactAddr -> CompactAddr -> Ordering
CompactAddr -> CompactAddr -> CompactAddr
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 :: CompactAddr -> CompactAddr -> CompactAddr
$cmin :: CompactAddr -> CompactAddr -> CompactAddr
max :: CompactAddr -> CompactAddr -> CompactAddr
$cmax :: CompactAddr -> CompactAddr -> CompactAddr
>= :: CompactAddr -> CompactAddr -> Bool
$c>= :: CompactAddr -> CompactAddr -> Bool
> :: CompactAddr -> CompactAddr -> Bool
$c> :: CompactAddr -> CompactAddr -> Bool
<= :: CompactAddr -> CompactAddr -> Bool
$c<= :: CompactAddr -> CompactAddr -> Bool
< :: CompactAddr -> CompactAddr -> Bool
$c< :: CompactAddr -> CompactAddr -> Bool
compare :: CompactAddr -> CompactAddr -> Ordering
$ccompare :: CompactAddr -> CompactAddr -> Ordering
Ord)
deriving newtype (Context -> CompactAddr -> IO (Maybe ThunkInfo)
Proxy CompactAddr -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy CompactAddr -> String
$cshowTypeOf :: Proxy CompactAddr -> String
wNoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
NoThunks, CompactAddr -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactAddr -> ()
$crnf :: CompactAddr -> ()
NFData)
instance Show CompactAddr where
show :: CompactAddr -> String
show CompactAddr
c = forall a. Show a => a -> String
show (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
c)
unCompactAddr :: CompactAddr -> ShortByteString
unCompactAddr :: CompactAddr -> ShortByteString
unCompactAddr (UnsafeCompactAddr ShortByteString
sbs) = ShortByteString
sbs
{-# INLINE unCompactAddr #-}
compactAddr :: Addr -> CompactAddr
compactAddr :: Addr -> CompactAddr
compactAddr = ShortByteString -> CompactAddr
UnsafeCompactAddr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> ByteString
serialiseAddr
{-# INLINE compactAddr #-}
decompactAddr :: HasCallStack => CompactAddr -> Addr
decompactAddr :: HasCallStack => CompactAddr -> Addr
decompactAddr (UnsafeCompactAddr ShortByteString
sbs) =
case forall e a. (IsString e, Semigroup e) => Fail e a -> Either e a
runFail forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
True Bool
True ShortByteString
sbs) Int
0 of
Right Addr
addr -> Addr
addr
Left String
err ->
forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
String
"Impossible: Malformed CompactAddr was allowed into the system. "
forall a. [a] -> [a] -> [a]
++ String
" Decoder error: "
forall a. [a] -> [a] -> [a]
++ String
err
{-# INLINE decompactAddr #-}
fromCborAddr :: Decoder s Addr
fromCborAddr :: forall s. Decoder s Addr
fromCborAddr = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s (Addr, CompactAddr)
fromCborBothAddr
{-# INLINE fromCborAddr #-}
fromCborCompactAddr :: Decoder s CompactAddr
fromCborCompactAddr :: forall s. Decoder s CompactAddr
fromCborCompactAddr = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s (Addr, CompactAddr)
fromCborBothAddr
{-# INLINE fromCborCompactAddr #-}
fromCborBothAddr :: Decoder s (Addr, CompactAddr)
fromCborBothAddr :: forall s. Decoder s (Addr, CompactAddr)
fromCborBothAddr = do
forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @7) forall s. Decoder s (Addr, CompactAddr)
decodeAddrRigorous forall s. Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr
where
decodeAddrRigorous :: Decoder s (Addr, CompactAddr)
decodeAddrRigorous = do
ShortByteString
sbs <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall a b. (a -> b) -> a -> b
$ do
Addr
addr <- forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
False Bool
False ShortByteString
sbs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr
addr, ShortByteString -> CompactAddr
UnsafeCompactAddr ShortByteString
sbs)
{-# INLINE decodeAddrRigorous #-}
{-# INLINE fromCborBothAddr #-}
fromCborBackwardsBothAddr :: Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr :: forall s. Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr = do
ShortByteString
sbs <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Int
0 forall a b. (a -> b) -> a -> b
$ do
Addr
addr <- forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
True Bool
True ShortByteString
sbs
Int
bytesConsumed <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let sbsCropped :: ShortByteString
sbsCropped = ByteString -> ShortByteString
SBS.toShort forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
bytesConsumed forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr
addr, ShortByteString -> CompactAddr
UnsafeCompactAddr ShortByteString
sbsCropped)
{-# INLINE fromCborBackwardsBothAddr #-}
class AddressBuffer b where
bufLength :: b -> Int
bufUnsafeIndex :: b -> Int -> Word8
bufToByteString :: b -> BS.ByteString
bufGetHash :: Hash.HashAlgorithm h => b -> Int -> Maybe (Hash.Hash h a)
instance AddressBuffer ShortByteString where
bufLength :: ShortByteString -> Int
bufLength = ShortByteString -> Int
SBS.length
{-# INLINE bufLength #-}
bufUnsafeIndex :: ShortByteString -> Int -> Word8
bufUnsafeIndex = ShortByteString -> Int -> Word8
unsafeShortByteStringIndex
{-# INLINE bufUnsafeIndex #-}
bufToByteString :: ShortByteString -> ByteString
bufToByteString = ShortByteString -> ByteString
SBS.fromShort
{-# INLINE bufToByteString #-}
bufGetHash :: forall h a.
HashAlgorithm h =>
ShortByteString -> Int -> Maybe (Hash h a)
bufGetHash = forall h a.
HashAlgorithm h =>
ShortByteString -> Int -> Maybe (Hash h a)
Hash.hashFromOffsetBytesShort
{-# INLINE bufGetHash #-}
instance AddressBuffer BS.ByteString where
bufLength :: ByteString -> Int
bufLength = ByteString -> Int
BS.length
{-# INLINE bufLength #-}
bufUnsafeIndex :: ByteString -> Int -> Word8
bufUnsafeIndex = ByteString -> Int -> Word8
BS.unsafeIndex
{-# INLINE bufUnsafeIndex #-}
bufToByteString :: ByteString -> ByteString
bufToByteString = forall a. a -> a
id
{-# INLINE bufToByteString #-}
bufGetHash :: forall h a. Hash.HashAlgorithm h => BS.ByteString -> Int -> Maybe (Hash.Hash h a)
bufGetHash :: forall h a.
HashAlgorithm h =>
ByteString -> Int -> Maybe (Hash h a)
bufGetHash ByteString
bs Int
offset = do
let size :: Int
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy h))
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
offset forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset forall a. Num a => a -> a -> a
+ Int
size forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
BS.length ByteString
bs)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes (Int -> ByteString -> ByteString
BS.unsafeTake Int
size (Int -> ByteString -> ByteString
BS.unsafeDrop Int
offset ByteString
bs))
{-# INLINE bufGetHash #-}
newtype = Word8
deriving newtype (Header -> Header -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Eq Header
Header -> Header -> Bool
Header -> Header -> Ordering
Header -> Header -> Header
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 :: Header -> Header -> Header
$cmin :: Header -> Header -> Header
max :: Header -> Header -> Header
$cmax :: Header -> Header -> Header
>= :: Header -> Header -> Bool
$c>= :: Header -> Header -> Bool
> :: Header -> Header -> Bool
$c> :: Header -> Header -> Bool
<= :: Header -> Header -> Bool
$c<= :: Header -> Header -> Bool
< :: Header -> Header -> Bool
$c< :: Header -> Header -> Bool
compare :: Header -> Header -> Ordering
$ccompare :: Header -> Header -> Ordering
Ord, Eq Header
Header
Int -> Header
Header -> Bool
Header -> Int
Header -> Maybe Int
Header -> Header
Header -> Int -> Bool
Header -> Int -> Header
Header -> Header -> Header
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Header -> Int
$cpopCount :: Header -> Int
rotateR :: Header -> Int -> Header
$crotateR :: Header -> Int -> Header
rotateL :: Header -> Int -> Header
$crotateL :: Header -> Int -> Header
unsafeShiftR :: Header -> Int -> Header
$cunsafeShiftR :: Header -> Int -> Header
shiftR :: Header -> Int -> Header
$cshiftR :: Header -> Int -> Header
unsafeShiftL :: Header -> Int -> Header
$cunsafeShiftL :: Header -> Int -> Header
shiftL :: Header -> Int -> Header
$cshiftL :: Header -> Int -> Header
isSigned :: Header -> Bool
$cisSigned :: Header -> Bool
bitSize :: Header -> Int
$cbitSize :: Header -> Int
bitSizeMaybe :: Header -> Maybe Int
$cbitSizeMaybe :: Header -> Maybe Int
testBit :: Header -> Int -> Bool
$ctestBit :: Header -> Int -> Bool
complementBit :: Header -> Int -> Header
$ccomplementBit :: Header -> Int -> Header
clearBit :: Header -> Int -> Header
$cclearBit :: Header -> Int -> Header
setBit :: Header -> Int -> Header
$csetBit :: Header -> Int -> Header
bit :: Int -> Header
$cbit :: Int -> Header
zeroBits :: Header
$czeroBits :: Header
rotate :: Header -> Int -> Header
$crotate :: Header -> Int -> Header
shift :: Header -> Int -> Header
$cshift :: Header -> Int -> Header
complement :: Header -> Header
$ccomplement :: Header -> Header
xor :: Header -> Header -> Header
$cxor :: Header -> Header -> Header
.|. :: Header -> Header -> Header
$c.|. :: Header -> Header -> Header
.&. :: Header -> Header -> Header
$c.&. :: Header -> Header -> Header
Bits, Integer -> Header
Header -> Header
Header -> Header -> Header
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Header
$cfromInteger :: Integer -> Header
signum :: Header -> Header
$csignum :: Header -> Header
abs :: Header -> Header
$cabs :: Header -> Header
negate :: Header -> Header
$cnegate :: Header -> Header
* :: Header -> Header -> Header
$c* :: Header -> Header -> Header
- :: Header -> Header -> Header
$c- :: Header -> Header -> Header
+ :: Header -> Header -> Header
$c+ :: Header -> Header -> Header
Num)
instance Show Header where
show :: Header -> String
show (Header Word8
header) = (String
"0b" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Word8
2 Int -> Char
intToDigit Word8
header forall a b. (a -> b) -> a -> b
$ String
""
headerByron :: Header
= Header
0b10000010
isByronAddress :: Header -> Bool
isByronAddress :: Header -> Bool
isByronAddress = (forall a. Eq a => a -> a -> Bool
== Header
headerByron)
{-# INLINE isByronAddress #-}
headerNonShelleyBits :: Header
= Header
headerByron forall a. Bits a => a -> a -> a
.|. Header
0b00001100
headerNetworkId :: Header -> Network
Header
header
| Header
header forall a. Bits a => a -> Int -> Bool
`testBit` Int
0 = Network
Mainnet
| Bool
otherwise = Network
Testnet
{-# INLINE headerNetworkId #-}
headerIsPaymentScript :: Header -> Bool
= (forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerIsPaymentScript #-}
headerIsEnterpriseAddr :: Header -> Bool
= (forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsEnterpriseAddr #-}
headerIsStakingScript :: Header -> Bool
= (forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsStakingScript #-}
headerIsBaseAddress :: Header -> Bool
= Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Bits a => a -> Int -> Bool
`testBit` Int
6)
{-# INLINE headerIsBaseAddress #-}
decodeAddrEither ::
BS.ByteString ->
Either String Addr
decodeAddrEither :: ByteString -> Either String Addr
decodeAddrEither ByteString
bs = forall e a. (IsString e, Semigroup e) => Fail e a -> Either e a
runFail forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
decodeAddrStateT ByteString
bs) Int
0
{-# INLINE decodeAddrEither #-}
decodeAddr ::
forall m.
MonadFail m =>
BS.ByteString ->
m Addr
decodeAddr :: forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr ByteString
bs = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
decodeAddrStateT ByteString
bs) Int
0
{-# INLINE decodeAddr #-}
decodeAddrStateT ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m Addr
decodeAddrStateT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
decodeAddrStateT = forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
False Bool
False
{-# INLINE decodeAddrStateT #-}
decodeAddrStateLenientT ::
(MonadFail m, AddressBuffer b) =>
Bool ->
Bool ->
b ->
StateT Int m Addr
decodeAddrStateLenientT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
isPtrLenient Bool
isLenient b
buf = do
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
"Header" Int
1 b
buf
let header :: Header
header = Word8 -> Header
Header forall a b. (a -> b) -> a -> b
$ forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
Addr
addr <-
if Header -> Bool
isByronAddress Header
header
then BootstrapAddress -> Addr
AddrBootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m BootstrapAddress
decodeBootstrapAddress b
buf
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header
header forall a. Bits a => a -> a -> a
.&. Header
headerNonShelleyBits forall a. Eq a => a -> a -> Bool
== Header
0)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding
String
"Shelley Address"
forall a b. (a -> b) -> a -> b
$ String
"Invalid header. Unused bits are not suppose to be set: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Header
header
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Num a => a -> a -> a
+ Int
1)
PaymentCredential
payment <- forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m PaymentCredential
decodePaymentCredential Header
header b
buf
StakeReference
staking <- forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Header -> b -> StateT Int m StakeReference
decodeStakeReference Bool
isPtrLenient Header
header b
buf
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Network -> PaymentCredential -> StakeReference -> Addr
Addr (Header -> Network
headerNetworkId Header
header) PaymentCredential
payment StakeReference
staking
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isLenient forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m ()
ensureBufIsConsumed String
"Addr" b
buf
forall (f :: * -> *) a. Applicative f => a -> f a
pure Addr
addr
{-# INLINE decodeAddrStateLenientT #-}
ensureBufIsConsumed ::
forall m b.
(MonadFail m, AddressBuffer b) =>
String ->
b ->
StateT Int m ()
ensureBufIsConsumed :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m ()
ensureBufIsConsumed String
name b
buf = do
Int
lastOffset <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let len :: Int
len = forall b. AddressBuffer b => b -> Int
bufLength b
buf
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
lastOffset forall a. Eq a => a -> a -> Bool
== Int
len) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name forall a b. (a -> b) -> a -> b
$
String
"Left over bytes: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
len forall a. Num a => a -> a -> a
- Int
lastOffset)
{-# INLINE ensureBufIsConsumed #-}
decodeBootstrapAddress ::
forall m b.
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m BootstrapAddress
decodeBootstrapAddress :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m BootstrapAddress
decodeBootstrapAddress b
buf =
case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
byronProtVer forall a b. (a -> b) -> a -> b
$ forall b. AddressBuffer b => b -> ByteString
bufToByteString b
buf of
Left DecoderError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show DecoderError
e
Right Address
addr -> Address -> BootstrapAddress
BootstrapAddress Address
addr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Num a => a -> a -> a
+ forall b. AddressBuffer b => b -> Int
bufLength b
buf)
{-# INLINE decodeBootstrapAddress #-}
decodePaymentCredential ::
(MonadFail m, AddressBuffer b) =>
Header ->
b ->
StateT Int m PaymentCredential
decodePaymentCredential :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m PaymentCredential
decodePaymentCredential Header
header b
buf
| Header -> Bool
headerIsPaymentScript Header
header = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
| Bool
otherwise = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b (kr :: KeyRole).
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr)
decodeKeyHash b
buf
{-# INLINE decodePaymentCredential #-}
decodeStakeReference ::
(MonadFail m, AddressBuffer b) =>
Bool ->
Header ->
b ->
StateT Int m StakeReference
decodeStakeReference :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Header -> b -> StateT Int m StakeReference
decodeStakeReference Bool
isLenientPtrDecoder Header
header b
buf
| Header -> Bool
headerIsBaseAddress Header
header =
if Header -> Bool
headerIsStakingScript Header
header
then Credential 'Staking -> StakeReference
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
else Credential 'Staking -> StakeReference
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b (kr :: KeyRole).
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr)
decodeKeyHash b
buf
| Bool
otherwise =
if Header -> Bool
headerIsEnterpriseAddr Header
header
then forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull
else Ptr -> StakeReference
StakeRefPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
isLenientPtrDecoder then forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtrLenient b
buf else forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtr b
buf
{-# INLINE decodeStakeReference #-}
decodeKeyHash ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m (KeyHash kr)
decodeKeyHash :: forall (m :: * -> *) b (kr :: KeyRole).
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr)
decodeKeyHash b
buf = forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a h (m :: * -> *) b.
(HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Hash h a)
decodeHash b
buf
{-# INLINE decodeKeyHash #-}
decodeScriptHash ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m ScriptHash
decodeScriptHash :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf = Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a h (m :: * -> *) b.
(HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Hash h a)
decodeHash b
buf
{-# INLINE decodeScriptHash #-}
decodeHash ::
forall a h m b.
(Hash.HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b ->
StateT Int m (Hash.Hash h a)
decodeHash :: forall a h (m :: * -> *) b.
(HashAlgorithm h, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Hash h a)
decodeHash b
buf = do
Int
offset <- forall (m :: * -> *) s. Monad m => StateT s m s
get
case forall b h a.
(AddressBuffer b, HashAlgorithm h) =>
b -> Int -> Maybe (Hash h a)
bufGetHash b
buf Int
offset of
Just Hash h a
h -> Hash h a
h forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Num a => a -> a -> a
+ Int
hashLen)
Maybe (Hash h a)
Nothing
| Int
offset forall a. Ord a => a -> a -> Bool
>= Int
0 ->
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
"Hash" forall a b. (a -> b) -> a -> b
$
String
"Not enough bytes supplied: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall b. AddressBuffer b => b -> Int
bufLength b
buf forall a. Num a => a -> a -> a
- Int
offset)
forall a. [a] -> [a] -> [a]
++ String
". Expected: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
hashLen
Maybe (Hash h a)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible: Negative offset"
where
hashLen :: Int
hashLen :: Int
hashLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy h))
{-# INLINE decodeHash #-}
decodePtr ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m Ptr
decodePtr :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtr b
buf =
SlotNo -> TxIx -> CertIx -> Ptr
Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word32
decodeVariableLengthWord32 String
"SlotNo" b
buf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx
TxIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
"TxIx" b
buf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CertIx
CertIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
"CertIx" b
buf)
{-# INLINE decodePtr #-}
decodePtrLenient ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m Ptr
decodePtrLenient :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtrLenient b
buf =
SlotNo -> TxIx -> CertIx -> Ptr
Ptr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotNo
SlotNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
"SlotNo" b
buf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> TxIx
TxIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
"TxIx" b
buf)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> CertIx
CertIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
"CertIx" b
buf)
{-# INLINE decodePtrLenient #-}
guardLength ::
(MonadFail m, AddressBuffer b) =>
String ->
Int ->
b ->
StateT Int m ()
guardLength :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
name Int
expectedLength b
buf = do
Int
offset <- forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset forall a. Ord a => a -> a -> Bool
> forall b. AddressBuffer b => b -> Int
bufLength b
buf forall a. Num a => a -> a -> a
- Int
expectedLength) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"Not enough bytes for decoding"
{-# INLINE guardLength #-}
decode7BitVarLength ::
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String ->
b ->
(a -> StateT Int m a) ->
a ->
StateT Int m a
decode7BitVarLength :: forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf a -> StateT Int m a
cont !a
acc = do
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
name Int
1 b
buf
Int
offset <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\Int
off -> (Int
off, Int
off forall a. Num a => a -> a -> a
+ Int
1))
let b8 :: Word8
b8 = forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
offset
if Word8
b8 forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
then a -> StateT Int m a
cont (a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
7 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b8 forall a. Bits a => a -> Int -> a
`clearBit` Int
7))
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
7 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b8)
{-# INLINE decode7BitVarLength #-}
failDecoding :: MonadFail m => String -> String -> m a
failDecoding :: forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
msg = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Decoding " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg
{-# NOINLINE failDecoding #-}
decodeVariableLengthWord16 ::
forall m b.
(MonadFail m, AddressBuffer b) =>
String ->
b ->
StateT Int m Word16
decodeVariableLengthWord16 :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
name b
buf = do
Int
off0 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let d7 :: (Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 = forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf
d7last :: Word16 -> StateT Int m Word16
d7last :: Word16 -> StateT Int m Word16
d7last Word16
acc = do
Word16
res <- forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf (\Word16
_ -> forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"too many bytes.") Word16
acc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
off0 forall a. Bits a => a -> a -> a
.&. Word8
0b11111100 forall a. Eq a => a -> a -> Bool
== Word8
0b10000000) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"More than 16bits was supplied"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
res
(Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 ((Word16 -> StateT Int m Word16) -> Word16 -> StateT Int m Word16
d7 Word16 -> StateT Int m Word16
d7last) Word16
0
{-# INLINE decodeVariableLengthWord16 #-}
decodeVariableLengthWord32 ::
forall m b.
(MonadFail m, AddressBuffer b) =>
String ->
b ->
StateT Int m Word32
decodeVariableLengthWord32 :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word32
decodeVariableLengthWord32 String
name b
buf = do
Int
off0 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let d7 :: (Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 = forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf
{-# INLINE d7 #-}
d7last :: Word32 -> StateT Int m Word32
d7last :: Word32 -> StateT Int m Word32
d7last Word32
acc = do
Word32
res <- forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf (\Word32
_ -> forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"too many bytes.") Word32
acc
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
off0 forall a. Bits a => a -> a -> a
.&. Word8
0b11110000 forall a. Eq a => a -> a -> Bool
== Word8
0b10000000) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
name String
"More than 32bits was supplied"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
res
{-# INLINE d7last #-}
(Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 ((Word32 -> StateT Int m Word32) -> Word32 -> StateT Int m Word32
d7 Word32 -> StateT Int m Word32
d7last))) Word32
0
{-# INLINE decodeVariableLengthWord32 #-}
decodeVariableLengthWord64 ::
forall m b.
(MonadFail m, AddressBuffer b) =>
String ->
b ->
StateT Int m Word64
decodeVariableLengthWord64 :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
name b
buf = forall a. (a -> a) -> a
fix (forall a b (m :: * -> *).
(Num a, Bits a, AddressBuffer b, MonadFail m) =>
String -> b -> (a -> StateT Int m a) -> a -> StateT Int m a
decode7BitVarLength String
name b
buf) Word64
0
{-# INLINE decodeVariableLengthWord64 #-}
decodeRewardAccount ::
forall b m.
(AddressBuffer b, MonadFail m) =>
b ->
m RewardAccount
decodeRewardAccount :: forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m RewardAccount
decodeRewardAccount b
buf = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m RewardAccount
decodeRewardAccountT b
buf) Int
0
fromCborRewardAccount :: Decoder s RewardAccount
fromCborRewardAccount :: forall s. Decoder s RewardAccount
fromCborRewardAccount = do
ShortByteString
sbs :: ShortByteString <- forall a s. DecCBOR a => Decoder s a
decCBOR
forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m RewardAccount
decodeRewardAccount ShortByteString
sbs
headerIsRewardAccount :: Header -> Bool
Header
header = Header
header forall a. Bits a => a -> a -> a
.&. Header
0b11101110 forall a. Eq a => a -> a -> Bool
== Header
0b11100000
{-# INLINE headerIsRewardAccount #-}
headerRewardAccountIsScript :: Header -> Bool
= (forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerRewardAccountIsScript #-}
decodeRewardAccountT ::
(MonadFail m, AddressBuffer b) =>
b ->
StateT Int m RewardAccount
decodeRewardAccountT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m RewardAccount
decodeRewardAccountT b
buf = do
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
"Header" Int
1 b
buf
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Num a => a -> a -> a
+ Int
1)
let header :: Header
header = Word8 -> Header
Header forall a b. (a -> b) -> a -> b
$ forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header -> Bool
headerIsRewardAccount Header
header) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
String
"Invalid header for the reward account: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Header
header
Credential 'Staking
account <-
if Header -> Bool
headerRewardAccountIsScript Header
header
then forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
else forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b (kr :: KeyRole).
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr)
decodeKeyHash b
buf
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m ()
ensureBufIsConsumed String
"RewardsAcnt" b
buf
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Network -> Credential 'Staking -> RewardAccount
RewardAccount (Header -> Network
headerNetworkId Header
header) Credential 'Staking
account
{-# INLINE decodeRewardAccountT #-}
instance EncCBOR CompactAddr where
encCBOR :: CompactAddr -> Encoding
encCBOR (UnsafeCompactAddr ShortByteString
bytes) = forall a. EncCBOR a => a -> Encoding
encCBOR ShortByteString
bytes
{-# INLINE encCBOR #-}
instance DecCBOR CompactAddr where
decCBOR :: forall s. Decoder s CompactAddr
decCBOR = forall s. Decoder s CompactAddr
fromCborCompactAddr
{-# INLINE decCBOR #-}
isPayCredScriptCompactAddr :: CompactAddr -> Bool
isPayCredScriptCompactAddr :: CompactAddr -> Bool
isPayCredScriptCompactAddr (UnsafeCompactAddr ShortByteString
bytes) =
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ShortByteString -> Int -> Word8
SBS.index ShortByteString
bytes Int
0) Int
payCredIsScript
isBootstrapCompactAddr :: CompactAddr -> Bool
isBootstrapCompactAddr :: CompactAddr -> Bool
isBootstrapCompactAddr (UnsafeCompactAddr ShortByteString
bytes) = forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ShortByteString -> Int -> Word8
SBS.index ShortByteString
bytes Int
0) Int
byron
fromBoostrapCompactAddress :: Byron.CompactAddress -> CompactAddr
fromBoostrapCompactAddress :: CompactAddress -> CompactAddr
fromBoostrapCompactAddress = ShortByteString -> CompactAddr
UnsafeCompactAddr forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactAddress -> ShortByteString
Byron.unsafeGetCompactAddress
newtype Withdrawals = Withdrawals {Withdrawals -> Map RewardAccount Coin
unWithdrawals :: Map RewardAccount Coin}
deriving (Int -> Withdrawals -> ShowS
[Withdrawals] -> ShowS
Withdrawals -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Withdrawals] -> ShowS
$cshowList :: [Withdrawals] -> ShowS
show :: Withdrawals -> String
$cshow :: Withdrawals -> String
showsPrec :: Int -> Withdrawals -> ShowS
$cshowsPrec :: Int -> Withdrawals -> ShowS
Show, Withdrawals -> Withdrawals -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Withdrawals -> Withdrawals -> Bool
$c/= :: Withdrawals -> Withdrawals -> Bool
== :: Withdrawals -> Withdrawals -> Bool
$c== :: Withdrawals -> Withdrawals -> Bool
Eq, forall x. Rep Withdrawals x -> Withdrawals
forall x. Withdrawals -> Rep Withdrawals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Withdrawals x -> Withdrawals
$cfrom :: forall x. Withdrawals -> Rep Withdrawals x
Generic)
deriving newtype (Context -> Withdrawals -> IO (Maybe ThunkInfo)
Proxy Withdrawals -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Withdrawals -> String
$cshowTypeOf :: Proxy Withdrawals -> String
wNoThunks :: Context -> Withdrawals -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Withdrawals -> IO (Maybe ThunkInfo)
noThunks :: Context -> Withdrawals -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Withdrawals -> IO (Maybe ThunkInfo)
NoThunks, Withdrawals -> ()
forall a. (a -> ()) -> NFData a
rnf :: Withdrawals -> ()
$crnf :: Withdrawals -> ()
NFData, Typeable Withdrawals
Withdrawals -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy Withdrawals -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy Withdrawals -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy Withdrawals -> Size
encCBOR :: Withdrawals -> Encoding
$cencCBOR :: Withdrawals -> Encoding
EncCBOR, Typeable Withdrawals
Proxy Withdrawals -> Text
forall s. Decoder s Withdrawals
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy Withdrawals -> Decoder s ()
label :: Proxy Withdrawals -> Text
$clabel :: Proxy Withdrawals -> Text
dropCBOR :: forall s. Proxy Withdrawals -> Decoder s ()
$cdropCBOR :: forall s. Proxy Withdrawals -> Decoder s ()
decCBOR :: forall s. Decoder s Withdrawals
$cdecCBOR :: forall s. Decoder s Withdrawals
DecCBOR)