{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Cardano.Ledger.Address (
  serialiseAddr,
  Addr (..),
  BootstrapAddress (..),
  bootstrapAddressAttrsSize,
  isBootstrapRedeemer,
  getNetwork,
  AccountAddress (..),
  AccountId (..),
  accountAddressAccountIdL,
  accountAddressCredentialL,
  accountAddressNetworkIdL,
  serialiseAccountAddress,
  deserialiseAccountAddress,
  putAccountAddress,
  decodeAccountAddress,
  fromCborAccountAddress,
  AddressBuffer,
  pattern RewardAccount,
  raNetwork,
  raCredential,
  rewardAccountCredentialL,
  rewardAccountNetworkL,
  serialiseRewardAccount,
  deserialiseRewardAccount,
  putRewardAccount,
  decodeRewardAccount,
  fromCborRewardAccount,
  bootstrapKeyHash,
  -- internals exported for testing
  putAddr,
  putCredential,
  putPtr,
  putVariableLengthWord64,
  Word7 (..),
  toWord7,

  -- * Compact Address
  fromBoostrapCompactAddress,
  compactAddr,
  decompactAddr,
  CompactAddr,
  unCompactAddr,
  isPayCredScriptCompactAddr,
  isBootstrapCompactAddr,
  decodeAddr,
  decodeAddrEither,
  decodeAddrStateT,
  decodeAddrStateLenientT,
  fromCborAddr,
  fromCborBothAddr,
  fromCborCompactAddr,
  fromCborRigorousBothAddr,
  fromCborBackwardsBothAddr,
  Withdrawals (..),
  DirectDeposits (..),
) 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 (..),
  TxIx (..),
  byronProtVer,
  natVersion,
  networkToWord8,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  decodeFull',
  ifDecoderVersionAtLeast,
  serialize,
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr (..),
  SlotNo32 (..),
  StakeReference (..),
  mkPtrNormalized,
 )
import Cardano.Ledger.Hashes (ScriptHash (..))
import Cardano.Ledger.Keys (KeyHash (..), KeyRole (..))
import Control.DeepSeq (NFData)
import Control.Monad (guard, unless, when)
import Control.Monad.Trans.Fail (FailT (..), 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 Data.ByteString.Short.Internal as SBS (unsafeIndex)
import qualified Data.ByteString.Unsafe as BS (unsafeDrop, unsafeIndex, unsafeTake)
import Data.Default (Default (..))
import Data.Function (fix)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.MemPack (MemPack, Unpack (..))
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))

