{-# 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 (
  mkRwdAcnt,
  serialiseAddr,
  deserialiseAddr,
  Addr (..),
  addrPtrNormalize,
  BootstrapAddress (..),
  bootstrapAddressAttrsSize,
  isBootstrapRedeemer,
  getNetwork,
  RewardAccount (.., RewardAcnt, getRwdNetwork, getRwdCred),
  serialiseRewardAccount,
  deserialiseRewardAccount,
  bootstrapKeyHash,
  -- internals exported for testing
  putAddr,
  putCredential,
  putPtr,
  putRewardAccount,
  putVariableLengthWord64,
  Word7 (..),
  toWord7,

  -- * Compact Address
  fromBoostrapCompactAddress,
  compactAddr,
  decompactAddr,
  CompactAddr,
  unCompactAddr,
  isPayCredScriptCompactAddr,
  isBootstrapCompactAddr,
  decodeAddr,
  decodeAddrEither,
  decodeAddrStateT,
  decodeAddrStateLenientT,
  fromCborAddr,
  fromCborBothAddr,
  fromCborCompactAddr,
  fromCborBackwardsBothAddr,
  decodeRewardAccount,
  fromCborRewardAccount,
  Withdrawals (..),

  -- * Deprecations
  RewardAcnt,
  serialiseRewardAcnt,
  deserialiseRewardAcnt,
  putRewardAcnt,
  decodeRewardAcnt,
  fromCborRewardAcnt,
  rewardAccountCredentialL,
  rewardAccountNetworkL,
)
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.Crypto (Crypto)
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.Class (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))

mkRwdAcnt ::
  Network ->
  Credential 'Staking c ->
  RewardAcnt c
mkRwdAcnt :: forall c. Network -> Credential 'Staking c -> RewardAcnt c
mkRwdAcnt Network
network script :: Credential 'Staking c
script@(ScriptHashObj ScriptHash c
_) = forall c. Network -> Credential 'Staking c -> RewardAcnt c
RewardAcnt Network
network Credential 'Staking c
script
mkRwdAcnt Network
network key :: Credential 'Staking c
key@(KeyHashObj KeyHash 'Staking c
_) = forall c. Network -> Credential 'Staking c -> RewardAcnt c
RewardAcnt Network
network Credential 'Staking c
key
{-# DEPRECATED mkRwdAcnt "In favor of `RewardAcnt`" #-}

-- | Serialise an address to the external format.
serialiseAddr :: Addr c -> ByteString
serialiseAddr :: forall c. Addr c -> 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
. forall c. Addr c -> Put
putAddr
{-# INLINE serialiseAddr #-}

-- | Deserialise an address from the external format. This will fail if the
-- input data is not in the right format (or if there is trailing data).
deserialiseAddr :: Crypto c => ByteString -> Maybe (Addr c)
deserialiseAddr :: forall c. Crypto c => ByteString -> Maybe (Addr c)
deserialiseAddr = forall c (m :: * -> *).
(Crypto c, MonadFail m) =>
ByteString -> m (Addr c)
decodeAddr
{-# INLINE deserialiseAddr #-}
{-# DEPRECATED
  deserialiseAddr
  "In favor of `Cardano.Ledger.Api.Tx.Address.decodeAddr` or `Cardano.Ledger.Api.Tx.Address.decodeAddrLenient`. Please choose the appropriate variant carefully depending on your use case"
  #-}

-- | Serialise a reward account to the external format.
serialiseRewardAccount :: RewardAcnt c -> ByteString
serialiseRewardAccount :: forall c. RewardAcnt c -> 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
. forall c. RewardAcnt c -> Put
putRewardAcnt

serialiseRewardAcnt :: RewardAcnt c -> ByteString
serialiseRewardAcnt :: forall c. RewardAcnt c -> ByteString
serialiseRewardAcnt = forall c. RewardAcnt c -> ByteString
serialiseRewardAccount
{-# INLINE serialiseRewardAcnt #-}
{-# DEPRECATED serialiseRewardAcnt "Use `serialiseRewardAccount` instead" #-}

-- | Deserialise a reward account from the external format. This will fail if the
-- input data is not in the right format (or if there is trailing data).
deserialiseRewardAccount :: Crypto c => ByteString -> Maybe (RewardAcnt c)
deserialiseRewardAccount :: forall c. Crypto c => ByteString -> Maybe (RewardAcnt c)
deserialiseRewardAccount = forall c b (m :: * -> *).
(Crypto c, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt c)
decodeRewardAcnt

deserialiseRewardAcnt :: Crypto c => ByteString -> Maybe (RewardAcnt c)
deserialiseRewardAcnt :: forall c. Crypto c => ByteString -> Maybe (RewardAcnt c)
deserialiseRewardAcnt = forall c. Crypto c => ByteString -> Maybe (RewardAcnt c)
deserialiseRewardAccount
{-# INLINE deserialiseRewardAcnt #-}
{-# DEPRECATED deserialiseRewardAcnt "Use `deserialiseRewardAccount` instead" #-}

-- | An address for UTxO.
--
-- Contents of Addr data type are intentionally left as lazy, otherwise
-- operating on compact form of an address will result in redundant work.
data Addr c
  = Addr Network (PaymentCredential c) (StakeReference c)
  | AddrBootstrap (BootstrapAddress c)
  deriving (Int -> Addr c -> ShowS
forall c. Int -> Addr c -> ShowS
forall c. [Addr c] -> ShowS
forall c. Addr c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Addr c] -> ShowS
$cshowList :: forall c. [Addr c] -> ShowS
show :: Addr c -> String
$cshow :: forall c. Addr c -> String
showsPrec :: Int -> Addr c -> ShowS
$cshowsPrec :: forall c. Int -> Addr c -> ShowS
Show, Addr c -> Addr c -> Bool
forall c. Addr c -> Addr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Addr c -> Addr c -> Bool
$c/= :: forall c. Addr c -> Addr c -> Bool
== :: Addr c -> Addr c -> Bool
$c== :: forall c. Addr c -> Addr c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (Addr c) x -> Addr c
forall c x. Addr c -> Rep (Addr c) x
$cto :: forall c x. Rep (Addr c) x -> Addr c
$cfrom :: forall c x. Addr c -> Rep (Addr c) x
Generic, forall c. Addr c -> ()
forall a. (a -> ()) -> NFData a
rnf :: Addr c -> ()
$crnf :: forall c. Addr c -> ()
NFData, Addr c -> Addr c -> Bool
Addr c -> Addr c -> Ordering
forall c. Eq (Addr c)
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
forall c. Addr c -> Addr c -> Bool
forall c. Addr c -> Addr c -> Ordering
forall c. Addr c -> Addr c -> Addr c
min :: Addr c -> Addr c -> Addr c
$cmin :: forall c. Addr c -> Addr c -> Addr c
max :: Addr c -> Addr c -> Addr c
$cmax :: forall c. Addr c -> Addr c -> Addr c
>= :: Addr c -> Addr c -> Bool
$c>= :: forall c. Addr c -> Addr c -> Bool
> :: Addr c -> Addr c -> Bool
$c> :: forall c. Addr c -> Addr c -> Bool
<= :: Addr c -> Addr c -> Bool
$c<= :: forall c. Addr c -> Addr c -> Bool
< :: Addr c -> Addr c -> Bool
$c< :: forall c. Addr c -> Addr c -> Bool
compare :: Addr c -> Addr c -> Ordering
$ccompare :: forall c. Addr c -> Addr c -> Ordering
Ord)

-- | Lookup a Network Id for an Address
getNetwork :: Addr c -> Network
getNetwork :: forall c. Addr c -> Network
getNetwork (Addr Network
n PaymentCredential c
_ StakeReference c
_) = 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 c)

-- | This function is implemented solely for the purpose of translating garbage pointers
-- into knowingly invalid ones. Any pointer that contains a SlotNo, TxIx or CertIx that
-- is too large to fit into Word32, Word16 and Word16 respectively, will have all of its
-- values set to 0 using `normalizePtr`.
--
-- There are two reasons why we can safely do that at the Babbage/Conway era boundary:
--
-- * Invalid pointers are no longer allowed in transactions starting with Babbage era
--
-- * There are only a handful of `Ptr`s on mainnet that are invalid.
--
-- Once the transition is complete and we are officially in Conway era, this translation
-- logic can be removed in favor of a fixed deserializer that does the same thing for all
-- eras prior to Babbage.
addrPtrNormalize :: Addr c -> Addr c
addrPtrNormalize :: forall c. Addr c -> Addr c
addrPtrNormalize = \case
  Addr Network
n PaymentCredential c
cred (StakeRefPtr Ptr
ptr) -> forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr Network
n PaymentCredential c
cred (forall c. Ptr -> StakeReference c
StakeRefPtr (Ptr -> Ptr
normalizePtr Ptr
ptr))
  Addr c
addr -> Addr c
addr

-- | An account based address for rewards
data RewardAccount c = RewardAccount
  { forall c. RewardAccount c -> Network
raNetwork :: !Network
  , forall c. RewardAccount c -> Credential 'Staking c
raCredential :: !(Credential 'Staking c)
  }
  deriving (Int -> RewardAccount c -> ShowS
forall c. Int -> RewardAccount c -> ShowS
forall c. [RewardAccount c] -> ShowS
forall c. RewardAccount c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RewardAccount c] -> ShowS
$cshowList :: forall c. [RewardAccount c] -> ShowS
show :: RewardAccount c -> String
$cshow :: forall c. RewardAccount c -> String
showsPrec :: Int -> RewardAccount c -> ShowS
$cshowsPrec :: forall c. Int -> RewardAccount c -> ShowS
Show, RewardAccount c -> RewardAccount c -> Bool
forall c. RewardAccount c -> RewardAccount c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RewardAccount c -> RewardAccount c -> Bool
$c/= :: forall c. RewardAccount c -> RewardAccount c -> Bool
== :: RewardAccount c -> RewardAccount c -> Bool
$c== :: forall c. RewardAccount c -> RewardAccount c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (RewardAccount c) x -> RewardAccount c
forall c x. RewardAccount c -> Rep (RewardAccount c) x
$cto :: forall c x. Rep (RewardAccount c) x -> RewardAccount c
$cfrom :: forall c x. RewardAccount c -> Rep (RewardAccount c) x
Generic, RewardAccount c -> RewardAccount c -> Bool
RewardAccount c -> RewardAccount c -> Ordering
forall c. Eq (RewardAccount c)
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
forall c. RewardAccount c -> RewardAccount c -> Bool
forall c. RewardAccount c -> RewardAccount c -> Ordering
forall c. RewardAccount c -> RewardAccount c -> RewardAccount c
min :: RewardAccount c -> RewardAccount c -> RewardAccount c
$cmin :: forall c. RewardAccount c -> RewardAccount c -> RewardAccount c
max :: RewardAccount c -> RewardAccount c -> RewardAccount c
$cmax :: forall c. RewardAccount c -> RewardAccount c -> RewardAccount c
>= :: RewardAccount c -> RewardAccount c -> Bool
$c>= :: forall c. RewardAccount c -> RewardAccount c -> Bool
> :: RewardAccount c -> RewardAccount c -> Bool
$c> :: forall c. RewardAccount c -> RewardAccount c -> Bool
<= :: RewardAccount c -> RewardAccount c -> Bool
$c<= :: forall c. RewardAccount c -> RewardAccount c -> Bool
< :: RewardAccount c -> RewardAccount c -> Bool
$c< :: forall c. RewardAccount c -> RewardAccount c -> Bool
compare :: RewardAccount c -> RewardAccount c -> Ordering
$ccompare :: forall c. RewardAccount c -> RewardAccount c -> Ordering
Ord, forall c. RewardAccount c -> ()
forall a. (a -> ()) -> NFData a
rnf :: RewardAccount c -> ()
$crnf :: forall c. RewardAccount c -> ()
NFData, forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
forall c. Crypto c => ToJSONKeyFunction [RewardAccount c]
forall c. Crypto c => ToJSONKeyFunction (RewardAccount c)
toJSONKeyList :: ToJSONKeyFunction [RewardAccount c]
$ctoJSONKeyList :: forall c. Crypto c => ToJSONKeyFunction [RewardAccount c]
toJSONKey :: ToJSONKeyFunction (RewardAccount c)
$ctoJSONKey :: forall c. Crypto c => ToJSONKeyFunction (RewardAccount c)
ToJSONKey, forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
forall c. Crypto c => FromJSONKeyFunction [RewardAccount c]
forall c. Crypto c => FromJSONKeyFunction (RewardAccount c)
fromJSONKeyList :: FromJSONKeyFunction [RewardAccount c]
$cfromJSONKeyList :: forall c. Crypto c => FromJSONKeyFunction [RewardAccount c]
fromJSONKey :: FromJSONKeyFunction (RewardAccount c)
$cfromJSONKey :: forall c. Crypto c => FromJSONKeyFunction (RewardAccount c)
FromJSONKey)

rewardAccountCredentialL :: Lens' (RewardAccount c) (Credential 'Staking c)
rewardAccountCredentialL :: forall c. Lens' (RewardAccount c) (Credential 'Staking c)
rewardAccountCredentialL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. RewardAccount c -> Credential 'Staking c
raCredential forall a b. (a -> b) -> a -> b
$ \RewardAccount c
x Credential 'Staking c
y -> RewardAccount c
x {raCredential :: Credential 'Staking c
raCredential = Credential 'Staking c
y}

rewardAccountNetworkL :: Lens' (RewardAccount c) Network
rewardAccountNetworkL :: forall c. Lens' (RewardAccount c) Network
rewardAccountNetworkL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. RewardAccount c -> Network
raNetwork forall a b. (a -> b) -> a -> b
$ \RewardAccount c
x Network
y -> RewardAccount c
x {raNetwork :: Network
raNetwork = Network
y}

pattern RewardAcnt :: Network -> Credential 'Staking c -> RewardAccount c
pattern $bRewardAcnt :: forall c. Network -> Credential 'Staking c -> RewardAcnt c
$mRewardAcnt :: forall {r} {c}.
RewardAccount c
-> (Network -> Credential 'Staking c -> r) -> ((# #) -> r) -> r
RewardAcnt {forall c. RewardAccount c -> Network
getRwdNetwork, forall c. RewardAccount c -> Credential 'Staking c
getRwdCred} = RewardAccount getRwdNetwork getRwdCred

{-# DEPRECATED getRwdNetwork "In favor of `raNetwork`" #-}
{-# DEPRECATED getRwdCred "In favor of `raCredential`" #-}

{-# COMPLETE RewardAcnt #-}

type RewardAcnt = RewardAccount

{-# DEPRECATED RewardAcnt "Use `RewardAccount` instead" #-}

instance Crypto c => Default (RewardAcnt c) where
  def :: RewardAcnt c
def = forall c. Network -> Credential 'Staking c -> RewardAcnt c
RewardAcnt forall a. Default a => a
def forall a. Default a => a
def

instance Crypto c => ToJSON (RewardAcnt c) where
  toJSON :: RewardAcnt c -> Value
toJSON RewardAcnt c
ra =
    [Pair] -> Value
Aeson.object
      [ Key
"network" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall c. RewardAccount c -> Network
raNetwork RewardAcnt c
ra
      , Key
"credential" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAcnt c
ra
      ]

instance Crypto c => FromJSON (RewardAcnt c) where
  parseJSON :: Value -> Parser (RewardAcnt c)
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"RewardAcnt" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      forall c. Network -> Credential 'Staking c -> RewardAcnt c
RewardAcnt
        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 (RewardAcnt c)

instance ToJSONKey (Addr c) where
  toJSONKey :: ToJSONKeyFunction (Addr c)
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
. forall c. Addr c -> Text
addrToText) (forall a. Text -> Encoding' a
Aeson.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Addr c -> Text
addrToText)

instance Crypto c => FromJSONKey (Addr c) where
  fromJSONKey :: FromJSONKeyFunction (Addr c)
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser forall c. Crypto c => Text -> Parser (Addr c)
parseAddr

instance ToJSON (Addr c) where
  toJSON :: Addr c -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Addr c -> Text
addrToText

instance Crypto c => FromJSON (Addr c) where
  parseJSON :: Value -> Parser (Addr c)
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"address" forall c. Crypto c => Text -> Parser (Addr c)
parseAddr

addrToText :: Addr c -> Text
addrToText :: forall c. Addr c -> 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
. forall c. Addr c -> ByteString
serialiseAddr

parseAddr :: Crypto c => Text -> Aeson.Parser (Addr c)
parseAddr :: forall c. Crypto c => Text -> Parser (Addr c)
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 b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. Parser a
badFormat forall (m :: * -> *) a. Monad m => a -> m a
return (forall c. Crypto c => ByteString -> Maybe (Addr c)
deserialiseAddr 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
    badFormat :: Parser a
badFormat = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Address is not in the right format"

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 c -> Put
putAddr :: forall c. Addr c -> 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 c
pc StakeReference c
sr) =
  let setPayCredBit :: Word8 -> Word8
setPayCredBit = case PaymentCredential c
pc of
        ScriptHashObj ScriptHash c
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
        KeyHashObj KeyHash 'Payment c
_ -> forall a. a -> a
id
      netId :: Word8
netId = Network -> Word8
networkToWord8 Network
network
   in case StakeReference c
sr of
        StakeRefBase StakeCredential c
sc -> do
          let setStakeCredBit :: Word8 -> Word8
setStakeCredBit = case StakeCredential c
sc of
                ScriptHashObj ScriptHash c
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
stakeCredIsScript
                KeyHashObj KeyHash 'Staking c
_ -> 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) c. Credential kr c -> Put
putCredential PaymentCredential c
pc
          forall (kr :: KeyRole) c. Credential kr c -> Put
putCredential StakeCredential c
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) c. Credential kr c -> Put
putCredential PaymentCredential c
pc
          Ptr -> Put
putPtr Ptr
ptr
        StakeReference c
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) c. Credential kr c -> Put
putCredential PaymentCredential c
pc
{-# INLINE putAddr #-}

putRewardAccount :: RewardAcnt c -> Put
putRewardAccount :: forall c. RewardAcnt c -> Put
putRewardAccount (RewardAcnt Network
network Credential 'Staking c
cred) = do
  let setPayCredBit :: Word8 -> Word8
setPayCredBit = case Credential 'Staking c
cred of
        ScriptHashObj ScriptHash c
_ -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
        KeyHashObj KeyHash 'Staking c
_ -> forall a. a -> a
id
      netId :: Word8
netId = Network -> Word8
networkToWord8 Network
network
      rewardAccountPrefix :: Word8
rewardAccountPrefix = Word8
0xE0 -- 0b11100000 are always set for reward accounts
      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) c. Credential kr c -> Put
putCredential Credential 'Staking c
cred
putRewardAcnt :: RewardAcnt c -> Put
putRewardAcnt :: forall c. RewardAcnt c -> Put
putRewardAcnt = forall c. RewardAcnt c -> Put
putRewardAccount
{-# INLINE putRewardAcnt #-}
{-# DEPRECATED putRewardAcnt "Use `putRewardAccount` instead" #-}

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 c -> Put
putCredential :: forall (kr :: KeyRole) c. Credential kr c -> Put
putCredential (ScriptHashObj (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h)) = forall h a. Hash h a -> Put
putHash Hash (ADDRHASH c) EraIndependentScript
h
putCredential (KeyHashObj (KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h)) = forall h a. Hash h a -> Put
putHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
h
{-# INLINE putCredential #-}

-- | The size of the extra attributes in a bootstrap (ie Byron) address. Used
-- to help enforce that people do not post huge ones on the chain.
bootstrapAddressAttrsSize :: BootstrapAddress c -> Int
bootstrapAddressAttrsSize :: forall c. BootstrapAddress c -> Int
bootstrapAddressAttrsSize (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

-- | Return True if a given address is a redeemer address from the Byron Era
isBootstrapRedeemer :: BootstrapAddress c -> Bool
isBootstrapRedeemer :: forall c. BootstrapAddress c -> Bool
isBootstrapRedeemer (BootstrapAddress (Byron.Address AddressHash Address'
_ Attributes AddrAttributes
_ AddrType
Byron.ATRedeem)) = Bool
True
isBootstrapRedeemer BootstrapAddress c
_ = 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) -- 0x7F = 0b01111111

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 Crypto c => EncCBOR (Addr c) where
  encCBOR :: Addr c -> 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
. forall c. Addr c -> Put
putAddr
  {-# INLINE encCBOR #-}

instance Crypto c => DecCBOR (Addr c) where
  decCBOR :: forall s. Decoder s (Addr c)
decCBOR = forall c s. Crypto c => Decoder s (Addr c)
fromCborAddr
  {-# INLINE decCBOR #-}

instance Crypto c => EncCBOR (RewardAcnt c) where
  encCBOR :: RewardAcnt c -> 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
. forall c. RewardAcnt c -> Put
putRewardAcnt
  {-# INLINE encCBOR #-}

instance Crypto c => DecCBOR (RewardAcnt c) where
  decCBOR :: forall s. Decoder s (RewardAcnt c)
decCBOR = forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAcnt
  {-# INLINE decCBOR #-}

newtype BootstrapAddress c = BootstrapAddress
  { forall c. BootstrapAddress c -> Address
unBootstrapAddress :: Byron.Address
  }
  deriving (BootstrapAddress c -> BootstrapAddress c -> Bool
forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c/= :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
== :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c== :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (BootstrapAddress c) x -> BootstrapAddress c
forall c x. BootstrapAddress c -> Rep (BootstrapAddress c) x
$cto :: forall c x. Rep (BootstrapAddress c) x -> BootstrapAddress c
$cfrom :: forall c x. BootstrapAddress c -> Rep (BootstrapAddress c) x
Generic)
  deriving newtype (BootstrapAddress c -> ()
forall c. BootstrapAddress c -> ()
forall a. (a -> ()) -> NFData a
rnf :: BootstrapAddress c -> ()
$crnf :: forall c. BootstrapAddress c -> ()
NFData, BootstrapAddress c -> BootstrapAddress c -> Bool
BootstrapAddress c -> BootstrapAddress c -> Ordering
BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
forall c. Eq (BootstrapAddress c)
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
forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
forall c. BootstrapAddress c -> BootstrapAddress c -> Ordering
forall c.
BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
min :: BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
$cmin :: forall c.
BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
max :: BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
$cmax :: forall c.
BootstrapAddress c -> BootstrapAddress c -> BootstrapAddress c
>= :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c>= :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
> :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c> :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
<= :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c<= :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
< :: BootstrapAddress c -> BootstrapAddress c -> Bool
$c< :: forall c. BootstrapAddress c -> BootstrapAddress c -> Bool
compare :: BootstrapAddress c -> BootstrapAddress c -> Ordering
$ccompare :: forall c. BootstrapAddress c -> BootstrapAddress c -> Ordering
Ord)
  deriving (Int -> BootstrapAddress c -> ShowS
[BootstrapAddress c] -> ShowS
BootstrapAddress c -> String
forall c. Int -> BootstrapAddress c -> ShowS
forall c. [BootstrapAddress c] -> ShowS
forall c. BootstrapAddress c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapAddress c] -> ShowS
$cshowList :: forall c. [BootstrapAddress c] -> ShowS
show :: BootstrapAddress c -> String
$cshow :: forall c. BootstrapAddress c -> String
showsPrec :: Int -> BootstrapAddress c -> ShowS
$cshowsPrec :: forall c. Int -> BootstrapAddress c -> ShowS
Show) via Quiet (BootstrapAddress c)

instance NoThunks (BootstrapAddress c)

bootstrapKeyHash ::
  forall c.
  Crypto c =>
  -- TODO: enforce this constraint
  -- (HASH era ~ Hash.Blake2b_224) =>
  BootstrapAddress c ->
  KeyHash 'Payment c
bootstrapKeyHash :: forall c. Crypto c => BootstrapAddress c -> KeyHash 'Payment c
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 c) (VerKeyDSIGN (DSIGN c))
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 (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
hash

------------------------------------------------------------------------------------------
-- Compact Address -----------------------------------------------------------------------
------------------------------------------------------------------------------------------

newtype CompactAddr c = UnsafeCompactAddr ShortByteString
  deriving stock (CompactAddr c -> CompactAddr c -> Bool
forall c. CompactAddr c -> CompactAddr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactAddr c -> CompactAddr c -> Bool
$c/= :: forall c. CompactAddr c -> CompactAddr c -> Bool
== :: CompactAddr c -> CompactAddr c -> Bool
$c== :: forall c. CompactAddr c -> CompactAddr c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (CompactAddr c) x -> CompactAddr c
forall c x. CompactAddr c -> Rep (CompactAddr c) x
$cto :: forall c x. Rep (CompactAddr c) x -> CompactAddr c
$cfrom :: forall c x. CompactAddr c -> Rep (CompactAddr c) x
Generic, CompactAddr c -> CompactAddr c -> Bool
CompactAddr c -> CompactAddr c -> Ordering
forall c. Eq (CompactAddr c)
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
forall c. CompactAddr c -> CompactAddr c -> Bool
forall c. CompactAddr c -> CompactAddr c -> Ordering
forall c. CompactAddr c -> CompactAddr c -> CompactAddr c
min :: CompactAddr c -> CompactAddr c -> CompactAddr c
$cmin :: forall c. CompactAddr c -> CompactAddr c -> CompactAddr c
max :: CompactAddr c -> CompactAddr c -> CompactAddr c
$cmax :: forall c. CompactAddr c -> CompactAddr c -> CompactAddr c
>= :: CompactAddr c -> CompactAddr c -> Bool
$c>= :: forall c. CompactAddr c -> CompactAddr c -> Bool
> :: CompactAddr c -> CompactAddr c -> Bool
$c> :: forall c. CompactAddr c -> CompactAddr c -> Bool
<= :: CompactAddr c -> CompactAddr c -> Bool
$c<= :: forall c. CompactAddr c -> CompactAddr c -> Bool
< :: CompactAddr c -> CompactAddr c -> Bool
$c< :: forall c. CompactAddr c -> CompactAddr c -> Bool
compare :: CompactAddr c -> CompactAddr c -> Ordering
$ccompare :: forall c. CompactAddr c -> CompactAddr c -> Ordering
Ord)
  deriving newtype (Context -> CompactAddr c -> IO (Maybe ThunkInfo)
Proxy (CompactAddr c) -> String
forall c. Context -> CompactAddr c -> IO (Maybe ThunkInfo)
forall c. Proxy (CompactAddr c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CompactAddr c) -> String
$cshowTypeOf :: forall c. Proxy (CompactAddr c) -> String
wNoThunks :: Context -> CompactAddr c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> CompactAddr c -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactAddr c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> CompactAddr c -> IO (Maybe ThunkInfo)
NoThunks, CompactAddr c -> ()
forall c. CompactAddr c -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactAddr c -> ()
$crnf :: forall c. CompactAddr c -> ()
NFData)

instance Crypto c => Show (CompactAddr c) where
  show :: CompactAddr c -> String
show CompactAddr c
c = forall a. Show a => a -> String
show (forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr CompactAddr c
c)

-- | Unwrap the compact address and get to the address' binary representation.
unCompactAddr :: CompactAddr c -> ShortByteString
unCompactAddr :: forall c. CompactAddr c -> ShortByteString
unCompactAddr (UnsafeCompactAddr ShortByteString
sbs) = ShortByteString
sbs
{-# INLINE unCompactAddr #-}

compactAddr :: Addr c -> CompactAddr c
compactAddr :: forall c. Addr c -> CompactAddr c
compactAddr = forall c. ShortByteString -> CompactAddr c
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
. forall c. Addr c -> ByteString
serialiseAddr
{-# INLINE compactAddr #-}

decompactAddr :: forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
decompactAddr :: forall c. (HasCallStack, Crypto c) => CompactAddr c -> Addr c
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 c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m (Addr c)
decodeAddrStateLenientT Bool
True Bool
True ShortByteString
sbs) Int
0 of
    Right Addr c
addr -> Addr c
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 #-}

------------------------------------------------------------------------------------------
-- Address Serializer --------------------------------------------------------------------
------------------------------------------------------------------------------------------

-- | Decoder for an `Addr`. Works in all eras
fromCborAddr :: forall c s. Crypto c => Decoder s (Addr c)
fromCborAddr :: forall c s. Crypto c => Decoder s (Addr c)
fromCborAddr = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBothAddr
{-# INLINE fromCborAddr #-}

-- | Returns the actual bytes that represent an addres, while ensuring that they can
-- be decoded in any era as an `Addr` when need be.
fromCborCompactAddr :: forall c s. Crypto c => Decoder s (CompactAddr c)
fromCborCompactAddr :: forall c s. Crypto c => Decoder s (CompactAddr c)
fromCborCompactAddr = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBothAddr
{-# INLINE fromCborCompactAddr #-}

-- | This is the decoder for an address that returns both the actual `Addr` and the bytes,
-- that it was encoded as.
fromCborBothAddr :: forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBothAddr :: forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
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} {c}. Decoder s (Addr c, CompactAddr c)
decodeAddrRigorous forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBackwardsBothAddr
  where
    -- Starting with Babbage we no longer allow addresses with garbage in them.
    decodeAddrRigorous :: Decoder s (Addr c, CompactAddr c)
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 c
addr <- forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m (Addr c)
decodeAddrStateLenientT Bool
False Bool
False ShortByteString
sbs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr c
addr, forall c. ShortByteString -> CompactAddr c
UnsafeCompactAddr ShortByteString
sbs)
    {-# INLINE decodeAddrRigorous #-}
{-# INLINE fromCborBothAddr #-}

-- | Prior to Babbage era we did not check if a binary blob representing an address was
-- fully consumed, so unfortunately we must preserve this behavior. However, we do not
-- need to preserve the unconsumed bytes in memory, therefore we can to drop the
-- garbage after we successfully decoded the malformed address. We also need to allow
-- bogus pointer address to be deserializeable prior to Babbage era.
fromCborBackwardsBothAddr :: forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
fromCborBackwardsBothAddr :: forall c s. Crypto c => Decoder s (Addr c, CompactAddr c)
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 c
addr <- forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m (Addr c)
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 c
addr, forall c. ShortByteString -> CompactAddr c
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 #-}

-- | Address header byte truth table:
newtype Header = Header 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
""

-- | Every Byron address starts with @[TkListLen 2]@, which encodes as 130 (or 0x80)
headerByron :: Header
headerByron :: Header
headerByron = Header
0b10000010 -- 0x80

isByronAddress :: Header -> Bool
isByronAddress :: Header -> Bool
isByronAddress = (forall a. Eq a => a -> a -> Bool
== Header
headerByron)
{-# INLINE isByronAddress #-}

headerNonShelleyBits :: Header
headerNonShelleyBits :: Header
headerNonShelleyBits = Header
headerByron forall a. Bits a => a -> a -> a
.|. Header
0b00001100

headerNetworkId :: Header -> Network
headerNetworkId :: Header -> Network
headerNetworkId 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
headerIsPaymentScript :: Header -> Bool
headerIsPaymentScript = (forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerIsPaymentScript #-}

headerIsEnterpriseAddr :: Header -> Bool
headerIsEnterpriseAddr :: Header -> Bool
headerIsEnterpriseAddr = (forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsEnterpriseAddr #-}

headerIsStakingScript :: Header -> Bool
headerIsStakingScript :: Header -> Bool
headerIsStakingScript = (forall a. Bits a => a -> Int -> Bool
`testBit` Int
5)
{-# INLINE headerIsStakingScript #-}

headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress = 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 #-}

-- | Same as `decodeAddr`, but produces an `Either` result
decodeAddrEither ::
  forall c.
  Crypto c =>
  BS.ByteString ->
  Either String (Addr c)
decodeAddrEither :: forall c. Crypto c => ByteString -> Either String (Addr c)
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 c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr c)
decodeAddrStateT ByteString
bs) Int
0
{-# INLINE decodeAddrEither #-}

-- | Strict decoder for an address from a `ByteString`. This will not let you decode some
-- of the buggy addresses that have been placed on chain. This decoder is intended for
-- addresses that are to be placed on chian today.
decodeAddr ::
  forall c m.
  (Crypto c, MonadFail m) =>
  BS.ByteString ->
  m (Addr c)
decodeAddr :: forall c (m :: * -> *).
(Crypto c, MonadFail m) =>
ByteString -> m (Addr c)
decodeAddr ByteString
bs = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr c)
decodeAddrStateT ByteString
bs) Int
0
{-# INLINE decodeAddr #-}

-- | Just like `decodeAddrStateLenientT`, but enforces the address to be well-formed.
decodeAddrStateT ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (Addr c)
decodeAddrStateT :: forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (Addr c)
decodeAddrStateT = forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m (Addr c)
decodeAddrStateLenientT Bool
False Bool
False
{-# INLINE decodeAddrStateT #-}

-- | This is the most general decoder for a Cardano address. This function is not meant to
-- be used directly, but it is exported for convenice. `decodeAddr` and other should be
-- used instead.
--
-- While decoding an Addr the header (the first byte in the buffer) is expected to be in a
-- certain format. Here are the meaning of all the bits:
--
-- @@@
--
-- ┏━━━━━━━━━━━━━━━━┳━┯━┯━┯━┯━┯━┯━┯━┓
-- ┃  Byron Address ┃1┊0┊0┊0┊0┊0┊1┊0┃
-- ┣━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━┫
-- ┃Shelley Address ┃0┊x┊x┊x┊0┊0┊0┊x┃
-- ┗━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━╋━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
--                  ┃0┊0┊0┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingKey    ┃
--                  ┃0┊0┊0┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingKey    ┃
--                  ┃0┊0┊0┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingKey    ┃
--                  ┃0┊0┊0┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingKey    ┃
--                  ┃0┊0┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingScript ┃
--                  ┃0┊0┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingScript ┃
--                  ┃0┊0┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingScript ┃
--                  ┃0┊0┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingScript ┃
--                  ┃0┊1┊0┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingPtr    ┃
--                  ┃0┊1┊0┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingPtr    ┃
--                  ┃0┊1┊0┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingPtr    ┃
--                  ┃0┊1┊0┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingPtr    ┃
--                  ┃0┊1┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingNull   ┃
--                  ┃0┊1┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingNull   ┃
--                  ┃0┊1┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingNull   ┃
--                  ┃0┊1┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingNull   ┃
--                  ┗━┷━┷━┷━┷━┷━┷━┷━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
--                      \ \ \       \
--                       \ \ \       `Is Mainnet Address
--                        \ \ `Payment Credential is a Script
--                         \ `Staking Credential is a Script / No Staking Credential
--                          `Not a Base Address
-- @@@
decodeAddrStateLenientT ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  -- | Enable lenient decoding for Ptrs, i.e. indicate whether junk can follow a Ptr. This
  -- is necessary for backwards compatibility only.  Setting this argument to True is only
  -- needed for backwards compatibility.
  Bool ->
  -- | Indicate whether decoder should not enforce the full input to be consumed or not,
  -- i.e. allow garbage at the end or not. Setting this argument to True is only needed
  -- for backwards compatibility.
  Bool ->
  b ->
  StateT Int m (Addr c)
decodeAddrStateLenientT :: forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m (Addr c)
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 c
addr <-
    if Header -> Bool
isByronAddress Header
header
      then forall c. BootstrapAddress c -> Addr c
AddrBootstrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (BootstrapAddress c)
decodeBootstrapAddress b
buf
      else do
        -- Ensure there are no unexpected bytes in the header
        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
        -- Advance one byte for the consumed header
        forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (forall a. Num a => a -> a -> a
+ Int
1)
        PaymentCredential c
payment <- forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (PaymentCredential c)
decodePaymentCredential Header
header b
buf
        StakeReference c
staking <- forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Header -> b -> StateT Int m (StakeReference c)
decodeStakeReference Bool
isPtrLenient Header
header b
buf
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr (Header -> Network
headerNetworkId Header
header) PaymentCredential c
payment StakeReference c
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 c
addr
{-# INLINE decodeAddrStateLenientT #-}

-- | Checks that the current offset is exactly at the end of the buffer.
ensureBufIsConsumed ::
  forall m b.
  (MonadFail m, AddressBuffer b) =>
  -- | Name for error reporting
  String ->
  -- | Buffer that should have been consumed.
  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 #-}

-- | This decoder assumes the whole `ShortByteString` is occupied by the `BootstrapAddress`
decodeBootstrapAddress ::
  forall c m b.
  (MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (BootstrapAddress c)
decodeBootstrapAddress :: forall c (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (BootstrapAddress c)
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 -> forall c. Address -> BootstrapAddress c
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 ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  Header ->
  b ->
  StateT Int m (PaymentCredential c)
decodePaymentCredential :: forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (PaymentCredential c)
decodePaymentCredential Header
header b
buf
  | Header -> Bool
headerIsPaymentScript Header
header = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash c)
decodeScriptHash b
buf
  | Bool
otherwise = forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b (kr :: KeyRole).
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr c)
decodeKeyHash b
buf
{-# INLINE decodePaymentCredential #-}

decodeStakeReference ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  Bool ->
  Header ->
  b ->
  StateT Int m (StakeReference c)
decodeStakeReference :: forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
Bool -> Header -> b -> StateT Int m (StakeReference c)
decodeStakeReference Bool
isLenientPtrDecoder Header
header b
buf
  | Header -> Bool
headerIsBaseAddress Header
header =
      if Header -> Bool
headerIsStakingScript Header
header
        then forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash c)
decodeScriptHash b
buf
        else forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b (kr :: KeyRole).
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr c)
decodeKeyHash b
buf
  | Bool
otherwise =
      if Header -> Bool
headerIsEnterpriseAddr Header
header
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall c. StakeReference c
StakeRefNull
        else forall c. Ptr -> StakeReference c
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 ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (KeyHash kr c)
decodeKeyHash :: forall c (m :: * -> *) b (kr :: KeyRole).
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr c)
decodeKeyHash b
buf = forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
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 ::
  (Crypto c, MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m (ScriptHash c)
decodeScriptHash :: forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash c)
decodeScriptHash b
buf = forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
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) =>
  -- | Name for what is being decoded for the error message
  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 #-}

-- | Decode a variable length integral value that is encoded with 7 bits of data
-- and the most significant bit (MSB), the 8th bit is set whenever there are
-- more bits following. Continuation style allows us to avoid
-- rucursion. Removing loops is good for performance.
decode7BitVarLength ::
  (Num a, Bits a, AddressBuffer b, MonadFail m) =>
  -- | Name of what is being decoded for error reporting
  String ->
  -- | Buffer that contains encoded number
  b ->
  -- | Continuation that will be invoked if MSB is set
  (a -> StateT Int m a) ->
  -- | Accumulator
  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
        -- Only while decoding the last 7bits we check if there was too many
        -- bits supplied at the beginning.
        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
        -- Only while decoding the last 7bits we check if there was too many
        -- bits supplied at the beginning.
        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 #-}

-- | This decoder is here only with the purpose of preserving old buggy behavior. Should
-- not be used for anything else.
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 #-}

------------------------------------------------------------------------------------------
-- Reward Account Deserializer -----------------------------------------------------------
------------------------------------------------------------------------------------------

decodeRewardAccount ::
  forall c b m.
  (Crypto c, AddressBuffer b, MonadFail m) =>
  b ->
  m (RewardAcnt c)
decodeRewardAccount :: forall c b (m :: * -> *).
(Crypto c, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt c)
decodeRewardAccount b
buf = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *) c b.
(MonadFail m, Crypto c, AddressBuffer b) =>
b -> StateT Int m (RewardAcnt c)
decodeRewardAccountT b
buf) Int
0
decodeRewardAcnt ::
  forall c b m.
  (Crypto c, AddressBuffer b, MonadFail m) =>
  b ->
  m (RewardAcnt c)
decodeRewardAcnt :: forall c b (m :: * -> *).
(Crypto c, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt c)
decodeRewardAcnt = forall c b (m :: * -> *).
(Crypto c, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt c)
decodeRewardAccount
{-# INLINE decodeRewardAcnt #-}
{-# DEPRECATED decodeRewardAcnt "Use `decodeRewardAccount` instead" #-}

fromCborRewardAccount :: forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAccount :: forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAccount = do
  ShortByteString
sbs :: ShortByteString <- forall a s. DecCBOR a => Decoder s a
decCBOR
  forall c b (m :: * -> *).
(Crypto c, AddressBuffer b, MonadFail m) =>
b -> m (RewardAcnt c)
decodeRewardAcnt @c ShortByteString
sbs
fromCborRewardAcnt :: forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAcnt :: forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAcnt = forall c s. Crypto c => Decoder s (RewardAcnt c)
fromCborRewardAccount
{-# INLINE fromCborRewardAcnt #-}
{-# DEPRECATED fromCborRewardAcnt "Use `fromCborRewardAccount` instead" #-}

headerIsRewardAccount :: Header -> Bool
headerIsRewardAccount :: Header -> Bool
headerIsRewardAccount 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
headerRewardAccountIsScript :: Header -> Bool
headerRewardAccountIsScript = (forall a. Bits a => a -> Int -> Bool
`testBit` Int
4)
{-# INLINE headerRewardAccountIsScript #-}

-- | Reward Account Header.
--
-- @@@
--
-- ┏━━━━━━━━━━━━━━━━┳━┯━┯━┯━┯━┯━┯━┯━┓
-- ┃ Reward Account ┃1┊1┊1┊x┊0┊0┊0┊x┃
-- ┗━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━╋━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
--                  ┃1┊1┊1┊0┊0┊0┊0┊0┃ Testnet PaymentKey    StakingKey    ┃
--                  ┃1┊1┊1┊0┊0┊0┊0┊1┃ Mainnet PaymentKey    StakingKey    ┃
--                  ┃1┊1┊1┊1┊0┊0┊0┊0┃ Testnet PaymentScript StakingKey    ┃
--                  ┃1┊1┊1┊1┊0┊0┊0┊1┃ Mainnet PaymentScript StakingKey    ┃
--                  ┗━┷━┷━┷━┷━┷━┷━┷━┻━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛
--                          \       \
--                           \       `Is Mainnet Address
--                            `Account Credential is a Script
-- @@@
decodeRewardAccountT ::
  (MonadFail m, Crypto c, AddressBuffer b) =>
  b ->
  StateT Int m (RewardAcnt c)
decodeRewardAccountT :: forall (m :: * -> *) c b.
(MonadFail m, Crypto c, AddressBuffer b) =>
b -> StateT Int m (RewardAcnt c)
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 c
account <-
    if Header -> Bool
headerRewardAccountIsScript Header
header
      then forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b.
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (ScriptHash c)
decodeScriptHash b
buf
      else forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) b (kr :: KeyRole).
(Crypto c, MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr c)
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
$! forall c. Network -> Credential 'Staking c -> RewardAcnt c
RewardAcnt (Header -> Network
headerNetworkId Header
header) Credential 'Staking c
account
{-# INLINE decodeRewardAccountT #-}

instance Crypto c => EncCBOR (CompactAddr c) where
  encCBOR :: CompactAddr c -> Encoding
encCBOR (UnsafeCompactAddr ShortByteString
bytes) = forall a. EncCBOR a => a -> Encoding
encCBOR ShortByteString
bytes
  {-# INLINE encCBOR #-}

instance Crypto c => DecCBOR (CompactAddr c) where
  decCBOR :: forall s. Decoder s (CompactAddr c)
decCBOR = forall c s. Crypto c => Decoder s (CompactAddr c)
fromCborCompactAddr
  {-# INLINE decCBOR #-}

-- | Efficiently check whether compacted adddress is an address with a credential
-- that is a payment script.
isPayCredScriptCompactAddr :: CompactAddr c -> Bool
isPayCredScriptCompactAddr :: forall c. CompactAddr c -> 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

-- | Efficiently check whether compated adddress is a Byron address.
isBootstrapCompactAddr :: CompactAddr c -> Bool
isBootstrapCompactAddr :: forall c. CompactAddr c -> 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

-- | Convert Byron's comapct address into `CompactAddr`. This is just an efficient type cast.
fromBoostrapCompactAddress :: Byron.CompactAddress -> CompactAddr c
fromBoostrapCompactAddress :: forall c. CompactAddress -> CompactAddr c
fromBoostrapCompactAddress = forall c. ShortByteString -> CompactAddr c
UnsafeCompactAddr forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactAddress -> ShortByteString
Byron.unsafeGetCompactAddress

-- | This is called @wdrl@ in the spec.
newtype Withdrawals c = Withdrawals {forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals :: Map (RewardAcnt c) Coin}
  deriving (Int -> Withdrawals c -> ShowS
forall c. Int -> Withdrawals c -> ShowS
forall c. [Withdrawals c] -> ShowS
forall c. Withdrawals c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Withdrawals c] -> ShowS
$cshowList :: forall c. [Withdrawals c] -> ShowS
show :: Withdrawals c -> String
$cshow :: forall c. Withdrawals c -> String
showsPrec :: Int -> Withdrawals c -> ShowS
$cshowsPrec :: forall c. Int -> Withdrawals c -> ShowS
Show, Withdrawals c -> Withdrawals c -> Bool
forall c. Withdrawals c -> Withdrawals c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Withdrawals c -> Withdrawals c -> Bool
$c/= :: forall c. Withdrawals c -> Withdrawals c -> Bool
== :: Withdrawals c -> Withdrawals c -> Bool
$c== :: forall c. Withdrawals c -> Withdrawals c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (Withdrawals c) x -> Withdrawals c
forall c x. Withdrawals c -> Rep (Withdrawals c) x
$cto :: forall c x. Rep (Withdrawals c) x -> Withdrawals c
$cfrom :: forall c x. Withdrawals c -> Rep (Withdrawals c) x
Generic)
  deriving newtype (Context -> Withdrawals c -> IO (Maybe ThunkInfo)
Proxy (Withdrawals c) -> String
forall c. Context -> Withdrawals c -> IO (Maybe ThunkInfo)
forall c. Proxy (Withdrawals c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Withdrawals c) -> String
$cshowTypeOf :: forall c. Proxy (Withdrawals c) -> String
wNoThunks :: Context -> Withdrawals c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> Withdrawals c -> IO (Maybe ThunkInfo)
noThunks :: Context -> Withdrawals c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> Withdrawals c -> IO (Maybe ThunkInfo)
NoThunks, Withdrawals c -> ()
forall c. Withdrawals c -> ()
forall a. (a -> ()) -> NFData a
rnf :: Withdrawals c -> ()
$crnf :: forall c. Withdrawals c -> ()
NFData, Withdrawals c -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals c] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Withdrawals c) -> 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
forall {c}. Crypto c => Typeable (Withdrawals c)
forall c. Crypto c => Withdrawals c -> Encoding
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals c] -> Size
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Withdrawals c) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals c] -> Size
$cencodedListSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [Withdrawals c] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Withdrawals c) -> Size
$cencodedSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (Withdrawals c) -> Size
encCBOR :: Withdrawals c -> Encoding
$cencCBOR :: forall c. Crypto c => Withdrawals c -> Encoding
EncCBOR, Proxy (Withdrawals c) -> Text
forall s. Decoder s (Withdrawals c)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (Withdrawals c) -> Decoder s ()
forall {c}. Crypto c => Typeable (Withdrawals c)
forall c. Crypto c => Proxy (Withdrawals c) -> Text
forall c s. Crypto c => Decoder s (Withdrawals c)
forall c s. Crypto c => Proxy (Withdrawals c) -> Decoder s ()
label :: Proxy (Withdrawals c) -> Text
$clabel :: forall c. Crypto c => Proxy (Withdrawals c) -> Text
dropCBOR :: forall s. Proxy (Withdrawals c) -> Decoder s ()
$cdropCBOR :: forall c s. Crypto c => Proxy (Withdrawals c) -> Decoder s ()
decCBOR :: forall s. Decoder s (Withdrawals c)
$cdecCBOR :: forall c s. Crypto c => Decoder s (Withdrawals c)
DecCBOR)