-- | Serialise an address to the external format.
serialiseAddr :: Addr -> ByteString
serialiseAddr :: Addr -> ByteString
serialiseAddr = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Addr -> LazyByteString) -> Addr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
B.runPut (Put -> LazyByteString) -> (Addr -> Put) -> Addr -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Put
putAddr
{-# INLINE serialiseAddr #-}

-- | Serialise an account address to the external format.
serialiseAccountAddress :: AccountAddress -> ByteString
serialiseAccountAddress :: AccountAddress -> ByteString
serialiseAccountAddress = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (AccountAddress -> LazyByteString)
-> AccountAddress
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
B.runPut (Put -> LazyByteString)
-> (AccountAddress -> Put) -> AccountAddress -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountAddress -> Put
putAccountAddress

-- | Deserialise an account address from the external format. This will fail if the
-- input data is not in the right format (or if there is trailing data).
deserialiseAccountAddress :: ByteString -> Maybe AccountAddress
deserialiseAccountAddress :: ByteString -> Maybe AccountAddress
deserialiseAccountAddress = ByteString -> Maybe AccountAddress
forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m AccountAddress
decodeAccountAddress

{-# DEPRECATED serialiseRewardAccount "In favor of `serialiseAccountAddress`" #-}
serialiseRewardAccount :: AccountAddress -> ByteString
serialiseRewardAccount :: AccountAddress -> ByteString
serialiseRewardAccount = AccountAddress -> ByteString
serialiseAccountAddress

{-# DEPRECATED deserialiseRewardAccount "In favor of `deserialiseAccountAddress`" #-}
deserialiseRewardAccount :: ByteString -> Maybe AccountAddress
deserialiseRewardAccount :: ByteString -> Maybe AccountAddress
deserialiseRewardAccount = ByteString -> Maybe AccountAddress
deserialiseAccountAddress

-- | 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
  = Addr Network (Credential Payment) StakeReference
  | AddrBootstrap BootstrapAddress
  deriving (Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Addr -> ShowS
showsPrec :: Int -> Addr -> ShowS
$cshow :: Addr -> String
show :: Addr -> String
$cshowList :: [Addr] -> ShowS
showList :: [Addr] -> ShowS
Show, Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
/= :: Addr -> Addr -> Bool
Eq, (forall x. Addr -> Rep Addr x)
-> (forall x. Rep Addr x -> Addr) -> Generic Addr
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
$cfrom :: forall x. Addr -> Rep Addr x
from :: forall x. Addr -> Rep Addr x
$cto :: forall x. Rep Addr x -> Addr
to :: forall x. Rep Addr x -> Addr
Generic, Addr -> ()
(Addr -> ()) -> NFData Addr
forall a. (a -> ()) -> NFData a
$crnf :: Addr -> ()
rnf :: Addr -> ()
NFData, Eq Addr
Eq Addr =>
(Addr -> Addr -> Ordering)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> Ord 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
$ccompare :: Addr -> Addr -> Ordering
compare :: Addr -> Addr -> Ordering
$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
>= :: Addr -> Addr -> Bool
$cmax :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
min :: Addr -> Addr -> Addr
Ord)

-- | Lookup a Network Id for an Address
getNetwork :: Addr -> Network
getNetwork :: Addr -> Network
getNetwork (Addr Network
n Credential Payment
_ StakeReference
_) = Network
n
getNetwork (AddrBootstrap (BootstrapAddress Address
byronAddr)) =
  case AddrAttributes -> NetworkMagic
Byron.aaNetworkMagic (AddrAttributes -> NetworkMagic)
-> (Address -> AddrAttributes) -> Address -> NetworkMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes AddrAttributes -> AddrAttributes
forall h. Attributes h -> h
Byron.attrData (Attributes AddrAttributes -> AddrAttributes)
-> (Address -> Attributes AddrAttributes)
-> Address
-> AddrAttributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Attributes AddrAttributes
Byron.addrAttributes (Address -> NetworkMagic) -> Address -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ Address
byronAddr of
    NetworkMagic
Byron.NetworkMainOrStage -> Network
Mainnet
    Byron.NetworkTestnet Word32
_ -> Network
Testnet

instance NoThunks Addr

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

newtype AccountId = AccountId {AccountId -> Credential Staking
unAccountId :: Credential Staking}
  deriving (Int -> AccountId -> ShowS
[AccountId] -> ShowS
AccountId -> String
(Int -> AccountId -> ShowS)
-> (AccountId -> String)
-> ([AccountId] -> ShowS)
-> Show AccountId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountId -> ShowS
showsPrec :: Int -> AccountId -> ShowS
$cshow :: AccountId -> String
show :: AccountId -> String
$cshowList :: [AccountId] -> ShowS
showList :: [AccountId] -> ShowS
Show, AccountId -> AccountId -> Bool
(AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool) -> Eq AccountId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountId -> AccountId -> Bool
== :: AccountId -> AccountId -> Bool
$c/= :: AccountId -> AccountId -> Bool
/= :: AccountId -> AccountId -> Bool
Eq, (forall x. AccountId -> Rep AccountId x)
-> (forall x. Rep AccountId x -> AccountId) -> Generic AccountId
forall x. Rep AccountId x -> AccountId
forall x. AccountId -> Rep AccountId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountId -> Rep AccountId x
from :: forall x. AccountId -> Rep AccountId x
$cto :: forall x. Rep AccountId x -> AccountId
to :: forall x. Rep AccountId x -> AccountId
Generic, Eq AccountId
Eq AccountId =>
(AccountId -> AccountId -> Ordering)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> Bool)
-> (AccountId -> AccountId -> AccountId)
-> (AccountId -> AccountId -> AccountId)
-> Ord AccountId
AccountId -> AccountId -> Bool
AccountId -> AccountId -> Ordering
AccountId -> AccountId -> AccountId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccountId -> AccountId -> Ordering
compare :: AccountId -> AccountId -> Ordering
$c< :: AccountId -> AccountId -> Bool
< :: AccountId -> AccountId -> Bool
$c<= :: AccountId -> AccountId -> Bool
<= :: AccountId -> AccountId -> Bool
$c> :: AccountId -> AccountId -> Bool
> :: AccountId -> AccountId -> Bool
$c>= :: AccountId -> AccountId -> Bool
>= :: AccountId -> AccountId -> Bool
$cmax :: AccountId -> AccountId -> AccountId
max :: AccountId -> AccountId -> AccountId
$cmin :: AccountId -> AccountId -> AccountId
min :: AccountId -> AccountId -> AccountId
Ord)
  deriving newtype (AccountId -> ()
(AccountId -> ()) -> NFData AccountId
forall a. (a -> ()) -> NFData a
$crnf :: AccountId -> ()
rnf :: AccountId -> ()
NFData, Context -> AccountId -> IO (Maybe ThunkInfo)
Proxy AccountId -> String
(Context -> AccountId -> IO (Maybe ThunkInfo))
-> (Context -> AccountId -> IO (Maybe ThunkInfo))
-> (Proxy AccountId -> String)
-> NoThunks AccountId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> AccountId -> IO (Maybe ThunkInfo)
noThunks :: Context -> AccountId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> AccountId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> AccountId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy AccountId -> String
showTypeOf :: Proxy AccountId -> String
NoThunks, [AccountId] -> Value
[AccountId] -> Encoding
AccountId -> Bool
AccountId -> Value
AccountId -> Encoding
(AccountId -> Value)
-> (AccountId -> Encoding)
-> ([AccountId] -> Value)
-> ([AccountId] -> Encoding)
-> (AccountId -> Bool)
-> ToJSON AccountId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AccountId -> Value
toJSON :: AccountId -> Value
$ctoEncoding :: AccountId -> Encoding
toEncoding :: AccountId -> Encoding
$ctoJSONList :: [AccountId] -> Value
toJSONList :: [AccountId] -> Value
$ctoEncodingList :: [AccountId] -> Encoding
toEncodingList :: [AccountId] -> Encoding
$comitField :: AccountId -> Bool
omitField :: AccountId -> Bool
ToJSON, Maybe AccountId
Value -> Parser [AccountId]
Value -> Parser AccountId
(Value -> Parser AccountId)
-> (Value -> Parser [AccountId])
-> Maybe AccountId
-> FromJSON AccountId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AccountId
parseJSON :: Value -> Parser AccountId
$cparseJSONList :: Value -> Parser [AccountId]
parseJSONList :: Value -> Parser [AccountId]
$comittedField :: Maybe AccountId
omittedField :: Maybe AccountId
FromJSON, AccountId -> Encoding
(AccountId -> Encoding) -> EncCBOR AccountId
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: AccountId -> Encoding
encCBOR :: AccountId -> Encoding
EncCBOR, Typeable AccountId
Typeable AccountId =>
(forall s. Decoder s AccountId)
-> (forall s. Proxy AccountId -> Decoder s ())
-> (Proxy AccountId -> Text)
-> DecCBOR AccountId
Proxy AccountId -> Text
forall s. Decoder s AccountId
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy AccountId -> Decoder s ()
$cdecCBOR :: forall s. Decoder s AccountId
decCBOR :: forall s. Decoder s AccountId
$cdropCBOR :: forall s. Proxy AccountId -> Decoder s ()
dropCBOR :: forall s. Proxy AccountId -> Decoder s ()
$clabel :: Proxy AccountId -> Text
label :: Proxy AccountId -> Text
DecCBOR)

-- | Deprecated pattern synonym for backward compatibility
pattern RewardAccount :: Network -> Credential Staking -> AccountAddress
pattern $mRewardAccount :: forall {r}.
AccountAddress
-> (Network -> Credential Staking -> r) -> ((# #) -> r) -> r
$bRewardAccount :: Network -> Credential Staking -> AccountAddress
RewardAccount {AccountAddress -> Network
raNetwork, AccountAddress -> Credential Staking
raCredential} = AccountAddress raNetwork (AccountId raCredential)
{-# DEPRECATED RewardAccount "In favor of `AccountAddress`" #-}

{-# DEPRECATED raNetwork "In favor of `aaNetworkId`" #-}

{-# DEPRECATED raCredential "In favor of `aaAccountId`" #-}

{-# COMPLETE RewardAccount #-}

accountAddressAccountIdL :: Lens' AccountAddress AccountId
accountAddressAccountIdL :: Lens' AccountAddress AccountId
accountAddressAccountIdL = (AccountAddress -> AccountId)
-> (AccountAddress -> AccountId -> AccountAddress)
-> Lens' AccountAddress AccountId
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountAddress -> AccountId
aaAccountId ((AccountAddress -> AccountId -> AccountAddress)
 -> Lens' AccountAddress AccountId)
-> (AccountAddress -> AccountId -> AccountAddress)
-> Lens' AccountAddress AccountId
forall a b. (a -> b) -> a -> b
$ \AccountAddress
x AccountId
y -> AccountAddress
x {aaAccountId = y}

accountAddressCredentialL :: Lens' AccountAddress (Credential Staking)
accountAddressCredentialL :: Lens' AccountAddress (Credential Staking)
accountAddressCredentialL = (AccountAddress -> Credential Staking)
-> (AccountAddress -> Credential Staking -> AccountAddress)
-> Lens' AccountAddress (Credential Staking)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(AccountAddress Network
_ (AccountId Credential Staking
c)) -> Credential Staking
c) ((AccountAddress -> Credential Staking -> AccountAddress)
 -> Lens' AccountAddress (Credential Staking))
-> (AccountAddress -> Credential Staking -> AccountAddress)
-> Lens' AccountAddress (Credential Staking)
forall a b. (a -> b) -> a -> b
$ \AccountAddress
x Credential Staking
y -> AccountAddress
x {aaAccountId = AccountId y}

accountAddressNetworkIdL :: Lens' AccountAddress Network
accountAddressNetworkIdL :: Lens' AccountAddress Network
accountAddressNetworkIdL = (AccountAddress -> Network)
-> (AccountAddress -> Network -> AccountAddress)
-> Lens' AccountAddress Network
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountAddress -> Network
aaNetworkId ((AccountAddress -> Network -> AccountAddress)
 -> Lens' AccountAddress Network)
-> (AccountAddress -> Network -> AccountAddress)
-> Lens' AccountAddress Network
forall a b. (a -> b) -> a -> b
$ \AccountAddress
x Network
y -> AccountAddress
x {aaNetworkId = y}

{-# DEPRECATED rewardAccountCredentialL "In favor of `accountAddressCredentialL`" #-}
rewardAccountCredentialL :: Lens' AccountAddress (Credential Staking)
rewardAccountCredentialL :: Lens' AccountAddress (Credential Staking)
rewardAccountCredentialL = (Credential Staking -> f (Credential Staking))
-> AccountAddress -> f AccountAddress
Lens' AccountAddress (Credential Staking)
accountAddressCredentialL

{-# DEPRECATED rewardAccountNetworkL "In favor of `accountAddressNetworkIdL`" #-}
rewardAccountNetworkL :: Lens' AccountAddress Network
rewardAccountNetworkL :: Lens' AccountAddress Network
rewardAccountNetworkL = (Network -> f Network) -> AccountAddress -> f AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL

instance Default AccountAddress where
  def :: AccountAddress
def = Network -> AccountId -> AccountAddress
AccountAddress Network
forall a. Default a => a
def (Credential Staking -> AccountId
AccountId Credential Staking
forall a. Default a => a
def)

instance ToJSON AccountAddress where
  toJSON :: AccountAddress -> Value
toJSON AccountAddress
aa =
    [Pair] -> Value
Aeson.object
      [ Key
"network" Key -> Network -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= AccountAddress -> Network
aaNetworkId AccountAddress
aa
      , Key
"credential" Key -> Credential Staking -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (AccountAddress
aa AccountAddress
-> Getting (Credential Staking) AccountAddress (Credential Staking)
-> Credential Staking
forall s a. s -> Getting a s a -> a
^. Getting (Credential Staking) AccountAddress (Credential Staking)
Lens' AccountAddress (Credential Staking)
accountAddressCredentialL)
      ]

instance FromJSON AccountAddress where
  parseJSON :: Value -> Parser AccountAddress
parseJSON =
    String
-> (Object -> Parser AccountAddress)
-> Value
-> Parser AccountAddress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"AccountAddress" ((Object -> Parser AccountAddress)
 -> Value -> Parser AccountAddress)
-> (Object -> Parser AccountAddress)
-> Value
-> Parser AccountAddress
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Network -> AccountId -> AccountAddress
AccountAddress
        (Network -> AccountId -> AccountAddress)
-> Parser Network -> Parser (AccountId -> AccountAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
          Object -> Key -> Parser Network
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"network"
        Parser (AccountId -> AccountAddress)
-> Parser AccountId -> Parser AccountAddress
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Parser (Credential Staking) -> Parser AccountId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Credential Staking)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"credential")

instance NoThunks AccountAddress

instance ToJSONKey Addr where
  toJSONKey :: ToJSONKeyFunction Addr
toJSONKey = (Addr -> Key) -> (Addr -> Encoding' Key) -> ToJSONKeyFunction Addr
forall a. (a -> Key) -> (a -> Encoding' Key) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText (Text -> Key
Aeson.fromText (Text -> Key) -> (Addr -> Text) -> Addr -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Text
addrToText) (Text -> Encoding' Key
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' Key) -> (Addr -> Text) -> Addr -> Encoding' Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Addr -> Text
addrToText)

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

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

instance FromJSON Addr where
  parseJSON :: Value -> Parser Addr
parseJSON = String -> (Text -> Parser Addr) -> Value -> Parser Addr
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 (ByteString -> Text) -> (Addr -> ByteString) -> Addr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode (ByteString -> ByteString)
-> (Addr -> ByteString) -> Addr -> ByteString
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
  bytes <- (String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
badHex ByteString -> Parser ByteString
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString
B16.decode (Text -> ByteString
Text.encodeUtf8 Text
t))
  decodeAddr bytes
  where
    badHex :: a -> m a
badHex a
h = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Addresses are expected in hex encoding for now: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
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)) =
  LazyByteString -> Put
B.putLazyByteString (Version -> Address -> LazyByteString
forall a. EncCBOR a => Version -> a -> LazyByteString
serialize Version
byronProtVer Address
byronAddr)
putAddr (Addr Network
network Credential Payment
pc StakeReference
sr) =
  let setPayCredBit :: Word8 -> Word8
setPayCredBit = case Credential Payment
pc of
        ScriptHashObj ScriptHash
_ -> (Word8 -> Int -> Word8) -> Int -> Word8 -> Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
        KeyHashObj KeyHash Payment
_ -> Word8 -> Word8
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
_ -> (Word8 -> Int -> Word8) -> Int -> Word8 -> Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Int
stakeCredIsScript
                KeyHashObj KeyHash Staking
_ -> Word8 -> Word8
forall a. a -> a
id
              header :: Word8
header = Word8 -> Word8
setStakeCredBit (Word8 -> Word8) -> (Word8 -> Word8) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8
setPayCredBit (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8
netId
          Word8 -> Put
B.putWord8 Word8
header
          Credential Payment -> Put
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential Payment
pc
          Credential Staking -> Put
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential Staking
sc
        StakeRefPtr Ptr
ptr -> do
          let header :: Word8
header = Word8 -> Word8
setPayCredBit (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8
netId Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
notBaseAddr
          Word8 -> Put
B.putWord8 Word8
header
          Credential Payment -> Put
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential Payment
pc
          Ptr -> Put
putPtr Ptr
ptr
        StakeReference
StakeRefNull -> do
          let header :: Word8
header = Word8 -> Word8
setPayCredBit (Word8 -> Word8) -> Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Word8
netId Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
isEnterpriseAddr Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
notBaseAddr
          Word8 -> Put
B.putWord8 Word8
header
          Credential Payment -> Put
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential Payment
pc
{-# INLINE putAddr #-}

putAccountAddress :: AccountAddress -> Put
putAccountAddress :: AccountAddress -> Put
putAccountAddress (AccountAddress Network
network (AccountId Credential Staking
cred)) = do
  let setPayCredBit :: Word8 -> Word8
setPayCredBit = case Credential Staking
cred of
        ScriptHashObj ScriptHash
_ -> (Word8 -> Int -> Word8) -> Int -> Word8 -> Word8
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit Int
payCredIsScript
        KeyHashObj KeyHash Staking
_ -> Word8 -> Word8
forall a. a -> a
id
      netId :: Word8
netId = Network -> Word8
networkToWord8 Network
network
      accountAddressPrefix :: Word8
accountAddressPrefix = Word8
0xE0 -- 0b11100000 are always set for account addresses
      header :: Word8
header = Word8 -> Word8
setPayCredBit (Word8
netId Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
accountAddressPrefix)
  Word8 -> Put
B.putWord8 Word8
header
  Credential Staking -> Put
forall (kr :: KeyRole). Credential kr -> Put
putCredential Credential Staking
cred
{-# INLINE putAccountAddress #-}

{-# DEPRECATED putRewardAccount "In favor of `putAccountAddress`" #-}
putRewardAccount :: AccountAddress -> Put
putRewardAccount :: AccountAddress -> Put
putRewardAccount = AccountAddress -> Put
putAccountAddress
{-# INLINE putRewardAccount #-}

putHash :: Hash.Hash h a -> Put
putHash :: forall h a. Hash h a -> Put
putHash = ByteString -> Put
B.putByteString (ByteString -> Put) -> (Hash h a -> ByteString) -> Hash h a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash h a -> ByteString
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)) = Hash ADDRHASH EraIndependentScript -> Put
forall h a. Hash h a -> Put
putHash Hash ADDRHASH EraIndependentScript
h
putCredential (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
h)) = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> Put
forall h a. Hash h a -> Put
putHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
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 -> Int
bootstrapAddressAttrsSize :: BootstrapAddress -> Int
bootstrapAddressAttrsSize (BootstrapAddress Address
addr) =
  Int -> (HDAddressPayload -> Int) -> Maybe HDAddressPayload -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 HDAddressPayload -> Int
payloadLen Maybe HDAddressPayload
derivationPath Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Attributes AddrAttributes -> Int
forall a. Attributes a -> Int
Byron.unknownAttributesLength Attributes AddrAttributes
attrs
  where
    payloadLen :: HDAddressPayload -> Int
payloadLen = ByteString -> Int
BS.length (ByteString -> Int)
-> (HDAddressPayload -> ByteString) -> HDAddressPayload -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HDAddressPayload -> ByteString
Byron.getHDAddressPayload
    derivationPath :: Maybe HDAddressPayload
derivationPath = AddrAttributes -> Maybe HDAddressPayload
Byron.aaVKDerivationPath (Attributes AddrAttributes -> AddrAttributes
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 -> 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 (SlotNo32 Word32
slot) (TxIx Word16
txIx) (CertIx Word16
certIx)) = do
  Word64 -> Put
putVariableLengthWord64 (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
slot)
  Word64 -> Put
putVariableLengthWord64 (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
txIx) -- TODO: switch to using MemPack for compacting Address at which point
  Word64 -> Put
putVariableLengthWord64 (Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
certIx) --     this conversion from Word16 to Word64 will no longer be necessary

newtype Word7 = Word7 Word8
  deriving (Word7 -> Word7 -> Bool
(Word7 -> Word7 -> Bool) -> (Word7 -> Word7 -> Bool) -> Eq Word7
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word7 -> Word7 -> Bool
== :: Word7 -> Word7 -> Bool
$c/= :: Word7 -> Word7 -> Bool
/= :: Word7 -> Word7 -> Bool
Eq, Int -> Word7 -> ShowS
[Word7] -> ShowS
Word7 -> String
(Int -> Word7 -> ShowS)
-> (Word7 -> String) -> ([Word7] -> ShowS) -> Show Word7
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word7 -> ShowS
showsPrec :: Int -> Word7 -> ShowS
$cshow :: Word7 -> String
show :: Word7 -> String
$cshowList :: [Word7] -> ShowS
showList :: [Word7] -> ShowS
Show)

toWord7 :: Word8 -> Word7
toWord7 :: Word8 -> Word7
toWord7 Word8
x = Word8 -> Word7
Word7 (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F) -- 0x7F = 0b01111111

putWord7s :: [Word7] -> Put
putWord7s :: [Word7] -> Put
putWord7s [] = () -> Put
forall a. a -> PutM a
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Word7] -> Put
putWord7s [Word7]
xs

word64ToWord7s :: Word64 -> [Word7]
word64ToWord7s :: Word64 -> [Word7]
word64ToWord7s = [Word7] -> [Word7]
forall a. [a] -> [a]
reverse ([Word7] -> [Word7]) -> (Word64 -> [Word7]) -> Word64 -> [Word7]
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0x7F = (Word8 -> Word7
toWord7 (Word8 -> Word7) -> (Word64 -> Word8) -> Word64 -> Word7
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word64
n Word7 -> [Word7] -> [Word7]
forall a. a -> [a] -> [a]
: Word64 -> [Word7]
go (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
n Int
7)
      | Bool
otherwise = [Word8 -> Word7
Word7 (Word8 -> Word7) -> (Word64 -> Word8) -> Word64 -> Word7
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word7) -> Word64 -> Word7
forall a b. (a -> b) -> a -> b
$ Word64
n]

putVariableLengthWord64 :: Word64 -> Put
putVariableLengthWord64 :: Word64 -> Put
putVariableLengthWord64 = [Word7] -> Put
putWord7s ([Word7] -> Put) -> (Word64 -> [Word7]) -> Word64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> [Word7]
word64ToWord7s

instance EncCBOR Addr where
  encCBOR :: Addr -> Encoding
encCBOR = LazyByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (LazyByteString -> Encoding)
-> (Addr -> LazyByteString) -> Addr -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
B.runPut (Put -> LazyByteString) -> (Addr -> Put) -> Addr -> LazyByteString
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 = Decoder s Addr
forall s. Decoder s Addr
fromCborAddr
  {-# INLINE decCBOR #-}

instance EncCBOR AccountAddress where
  encCBOR :: AccountAddress -> Encoding
encCBOR = LazyByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (LazyByteString -> Encoding)
-> (AccountAddress -> LazyByteString) -> AccountAddress -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
B.runPut (Put -> LazyByteString)
-> (AccountAddress -> Put) -> AccountAddress -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountAddress -> Put
putAccountAddress
  {-# INLINE encCBOR #-}

instance DecCBOR AccountAddress where
  decCBOR :: forall s. Decoder s AccountAddress
decCBOR = Decoder s AccountAddress
forall s. Decoder s AccountAddress
fromCborAccountAddress
  {-# INLINE decCBOR #-}

newtype BootstrapAddress = BootstrapAddress
  { BootstrapAddress -> Address
unBootstrapAddress :: Byron.Address
  }
  deriving (BootstrapAddress -> BootstrapAddress -> Bool
(BootstrapAddress -> BootstrapAddress -> Bool)
-> (BootstrapAddress -> BootstrapAddress -> Bool)
-> Eq BootstrapAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BootstrapAddress -> BootstrapAddress -> Bool
== :: BootstrapAddress -> BootstrapAddress -> Bool
$c/= :: BootstrapAddress -> BootstrapAddress -> Bool
/= :: BootstrapAddress -> BootstrapAddress -> Bool
Eq, (forall x. BootstrapAddress -> Rep BootstrapAddress x)
-> (forall x. Rep BootstrapAddress x -> BootstrapAddress)
-> Generic BootstrapAddress
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
$cfrom :: forall x. BootstrapAddress -> Rep BootstrapAddress x
from :: forall x. BootstrapAddress -> Rep BootstrapAddress x
$cto :: forall x. Rep BootstrapAddress x -> BootstrapAddress
to :: forall x. Rep BootstrapAddress x -> BootstrapAddress
Generic)
  deriving newtype (BootstrapAddress -> ()
(BootstrapAddress -> ()) -> NFData BootstrapAddress
forall a. (a -> ()) -> NFData a
$crnf :: BootstrapAddress -> ()
rnf :: BootstrapAddress -> ()
NFData, Eq BootstrapAddress
Eq BootstrapAddress =>
(BootstrapAddress -> BootstrapAddress -> Ordering)
-> (BootstrapAddress -> BootstrapAddress -> Bool)
-> (BootstrapAddress -> BootstrapAddress -> Bool)
-> (BootstrapAddress -> BootstrapAddress -> Bool)
-> (BootstrapAddress -> BootstrapAddress -> Bool)
-> (BootstrapAddress -> BootstrapAddress -> BootstrapAddress)
-> (BootstrapAddress -> BootstrapAddress -> BootstrapAddress)
-> Ord 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
$ccompare :: BootstrapAddress -> BootstrapAddress -> Ordering
compare :: BootstrapAddress -> BootstrapAddress -> Ordering
$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
>= :: BootstrapAddress -> BootstrapAddress -> Bool
$cmax :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
max :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
$cmin :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
min :: BootstrapAddress -> BootstrapAddress -> BootstrapAddress
Ord)
  deriving (Int -> BootstrapAddress -> ShowS
[BootstrapAddress] -> ShowS
BootstrapAddress -> String
(Int -> BootstrapAddress -> ShowS)
-> (BootstrapAddress -> String)
-> ([BootstrapAddress] -> ShowS)
-> Show BootstrapAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BootstrapAddress -> ShowS
showsPrec :: Int -> BootstrapAddress -> ShowS
$cshow :: BootstrapAddress -> String
show :: BootstrapAddress -> String
$cshowList :: [BootstrapAddress] -> ShowS
showList :: [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 = AddressHash Address' -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.abstractHashToBytes AddressHash Address'
root
      !hash :: Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash =
        Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall a. a -> Maybe a -> a
fromMaybe (String -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall a. HasCallStack => String -> a
error String
"bootstrapKeyHash: incorrect hash length") (Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
 -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall a b. (a -> b) -> a -> b
$
          ByteString -> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
bytes
   in Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash Payment
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash

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

newtype CompactAddr = UnsafeCompactAddr ShortByteString
  deriving stock (CompactAddr -> CompactAddr -> Bool
(CompactAddr -> CompactAddr -> Bool)
-> (CompactAddr -> CompactAddr -> Bool) -> Eq CompactAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactAddr -> CompactAddr -> Bool
== :: CompactAddr -> CompactAddr -> Bool
$c/= :: CompactAddr -> CompactAddr -> Bool
/= :: CompactAddr -> CompactAddr -> Bool
Eq, (forall x. CompactAddr -> Rep CompactAddr x)
-> (forall x. Rep CompactAddr x -> CompactAddr)
-> Generic CompactAddr
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
$cfrom :: forall x. CompactAddr -> Rep CompactAddr x
from :: forall x. CompactAddr -> Rep CompactAddr x
$cto :: forall x. Rep CompactAddr x -> CompactAddr
to :: forall x. Rep CompactAddr x -> CompactAddr
Generic, Eq CompactAddr
Eq CompactAddr =>
(CompactAddr -> CompactAddr -> Ordering)
-> (CompactAddr -> CompactAddr -> Bool)
-> (CompactAddr -> CompactAddr -> Bool)
-> (CompactAddr -> CompactAddr -> Bool)
-> (CompactAddr -> CompactAddr -> Bool)
-> (CompactAddr -> CompactAddr -> CompactAddr)
-> (CompactAddr -> CompactAddr -> CompactAddr)
-> Ord 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
$ccompare :: CompactAddr -> CompactAddr -> Ordering
compare :: CompactAddr -> CompactAddr -> Ordering
$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
>= :: CompactAddr -> CompactAddr -> Bool
$cmax :: CompactAddr -> CompactAddr -> CompactAddr
max :: CompactAddr -> CompactAddr -> CompactAddr
$cmin :: CompactAddr -> CompactAddr -> CompactAddr
min :: CompactAddr -> CompactAddr -> CompactAddr
Ord)
  deriving newtype (Context -> CompactAddr -> IO (Maybe ThunkInfo)
Proxy CompactAddr -> String
(Context -> CompactAddr -> IO (Maybe ThunkInfo))
-> (Context -> CompactAddr -> IO (Maybe ThunkInfo))
-> (Proxy CompactAddr -> String)
-> NoThunks CompactAddr
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactAddr -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CompactAddr -> String
showTypeOf :: Proxy CompactAddr -> String
NoThunks, CompactAddr -> ()
(CompactAddr -> ()) -> NFData CompactAddr
forall a. (a -> ()) -> NFData a
$crnf :: CompactAddr -> ()
rnf :: CompactAddr -> ()
NFData, String
String
-> (CompactAddr -> Int)
-> (forall s. CompactAddr -> Pack s ())
-> (forall b s. Buffer b => Unpack s b CompactAddr)
-> MemPack CompactAddr
CompactAddr -> Int
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b s. Buffer b => Unpack s b a)
-> MemPack a
forall s. CompactAddr -> Pack s ()
forall b s. Buffer b => Unpack s b CompactAddr
$ctypeName :: String
typeName :: String
$cpackedByteCount :: CompactAddr -> Int
packedByteCount :: CompactAddr -> Int
$cpackM :: forall s. CompactAddr -> Pack s ()
packM :: forall s. CompactAddr -> Pack s ()
$cunpackM :: forall b s. Buffer b => Unpack s b CompactAddr
unpackM :: forall b s. Buffer b => Unpack s b CompactAddr
MemPack)

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

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

compactAddr :: Addr -> CompactAddr
compactAddr :: Addr -> CompactAddr
compactAddr = ShortByteString -> CompactAddr
UnsafeCompactAddr (ShortByteString -> CompactAddr)
-> (Addr -> ShortByteString) -> Addr -> CompactAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Addr -> ByteString) -> Addr -> ShortByteString
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 Fail String Addr -> Either String Addr
forall e a. (IsString e, Semigroup e) => Fail e a -> Either e a
runFail (Fail String Addr -> Either String Addr)
-> Fail String Addr -> Either String Addr
forall a b. (a -> b) -> a -> b
$ StateT Int (FailT String Identity) Addr -> Int -> Fail String Addr
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Bool
-> Bool
-> ShortByteString
-> StateT Int (FailT String Identity) Addr
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 ->
      String -> Addr
forall a. HasCallStack => String -> a
error (String -> Addr) -> String -> Addr
forall a b. (a -> b) -> a -> b
$
        String
"Impossible: Malformed CompactAddr was allowed into the system. "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Decoder error: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
{-# INLINE decompactAddr #-}

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

-- | Decoder for an `Addr`. Works in all eras
fromCborAddr :: Decoder s Addr
fromCborAddr :: forall s. Decoder s Addr
fromCborAddr = (Addr, CompactAddr) -> Addr
forall a b. (a, b) -> a
fst ((Addr, CompactAddr) -> Addr)
-> Decoder s (Addr, CompactAddr) -> Decoder s Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Addr, CompactAddr)
forall s. Decoder s (Addr, CompactAddr)
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 :: Decoder s CompactAddr
fromCborCompactAddr :: forall s. Decoder s CompactAddr
fromCborCompactAddr = (Addr, CompactAddr) -> CompactAddr
forall a b. (a, b) -> b
snd ((Addr, CompactAddr) -> CompactAddr)
-> Decoder s (Addr, CompactAddr) -> Decoder s CompactAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Addr, CompactAddr)
forall s. Decoder s (Addr, CompactAddr)
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 :: Decoder s (Addr, CompactAddr)
fromCborBothAddr :: forall s. Decoder s (Addr, CompactAddr)
fromCborBothAddr = do
  Version
-> Decoder s (Addr, CompactAddr)
-> Decoder s (Addr, CompactAddr)
-> Decoder s (Addr, CompactAddr)
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)
    ( Version
-> Decoder s (Addr, CompactAddr)
-> Decoder s (Addr, CompactAddr)
-> Decoder s (Addr, CompactAddr)
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 @9)
        (Bool -> Decoder s (Addr, CompactAddr)
forall s. Bool -> Decoder s (Addr, CompactAddr)
fromCborRigorousBothAddr Bool
False)
        (Bool -> Decoder s (Addr, CompactAddr)
forall s. Bool -> Decoder s (Addr, CompactAddr)
fromCborRigorousBothAddr Bool
True)
    )
    Decoder s (Addr, CompactAddr)
forall s. Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr
{-# INLINE fromCborBothAddr #-}

-- | Starting with Babbage we no longer allow addresses with garbage in them.
fromCborRigorousBothAddr ::
  -- | Should there be a hard failure for garbage pointers (`False`) or should they be normalized instead (`True`)
  Bool ->
  Decoder s (Addr, CompactAddr)
fromCborRigorousBothAddr :: forall s. Bool -> Decoder s (Addr, CompactAddr)
fromCborRigorousBothAddr Bool
isPtrLenient = do
  sbs <- Decoder s ShortByteString
forall s. Decoder s ShortByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
  flip evalStateT 0 $ do
    addr <- decodeAddrStateLenientT isPtrLenient False sbs
    pure (addr, UnsafeCompactAddr sbs)
{-# INLINE fromCborRigorousBothAddr #-}

-- | 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 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 :: Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr :: forall s. Decoder s (Addr, CompactAddr)
fromCborBackwardsBothAddr = do
  sbs <- Decoder s ShortByteString
forall s. Decoder s ShortByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
  flip evalStateT 0 $ do
    addr <- decodeAddrStateLenientT True True sbs
    bytesConsumed <- get
    let sbsCropped = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
bytesConsumed (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs
    pure (addr, UnsafeCompactAddr sbsCropped)
{-# INLINE fromCborBackwardsBothAddr #-}

-- | Class specialized for decoding of addresses
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
SBS.unsafeIndex
  {-# 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 = ShortByteString -> Int -> Maybe (Hash h a)
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 = ByteString -> ByteString
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 = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (Proxy h
forall {k} (t :: k). Proxy t
Proxy :: Proxy h))
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
BS.length ByteString
bs)
    ByteString -> Maybe (Hash h a)
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
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq, Eq Header
Eq Header =>
(Header -> Header -> Ordering)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Bool)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> Ord 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
$ccompare :: Header -> Header -> Ordering
compare :: Header -> Header -> Ordering
$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
>= :: Header -> Header -> Bool
$cmax :: Header -> Header -> Header
max :: Header -> Header -> Header
$cmin :: Header -> Header -> Header
min :: Header -> Header -> Header
Ord, Eq Header
Header
Eq Header =>
(Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> Header
-> (Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Bool)
-> (Header -> Maybe Int)
-> (Header -> Int)
-> (Header -> Bool)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int -> Header)
-> (Header -> Int)
-> Bits 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
$c.&. :: Header -> Header -> Header
.&. :: Header -> Header -> Header
$c.|. :: Header -> Header -> Header
.|. :: Header -> Header -> Header
$cxor :: Header -> Header -> Header
xor :: Header -> Header -> Header
$ccomplement :: Header -> Header
complement :: Header -> Header
$cshift :: Header -> Int -> Header
shift :: Header -> Int -> Header
$crotate :: Header -> Int -> Header
rotate :: Header -> Int -> Header
$czeroBits :: Header
zeroBits :: Header
$cbit :: Int -> Header
bit :: Int -> Header
$csetBit :: Header -> Int -> Header
setBit :: Header -> Int -> Header
$cclearBit :: Header -> Int -> Header
clearBit :: Header -> Int -> Header
$ccomplementBit :: Header -> Int -> Header
complementBit :: Header -> Int -> Header
$ctestBit :: Header -> Int -> Bool
testBit :: Header -> Int -> Bool
$cbitSizeMaybe :: Header -> Maybe Int
bitSizeMaybe :: Header -> Maybe Int
$cbitSize :: Header -> Int
bitSize :: Header -> Int
$cisSigned :: Header -> Bool
isSigned :: Header -> Bool
$cshiftL :: Header -> Int -> Header
shiftL :: Header -> Int -> Header
$cunsafeShiftL :: Header -> Int -> Header
unsafeShiftL :: Header -> Int -> Header
$cshiftR :: Header -> Int -> Header
shiftR :: Header -> Int -> Header
$cunsafeShiftR :: Header -> Int -> Header
unsafeShiftR :: Header -> Int -> Header
$crotateL :: Header -> Int -> Header
rotateL :: Header -> Int -> Header
$crotateR :: Header -> Int -> Header
rotateR :: Header -> Int -> Header
$cpopCount :: Header -> Int
popCount :: Header -> Int
Bits, Integer -> Header
Header -> Header
Header -> Header -> Header
(Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header -> Header)
-> (Header -> Header)
-> (Header -> Header)
-> (Header -> Header)
-> (Integer -> Header)
-> Num Header
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Header -> Header -> Header
+ :: Header -> Header -> Header
$c- :: Header -> Header -> Header
- :: Header -> Header -> Header
$c* :: Header -> Header -> Header
* :: Header -> Header -> Header
$cnegate :: Header -> Header
negate :: Header -> Header
$cabs :: Header -> Header
abs :: Header -> Header
$csignum :: Header -> Header
signum :: Header -> Header
$cfromInteger :: Integer -> Header
fromInteger :: Integer -> Header
Num)

instance Show Header where
  show :: Header -> String
show (Header Word8
header) = (String
"0b" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> (Int -> Char) -> Word8 -> ShowS
forall a. Integral a => a -> (Int -> Char) -> a -> ShowS
showIntAtBase Word8
2 Int -> Char
intToDigit Word8
header ShowS -> ShowS
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 = (Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
headerByron)
{-# INLINE isByronAddress #-}

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

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

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

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

headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress :: Header -> Bool
headerIsBaseAddress = Bool -> Bool
not (Bool -> Bool) -> (Header -> Bool) -> Header -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6)
{-# INLINE headerIsBaseAddress #-}

-- | Same as `decodeAddr`, but produces an `Either` result
decodeAddrEither ::
  BS.ByteString ->
  Either String Addr
decodeAddrEither :: ByteString -> Either String Addr
decodeAddrEither ByteString
bs = Fail String Addr -> Either String Addr
forall e a. (IsString e, Semigroup e) => Fail e a -> Either e a
runFail (Fail String Addr -> Either String Addr)
-> Fail String Addr -> Either String Addr
forall a b. (a -> b) -> a -> b
$ StateT Int (FailT String Identity) Addr -> Int -> Fail String Addr
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ByteString -> StateT Int (FailT String Identity) Addr
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
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 m.
  MonadFail m =>
  BS.ByteString ->
  m Addr
decodeAddr :: forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr ByteString
bs = StateT Int m Addr -> Int -> m Addr
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ByteString -> StateT Int m Addr
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
decodeAddrStateT ByteString
bs) Int
0
{-# INLINE decodeAddr #-}

-- | Just like `decodeAddrStateLenientT`, but enforces the address to be well-formed.
decodeAddrStateT ::
  (MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m Addr
decodeAddrStateT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Addr
decodeAddrStateT = Bool -> Bool -> b -> StateT Int m Addr
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
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 ::
  (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
decodeAddrStateLenientT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Bool -> Bool -> b -> StateT Int m Addr
decodeAddrStateLenientT Bool
isPtrLenient Bool
isLenient b
buf = do
  String -> Int -> b -> StateT Int m ()
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 (Word8 -> Header) -> Word8 -> Header
forall a b. (a -> b) -> a -> b
$ b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
  addr <-
    if Header -> Bool
isByronAddress Header
header
      then BootstrapAddress -> Addr
AddrBootstrap (BootstrapAddress -> Addr)
-> StateT Int m BootstrapAddress -> StateT Int m Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m BootstrapAddress
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m BootstrapAddress
decodeBootstrapAddress b
buf
      else do
        -- Ensure there are no unexpected bytes in the header
        Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header
header Header -> Header -> Header
forall a. Bits a => a -> a -> a
.&. Header
headerNonShelleyBits Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
0)
          (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> StateT Int m ()
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding
            String
"Shelley Address"
          (String -> StateT Int m ()) -> String -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid header. Unused bits are not suppose to be set: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Header -> String
forall a. Show a => a -> String
show Header
header
        -- Advance one byte for the consumed header
        (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        payment <- Header -> b -> StateT Int m (Credential Payment)
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (Credential Payment)
decodePaymentCredential Header
header b
buf
        staking <- decodeStakeReference isPtrLenient header buf
        pure $ Addr (headerNetworkId header) payment staking
  unless isLenient $
    ensureBufIsConsumed "Addr" buf
  pure 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
  lastOffset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let len = b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf
  unless (lastOffset == len) $
    failDecoding name $
      "Left over bytes: " ++ show (len - lastOffset)
{-# INLINE ensureBufIsConsumed #-}

-- | This decoder assumes the whole `ShortByteString` is occupied by the `BootstrapAddress`
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 Version -> ByteString -> Either DecoderError Address
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
byronProtVer (ByteString -> Either DecoderError Address)
-> ByteString -> Either DecoderError Address
forall a b. (a -> b) -> a -> b
$ b -> ByteString
forall b. AddressBuffer b => b -> ByteString
bufToByteString b
buf of
    Left DecoderError
e -> String -> StateT Int m BootstrapAddress
forall a. String -> StateT Int m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT Int m BootstrapAddress)
-> String -> StateT Int m BootstrapAddress
forall a b. (a -> b) -> a -> b
$ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
    Right Address
addr -> Address -> BootstrapAddress
BootstrapAddress Address
addr BootstrapAddress
-> StateT Int m () -> StateT Int m BootstrapAddress
forall a b. a -> StateT Int m b -> StateT Int m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf)
{-# INLINE decodeBootstrapAddress #-}

decodePaymentCredential ::
  (MonadFail m, AddressBuffer b) =>
  Header ->
  b ->
  StateT Int m (Credential Payment)
decodePaymentCredential :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
Header -> b -> StateT Int m (Credential Payment)
decodePaymentCredential Header
header b
buf
  | Header -> Bool
headerIsPaymentScript Header
header = ScriptHash -> Credential Payment
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Payment)
-> StateT Int m ScriptHash -> StateT Int m (Credential Payment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m ScriptHash
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
  | Bool
otherwise = KeyHash Payment -> Credential Payment
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Payment -> Credential Payment)
-> StateT Int m (KeyHash Payment)
-> StateT Int m (Credential Payment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash Payment)
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 (Credential Staking -> StakeReference)
-> (ScriptHash -> Credential Staking)
-> ScriptHash
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> StakeReference)
-> StateT Int m ScriptHash -> StateT Int m StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m ScriptHash
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
        else Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> (KeyHash Staking -> Credential Staking)
-> KeyHash Staking
-> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> StakeReference)
-> StateT Int m (KeyHash Staking) -> StateT Int m StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash Staking)
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 StakeReference -> StateT Int m StakeReference
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull
        else Ptr -> StakeReference
StakeRefPtr (Ptr -> StakeReference)
-> StateT Int m Ptr -> StateT Int m StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
isLenientPtrDecoder then b -> StateT Int m Ptr
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m Ptr
decodePtrLenient b
buf else b -> StateT Int m Ptr
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 = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash kr)
-> StateT Int m (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> StateT Int m (KeyHash kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (Hash ADDRHASH (VerKeyDSIGN DSIGN))
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 (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> StateT Int m (Hash ADDRHASH EraIndependentScript)
-> StateT Int m ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (Hash ADDRHASH EraIndependentScript)
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
  offset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  case bufGetHash buf offset of
    Just Hash h a
h -> Hash h a
h Hash h a -> StateT Int m () -> StateT Int m (Hash h a)
forall a b. a -> StateT Int m b -> StateT Int m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hashLen)
    Maybe (Hash h a)
Nothing
      | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 ->
          String -> String -> StateT Int m (Hash h a)
forall (m :: * -> *) a. MonadFail m => String -> String -> m a
failDecoding String
"Hash" (String -> StateT Int m (Hash h a))
-> String -> StateT Int m (Hash h a)
forall a b. (a -> b) -> a -> b
$
            String
"Not enough bytes supplied: "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (b -> Int
forall b. AddressBuffer b => b -> Int
bufLength b
buf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Expected: "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
hashLen
    Maybe (Hash h a)
Nothing -> String -> StateT Int m (Hash h a)
forall a. String -> StateT Int m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible: Negative offset"
  where
    hashLen :: Int
    hashLen :: Int
hashLen = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy h -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (Proxy h
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 =
  SlotNo32 -> TxIx -> CertIx -> Ptr
Ptr
    (SlotNo32 -> TxIx -> CertIx -> Ptr)
-> StateT Int m SlotNo32 -> StateT Int m (TxIx -> CertIx -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> SlotNo32
SlotNo32 (Word32 -> SlotNo32)
-> StateT Int m Word32 -> StateT Int m SlotNo32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word32
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word32
decodeVariableLengthWord32 String
"SlotNo" b
buf)
    StateT Int m (TxIx -> CertIx -> Ptr)
-> StateT Int m TxIx -> StateT Int m (CertIx -> Ptr)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> TxIx
TxIx (Word16 -> TxIx) -> StateT Int m Word16 -> StateT Int m TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word16
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word16
decodeVariableLengthWord16 String
"TxIx" b
buf)
    StateT Int m (CertIx -> Ptr)
-> StateT Int m CertIx -> StateT Int m Ptr
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> CertIx
CertIx (Word16 -> CertIx) -> StateT Int m Word16 -> StateT Int m CertIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word16
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 =
  Word64 -> Word64 -> Word64 -> Ptr
mkPtrNormalized
    (Word64 -> Word64 -> Word64 -> Ptr)
-> StateT Int m Word64 -> StateT Int m (Word64 -> Word64 -> Ptr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> b -> StateT Int m Word64
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
"SlotNo" b
buf
    StateT Int m (Word64 -> Word64 -> Ptr)
-> StateT Int m Word64 -> StateT Int m (Word64 -> Ptr)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> b -> StateT Int m Word64
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> b -> StateT Int m Word64
decodeVariableLengthWord64 String
"TxIx" b
buf
    StateT Int m (Word64 -> Ptr)
-> StateT Int m Word64 -> StateT Int m Ptr
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> b -> StateT Int m Word64
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
  offset <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  when (offset > bufLength buf - expectedLength) $
    failDecoding name "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
  String -> Int -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
name Int
1 b
buf
  offset <- (Int -> (Int, Int)) -> StateT Int m Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (\Int
off -> (Int
off, Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  let b8 = b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
offset
  if b8 `testBit` 7
    then cont (acc `shiftL` 7 .|. fromIntegral (b8 `clearBit` 7))
    else pure (acc `shiftL` 7 .|. fromIntegral 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 = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Decoding " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
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
  off0 <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let d7 = String
-> b
-> (Word16 -> StateT Int m Word16)
-> Word16
-> StateT Int m Word16
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
acc = do
        res <- String
-> b
-> (Word16 -> StateT Int m Word16)
-> Word16
-> StateT Int m Word16
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
_ -> String -> String -> StateT Int m 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.
        unless (bufUnsafeIndex buf off0 .&. 0b11111100 == 0b10000000) $
          failDecoding name "More than 16bits was supplied"
        pure res
  d7 (d7 d7last) 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
  off0 <- StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let d7 = String
-> b
-> (Word32 -> StateT Int m Word32)
-> Word32
-> StateT Int m Word32
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
acc = do
        res <- String
-> b
-> (Word32 -> StateT Int m Word32)
-> Word32
-> StateT Int m Word32
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
_ -> String -> String -> StateT Int m 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.
        unless (bufUnsafeIndex buf off0 .&. 0b11110000 == 0b10000000) $
          failDecoding name "More than 32bits was supplied"
        pure res
      {-# INLINE d7last #-}
  d7 (d7 (d7 (d7 d7last))) 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 = ((Word64 -> StateT Int m Word64) -> Word64 -> StateT Int m Word64)
-> Word64 -> StateT Int m Word64
forall a. (a -> a) -> a
fix (String
-> b
-> (Word64 -> StateT Int m Word64)
-> Word64
-> StateT Int m Word64
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 #-}

------------------------------------------------------------------------------------------
-- Account Address Deserializer ----------------------------------------------------------
------------------------------------------------------------------------------------------

-- | Account Address Header.
--
-- @
--
-- ┏━━━━━━━━━━━━━━━━━┳━┯━┯━┯━┯━┯━┯━┯━┓
-- ┃ Account Address ┃1┊1┊1┊x┊0┊0┊0┊x┃
-- ┗━━━━━━━━━━━━━━━━━╋━┿━┿━┿━┿━┿━┿━┿━╋━━━━━━━━━━━━━━━━━━━━━━━┓
--                   ┃1┊1┊1┊0┊0┊0┊0┊0┃ Testnet StakingKey    ┃
--                   ┃1┊1┊1┊0┊0┊0┊0┊1┃ Mainnet StakingKey    ┃
--                   ┃1┊1┊1┊1┊0┊0┊0┊0┃ Testnet StakingScript ┃
--                   ┃1┊1┊1┊1┊0┊0┊0┊1┃ Mainnet StakingScript ┃
--                   ┗━┷━┷━┷━┷━┷━┷━┷━┻━━━━━━━━━━━━━━━━━━━━━━━┛
--                          |       |
--                          |       `Is Mainnet Address
--                          `Account Credential is a Script
--
-- @
decodeAccountAddress ::
  forall b m.
  (AddressBuffer b, MonadFail m) =>
  b ->
  m AccountAddress
decodeAccountAddress :: forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m AccountAddress
decodeAccountAddress b
buf = StateT Int m AccountAddress -> Int -> m AccountAddress
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (b -> StateT Int m AccountAddress
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m AccountAddress
decodeAccountAddressT b
buf) Int
0

fromCborAccountAddress :: Decoder s AccountAddress
fromCborAccountAddress :: forall s. Decoder s AccountAddress
fromCborAccountAddress = do
  sbs :: ShortByteString <- Decoder s ShortByteString
forall s. Decoder s ShortByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
  decodeAccountAddress sbs

{-# DEPRECATED decodeRewardAccount "In favor of `decodeAccountAddress`" #-}
decodeRewardAccount ::
  forall b m.
  (AddressBuffer b, MonadFail m) =>
  b ->
  m AccountAddress
decodeRewardAccount :: forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m AccountAddress
decodeRewardAccount = b -> m AccountAddress
forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m AccountAddress
decodeAccountAddress

{-# DEPRECATED fromCborRewardAccount "In favor of `fromCborAccountAddress`" #-}
fromCborRewardAccount :: Decoder s AccountAddress
fromCborRewardAccount :: forall s. Decoder s AccountAddress
fromCborRewardAccount = Decoder s AccountAddress
forall s. Decoder s AccountAddress
fromCborAccountAddress

headerIsAccountAddress :: Header -> Bool
headerIsAccountAddress :: Header -> Bool
headerIsAccountAddress Header
header = Header
header Header -> Header -> Header
forall a. Bits a => a -> a -> a
.&. Header
0b11101110 Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
0b11100000
{-# INLINE headerIsAccountAddress #-}

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

decodeAccountAddressT ::
  (MonadFail m, AddressBuffer b) =>
  b ->
  StateT Int m AccountAddress
decodeAccountAddressT :: forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m AccountAddress
decodeAccountAddressT b
buf = do
  String -> Int -> b -> StateT Int m ()
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
String -> Int -> b -> StateT Int m ()
guardLength String
"Header" Int
1 b
buf
  (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  let header :: Header
header = Word8 -> Header
Header (Word8 -> Header) -> Word8 -> Header
forall a b. (a -> b) -> a -> b
$ b -> Int -> Word8
forall b. AddressBuffer b => b -> Int -> Word8
bufUnsafeIndex b
buf Int
0
  Bool -> StateT Int m () -> StateT Int m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Header -> Bool
headerIsAccountAddress Header
header) (StateT Int m () -> StateT Int m ())
-> StateT Int m () -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
    String -> StateT Int m ()
forall a. String -> StateT Int m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StateT Int m ()) -> String -> StateT Int m ()
forall a b. (a -> b) -> a -> b
$
      String
"Invalid header for the account address: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Header -> String
forall a. Show a => a -> String
show Header
header
  account <-
    if Header -> Bool
headerAccountAddressIsScript Header
header
      then ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Staking)
-> StateT Int m ScriptHash -> StateT Int m (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m ScriptHash
forall (m :: * -> *) b.
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m ScriptHash
decodeScriptHash b
buf
      else KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> StateT Int m (KeyHash Staking)
-> StateT Int m (Credential Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> StateT Int m (KeyHash Staking)
forall (m :: * -> *) b (kr :: KeyRole).
(MonadFail m, AddressBuffer b) =>
b -> StateT Int m (KeyHash kr)
decodeKeyHash b
buf
  ensureBufIsConsumed "AccountAddress" buf
  pure $! AccountAddress (headerNetworkId header) (AccountId account)
{-# INLINE decodeAccountAddressT #-}

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

instance DecCBOR CompactAddr where
  decCBOR :: forall s. Decoder s CompactAddr
decCBOR = Decoder s CompactAddr
forall s. Decoder s CompactAddr
fromCborCompactAddr
  {-# INLINE decCBOR #-}

-- | Efficiently check whether compacted adddress is an address with a credential
-- that is a payment script.
isPayCredScriptCompactAddr :: CompactAddr -> Bool
isPayCredScriptCompactAddr :: CompactAddr -> Bool
isPayCredScriptCompactAddr (UnsafeCompactAddr ShortByteString
bytes) =
  Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ShortByteString -> Int -> Word8
ShortByteString -> Int -> Word8
SBS.index ShortByteString
bytes Int
0) Int
payCredIsScript

-- | Efficiently check whether compated adddress is a Byron address.
isBootstrapCompactAddr :: CompactAddr -> Bool
isBootstrapCompactAddr :: CompactAddr -> Bool
isBootstrapCompactAddr (UnsafeCompactAddr ShortByteString
bytes) = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ShortByteString -> Int -> Word8
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
fromBoostrapCompactAddress :: CompactAddress -> CompactAddr
fromBoostrapCompactAddress = ShortByteString -> CompactAddr
UnsafeCompactAddr (ShortByteString -> CompactAddr)
-> (CompactAddress -> ShortByteString)
-> CompactAddress
-> CompactAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactAddress -> ShortByteString
Byron.unsafeGetCompactAddress

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

instance Semigroup Withdrawals where
  Withdrawals Map AccountAddress Coin
w1 <> :: Withdrawals -> Withdrawals -> Withdrawals
<> Withdrawals Map AccountAddress Coin
w2 = Map AccountAddress Coin -> Withdrawals
Withdrawals (Map AccountAddress Coin -> Withdrawals)
-> Map AccountAddress Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$ (Coin -> Coin -> Coin)
-> Map AccountAddress Coin
-> Map AccountAddress Coin
-> Map AccountAddress Coin
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Map AccountAddress Coin
w1 Map AccountAddress Coin
w2

instance Monoid Withdrawals where
  mempty :: Withdrawals
mempty = Map AccountAddress Coin -> Withdrawals
Withdrawals Map AccountAddress Coin
forall k a. Map k a
Map.empty

-- | Direct deposits to account addresses.
newtype DirectDeposits = DirectDeposits {DirectDeposits -> Map AccountAddress Coin
unDirectDeposits :: Map AccountAddress Coin}
  deriving (Int -> DirectDeposits -> ShowS
[DirectDeposits] -> ShowS
DirectDeposits -> String
(Int -> DirectDeposits -> ShowS)
-> (DirectDeposits -> String)
-> ([DirectDeposits] -> ShowS)
-> Show DirectDeposits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectDeposits -> ShowS
showsPrec :: Int -> DirectDeposits -> ShowS
$cshow :: DirectDeposits -> String
show :: DirectDeposits -> String
$cshowList :: [DirectDeposits] -> ShowS
showList :: [DirectDeposits] -> ShowS
Show, DirectDeposits -> DirectDeposits -> Bool
(DirectDeposits -> DirectDeposits -> Bool)
-> (DirectDeposits -> DirectDeposits -> Bool) -> Eq DirectDeposits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectDeposits -> DirectDeposits -> Bool
== :: DirectDeposits -> DirectDeposits -> Bool
$c/= :: DirectDeposits -> DirectDeposits -> Bool
/= :: DirectDeposits -> DirectDeposits -> Bool
Eq, (forall x. DirectDeposits -> Rep DirectDeposits x)
-> (forall x. Rep DirectDeposits x -> DirectDeposits)
-> Generic DirectDeposits
forall x. Rep DirectDeposits x -> DirectDeposits
forall x. DirectDeposits -> Rep DirectDeposits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectDeposits -> Rep DirectDeposits x
from :: forall x. DirectDeposits -> Rep DirectDeposits x
$cto :: forall x. Rep DirectDeposits x -> DirectDeposits
to :: forall x. Rep DirectDeposits x -> DirectDeposits
Generic)
  deriving newtype (Context -> DirectDeposits -> IO (Maybe ThunkInfo)
Proxy DirectDeposits -> String
(Context -> DirectDeposits -> IO (Maybe ThunkInfo))
-> (Context -> DirectDeposits -> IO (Maybe ThunkInfo))
-> (Proxy DirectDeposits -> String)
-> NoThunks DirectDeposits
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DirectDeposits -> IO (Maybe ThunkInfo)
noThunks :: Context -> DirectDeposits -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DirectDeposits -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DirectDeposits -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DirectDeposits -> String
showTypeOf :: Proxy DirectDeposits -> String
NoThunks, DirectDeposits -> ()
(DirectDeposits -> ()) -> NFData DirectDeposits
forall a. (a -> ()) -> NFData a
$crnf :: DirectDeposits -> ()
rnf :: DirectDeposits -> ()
NFData, DirectDeposits -> Encoding
(DirectDeposits -> Encoding) -> EncCBOR DirectDeposits
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: DirectDeposits -> Encoding
encCBOR :: DirectDeposits -> Encoding
EncCBOR, Typeable DirectDeposits
Typeable DirectDeposits =>
(forall s. Decoder s DirectDeposits)
-> (forall s. Proxy DirectDeposits -> Decoder s ())
-> (Proxy DirectDeposits -> Text)
-> DecCBOR DirectDeposits
Proxy DirectDeposits -> Text
forall s. Decoder s DirectDeposits
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy DirectDeposits -> Decoder s ()
$cdecCBOR :: forall s. Decoder s DirectDeposits
decCBOR :: forall s. Decoder s DirectDeposits
$cdropCBOR :: forall s. Proxy DirectDeposits -> Decoder s ()
dropCBOR :: forall s. Proxy DirectDeposits -> Decoder s ()
$clabel :: Proxy DirectDeposits -> Text
label :: Proxy DirectDeposits -> Text
DecCBOR)

instance Semigroup DirectDeposits where
  DirectDeposits Map AccountAddress Coin
d1 <> :: DirectDeposits -> DirectDeposits -> DirectDeposits
<> DirectDeposits Map AccountAddress Coin
d2 = Map AccountAddress Coin -> DirectDeposits
DirectDeposits (Map AccountAddress Coin -> DirectDeposits)
-> Map AccountAddress Coin -> DirectDeposits
forall a b. (a -> b) -> a -> b
$ (Coin -> Coin -> Coin)
-> Map AccountAddress Coin
-> Map AccountAddress Coin
-> Map AccountAddress Coin
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
(<>) Map AccountAddress Coin
d1 Map AccountAddress Coin
d2

instance Monoid DirectDeposits where
  mempty :: DirectDeposits
mempty = Map AccountAddress Coin -> DirectDeposits
DirectDeposits Map AccountAddress Coin
forall k a. Map k a
Map.empty