{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Cardano.Ledger.Shelley.TxBody
  ( DCert (..),
    DelegCert (..),
    Delegation (..),
    GenesisDelegCert (..),
    MIRCert (..),
    MIRPot (..),
    MIRTarget (..),
    PoolCert (..),
    PoolMetadata (..),
    PoolParams (..),
    Ptr (..),
    RewardAcnt (..),
    StakeCreds (..),
    StakePoolRelay (..),
    TxBody
      ( TxBody,
        TxBodyConstr,
        _inputs,
        _outputs,
        _certs,
        _wdrls,
        _txfee,
        _ttl,
        _txUpdate,
        _mdHash
      ),
    TxBodyRaw (..),
    EraIndependentTxBody,
    TxOut (TxOut, TxOutCompact),
    Url,
    Wdrl (..),
    WitVKey (WitVKey, wvkBytes),
    --
    witKeyHash,
    --
    SizeOfPoolOwners (..),
    SizeOfPoolRelays (..),
    --
    TransTxId,
    TransTxOut,
    TransTxBody,
  )
where

import Cardano.Binary
  ( Annotator (..),
    Case (..),
    FromCBOR (fromCBOR),
    Size,
    ToCBOR (..),
    TokenType (TypeMapLen, TypeMapLen64, TypeMapLenIndef),
    annotatorSlice,
    decodeWord,
    encodeListLen,
    encodePreEncoded,
    peekTokenType,
    serializeEncoding,
    szCases,
  )
import qualified Cardano.Crypto.Hash.Class as HS
import Cardano.Ledger.Address (Addr (..), RewardAcnt (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.BaseTypes
  ( DnsName,
    Port,
    StrictMaybe (..),
    UnitInterval,
    Url,
    invalidKey,
    maybeToStrictMaybe,
    strictMaybeToMaybe,
  )
import Cardano.Ledger.Coin (Coin (..), DeltaCoin)
import Cardano.Ledger.CompactAddress (CompactAddr, compactAddr, decompactAddr)
import Cardano.Ledger.Compactible
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Credential (Credential (..), Ptr (..), StakeCredential)
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Ledger.Era
import Cardano.Ledger.Hashes (EraIndependentTxBody, ScriptHash)
import Cardano.Ledger.Keys
  ( Hash,
    KeyHash (..),
    KeyRole (..),
    SignedDSIGN,
    VKey,
    VerKeyVRF,
    asWitness,
    decodeSignedDSIGN,
    encodeSignedDSIGN,
    hashKey,
    hashSignature,
  )
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash)
import Cardano.Ledger.Serialization
  ( CBORGroup (..),
    CborSeq (..),
    FromCBORGroup (..),
    ToCBORGroup (..),
    decodeNullMaybe,
    decodeRecordNamed,
    decodeRecordSum,
    decodeSet,
    decodeStrictSeq,
    encodeFoldable,
    encodeNullMaybe,
    ipv4FromCBOR,
    ipv4ToCBOR,
    ipv6FromCBOR,
    ipv6ToCBOR,
    listLenInt,
    mapFromCBOR,
    mapToCBOR,
  )
import Cardano.Ledger.Shelley.Constraints (TransValue)
import Cardano.Ledger.Shelley.Orphans ()
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Slot (EpochNo (..), SlotNo (..))
import qualified Cardano.Ledger.TxIn as Core
import Cardano.Ledger.Val (DecodeNonNegative (..))
import Cardano.Prelude (HeapWords (..), panic)
import Control.DeepSeq (NFData (rnf))
import Control.SetAlgebra (BaseRep (MapR), Embed (..), Exp (Base), HasExp (toExp))
import Data.Aeson (FromJSON (..), ToJSON (..), Value, (.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser, explicitParseField)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short (ShortByteString, pack)
import Data.Coders
  ( Decode (..),
    Density (..),
    Encode (..),
    Field,
    Wrapped (..),
    decode,
    encode,
    encodeKeyedStrictMaybe,
    field,
    invalidField,
    ofield,
    (!>),
  )
import Data.Constraint (Constraint)
import Data.Foldable (asum)
import Data.IP (IPv4, IPv6)
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.MemoBytes (Mem, MemoBytes (..), memoBytes)
import Data.Ord (comparing)
import Data.Proxy (Proxy (..))
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Sharing
import qualified Data.Text.Encoding as Text
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class
  ( AllowThunksIn (..),
    InspectHeapNamed (..),
    NoThunks (..),
  )
import Quiet

-- ========================================================================

instance HasExp (StakeCreds era) (Map (Credential 'Staking era) SlotNo) where
  toExp :: StakeCreds era -> Exp (Map (Credential 'Staking era) SlotNo)
toExp (StakeCreds Map (Credential 'Staking era) SlotNo
x) = BaseRep Map (Credential 'Staking era) SlotNo
-> Map (Credential 'Staking era) SlotNo
-> Exp (Map (Credential 'Staking era) SlotNo)
forall k (f :: * -> * -> *) v.
(Ord k, Basic f, Iter f) =>
BaseRep f k v -> f k v -> Exp (f k v)
Base BaseRep Map (Credential 'Staking era) SlotNo
forall k v. Basic Map => BaseRep Map k v
MapR Map (Credential 'Staking era) SlotNo
x

instance Embed (StakeCreds era) (Map (Credential 'Staking era) SlotNo) where
  toBase :: StakeCreds era -> Map (Credential 'Staking era) SlotNo
toBase (StakeCreds Map (Credential 'Staking era) SlotNo
x) = Map (Credential 'Staking era) SlotNo
x
  fromBase :: Map (Credential 'Staking era) SlotNo -> StakeCreds era
fromBase Map (Credential 'Staking era) SlotNo
x = Map (Credential 'Staking era) SlotNo -> StakeCreds era
forall era. Map (Credential 'Staking era) SlotNo -> StakeCreds era
StakeCreds Map (Credential 'Staking era) SlotNo
x

-- | The delegation of one stake key to another.
data Delegation crypto = Delegation
  { Delegation crypto -> StakeCredential crypto
_delegator :: !(StakeCredential crypto),
    Delegation crypto -> KeyHash 'StakePool crypto
_delegatee :: !(KeyHash 'StakePool crypto)
  }
  deriving (Delegation crypto -> Delegation crypto -> Bool
(Delegation crypto -> Delegation crypto -> Bool)
-> (Delegation crypto -> Delegation crypto -> Bool)
-> Eq (Delegation crypto)
forall crypto. Delegation crypto -> Delegation crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delegation crypto -> Delegation crypto -> Bool
$c/= :: forall crypto. Delegation crypto -> Delegation crypto -> Bool
== :: Delegation crypto -> Delegation crypto -> Bool
$c== :: forall crypto. Delegation crypto -> Delegation crypto -> Bool
Eq, (forall x. Delegation crypto -> Rep (Delegation crypto) x)
-> (forall x. Rep (Delegation crypto) x -> Delegation crypto)
-> Generic (Delegation crypto)
forall x. Rep (Delegation crypto) x -> Delegation crypto
forall x. Delegation crypto -> Rep (Delegation crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Delegation crypto) x -> Delegation crypto
forall crypto x. Delegation crypto -> Rep (Delegation crypto) x
$cto :: forall crypto x. Rep (Delegation crypto) x -> Delegation crypto
$cfrom :: forall crypto x. Delegation crypto -> Rep (Delegation crypto) x
Generic, Int -> Delegation crypto -> ShowS
[Delegation crypto] -> ShowS
Delegation crypto -> String
(Int -> Delegation crypto -> ShowS)
-> (Delegation crypto -> String)
-> ([Delegation crypto] -> ShowS)
-> Show (Delegation crypto)
forall crypto. Int -> Delegation crypto -> ShowS
forall crypto. [Delegation crypto] -> ShowS
forall crypto. Delegation crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delegation crypto] -> ShowS
$cshowList :: forall crypto. [Delegation crypto] -> ShowS
show :: Delegation crypto -> String
$cshow :: forall crypto. Delegation crypto -> String
showsPrec :: Int -> Delegation crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> Delegation crypto -> ShowS
Show, Delegation crypto -> ()
(Delegation crypto -> ()) -> NFData (Delegation crypto)
forall crypto. Delegation crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: Delegation crypto -> ()
$crnf :: forall crypto. Delegation crypto -> ()
NFData)

instance NoThunks (Delegation crypto)

data PoolMetadata = PoolMetadata
  { PoolMetadata -> Url
_poolMDUrl :: !Url,
    PoolMetadata -> ByteString
_poolMDHash :: !ByteString
  }
  deriving (PoolMetadata -> PoolMetadata -> Bool
(PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool) -> Eq PoolMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolMetadata -> PoolMetadata -> Bool
$c/= :: PoolMetadata -> PoolMetadata -> Bool
== :: PoolMetadata -> PoolMetadata -> Bool
$c== :: PoolMetadata -> PoolMetadata -> Bool
Eq, Eq PoolMetadata
Eq PoolMetadata
-> (PoolMetadata -> PoolMetadata -> Ordering)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> Bool)
-> (PoolMetadata -> PoolMetadata -> PoolMetadata)
-> (PoolMetadata -> PoolMetadata -> PoolMetadata)
-> Ord PoolMetadata
PoolMetadata -> PoolMetadata -> Bool
PoolMetadata -> PoolMetadata -> Ordering
PoolMetadata -> PoolMetadata -> PoolMetadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PoolMetadata -> PoolMetadata -> PoolMetadata
$cmin :: PoolMetadata -> PoolMetadata -> PoolMetadata
max :: PoolMetadata -> PoolMetadata -> PoolMetadata
$cmax :: PoolMetadata -> PoolMetadata -> PoolMetadata
>= :: PoolMetadata -> PoolMetadata -> Bool
$c>= :: PoolMetadata -> PoolMetadata -> Bool
> :: PoolMetadata -> PoolMetadata -> Bool
$c> :: PoolMetadata -> PoolMetadata -> Bool
<= :: PoolMetadata -> PoolMetadata -> Bool
$c<= :: PoolMetadata -> PoolMetadata -> Bool
< :: PoolMetadata -> PoolMetadata -> Bool
$c< :: PoolMetadata -> PoolMetadata -> Bool
compare :: PoolMetadata -> PoolMetadata -> Ordering
$ccompare :: PoolMetadata -> PoolMetadata -> Ordering
$cp1Ord :: Eq PoolMetadata
Ord, (forall x. PoolMetadata -> Rep PoolMetadata x)
-> (forall x. Rep PoolMetadata x -> PoolMetadata)
-> Generic PoolMetadata
forall x. Rep PoolMetadata x -> PoolMetadata
forall x. PoolMetadata -> Rep PoolMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoolMetadata x -> PoolMetadata
$cfrom :: forall x. PoolMetadata -> Rep PoolMetadata x
Generic, Int -> PoolMetadata -> ShowS
[PoolMetadata] -> ShowS
PoolMetadata -> String
(Int -> PoolMetadata -> ShowS)
-> (PoolMetadata -> String)
-> ([PoolMetadata] -> ShowS)
-> Show PoolMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolMetadata] -> ShowS
$cshowList :: [PoolMetadata] -> ShowS
show :: PoolMetadata -> String
$cshow :: PoolMetadata -> String
showsPrec :: Int -> PoolMetadata -> ShowS
$cshowsPrec :: Int -> PoolMetadata -> ShowS
Show)

deriving instance NFData PoolMetadata

instance ToJSON PoolMetadata where
  toJSON :: PoolMetadata -> Value
toJSON PoolMetadata
pmd =
    [Pair] -> Value
Aeson.object
      [ Key
"url" Key -> Url -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolMetadata -> Url
_poolMDUrl PoolMetadata
pmd,
        Key
"hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode) (PoolMetadata -> ByteString
_poolMDHash PoolMetadata
pmd)
      ]

instance FromJSON PoolMetadata where
  parseJSON :: Value -> Parser PoolMetadata
parseJSON =
    String
-> (Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolMetadata" ((Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata)
-> (Object -> Parser PoolMetadata) -> Value -> Parser PoolMetadata
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Url
url <- Object
obj Object -> Key -> Parser Url
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      ByteString
hash <- (Value -> Parser ByteString) -> Object -> Key -> Parser ByteString
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser ByteString
parseJsonBase16 Object
obj Key
"hash"
      PoolMetadata -> Parser PoolMetadata
forall (m :: * -> *) a. Monad m => a -> m a
return (PoolMetadata -> Parser PoolMetadata)
-> PoolMetadata -> Parser PoolMetadata
forall a b. (a -> b) -> a -> b
$ Url -> ByteString -> PoolMetadata
PoolMetadata Url
url ByteString
hash

parseJsonBase16 :: Value -> Parser ByteString
parseJsonBase16 :: Value -> Parser ByteString
parseJsonBase16 Value
v = do
  String
s <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  case ByteString -> Either String ByteString
B16.decode (String -> ByteString
Char8.pack String
s) of
    Right ByteString
bs -> ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    Left String
msg -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

instance NoThunks PoolMetadata

data StakePoolRelay
  = -- | One or both of IPv4 & IPv6
    SingleHostAddr !(StrictMaybe Port) !(StrictMaybe IPv4) !(StrictMaybe IPv6)
  | -- | An @A@ or @AAAA@ DNS record
    SingleHostName !(StrictMaybe Port) !DnsName
  | -- | A @SRV@ DNS record
    MultiHostName !DnsName
  deriving (StakePoolRelay -> StakePoolRelay -> Bool
(StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool) -> Eq StakePoolRelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakePoolRelay -> StakePoolRelay -> Bool
$c/= :: StakePoolRelay -> StakePoolRelay -> Bool
== :: StakePoolRelay -> StakePoolRelay -> Bool
$c== :: StakePoolRelay -> StakePoolRelay -> Bool
Eq, Eq StakePoolRelay
Eq StakePoolRelay
-> (StakePoolRelay -> StakePoolRelay -> Ordering)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> Bool)
-> (StakePoolRelay -> StakePoolRelay -> StakePoolRelay)
-> (StakePoolRelay -> StakePoolRelay -> StakePoolRelay)
-> Ord StakePoolRelay
StakePoolRelay -> StakePoolRelay -> Bool
StakePoolRelay -> StakePoolRelay -> Ordering
StakePoolRelay -> StakePoolRelay -> StakePoolRelay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
$cmin :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
max :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
$cmax :: StakePoolRelay -> StakePoolRelay -> StakePoolRelay
>= :: StakePoolRelay -> StakePoolRelay -> Bool
$c>= :: StakePoolRelay -> StakePoolRelay -> Bool
> :: StakePoolRelay -> StakePoolRelay -> Bool
$c> :: StakePoolRelay -> StakePoolRelay -> Bool
<= :: StakePoolRelay -> StakePoolRelay -> Bool
$c<= :: StakePoolRelay -> StakePoolRelay -> Bool
< :: StakePoolRelay -> StakePoolRelay -> Bool
$c< :: StakePoolRelay -> StakePoolRelay -> Bool
compare :: StakePoolRelay -> StakePoolRelay -> Ordering
$ccompare :: StakePoolRelay -> StakePoolRelay -> Ordering
$cp1Ord :: Eq StakePoolRelay
Ord, (forall x. StakePoolRelay -> Rep StakePoolRelay x)
-> (forall x. Rep StakePoolRelay x -> StakePoolRelay)
-> Generic StakePoolRelay
forall x. Rep StakePoolRelay x -> StakePoolRelay
forall x. StakePoolRelay -> Rep StakePoolRelay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StakePoolRelay x -> StakePoolRelay
$cfrom :: forall x. StakePoolRelay -> Rep StakePoolRelay x
Generic, Int -> StakePoolRelay -> ShowS
[StakePoolRelay] -> ShowS
StakePoolRelay -> String
(Int -> StakePoolRelay -> ShowS)
-> (StakePoolRelay -> String)
-> ([StakePoolRelay] -> ShowS)
-> Show StakePoolRelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakePoolRelay] -> ShowS
$cshowList :: [StakePoolRelay] -> ShowS
show :: StakePoolRelay -> String
$cshow :: StakePoolRelay -> String
showsPrec :: Int -> StakePoolRelay -> ShowS
$cshowsPrec :: Int -> StakePoolRelay -> ShowS
Show)

instance FromJSON StakePoolRelay where
  parseJSON :: Value -> Parser StakePoolRelay
parseJSON =
    String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Credential" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      [Parser StakePoolRelay] -> Parser StakePoolRelay
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser1 Object
obj Key
"single host address",
          (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser2 Object
obj Key
"single host name",
          (Value -> Parser StakePoolRelay)
-> Object -> Key -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser3 Object
obj Key
"multi host name"
        ]
    where
      parser1 :: Value -> Parser StakePoolRelay
parser1 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostAddr" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr
          (StrictMaybe Port
 -> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe Port)
-> Parser (StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" Parser (Maybe (StrictMaybe Port))
-> StrictMaybe Port -> Parser (StrictMaybe Port)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe Port
forall a. StrictMaybe a
SNothing
          Parser (StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe IPv4)
-> Parser (StrictMaybe IPv6 -> StakePoolRelay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe IPv4))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv4" Parser (Maybe (StrictMaybe IPv4))
-> StrictMaybe IPv4 -> Parser (StrictMaybe IPv4)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe IPv4
forall a. StrictMaybe a
SNothing
          Parser (StrictMaybe IPv6 -> StakePoolRelay)
-> Parser (StrictMaybe IPv6) -> Parser StakePoolRelay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe IPv6))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"IPv6" Parser (Maybe (StrictMaybe IPv6))
-> StrictMaybe IPv6 -> Parser (StrictMaybe IPv6)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe IPv6
forall a. StrictMaybe a
SNothing
      parser2 :: Value -> Parser StakePoolRelay
parser2 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SingleHostName" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName
          (StrictMaybe Port -> DnsName -> StakePoolRelay)
-> Parser (StrictMaybe Port) -> Parser (DnsName -> StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"port" Parser (Maybe (StrictMaybe Port))
-> StrictMaybe Port -> Parser (StrictMaybe Port)
forall a. Parser (Maybe a) -> a -> Parser a
.!= StrictMaybe Port
forall a. StrictMaybe a
SNothing
          Parser (DnsName -> StakePoolRelay)
-> Parser DnsName -> Parser StakePoolRelay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser DnsName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dnsName"
      parser3 :: Value -> Parser StakePoolRelay
parser3 = String
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"MultiHostName" ((Object -> Parser StakePoolRelay)
 -> Value -> Parser StakePoolRelay)
-> (Object -> Parser StakePoolRelay)
-> Value
-> Parser StakePoolRelay
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        DnsName -> StakePoolRelay
MultiHostName
          (DnsName -> StakePoolRelay)
-> Parser DnsName -> Parser StakePoolRelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser DnsName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dnsName"

instance ToJSON StakePoolRelay where
  toJSON :: StakePoolRelay -> Value
toJSON (SingleHostAddr StrictMaybe Port
port StrictMaybe IPv4
ipv4 StrictMaybe IPv6
ipv6) =
    [Pair] -> Value
Aeson.object
      [ Key
"single host address"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" Key -> StrictMaybe Port -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port,
              Key
"IPv4" Key -> StrictMaybe IPv4 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe IPv4
ipv4,
              Key
"IPv6" Key -> StrictMaybe IPv6 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe IPv6
ipv6
            ]
      ]
  toJSON (SingleHostName StrictMaybe Port
port DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Key
"single host name"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"port" Key -> StrictMaybe Port -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Port
port,
              Key
"dnsName" Key -> DnsName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DnsName
dnsName
            ]
      ]
  toJSON (MultiHostName DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Key
"multi host name"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"dnsName" Key -> DnsName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DnsName
dnsName
            ]
      ]

instance NoThunks StakePoolRelay

instance NFData StakePoolRelay

instance ToCBOR StakePoolRelay where
  toCBOR :: StakePoolRelay -> Encoding
toCBOR (SingleHostAddr StrictMaybe Port
p StrictMaybe IPv4
ipv4 StrictMaybe IPv6
ipv6) =
    Word -> Encoding
encodeListLen Word
4
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Port -> Encoding) -> Maybe Port -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe Port -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (IPv4 -> Encoding) -> Maybe IPv4 -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe IPv4 -> Encoding
ipv4ToCBOR (StrictMaybe IPv4 -> Maybe IPv4
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv4
ipv4)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (IPv6 -> Encoding) -> Maybe IPv6 -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe IPv6 -> Encoding
ipv6ToCBOR (StrictMaybe IPv6 -> Maybe IPv6
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe IPv6
ipv6)
  toCBOR (SingleHostName StrictMaybe Port
p DnsName
n) =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Port -> Encoding) -> Maybe Port -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe Port -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe Port -> Maybe Port
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe Port
p)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DnsName -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DnsName
n
  toCBOR (MultiHostName DnsName
n) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> DnsName -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR DnsName
n

instance FromCBOR StakePoolRelay where
  fromCBOR :: Decoder s StakePoolRelay
fromCBOR = String
-> (Word -> Decoder s (Int, StakePoolRelay))
-> Decoder s StakePoolRelay
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"StakePoolRelay" ((Word -> Decoder s (Int, StakePoolRelay))
 -> Decoder s StakePoolRelay)
-> (Word -> Decoder s (Int, StakePoolRelay))
-> Decoder s StakePoolRelay
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 ->
        (\StrictMaybe Port
x StrictMaybe IPv4
y StrictMaybe IPv6
z -> (Int
4, StrictMaybe Port
-> StrictMaybe IPv4 -> StrictMaybe IPv6 -> StakePoolRelay
SingleHostAddr StrictMaybe Port
x StrictMaybe IPv4
y StrictMaybe IPv6
z))
          (StrictMaybe Port
 -> StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe Port)
-> Decoder
     s (StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Port -> StrictMaybe Port
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe Port -> StrictMaybe Port)
-> Decoder s (Maybe Port) -> Decoder s (StrictMaybe Port)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Port -> Decoder s (Maybe Port)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s Port
forall a s. FromCBOR a => Decoder s a
fromCBOR)
          Decoder
  s (StrictMaybe IPv4 -> StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe IPv4)
-> Decoder s (StrictMaybe IPv6 -> (Int, StakePoolRelay))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe IPv4 -> StrictMaybe IPv4
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe IPv4 -> StrictMaybe IPv4)
-> Decoder s (Maybe IPv4) -> Decoder s (StrictMaybe IPv4)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IPv4 -> Decoder s (Maybe IPv4)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IPv4
forall s. Decoder s IPv4
ipv4FromCBOR)
          Decoder s (StrictMaybe IPv6 -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe IPv6) -> Decoder s (Int, StakePoolRelay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe IPv6 -> StrictMaybe IPv6
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe IPv6 -> StrictMaybe IPv6)
-> Decoder s (Maybe IPv6) -> Decoder s (StrictMaybe IPv6)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s IPv6 -> Decoder s (Maybe IPv6)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s IPv6
forall s. Decoder s IPv6
ipv6FromCBOR)
      Word
1 ->
        (\StrictMaybe Port
x DnsName
y -> (Int
3, StrictMaybe Port -> DnsName -> StakePoolRelay
SingleHostName StrictMaybe Port
x DnsName
y))
          (StrictMaybe Port -> DnsName -> (Int, StakePoolRelay))
-> Decoder s (StrictMaybe Port)
-> Decoder s (DnsName -> (Int, StakePoolRelay))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Port -> StrictMaybe Port
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe Port -> StrictMaybe Port)
-> Decoder s (Maybe Port) -> Decoder s (StrictMaybe Port)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Port -> Decoder s (Maybe Port)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s Port
forall a s. FromCBOR a => Decoder s a
fromCBOR)
          Decoder s (DnsName -> (Int, StakePoolRelay))
-> Decoder s DnsName -> Decoder s (Int, StakePoolRelay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s DnsName
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word
2 -> do
        DnsName
x <- Decoder s DnsName
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, StakePoolRelay) -> Decoder s (Int, StakePoolRelay)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, DnsName -> StakePoolRelay
MultiHostName DnsName
x)
      Word
k -> Word -> Decoder s (Int, StakePoolRelay)
forall s a. Word -> Decoder s a
invalidKey Word
k

-- | A stake pool.
data PoolParams crypto = PoolParams
  { PoolParams crypto -> KeyHash 'StakePool crypto
_poolId :: !(KeyHash 'StakePool crypto),
    PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf :: !(Hash crypto (VerKeyVRF crypto)),
    PoolParams crypto -> Coin
_poolPledge :: !Coin,
    PoolParams crypto -> Coin
_poolCost :: !Coin,
    PoolParams crypto -> UnitInterval
_poolMargin :: !UnitInterval,
    PoolParams crypto -> RewardAcnt crypto
_poolRAcnt :: !(RewardAcnt crypto),
    PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners :: !(Set (KeyHash 'Staking crypto)),
    PoolParams crypto -> StrictSeq StakePoolRelay
_poolRelays :: !(StrictSeq StakePoolRelay),
    PoolParams crypto -> StrictMaybe PoolMetadata
_poolMD :: !(StrictMaybe PoolMetadata)
  }
  deriving (Int -> PoolParams crypto -> ShowS
[PoolParams crypto] -> ShowS
PoolParams crypto -> String
(Int -> PoolParams crypto -> ShowS)
-> (PoolParams crypto -> String)
-> ([PoolParams crypto] -> ShowS)
-> Show (PoolParams crypto)
forall crypto. Int -> PoolParams crypto -> ShowS
forall crypto. [PoolParams crypto] -> ShowS
forall crypto. PoolParams crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolParams crypto] -> ShowS
$cshowList :: forall crypto. [PoolParams crypto] -> ShowS
show :: PoolParams crypto -> String
$cshow :: forall crypto. PoolParams crypto -> String
showsPrec :: Int -> PoolParams crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PoolParams crypto -> ShowS
Show, (forall x. PoolParams crypto -> Rep (PoolParams crypto) x)
-> (forall x. Rep (PoolParams crypto) x -> PoolParams crypto)
-> Generic (PoolParams crypto)
forall x. Rep (PoolParams crypto) x -> PoolParams crypto
forall x. PoolParams crypto -> Rep (PoolParams crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PoolParams crypto) x -> PoolParams crypto
forall crypto x. PoolParams crypto -> Rep (PoolParams crypto) x
$cto :: forall crypto x. Rep (PoolParams crypto) x -> PoolParams crypto
$cfrom :: forall crypto x. PoolParams crypto -> Rep (PoolParams crypto) x
Generic, PoolParams crypto -> PoolParams crypto -> Bool
(PoolParams crypto -> PoolParams crypto -> Bool)
-> (PoolParams crypto -> PoolParams crypto -> Bool)
-> Eq (PoolParams crypto)
forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolParams crypto -> PoolParams crypto -> Bool
$c/= :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
== :: PoolParams crypto -> PoolParams crypto -> Bool
$c== :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
Eq, Eq (PoolParams crypto)
Eq (PoolParams crypto)
-> (PoolParams crypto -> PoolParams crypto -> Ordering)
-> (PoolParams crypto -> PoolParams crypto -> Bool)
-> (PoolParams crypto -> PoolParams crypto -> Bool)
-> (PoolParams crypto -> PoolParams crypto -> Bool)
-> (PoolParams crypto -> PoolParams crypto -> Bool)
-> (PoolParams crypto -> PoolParams crypto -> PoolParams crypto)
-> (PoolParams crypto -> PoolParams crypto -> PoolParams crypto)
-> Ord (PoolParams crypto)
PoolParams crypto -> PoolParams crypto -> Bool
PoolParams crypto -> PoolParams crypto -> Ordering
PoolParams crypto -> PoolParams crypto -> PoolParams crypto
forall crypto. Eq (PoolParams crypto)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
forall crypto. PoolParams crypto -> PoolParams crypto -> Ordering
forall crypto.
PoolParams crypto -> PoolParams crypto -> PoolParams crypto
min :: PoolParams crypto -> PoolParams crypto -> PoolParams crypto
$cmin :: forall crypto.
PoolParams crypto -> PoolParams crypto -> PoolParams crypto
max :: PoolParams crypto -> PoolParams crypto -> PoolParams crypto
$cmax :: forall crypto.
PoolParams crypto -> PoolParams crypto -> PoolParams crypto
>= :: PoolParams crypto -> PoolParams crypto -> Bool
$c>= :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
> :: PoolParams crypto -> PoolParams crypto -> Bool
$c> :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
<= :: PoolParams crypto -> PoolParams crypto -> Bool
$c<= :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
< :: PoolParams crypto -> PoolParams crypto -> Bool
$c< :: forall crypto. PoolParams crypto -> PoolParams crypto -> Bool
compare :: PoolParams crypto -> PoolParams crypto -> Ordering
$ccompare :: forall crypto. PoolParams crypto -> PoolParams crypto -> Ordering
$cp1Ord :: forall crypto. Eq (PoolParams crypto)
Ord)
  deriving (Typeable (PoolParams crypto)
Typeable (PoolParams crypto)
-> (PoolParams crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (PoolParams crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PoolParams crypto] -> Size)
-> ToCBOR (PoolParams crypto)
PoolParams crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams crypto) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall crypto. Crypto crypto => Typeable (PoolParams crypto)
forall crypto. Crypto crypto => PoolParams crypto -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams crypto] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams crypto) -> Size
toCBOR :: PoolParams crypto -> Encoding
$ctoCBOR :: forall crypto. Crypto crypto => PoolParams crypto -> Encoding
$cp1ToCBOR :: forall crypto. Crypto crypto => Typeable (PoolParams crypto)
ToCBOR) via CBORGroup (PoolParams crypto)
  deriving (Typeable (PoolParams crypto)
Decoder s (PoolParams crypto)
Typeable (PoolParams crypto)
-> (forall s. Decoder s (PoolParams crypto))
-> (Proxy (PoolParams crypto) -> Text)
-> FromCBOR (PoolParams crypto)
Proxy (PoolParams crypto) -> Text
forall s. Decoder s (PoolParams crypto)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall crypto. Crypto crypto => Typeable (PoolParams crypto)
forall crypto. Crypto crypto => Proxy (PoolParams crypto) -> Text
forall crypto s. Crypto crypto => Decoder s (PoolParams crypto)
label :: Proxy (PoolParams crypto) -> Text
$clabel :: forall crypto. Crypto crypto => Proxy (PoolParams crypto) -> Text
fromCBOR :: Decoder s (PoolParams crypto)
$cfromCBOR :: forall crypto s. Crypto crypto => Decoder s (PoolParams crypto)
$cp1FromCBOR :: forall crypto. Crypto crypto => Typeable (PoolParams crypto)
FromCBOR) via CBORGroup (PoolParams crypto)

instance NoThunks (PoolParams crypto)

deriving instance NFData (PoolParams crypto)

newtype Wdrl crypto = Wdrl {Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl :: Map (RewardAcnt crypto) Coin}
  deriving (Int -> Wdrl crypto -> ShowS
[Wdrl crypto] -> ShowS
Wdrl crypto -> String
(Int -> Wdrl crypto -> ShowS)
-> (Wdrl crypto -> String)
-> ([Wdrl crypto] -> ShowS)
-> Show (Wdrl crypto)
forall crypto. Int -> Wdrl crypto -> ShowS
forall crypto. [Wdrl crypto] -> ShowS
forall crypto. Wdrl crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wdrl crypto] -> ShowS
$cshowList :: forall crypto. [Wdrl crypto] -> ShowS
show :: Wdrl crypto -> String
$cshow :: forall crypto. Wdrl crypto -> String
showsPrec :: Int -> Wdrl crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> Wdrl crypto -> ShowS
Show, Wdrl crypto -> Wdrl crypto -> Bool
(Wdrl crypto -> Wdrl crypto -> Bool)
-> (Wdrl crypto -> Wdrl crypto -> Bool) -> Eq (Wdrl crypto)
forall crypto. Wdrl crypto -> Wdrl crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wdrl crypto -> Wdrl crypto -> Bool
$c/= :: forall crypto. Wdrl crypto -> Wdrl crypto -> Bool
== :: Wdrl crypto -> Wdrl crypto -> Bool
$c== :: forall crypto. Wdrl crypto -> Wdrl crypto -> Bool
Eq, (forall x. Wdrl crypto -> Rep (Wdrl crypto) x)
-> (forall x. Rep (Wdrl crypto) x -> Wdrl crypto)
-> Generic (Wdrl crypto)
forall x. Rep (Wdrl crypto) x -> Wdrl crypto
forall x. Wdrl crypto -> Rep (Wdrl crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (Wdrl crypto) x -> Wdrl crypto
forall crypto x. Wdrl crypto -> Rep (Wdrl crypto) x
$cto :: forall crypto x. Rep (Wdrl crypto) x -> Wdrl crypto
$cfrom :: forall crypto x. Wdrl crypto -> Rep (Wdrl crypto) x
Generic)
  deriving newtype (Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
Proxy (Wdrl crypto) -> String
(Context -> Wdrl crypto -> IO (Maybe ThunkInfo))
-> (Context -> Wdrl crypto -> IO (Maybe ThunkInfo))
-> (Proxy (Wdrl crypto) -> String)
-> NoThunks (Wdrl crypto)
forall crypto. Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (Wdrl crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Wdrl crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (Wdrl crypto) -> String
wNoThunks :: Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> Wdrl crypto -> IO (Maybe ThunkInfo)
NoThunks, Wdrl crypto -> ()
(Wdrl crypto -> ()) -> NFData (Wdrl crypto)
forall crypto. Wdrl crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: Wdrl crypto -> ()
$crnf :: forall crypto. Wdrl crypto -> ()
NFData)

instance CC.Crypto crypto => ToCBOR (Wdrl crypto) where
  toCBOR :: Wdrl crypto -> Encoding
toCBOR = Map (RewardAcnt crypto) Coin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR (Map (RewardAcnt crypto) Coin -> Encoding)
-> (Wdrl crypto -> Map (RewardAcnt crypto) Coin)
-> Wdrl crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl crypto -> Map (RewardAcnt crypto) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl

instance CC.Crypto crypto => FromCBOR (Wdrl crypto) where
  fromCBOR :: Decoder s (Wdrl crypto)
fromCBOR = Map (RewardAcnt crypto) Coin -> Wdrl crypto
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Wdrl (Map (RewardAcnt crypto) Coin -> Wdrl crypto)
-> Decoder s (Map (RewardAcnt crypto) Coin)
-> Decoder s (Wdrl crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (RewardAcnt crypto) Coin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR

instance CC.Crypto crypto => ToJSON (PoolParams crypto) where
  toJSON :: PoolParams crypto -> Value
toJSON PoolParams crypto
pp =
    [Pair] -> Value
Aeson.object
      [ Key
"publicKey" Key -> KeyHash 'StakePool crypto -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> KeyHash 'StakePool crypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams crypto
pp, -- TODO publicKey is an unfortunate name, should be poolId
        Key
"vrf" Key -> Hash (HASH crypto) (VerKeyVRF (VRF crypto)) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf PoolParams crypto
pp,
        Key
"pledge" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams crypto
pp,
        Key
"cost" Key -> Coin -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolCost PoolParams crypto
pp,
        Key
"margin" Key -> UnitInterval -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> UnitInterval
forall crypto. PoolParams crypto -> UnitInterval
_poolMargin PoolParams crypto
pp,
        Key
"rewardAccount" Key -> RewardAcnt crypto -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> RewardAcnt crypto
forall crypto. PoolParams crypto -> RewardAcnt crypto
_poolRAcnt PoolParams crypto
pp,
        Key
"owners" Key -> Set (KeyHash 'Staking crypto) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
pp,
        Key
"relays" Key -> StrictSeq StakePoolRelay -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> StrictSeq StakePoolRelay
forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
_poolRelays PoolParams crypto
pp,
        Key
"metadata" Key -> StrictMaybe PoolMetadata -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PoolParams crypto -> StrictMaybe PoolMetadata
forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
_poolMD PoolParams crypto
pp
      ]

instance CC.Crypto crypto => FromJSON (PoolParams crypto) where
  parseJSON :: Value -> Parser (PoolParams crypto)
parseJSON =
    String
-> (Object -> Parser (PoolParams crypto))
-> Value
-> Parser (PoolParams crypto)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PoolParams" ((Object -> Parser (PoolParams crypto))
 -> Value -> Parser (PoolParams crypto))
-> (Object -> Parser (PoolParams crypto))
-> Value
-> Parser (PoolParams crypto)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      KeyHash 'StakePool crypto
-> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
PoolParams
        (KeyHash 'StakePool crypto
 -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
 -> Coin
 -> Coin
 -> UnitInterval
 -> RewardAcnt crypto
 -> Set (KeyHash 'Staking crypto)
 -> StrictSeq StakePoolRelay
 -> StrictMaybe PoolMetadata
 -> PoolParams crypto)
-> Parser (KeyHash 'StakePool crypto)
-> Parser
     (Hash (HASH crypto) (VerKeyVRF (VRF crypto))
      -> Coin
      -> Coin
      -> UnitInterval
      -> RewardAcnt crypto
      -> Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (KeyHash 'StakePool crypto)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publicKey" -- TODO publicKey is an unfortunate name, should be poolId
        Parser
  (Hash (HASH crypto) (VerKeyVRF (VRF crypto))
   -> Coin
   -> Coin
   -> UnitInterval
   -> RewardAcnt crypto
   -> Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
-> Parser
     (Coin
      -> Coin
      -> UnitInterval
      -> RewardAcnt crypto
      -> Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object
-> Key -> Parser (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vrf"
        Parser
  (Coin
   -> Coin
   -> UnitInterval
   -> RewardAcnt crypto
   -> Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser Coin
-> Parser
     (Coin
      -> UnitInterval
      -> RewardAcnt crypto
      -> Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pledge"
        Parser
  (Coin
   -> UnitInterval
   -> RewardAcnt crypto
   -> Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser Coin
-> Parser
     (UnitInterval
      -> RewardAcnt crypto
      -> Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Coin
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cost"
        Parser
  (UnitInterval
   -> RewardAcnt crypto
   -> Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser UnitInterval
-> Parser
     (RewardAcnt crypto
      -> Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"margin"
        Parser
  (RewardAcnt crypto
   -> Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser (RewardAcnt crypto)
-> Parser
     (Set (KeyHash 'Staking crypto)
      -> StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata
      -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (RewardAcnt crypto)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rewardAccount"
        Parser
  (Set (KeyHash 'Staking crypto)
   -> StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata
   -> PoolParams crypto)
-> Parser (Set (KeyHash 'Staking crypto))
-> Parser
     (StrictSeq StakePoolRelay
      -> StrictMaybe PoolMetadata -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Set (KeyHash 'Staking crypto))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owners"
        Parser
  (StrictSeq StakePoolRelay
   -> StrictMaybe PoolMetadata -> PoolParams crypto)
-> Parser (StrictSeq StakePoolRelay)
-> Parser (StrictMaybe PoolMetadata -> PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (StrictSeq StakePoolRelay)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relays"
        Parser (StrictMaybe PoolMetadata -> PoolParams crypto)
-> Parser (StrictMaybe PoolMetadata) -> Parser (PoolParams crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (StrictMaybe PoolMetadata)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metadata"

type TransTxId (c :: Type -> Constraint) era =
  -- Transaction Ids are the hash of a transaction body, which contains
  -- a Core.TxBody and Core.TxOut, hence the need for the ToCBOR instances
  -- in order to hash them.
  ( HashAnnotated (Core.TxBody era) EraIndependentTxBody (Crypto era),
    ToCBOR (Core.TxBody era),
    ToCBOR (Core.TxOut era),
    TransValue ToCBOR era,
    TransValue c era
  )

-- | The output of a UTxO.
data TxOut era
  = TxOutCompact
      {-# UNPACK #-} !(CompactAddr (Crypto era))
      !(CompactForm (Core.Value era))

type TransTxOut (c :: Type -> Constraint) era =
  ( c (Core.Value era),
    Compactible (Core.Value era)
  )

-- assume Shelley+ type address : payment addr, staking addr (same length as payment), plus 1 word overhead
instance
  ( CC.Crypto (Crypto era),
    HeapWords (CompactForm (Core.Value era))
  ) =>
  HeapWords (TxOut era)
  where
  heapWords :: TxOut era -> Int
heapWords (TxOutCompact CompactAddr (Crypto era)
_ CompactForm (Value era)
vl) =
    Int
3
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShortByteString -> Int
forall a. HeapWords a => a -> Int
heapWords (Proxy era -> ShortByteString
forall (proxy :: * -> *) era.
Crypto (Crypto era) =>
proxy era -> ShortByteString
packedADDRHASH (Proxy era
forall k (t :: k). Proxy t
Proxy :: Proxy era))
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CompactForm (Value era) -> Int
forall a. HeapWords a => a -> Int
heapWords CompactForm (Value era)
vl

-- a ShortByteString of the same length as the ADDRHASH
-- used to calculate heapWords
packedADDRHASH :: forall proxy era. (CC.Crypto (Crypto era)) => proxy era -> ShortByteString
packedADDRHASH :: proxy era -> ShortByteString
packedADDRHASH proxy era
_ = [Word8] -> ShortByteString
pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
2 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Proxy (ADDRHASH (Crypto era)) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
HS.sizeHash (Proxy (ADDRHASH (Crypto era))
forall k (t :: k). Proxy t
Proxy :: Proxy (CC.ADDRHASH (Crypto era))))) (Word8
1 :: Word8))

instance
  (TransTxOut Show era, Era era) => -- Use the weakest constraint possible here
  Show (TxOut era)
  where
  show :: TxOut era -> String
show = (Addr (Crypto era), Value era) -> String
forall a. Show a => a -> String
show ((Addr (Crypto era), Value era) -> String)
-> (TxOut era -> (Addr (Crypto era), Value era))
-> TxOut era
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut era -> (Addr (Crypto era), Value era)
forall era. Era era => TxOut era -> (Addr (Crypto era), Value era)
viewCompactTxOut

deriving stock instance
  -- weakest constraint
  TransTxOut Eq era => Eq (TxOut era)

instance NFData (TxOut era) where
  rnf :: TxOut era -> ()
rnf = (TxOut era -> () -> ()
`seq` ())

deriving via InspectHeapNamed "TxOut" (TxOut era) instance NoThunks (TxOut era)

pattern TxOut ::
  (Era era, Show (Core.Value era), Compactible (Core.Value era)) =>
  Addr (Crypto era) ->
  Core.Value era ->
  TxOut era
pattern $bTxOut :: Addr (Crypto era) -> Value era -> TxOut era
$mTxOut :: forall r era.
(Era era, Show (Value era), Compactible (Value era)) =>
TxOut era
-> (Addr (Crypto era) -> Value era -> r) -> (Void# -> r) -> r
TxOut addr vl <-
  (viewCompactTxOut -> (addr, vl))
  where
    TxOut Addr (Crypto era)
addr Value era
vl =
      CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact
        (Addr (Crypto era) -> CompactAddr (Crypto era)
forall crypto. Addr crypto -> CompactAddr crypto
compactAddr Addr (Crypto era)
addr)
        (CompactForm (Value era)
-> Maybe (CompactForm (Value era)) -> CompactForm (Value era)
forall a. a -> Maybe a -> a
fromMaybe (String -> CompactForm (Value era)
forall a. HasCallStack => String -> a
error (String -> CompactForm (Value era))
-> String -> CompactForm (Value era)
forall a b. (a -> b) -> a -> b
$ String
"illegal value in txout: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value era -> String
forall a. Show a => a -> String
show Value era
vl) (Maybe (CompactForm (Value era)) -> CompactForm (Value era))
-> Maybe (CompactForm (Value era)) -> CompactForm (Value era)
forall a b. (a -> b) -> a -> b
$ Value era -> Maybe (CompactForm (Value era))
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Value era
vl)

{-# COMPLETE TxOut #-}

viewCompactTxOut ::
  forall era.
  (Era era) => -- Use the weakest constraint possible here
  TxOut era ->
  (Addr (Crypto era), Core.Value era)
viewCompactTxOut :: TxOut era -> (Addr (Crypto era), Value era)
viewCompactTxOut (TxOutCompact CompactAddr (Crypto era)
bs CompactForm (Value era)
c) = (Addr (Crypto era)
addr, Value era
val)
  where
    addr :: Addr (Crypto era)
addr = CompactAddr (Crypto era) -> Addr (Crypto era)
forall crypto. Crypto crypto => CompactAddr crypto -> Addr crypto
decompactAddr CompactAddr (Crypto era)
bs
    val :: Value era
val = CompactForm (Value era) -> Value era
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm (Value era)
c

-- ---------------------------
-- WellFormed instances

instance (Compactible v, v ~ Core.Value era) => HasField "value" (TxOut era) v where
  getField :: TxOut era -> v
getField (TxOutCompact CompactAddr (Crypto era)
_ CompactForm (Value era)
v) = CompactForm v -> v
forall a. Compactible a => CompactForm a -> a
fromCompact CompactForm v
CompactForm (Value era)
v

data DelegCert crypto
  = -- | A stake key registration certificate.
    RegKey !(StakeCredential crypto)
  | -- | A stake key deregistration certificate.
    DeRegKey !(StakeCredential crypto)
  | -- | A stake delegation certificate.
    Delegate !(Delegation crypto)
  deriving (Int -> DelegCert crypto -> ShowS
[DelegCert crypto] -> ShowS
DelegCert crypto -> String
(Int -> DelegCert crypto -> ShowS)
-> (DelegCert crypto -> String)
-> ([DelegCert crypto] -> ShowS)
-> Show (DelegCert crypto)
forall crypto. Int -> DelegCert crypto -> ShowS
forall crypto. [DelegCert crypto] -> ShowS
forall crypto. DelegCert crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelegCert crypto] -> ShowS
$cshowList :: forall crypto. [DelegCert crypto] -> ShowS
show :: DelegCert crypto -> String
$cshow :: forall crypto. DelegCert crypto -> String
showsPrec :: Int -> DelegCert crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> DelegCert crypto -> ShowS
Show, (forall x. DelegCert crypto -> Rep (DelegCert crypto) x)
-> (forall x. Rep (DelegCert crypto) x -> DelegCert crypto)
-> Generic (DelegCert crypto)
forall x. Rep (DelegCert crypto) x -> DelegCert crypto
forall x. DelegCert crypto -> Rep (DelegCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (DelegCert crypto) x -> DelegCert crypto
forall crypto x. DelegCert crypto -> Rep (DelegCert crypto) x
$cto :: forall crypto x. Rep (DelegCert crypto) x -> DelegCert crypto
$cfrom :: forall crypto x. DelegCert crypto -> Rep (DelegCert crypto) x
Generic, DelegCert crypto -> DelegCert crypto -> Bool
(DelegCert crypto -> DelegCert crypto -> Bool)
-> (DelegCert crypto -> DelegCert crypto -> Bool)
-> Eq (DelegCert crypto)
forall crypto. DelegCert crypto -> DelegCert crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelegCert crypto -> DelegCert crypto -> Bool
$c/= :: forall crypto. DelegCert crypto -> DelegCert crypto -> Bool
== :: DelegCert crypto -> DelegCert crypto -> Bool
$c== :: forall crypto. DelegCert crypto -> DelegCert crypto -> Bool
Eq, DelegCert crypto -> ()
(DelegCert crypto -> ()) -> NFData (DelegCert crypto)
forall crypto. DelegCert crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: DelegCert crypto -> ()
$crnf :: forall crypto. DelegCert crypto -> ()
NFData)

data PoolCert crypto
  = -- | A stake pool registration certificate.
    RegPool !(PoolParams crypto)
  | -- | A stake pool retirement certificate.
    RetirePool !(KeyHash 'StakePool crypto) !EpochNo
  deriving (Int -> PoolCert crypto -> ShowS
[PoolCert crypto] -> ShowS
PoolCert crypto -> String
(Int -> PoolCert crypto -> ShowS)
-> (PoolCert crypto -> String)
-> ([PoolCert crypto] -> ShowS)
-> Show (PoolCert crypto)
forall crypto. Int -> PoolCert crypto -> ShowS
forall crypto. [PoolCert crypto] -> ShowS
forall crypto. PoolCert crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolCert crypto] -> ShowS
$cshowList :: forall crypto. [PoolCert crypto] -> ShowS
show :: PoolCert crypto -> String
$cshow :: forall crypto. PoolCert crypto -> String
showsPrec :: Int -> PoolCert crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> PoolCert crypto -> ShowS
Show, (forall x. PoolCert crypto -> Rep (PoolCert crypto) x)
-> (forall x. Rep (PoolCert crypto) x -> PoolCert crypto)
-> Generic (PoolCert crypto)
forall x. Rep (PoolCert crypto) x -> PoolCert crypto
forall x. PoolCert crypto -> Rep (PoolCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (PoolCert crypto) x -> PoolCert crypto
forall crypto x. PoolCert crypto -> Rep (PoolCert crypto) x
$cto :: forall crypto x. Rep (PoolCert crypto) x -> PoolCert crypto
$cfrom :: forall crypto x. PoolCert crypto -> Rep (PoolCert crypto) x
Generic, PoolCert crypto -> PoolCert crypto -> Bool
(PoolCert crypto -> PoolCert crypto -> Bool)
-> (PoolCert crypto -> PoolCert crypto -> Bool)
-> Eq (PoolCert crypto)
forall crypto. PoolCert crypto -> PoolCert crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolCert crypto -> PoolCert crypto -> Bool
$c/= :: forall crypto. PoolCert crypto -> PoolCert crypto -> Bool
== :: PoolCert crypto -> PoolCert crypto -> Bool
$c== :: forall crypto. PoolCert crypto -> PoolCert crypto -> Bool
Eq, PoolCert crypto -> ()
(PoolCert crypto -> ()) -> NFData (PoolCert crypto)
forall crypto. PoolCert crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: PoolCert crypto -> ()
$crnf :: forall crypto. PoolCert crypto -> ()
NFData)

-- | Genesis key delegation certificate
data GenesisDelegCert crypto
  = GenesisDelegCert
      !(KeyHash 'Genesis crypto)
      !(KeyHash 'GenesisDelegate crypto)
      !(Hash crypto (VerKeyVRF crypto))
  deriving (Int -> GenesisDelegCert crypto -> ShowS
[GenesisDelegCert crypto] -> ShowS
GenesisDelegCert crypto -> String
(Int -> GenesisDelegCert crypto -> ShowS)
-> (GenesisDelegCert crypto -> String)
-> ([GenesisDelegCert crypto] -> ShowS)
-> Show (GenesisDelegCert crypto)
forall crypto. Int -> GenesisDelegCert crypto -> ShowS
forall crypto. [GenesisDelegCert crypto] -> ShowS
forall crypto. GenesisDelegCert crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisDelegCert crypto] -> ShowS
$cshowList :: forall crypto. [GenesisDelegCert crypto] -> ShowS
show :: GenesisDelegCert crypto -> String
$cshow :: forall crypto. GenesisDelegCert crypto -> String
showsPrec :: Int -> GenesisDelegCert crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> GenesisDelegCert crypto -> ShowS
Show, (forall x.
 GenesisDelegCert crypto -> Rep (GenesisDelegCert crypto) x)
-> (forall x.
    Rep (GenesisDelegCert crypto) x -> GenesisDelegCert crypto)
-> Generic (GenesisDelegCert crypto)
forall x.
Rep (GenesisDelegCert crypto) x -> GenesisDelegCert crypto
forall x.
GenesisDelegCert crypto -> Rep (GenesisDelegCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x.
Rep (GenesisDelegCert crypto) x -> GenesisDelegCert crypto
forall crypto x.
GenesisDelegCert crypto -> Rep (GenesisDelegCert crypto) x
$cto :: forall crypto x.
Rep (GenesisDelegCert crypto) x -> GenesisDelegCert crypto
$cfrom :: forall crypto x.
GenesisDelegCert crypto -> Rep (GenesisDelegCert crypto) x
Generic, GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
(GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool)
-> (GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool)
-> Eq (GenesisDelegCert crypto)
forall crypto.
GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
$c/= :: forall crypto.
GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
== :: GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
$c== :: forall crypto.
GenesisDelegCert crypto -> GenesisDelegCert crypto -> Bool
Eq, GenesisDelegCert crypto -> ()
(GenesisDelegCert crypto -> ()) -> NFData (GenesisDelegCert crypto)
forall crypto. GenesisDelegCert crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: GenesisDelegCert crypto -> ()
$crnf :: forall crypto. GenesisDelegCert crypto -> ()
NFData)

data MIRPot = ReservesMIR | TreasuryMIR
  deriving (Int -> MIRPot -> ShowS
[MIRPot] -> ShowS
MIRPot -> String
(Int -> MIRPot -> ShowS)
-> (MIRPot -> String) -> ([MIRPot] -> ShowS) -> Show MIRPot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIRPot] -> ShowS
$cshowList :: [MIRPot] -> ShowS
show :: MIRPot -> String
$cshow :: MIRPot -> String
showsPrec :: Int -> MIRPot -> ShowS
$cshowsPrec :: Int -> MIRPot -> ShowS
Show, (forall x. MIRPot -> Rep MIRPot x)
-> (forall x. Rep MIRPot x -> MIRPot) -> Generic MIRPot
forall x. Rep MIRPot x -> MIRPot
forall x. MIRPot -> Rep MIRPot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MIRPot x -> MIRPot
$cfrom :: forall x. MIRPot -> Rep MIRPot x
Generic, MIRPot -> MIRPot -> Bool
(MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool) -> Eq MIRPot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRPot -> MIRPot -> Bool
$c/= :: MIRPot -> MIRPot -> Bool
== :: MIRPot -> MIRPot -> Bool
$c== :: MIRPot -> MIRPot -> Bool
Eq, MIRPot -> ()
(MIRPot -> ()) -> NFData MIRPot
forall a. (a -> ()) -> NFData a
rnf :: MIRPot -> ()
$crnf :: MIRPot -> ()
NFData, Eq MIRPot
Eq MIRPot
-> (MIRPot -> MIRPot -> Ordering)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> Bool)
-> (MIRPot -> MIRPot -> MIRPot)
-> (MIRPot -> MIRPot -> MIRPot)
-> Ord MIRPot
MIRPot -> MIRPot -> Bool
MIRPot -> MIRPot -> Ordering
MIRPot -> MIRPot -> MIRPot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MIRPot -> MIRPot -> MIRPot
$cmin :: MIRPot -> MIRPot -> MIRPot
max :: MIRPot -> MIRPot -> MIRPot
$cmax :: MIRPot -> MIRPot -> MIRPot
>= :: MIRPot -> MIRPot -> Bool
$c>= :: MIRPot -> MIRPot -> Bool
> :: MIRPot -> MIRPot -> Bool
$c> :: MIRPot -> MIRPot -> Bool
<= :: MIRPot -> MIRPot -> Bool
$c<= :: MIRPot -> MIRPot -> Bool
< :: MIRPot -> MIRPot -> Bool
$c< :: MIRPot -> MIRPot -> Bool
compare :: MIRPot -> MIRPot -> Ordering
$ccompare :: MIRPot -> MIRPot -> Ordering
$cp1Ord :: Eq MIRPot
Ord, Int -> MIRPot
MIRPot -> Int
MIRPot -> [MIRPot]
MIRPot -> MIRPot
MIRPot -> MIRPot -> [MIRPot]
MIRPot -> MIRPot -> MIRPot -> [MIRPot]
(MIRPot -> MIRPot)
-> (MIRPot -> MIRPot)
-> (Int -> MIRPot)
-> (MIRPot -> Int)
-> (MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> [MIRPot])
-> (MIRPot -> MIRPot -> MIRPot -> [MIRPot])
-> Enum MIRPot
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
$cenumFromThenTo :: MIRPot -> MIRPot -> MIRPot -> [MIRPot]
enumFromTo :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromTo :: MIRPot -> MIRPot -> [MIRPot]
enumFromThen :: MIRPot -> MIRPot -> [MIRPot]
$cenumFromThen :: MIRPot -> MIRPot -> [MIRPot]
enumFrom :: MIRPot -> [MIRPot]
$cenumFrom :: MIRPot -> [MIRPot]
fromEnum :: MIRPot -> Int
$cfromEnum :: MIRPot -> Int
toEnum :: Int -> MIRPot
$ctoEnum :: Int -> MIRPot
pred :: MIRPot -> MIRPot
$cpred :: MIRPot -> MIRPot
succ :: MIRPot -> MIRPot
$csucc :: MIRPot -> MIRPot
Enum, MIRPot
MIRPot -> MIRPot -> Bounded MIRPot
forall a. a -> a -> Bounded a
maxBound :: MIRPot
$cmaxBound :: MIRPot
minBound :: MIRPot
$cminBound :: MIRPot
Bounded)

deriving instance NoThunks MIRPot

instance ToCBOR MIRPot where
  toCBOR :: MIRPot -> Encoding
toCBOR MIRPot
ReservesMIR = Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
  toCBOR MIRPot
TreasuryMIR = Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)

instance FromCBOR MIRPot where
  fromCBOR :: Decoder s MIRPot
fromCBOR =
    Decoder s Word
forall s. Decoder s Word
decodeWord Decoder s Word -> (Word -> Decoder s MIRPot) -> Decoder s MIRPot
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word
0 -> MIRPot -> Decoder s MIRPot
forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
ReservesMIR
      Word
1 -> MIRPot -> Decoder s MIRPot
forall (f :: * -> *) a. Applicative f => a -> f a
pure MIRPot
TreasuryMIR
      Word
k -> Word -> Decoder s MIRPot
forall s a. Word -> Decoder s a
invalidKey Word
k

-- | MIRTarget specifies if funds from either the reserves
-- or the treasury are to be handed out to a collection of
-- reward accounts or instead transfered to the opposite pot.
data MIRTarget crypto
  = StakeAddressesMIR (Map (Credential 'Staking crypto) DeltaCoin)
  | SendToOppositePotMIR Coin
  deriving (Int -> MIRTarget crypto -> ShowS
[MIRTarget crypto] -> ShowS
MIRTarget crypto -> String
(Int -> MIRTarget crypto -> ShowS)
-> (MIRTarget crypto -> String)
-> ([MIRTarget crypto] -> ShowS)
-> Show (MIRTarget crypto)
forall crypto. Int -> MIRTarget crypto -> ShowS
forall crypto. [MIRTarget crypto] -> ShowS
forall crypto. MIRTarget crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIRTarget crypto] -> ShowS
$cshowList :: forall crypto. [MIRTarget crypto] -> ShowS
show :: MIRTarget crypto -> String
$cshow :: forall crypto. MIRTarget crypto -> String
showsPrec :: Int -> MIRTarget crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> MIRTarget crypto -> ShowS
Show, (forall x. MIRTarget crypto -> Rep (MIRTarget crypto) x)
-> (forall x. Rep (MIRTarget crypto) x -> MIRTarget crypto)
-> Generic (MIRTarget crypto)
forall x. Rep (MIRTarget crypto) x -> MIRTarget crypto
forall x. MIRTarget crypto -> Rep (MIRTarget crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (MIRTarget crypto) x -> MIRTarget crypto
forall crypto x. MIRTarget crypto -> Rep (MIRTarget crypto) x
$cto :: forall crypto x. Rep (MIRTarget crypto) x -> MIRTarget crypto
$cfrom :: forall crypto x. MIRTarget crypto -> Rep (MIRTarget crypto) x
Generic, MIRTarget crypto -> MIRTarget crypto -> Bool
(MIRTarget crypto -> MIRTarget crypto -> Bool)
-> (MIRTarget crypto -> MIRTarget crypto -> Bool)
-> Eq (MIRTarget crypto)
forall crypto. MIRTarget crypto -> MIRTarget crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRTarget crypto -> MIRTarget crypto -> Bool
$c/= :: forall crypto. MIRTarget crypto -> MIRTarget crypto -> Bool
== :: MIRTarget crypto -> MIRTarget crypto -> Bool
$c== :: forall crypto. MIRTarget crypto -> MIRTarget crypto -> Bool
Eq, MIRTarget crypto -> ()
(MIRTarget crypto -> ()) -> NFData (MIRTarget crypto)
forall crypto. MIRTarget crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRTarget crypto -> ()
$crnf :: forall crypto. MIRTarget crypto -> ()
NFData)

deriving instance NoThunks (MIRTarget crypto)

instance
  CC.Crypto crypto =>
  FromCBOR (MIRTarget crypto)
  where
  fromCBOR :: Decoder s (MIRTarget crypto)
fromCBOR = do
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (MIRTarget crypto))
-> Decoder s (MIRTarget crypto)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeMapLen -> Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
StakeAddressesMIR (Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto)
-> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
-> Decoder s (MIRTarget crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      TokenType
TypeMapLen64 -> Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
StakeAddressesMIR (Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto)
-> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
-> Decoder s (MIRTarget crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      TokenType
TypeMapLenIndef -> Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
forall crypto.
Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto
StakeAddressesMIR (Map (Credential 'Staking crypto) DeltaCoin -> MIRTarget crypto)
-> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
-> Decoder s (MIRTarget crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Map (Credential 'Staking crypto) DeltaCoin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
      TokenType
_ -> Coin -> MIRTarget crypto
forall crypto. Coin -> MIRTarget crypto
SendToOppositePotMIR (Coin -> MIRTarget crypto)
-> Decoder s Coin -> Decoder s (MIRTarget crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance
  CC.Crypto crypto =>
  ToCBOR (MIRTarget crypto)
  where
  toCBOR :: MIRTarget crypto -> Encoding
toCBOR (StakeAddressesMIR Map (Credential 'Staking crypto) DeltaCoin
m) = Map (Credential 'Staking crypto) DeltaCoin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (Credential 'Staking crypto) DeltaCoin
m
  toCBOR (SendToOppositePotMIR Coin
c) = Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
c

-- | Move instantaneous rewards certificate
data MIRCert crypto = MIRCert
  { MIRCert crypto -> MIRPot
mirPot :: MIRPot,
    MIRCert crypto -> MIRTarget crypto
mirRewards :: MIRTarget crypto
  }
  deriving (Int -> MIRCert crypto -> ShowS
[MIRCert crypto] -> ShowS
MIRCert crypto -> String
(Int -> MIRCert crypto -> ShowS)
-> (MIRCert crypto -> String)
-> ([MIRCert crypto] -> ShowS)
-> Show (MIRCert crypto)
forall crypto. Int -> MIRCert crypto -> ShowS
forall crypto. [MIRCert crypto] -> ShowS
forall crypto. MIRCert crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MIRCert crypto] -> ShowS
$cshowList :: forall crypto. [MIRCert crypto] -> ShowS
show :: MIRCert crypto -> String
$cshow :: forall crypto. MIRCert crypto -> String
showsPrec :: Int -> MIRCert crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> MIRCert crypto -> ShowS
Show, (forall x. MIRCert crypto -> Rep (MIRCert crypto) x)
-> (forall x. Rep (MIRCert crypto) x -> MIRCert crypto)
-> Generic (MIRCert crypto)
forall x. Rep (MIRCert crypto) x -> MIRCert crypto
forall x. MIRCert crypto -> Rep (MIRCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (MIRCert crypto) x -> MIRCert crypto
forall crypto x. MIRCert crypto -> Rep (MIRCert crypto) x
$cto :: forall crypto x. Rep (MIRCert crypto) x -> MIRCert crypto
$cfrom :: forall crypto x. MIRCert crypto -> Rep (MIRCert crypto) x
Generic, MIRCert crypto -> MIRCert crypto -> Bool
(MIRCert crypto -> MIRCert crypto -> Bool)
-> (MIRCert crypto -> MIRCert crypto -> Bool)
-> Eq (MIRCert crypto)
forall crypto. MIRCert crypto -> MIRCert crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MIRCert crypto -> MIRCert crypto -> Bool
$c/= :: forall crypto. MIRCert crypto -> MIRCert crypto -> Bool
== :: MIRCert crypto -> MIRCert crypto -> Bool
$c== :: forall crypto. MIRCert crypto -> MIRCert crypto -> Bool
Eq, MIRCert crypto -> ()
(MIRCert crypto -> ()) -> NFData (MIRCert crypto)
forall crypto. MIRCert crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: MIRCert crypto -> ()
$crnf :: forall crypto. MIRCert crypto -> ()
NFData)

instance
  CC.Crypto crypto =>
  FromCBOR (MIRCert crypto)
  where
  fromCBOR :: Decoder s (MIRCert crypto)
fromCBOR =
    Text
-> (MIRCert crypto -> Int)
-> Decoder s (MIRCert crypto)
-> Decoder s (MIRCert crypto)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"MIRCert" (Int -> MIRCert crypto -> Int
forall a b. a -> b -> a
const Int
2) (MIRPot -> MIRTarget crypto -> MIRCert crypto
forall crypto. MIRPot -> MIRTarget crypto -> MIRCert crypto
MIRCert (MIRPot -> MIRTarget crypto -> MIRCert crypto)
-> Decoder s MIRPot
-> Decoder s (MIRTarget crypto -> MIRCert crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s MIRPot
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (MIRTarget crypto -> MIRCert crypto)
-> Decoder s (MIRTarget crypto) -> Decoder s (MIRCert crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (MIRTarget crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR)

instance
  CC.Crypto crypto =>
  ToCBOR (MIRCert crypto)
  where
  toCBOR :: MIRCert crypto -> Encoding
toCBOR (MIRCert MIRPot
pot MIRTarget crypto
targets) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRPot -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR MIRPot
pot
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRTarget crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR MIRTarget crypto
targets

-- | A heavyweight certificate.
data DCert crypto
  = DCertDeleg !(DelegCert crypto)
  | DCertPool !(PoolCert crypto)
  | DCertGenesis !(GenesisDelegCert crypto)
  | DCertMir !(MIRCert crypto)
  deriving (Int -> DCert crypto -> ShowS
[DCert crypto] -> ShowS
DCert crypto -> String
(Int -> DCert crypto -> ShowS)
-> (DCert crypto -> String)
-> ([DCert crypto] -> ShowS)
-> Show (DCert crypto)
forall crypto. Int -> DCert crypto -> ShowS
forall crypto. [DCert crypto] -> ShowS
forall crypto. DCert crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DCert crypto] -> ShowS
$cshowList :: forall crypto. [DCert crypto] -> ShowS
show :: DCert crypto -> String
$cshow :: forall crypto. DCert crypto -> String
showsPrec :: Int -> DCert crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> DCert crypto -> ShowS
Show, (forall x. DCert crypto -> Rep (DCert crypto) x)
-> (forall x. Rep (DCert crypto) x -> DCert crypto)
-> Generic (DCert crypto)
forall x. Rep (DCert crypto) x -> DCert crypto
forall x. DCert crypto -> Rep (DCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (DCert crypto) x -> DCert crypto
forall crypto x. DCert crypto -> Rep (DCert crypto) x
$cto :: forall crypto x. Rep (DCert crypto) x -> DCert crypto
$cfrom :: forall crypto x. DCert crypto -> Rep (DCert crypto) x
Generic, DCert crypto -> DCert crypto -> Bool
(DCert crypto -> DCert crypto -> Bool)
-> (DCert crypto -> DCert crypto -> Bool) -> Eq (DCert crypto)
forall crypto. DCert crypto -> DCert crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DCert crypto -> DCert crypto -> Bool
$c/= :: forall crypto. DCert crypto -> DCert crypto -> Bool
== :: DCert crypto -> DCert crypto -> Bool
$c== :: forall crypto. DCert crypto -> DCert crypto -> Bool
Eq, DCert crypto -> ()
(DCert crypto -> ()) -> NFData (DCert crypto)
forall crypto. DCert crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: DCert crypto -> ()
$crnf :: forall crypto. DCert crypto -> ()
NFData)

instance NoThunks (DelegCert crypto)

instance NoThunks (PoolCert crypto)

instance NoThunks (GenesisDelegCert crypto)

instance NoThunks (MIRCert crypto)

instance NoThunks (DCert crypto)

-- ==============================
-- The underlying type for TxBody

data TxBodyRaw era = TxBodyRaw
  { TxBodyRaw era -> Set (TxIn (Crypto era))
_inputsX :: !(Set (Core.TxIn (Crypto era))),
    TxBodyRaw era -> StrictSeq (TxOut era)
_outputsX :: !(StrictSeq (Core.TxOut era)),
    TxBodyRaw era -> StrictSeq (DCert (Crypto era))
_certsX :: !(StrictSeq (DCert (Crypto era))),
    TxBodyRaw era -> Wdrl (Crypto era)
_wdrlsX :: !(Wdrl (Crypto era)),
    TxBodyRaw era -> Coin
_txfeeX :: !Coin,
    TxBodyRaw era -> SlotNo
_ttlX :: !SlotNo,
    TxBodyRaw era -> StrictMaybe (Update era)
_txUpdateX :: !(StrictMaybe (Update era)),
    TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHashX :: !(StrictMaybe (AuxiliaryDataHash (Crypto era)))
  }
  deriving ((forall x. TxBodyRaw era -> Rep (TxBodyRaw era) x)
-> (forall x. Rep (TxBodyRaw era) x -> TxBodyRaw era)
-> Generic (TxBodyRaw era)
forall x. Rep (TxBodyRaw era) x -> TxBodyRaw era
forall x. TxBodyRaw era -> Rep (TxBodyRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxBodyRaw era) x -> TxBodyRaw era
forall era x. TxBodyRaw era -> Rep (TxBodyRaw era) x
$cto :: forall era x. Rep (TxBodyRaw era) x -> TxBodyRaw era
$cfrom :: forall era x. TxBodyRaw era -> Rep (TxBodyRaw era) x
Generic, Typeable)

deriving instance TransTxBody NoThunks era => NoThunks (TxBodyRaw era)

type TransTxBody (c :: Type -> Constraint) era =
  ( c (Core.TxOut era),
    c (Core.PParamsDelta era),
    HashAnnotated (Core.TxBody era) EraIndependentTxBody (Crypto era)
  )

deriving instance
  (NFData (Core.TxOut era), CC.Crypto (Crypto era), NFData (Core.PParamsDelta era)) =>
  NFData (TxBodyRaw era)

deriving instance (Era era, TransTxBody Eq era) => Eq (TxBodyRaw era)

deriving instance (Era era, TransTxBody Show era) => Show (TxBodyRaw era)

instance
  ( FromCBOR (Core.TxOut era),
    Era era,
    FromCBOR (Core.PParamsDelta era),
    ToCBOR (Core.PParamsDelta era)
  ) =>
  FromCBOR (TxBodyRaw era)
  where
  fromCBOR :: Decoder s (TxBodyRaw era)
fromCBOR =
    Decode ('Closed 'Dense) (TxBodyRaw era)
-> Decoder s (TxBodyRaw era)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      ( String
-> TxBodyRaw era
-> (Word -> Field (TxBodyRaw era))
-> [(Word, String)]
-> Decode ('Closed 'Dense) (TxBodyRaw era)
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
          String
"TxBody"
          TxBodyRaw era
forall era. TxBodyRaw era
baseTxBodyRaw
          Word -> Field (TxBodyRaw era)
forall era.
(Era era, FromCBOR (TxOut era), FromCBOR (PParamsDelta era)) =>
Word -> Field (TxBodyRaw era)
boxBody
          [(Word
0, String
"inputs"), (Word
1, String
"outputs"), (Word
2, String
"fee"), (Word
3, String
"ttl")]
      )

instance
  (TransTxBody FromCBOR era, ToCBOR (Core.PParamsDelta era), Era era) =>
  FromCBOR (Annotator (TxBodyRaw era))
  where
  fromCBOR :: Decoder s (Annotator (TxBodyRaw era))
fromCBOR = TxBodyRaw era -> Annotator (TxBodyRaw era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyRaw era -> Annotator (TxBodyRaw era))
-> Decoder s (TxBodyRaw era)
-> Decoder s (Annotator (TxBodyRaw era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TxBodyRaw era)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- =================================================================
-- Composable components for building TxBody optional sparse serialisers.
-- The order of serializing optional fields, and their key values is
-- demanded by backward compatibility concerns.

-- | Choose a de-serialiser when given the key (of type Word).
--   Wrap it in a Field which pairs it with its update function which
--   changes only the field being deserialised.
boxBody ::
  ( Era era,
    FromCBOR (Core.TxOut era),
    FromCBOR (Core.PParamsDelta era)
  ) =>
  Word ->
  Field (TxBodyRaw era)
boxBody :: Word -> Field (TxBodyRaw era)
boxBody Word
0 = (Set (TxIn (Crypto era)) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set (TxIn (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_inputsX :: Set (TxIn (Crypto era))
_inputsX = Set (TxIn (Crypto era))
x}) ((forall s. Decoder s (Set (TxIn (Crypto era))))
-> Decode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxIn (Crypto era))
-> Decoder s (Set (TxIn (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (TxIn (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
boxBody Word
1 = (StrictSeq (TxOut era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (StrictSeq (TxOut era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (TxOut era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_outputsX :: StrictSeq (TxOut era)
_outputsX = StrictSeq (TxOut era)
x}) ((forall s. Decoder s (StrictSeq (TxOut era)))
-> Decode ('Closed 'Dense) (StrictSeq (TxOut era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxOut era) -> Decoder s (StrictSeq (TxOut era))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (TxOut era)
forall a s. FromCBOR a => Decoder s a
fromCBOR))
boxBody Word
4 = (StrictSeq (DCert (Crypto era)) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\StrictSeq (DCert (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_certsX :: StrictSeq (DCert (Crypto era))
_certsX = StrictSeq (DCert (Crypto era))
x}) ((forall s. Decoder s (StrictSeq (DCert (Crypto era))))
-> Decode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (DCert (Crypto era))
-> Decoder s (StrictSeq (DCert (Crypto era)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (DCert (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR))
boxBody Word
5 = (Wdrl (Crypto era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (Wdrl (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Wdrl (Crypto era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_wdrlsX :: Wdrl (Crypto era)
_wdrlsX = Wdrl (Crypto era)
x}) Decode ('Closed Any) (Wdrl (Crypto era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
2 = (Coin -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) Coin -> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_txfeeX :: Coin
_txfeeX = Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
3 = (SlotNo -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) SlotNo -> Field (TxBodyRaw era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\SlotNo
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_ttlX :: SlotNo
_ttlX = SlotNo
x}) Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
6 = (StrictMaybe (Update era) -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (Update era) -> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (Update era)
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_txUpdateX :: StrictMaybe (Update era)
_txUpdateX = StrictMaybe (Update era)
x}) Decode ('Closed Any) (Update era)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
7 = (StrictMaybe (AuxiliaryDataHash (Crypto era))
 -> TxBodyRaw era -> TxBodyRaw era)
-> Decode ('Closed Any) (AuxiliaryDataHash (Crypto era))
-> Field (TxBodyRaw era)
forall x t (d :: Density).
(StrictMaybe x -> t -> t) -> Decode ('Closed d) x -> Field t
ofield (\StrictMaybe (AuxiliaryDataHash (Crypto era))
x TxBodyRaw era
tx -> TxBodyRaw era
tx {_mdHashX :: StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHashX = StrictMaybe (AuxiliaryDataHash (Crypto era))
x}) Decode ('Closed Any) (AuxiliaryDataHash (Crypto era))
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
n = Word -> Field (TxBodyRaw era)
forall t. Word -> Field t
invalidField Word
n

-- | Tells how to serialise each field, and what tag to label it with in the
--   serialisation. boxBody and txSparse should be Duals, visually inspect
--   The key order looks strange but was choosen for backward compatibility.
txSparse ::
  (TransTxBody ToCBOR era, Era era) =>
  TxBodyRaw era ->
  Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse :: TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse (TxBodyRaw Set (TxIn (Crypto era))
input StrictSeq (TxOut era)
output StrictSeq (DCert (Crypto era))
cert Wdrl (Crypto era)
wdrl Coin
fee SlotNo
ttl StrictMaybe (Update era)
update StrictMaybe (AuxiliaryDataHash (Crypto era))
hash) =
  (Set (TxIn (Crypto era))
 -> StrictSeq (TxOut era)
 -> Coin
 -> SlotNo
 -> StrictSeq (DCert (Crypto era))
 -> Wdrl (Crypto era)
 -> StrictMaybe (Update era)
 -> StrictMaybe (AuxiliaryDataHash (Crypto era))
 -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse)
     (Set (TxIn (Crypto era))
      -> StrictSeq (TxOut era)
      -> Coin
      -> SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed (\Set (TxIn (Crypto era))
i StrictSeq (TxOut era)
o Coin
f SlotNo
t StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (Crypto era))
h -> Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBodyRaw era
TxBodyRaw Set (TxIn (Crypto era))
i StrictSeq (TxOut era)
o StrictSeq (DCert (Crypto era))
c Wdrl (Crypto era)
w Coin
f SlotNo
t StrictMaybe (Update era)
u StrictMaybe (AuxiliaryDataHash (Crypto era))
h)
    Encode
  ('Closed 'Sparse)
  (Set (TxIn (Crypto era))
   -> StrictSeq (TxOut era)
   -> Coin
   -> SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (TxOut era)
      -> Coin
      -> SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
-> Encode ('Closed 'Sparse) (Set (TxIn (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 ((Set (TxIn (Crypto era)) -> Encoding)
-> Set (TxIn (Crypto era))
-> Encode ('Closed 'Dense) (Set (TxIn (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Set (TxIn (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (TxIn (Crypto era))
input) -- We don't have to send these in TxBodyRaw order
    Encode
  ('Closed 'Sparse)
  (StrictSeq (TxOut era)
   -> Coin
   -> SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (TxOut era))
-> Encode
     ('Closed 'Sparse)
     (Coin
      -> SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) (StrictSeq (TxOut era))
-> Encode ('Closed 'Sparse) (StrictSeq (TxOut era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 ((StrictSeq (TxOut era) -> Encoding)
-> StrictSeq (TxOut era)
-> Encode ('Closed 'Dense) (StrictSeq (TxOut era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (TxOut era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (TxOut era)
output) -- Just hack up a fake constructor with the lambda.
    Encode
  ('Closed 'Sparse)
  (Coin
   -> SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (SlotNo
      -> StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) Coin -> Encode ('Closed 'Sparse) Coin
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
fee)
    Encode
  ('Closed 'Sparse)
  (SlotNo
   -> StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) SlotNo
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (DCert (Crypto era))
      -> Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) SlotNo
-> Encode ('Closed 'Sparse) SlotNo
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
3 (SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
ttl)
    Encode
  ('Closed 'Sparse)
  (StrictSeq (DCert (Crypto era))
   -> Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
-> Encode
     ('Closed 'Sparse)
     (Wdrl (Crypto era)
      -> StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era))
      -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (DCert (Crypto era)) -> Bool)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictSeq (DCert (Crypto era)) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert (Crypto era)))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 ((StrictSeq (DCert (Crypto era)) -> Encoding)
-> StrictSeq (DCert (Crypto era))
-> Encode ('Closed 'Dense) (StrictSeq (DCert (Crypto era)))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (DCert (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (DCert (Crypto era))
cert))
    Encode
  ('Closed 'Sparse)
  (Wdrl (Crypto era)
   -> StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era))
   -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Update era)
      -> StrictMaybe (AuxiliaryDataHash (Crypto era)) -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Wdrl (Crypto era) -> Bool)
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Map (RewardAcnt (Crypto era)) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map (RewardAcnt (Crypto era)) Coin -> Bool)
-> (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> Wdrl (Crypto era)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl) (Word
-> Encode ('Closed 'Dense) (Wdrl (Crypto era))
-> Encode ('Closed 'Sparse) (Wdrl (Crypto era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (Wdrl (Crypto era) -> Encode ('Closed 'Dense) (Wdrl (Crypto era))
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Wdrl (Crypto era)
wdrl))
    Encode
  ('Closed 'Sparse)
  (StrictMaybe (Update era)
   -> StrictMaybe (AuxiliaryDataHash (Crypto era)) -> TxBodyRaw era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (AuxiliaryDataHash (Crypto era)) -> TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (Update era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
forall a.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
6 StrictMaybe (Update era)
update
    Encode
  ('Closed 'Sparse)
  (StrictMaybe (AuxiliaryDataHash (Crypto era)) -> TxBodyRaw era)
-> Encode
     ('Closed 'Sparse) (StrictMaybe (AuxiliaryDataHash (Crypto era)))
-> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> Encode
     ('Closed 'Sparse) (StrictMaybe (AuxiliaryDataHash (Crypto era)))
forall a.
ToCBOR a =>
Word -> StrictMaybe a -> Encode ('Closed 'Sparse) (StrictMaybe a)
encodeKeyedStrictMaybe Word
7 StrictMaybe (AuxiliaryDataHash (Crypto era))
hash

-- The initial TxBody. We will overide some of these fields as we build a TxBody,
-- adding one field at a time, using optional serialisers, inside the Pattern.
baseTxBodyRaw :: TxBodyRaw era
baseTxBodyRaw :: TxBodyRaw era
baseTxBodyRaw =
  TxBodyRaw :: forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBodyRaw era
TxBodyRaw
    { _inputsX :: Set (TxIn (Crypto era))
_inputsX = Set (TxIn (Crypto era))
forall a. Set a
Set.empty,
      _outputsX :: StrictSeq (TxOut era)
_outputsX = StrictSeq (TxOut era)
forall a. StrictSeq a
StrictSeq.empty,
      _txfeeX :: Coin
_txfeeX = Integer -> Coin
Coin Integer
0,
      _ttlX :: SlotNo
_ttlX = Word64 -> SlotNo
SlotNo Word64
0,
      _certsX :: StrictSeq (DCert (Crypto era))
_certsX = StrictSeq (DCert (Crypto era))
forall a. StrictSeq a
StrictSeq.empty,
      _wdrlsX :: Wdrl (Crypto era)
_wdrlsX = Map (RewardAcnt (Crypto era)) Coin -> Wdrl (Crypto era)
forall crypto. Map (RewardAcnt crypto) Coin -> Wdrl crypto
Wdrl Map (RewardAcnt (Crypto era)) Coin
forall k a. Map k a
Map.empty,
      _txUpdateX :: StrictMaybe (Update era)
_txUpdateX = StrictMaybe (Update era)
forall a. StrictMaybe a
SNothing,
      _mdHashX :: StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHashX = StrictMaybe (AuxiliaryDataHash (Crypto era))
forall a. StrictMaybe a
SNothing
    }

instance
  ( Era era,
    FromCBOR (Core.PParamsDelta era),
    TransTxBody ToCBOR era
  ) =>
  ToCBOR (TxBodyRaw era)
  where
  toCBOR :: TxBodyRaw era -> Encoding
toCBOR TxBodyRaw era
x = Encode ('Closed 'Sparse) (TxBodyRaw era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall era.
(TransTxBody ToCBOR era, Era era) =>
TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse TxBodyRaw era
x)

-- ====================================================
-- Introduce TxBody as a newtype around a MemoBytes

newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era))
  deriving ((forall x. TxBody era -> Rep (TxBody era) x)
-> (forall x. Rep (TxBody era) x -> TxBody era)
-> Generic (TxBody era)
forall x. Rep (TxBody era) x -> TxBody era
forall x. TxBody era -> Rep (TxBody era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxBody era) x -> TxBody era
forall era x. TxBody era -> Rep (TxBody era) x
$cto :: forall era x. Rep (TxBody era) x -> TxBody era
$cfrom :: forall era x. TxBody era -> Rep (TxBody era) x
Generic, Typeable)
  deriving newtype (Proxy c -> Proxy index -> TxBody era -> SafeHash c index
TxBody era -> ByteString
(TxBody era -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> TxBody era -> SafeHash c index)
-> SafeToHash (TxBody era)
forall era. TxBody era -> ByteString
forall t.
(t -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> TxBody era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> TxBody era -> SafeHash c index
originalBytes :: TxBody era -> ByteString
$coriginalBytes :: forall era. TxBody era -> ByteString
SafeToHash)

deriving newtype instance
  (TransTxBody NoThunks era, Typeable era) => NoThunks (TxBody era)

deriving newtype instance
  (NFData (Core.TxOut era), CC.Crypto (Crypto era), NFData (Core.PParamsDelta era)) =>
  NFData (TxBody era)

deriving instance (Era era, TransTxBody Show era) => Show (TxBody era)

deriving instance (Era era, TransTxBody Eq era) => Eq (TxBody era)

deriving via
  (Mem (TxBodyRaw era))
  instance
    ( Era era,
      FromCBOR (Core.TxOut era),
      FromCBOR (Core.PParamsDelta era),
      ToCBOR (Core.PParamsDelta era)
    ) =>
    FromCBOR (Annotator (TxBody era))

-- | Pattern for use by external users
pattern TxBody ::
  (Era era, FromCBOR (Core.PParamsDelta era), TransTxBody ToCBOR era) =>
  Set (Core.TxIn (Crypto era)) ->
  StrictSeq (Core.TxOut era) ->
  StrictSeq (DCert (Crypto era)) ->
  Wdrl (Crypto era) ->
  Coin ->
  SlotNo ->
  StrictMaybe (Update era) ->
  StrictMaybe (AuxiliaryDataHash (Crypto era)) ->
  TxBody era
pattern $bTxBody :: Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBody era
$mTxBody :: forall r era.
(Era era, FromCBOR (PParamsDelta era), TransTxBody ToCBOR era) =>
TxBody era
-> (Set (TxIn (Crypto era))
    -> StrictSeq (TxOut era)
    -> StrictSeq (DCert (Crypto era))
    -> Wdrl (Crypto era)
    -> Coin
    -> SlotNo
    -> StrictMaybe (Update era)
    -> StrictMaybe (AuxiliaryDataHash (Crypto era))
    -> r)
-> (Void# -> r)
-> r
TxBody {TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Set (TxIn (Crypto era))
_inputs, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictSeq (TxOut era)
_outputs, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictSeq (DCert (Crypto era))
_certs, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Wdrl (Crypto era)
_wdrls, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   Coin
_txfee, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   SlotNo
_ttl, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictMaybe (Update era)
_txUpdate, TxBody era
-> (Era era, FromCBOR (PParamsDelta era),
    TransTxBody ToCBOR era) =>
   StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHash} <-
  TxBodyConstr
    ( Memo
        TxBodyRaw
          { _inputsX = _inputs,
            _outputsX = _outputs,
            _certsX = _certs,
            _wdrlsX = _wdrls,
            _txfeeX = _txfee,
            _ttlX = _ttl,
            _txUpdateX = _txUpdate,
            _mdHashX = _mdHash
          }
        _
      )
  where
    TxBody Set (TxIn (Crypto era))
_inputs StrictSeq (TxOut era)
_outputs StrictSeq (DCert (Crypto era))
_certs Wdrl (Crypto era)
_wdrls Coin
_txfee SlotNo
_ttl StrictMaybe (Update era)
_txUpdate StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHash =
      MemoBytes (TxBodyRaw era) -> TxBody era
forall era. MemoBytes (TxBodyRaw era) -> TxBody era
TxBodyConstr (MemoBytes (TxBodyRaw era) -> TxBody era)
-> MemoBytes (TxBodyRaw era) -> TxBody era
forall a b. (a -> b) -> a -> b
$ Encode ('Closed 'Sparse) (TxBodyRaw era)
-> MemoBytes (TxBodyRaw era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes (TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
forall era.
(TransTxBody ToCBOR era, Era era) =>
TxBodyRaw era -> Encode ('Closed 'Sparse) (TxBodyRaw era)
txSparse (Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBodyRaw era
forall era.
Set (TxIn (Crypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (DCert (Crypto era))
-> Wdrl (Crypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (Crypto era))
-> TxBodyRaw era
TxBodyRaw Set (TxIn (Crypto era))
_inputs StrictSeq (TxOut era)
_outputs StrictSeq (DCert (Crypto era))
_certs Wdrl (Crypto era)
_wdrls Coin
_txfee SlotNo
_ttl StrictMaybe (Update era)
_txUpdate StrictMaybe (AuxiliaryDataHash (Crypto era))
_mdHash))

{-# COMPLETE TxBody #-}

-- =========================================
-- WellFormed era   instances

instance (Era era, c ~ Crypto era) => HashAnnotated (TxBody era) EraIndependentTxBody c

instance (Era era) => ToCBOR (TxBody era) where
  toCBOR :: TxBody era -> Encoding
toCBOR (TxBodyConstr MemoBytes (TxBodyRaw era)
memo) = MemoBytes (TxBodyRaw era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR MemoBytes (TxBodyRaw era)
memo

instance Crypto era ~ crypto => HasField "inputs" (TxBody era) (Set (Core.TxIn crypto)) where
  getField :: TxBody era -> Set (TxIn crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (TxIn crypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_inputsX" TxBodyRaw era
m

instance Core.TxOut era ~ out => HasField "outputs" (TxBody era) (StrictSeq out) where
  getField :: TxBody era -> StrictSeq out
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictSeq out
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_outputsX" TxBodyRaw era
m

instance Crypto era ~ crypto => HasField "certs" (TxBody era) (StrictSeq (DCert crypto)) where
  getField :: TxBody era -> StrictSeq (DCert crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictSeq (DCert crypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_certsX" TxBodyRaw era
m

instance Crypto era ~ crypto => HasField "wdrls" (TxBody era) (Wdrl crypto) where
  getField :: TxBody era -> Wdrl crypto
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Wdrl crypto
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_wdrlsX" TxBodyRaw era
m

instance HasField "txfee" (TxBody era) Coin where
  getField :: TxBody era -> Coin
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_txfeeX" TxBodyRaw era
m

instance HasField "ttl" (TxBody era) SlotNo where
  getField :: TxBody era -> SlotNo
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> SlotNo
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_ttlX" TxBodyRaw era
m

instance HasField "update" (TxBody era) (StrictMaybe (Update era)) where
  getField :: TxBody era -> StrictMaybe (Update era)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (Update era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_txUpdateX" TxBodyRaw era
m

instance
  Crypto era ~ crypto =>
  HasField "adHash" (TxBody era) (StrictMaybe (AuxiliaryDataHash crypto))
  where
  getField :: TxBody era -> StrictMaybe (AuxiliaryDataHash crypto)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> StrictMaybe (AuxiliaryDataHash crypto)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_mdHashX" TxBodyRaw era
m

instance c ~ Crypto era => HasField "minted" (TxBody era) (Set (ScriptHash c)) where
  getField :: TxBody era -> Set (ScriptHash c)
getField TxBody era
_ = Set (ScriptHash c)
forall a. Set a
Set.empty

instance
  c ~ Crypto era =>
  HasField "txinputs_fee" (TxBody era) (Set (Core.TxIn c))
  where
  getField :: TxBody era -> Set (TxIn c)
getField (TxBodyConstr (Memo TxBodyRaw era
m ShortByteString
_)) = TxBodyRaw era -> Set (TxIn c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_inputsX" TxBodyRaw era
m

-- ===============================================================

-- | Proof/Witness that a transaction is authorized by the given key holder.
data WitVKey kr crypto = WitVKey'
  { WitVKey kr crypto -> VKey kr crypto
wvkKey' :: !(VKey kr crypto),
    WitVKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
wvkSig' :: !(SignedDSIGN crypto (Hash crypto EraIndependentTxBody)),
    -- | Hash of the witness vkey. We store this here to avoid repeated hashing
    --   when used in ordering.
    WitVKey kr crypto -> KeyHash 'Witness crypto
wvkKeyHash :: !(KeyHash 'Witness crypto),
    WitVKey kr crypto -> ByteString
wvkBytes :: BSL.ByteString
  }
  deriving ((forall x. WitVKey kr crypto -> Rep (WitVKey kr crypto) x)
-> (forall x. Rep (WitVKey kr crypto) x -> WitVKey kr crypto)
-> Generic (WitVKey kr crypto)
forall x. Rep (WitVKey kr crypto) x -> WitVKey kr crypto
forall x. WitVKey kr crypto -> Rep (WitVKey kr crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kr :: KeyRole) crypto x.
Rep (WitVKey kr crypto) x -> WitVKey kr crypto
forall (kr :: KeyRole) crypto x.
WitVKey kr crypto -> Rep (WitVKey kr crypto) x
$cto :: forall (kr :: KeyRole) crypto x.
Rep (WitVKey kr crypto) x -> WitVKey kr crypto
$cfrom :: forall (kr :: KeyRole) crypto x.
WitVKey kr crypto -> Rep (WitVKey kr crypto) x
Generic)

deriving instance CC.Crypto crypto => Show (WitVKey kr crypto)

deriving instance CC.Crypto crypto => Eq (WitVKey kr crypto)

instance NFData (WitVKey kr crypto) where
  rnf :: WitVKey kr crypto -> ()
rnf (WitVKey' VKey kr crypto
_ SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
_ KeyHash 'Witness crypto
_ ByteString
bytes) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
bytes

deriving via
  (AllowThunksIn '["wvkBytes"] (WitVKey kr crypto))
  instance
    (CC.Crypto crypto, Typeable kr) => NoThunks (WitVKey kr crypto)

pattern WitVKey ::
  (Typeable kr, CC.Crypto crypto) =>
  VKey kr crypto ->
  SignedDSIGN crypto (Hash crypto EraIndependentTxBody) ->
  WitVKey kr crypto
pattern $bWitVKey :: VKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> WitVKey kr crypto
$mWitVKey :: forall r (kr :: KeyRole) crypto.
(Typeable kr, Crypto crypto) =>
WitVKey kr crypto
-> (VKey kr crypto
    -> SignedDSIGN crypto (Hash crypto EraIndependentTxBody) -> r)
-> (Void# -> r)
-> r
WitVKey k s <-
  WitVKey' k s _ _
  where
    WitVKey VKey kr crypto
k SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
s =
      let bytes :: ByteString
bytes =
            Encoding -> ByteString
serializeEncoding (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
              Word -> Encoding
encodeListLen Word
2
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VKey kr crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VKey kr crypto
k
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedDSIGN crypto (Hash crypto EraIndependentTxBody) -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
s
          hash :: KeyHash 'Witness crypto
hash = KeyHash kr crypto -> KeyHash 'Witness crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (KeyHash kr crypto -> KeyHash 'Witness crypto)
-> KeyHash kr crypto -> KeyHash 'Witness crypto
forall a b. (a -> b) -> a -> b
$ VKey kr crypto -> KeyHash kr crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey VKey kr crypto
k
       in VKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> KeyHash 'Witness crypto
-> ByteString
-> WitVKey kr crypto
forall (kr :: KeyRole) crypto.
VKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> KeyHash 'Witness crypto
-> ByteString
-> WitVKey kr crypto
WitVKey' VKey kr crypto
k SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
s KeyHash 'Witness crypto
hash ByteString
bytes

{-# COMPLETE WitVKey #-}

witKeyHash ::
  WitVKey kr crypto ->
  KeyHash 'Witness crypto
witKeyHash :: WitVKey kr crypto -> KeyHash 'Witness crypto
witKeyHash (WitVKey' VKey kr crypto
_ SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
_ KeyHash 'Witness crypto
kh ByteString
_) = KeyHash 'Witness crypto
kh

instance (Typeable kr, CC.Crypto crypto) => Ord (WitVKey kr crypto) where
  compare :: WitVKey kr crypto -> WitVKey kr crypto -> Ordering
compare WitVKey kr crypto
x WitVKey kr crypto
y =
    -- It is advised against comparison on keys and signatures directly,
    -- therefore we use hashes of verification keys and signatures for
    -- implementing this Ord instance. Note that we do not need to memoize the
    -- hash of a signature, like it is done with the hash of a key, because Ord
    -- instance is only used for Sets of WitVKeys and it would be a mistake to
    -- have two WitVKeys in a same Set for different transactions. Therefore
    -- comparison on signatures is unlikely to happen and is only needed for
    -- compliance with Ord laws.
    (WitVKey kr crypto -> KeyHash 'Witness crypto)
-> WitVKey kr crypto -> WitVKey kr crypto -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing WitVKey kr crypto -> KeyHash 'Witness crypto
forall (kr :: KeyRole) crypto.
WitVKey kr crypto -> KeyHash 'Witness crypto
wvkKeyHash WitVKey kr crypto
x WitVKey kr crypto
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (WitVKey kr crypto
 -> Hash
      (HASH crypto)
      (SignedDSIGN
         (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)))
-> WitVKey kr crypto -> WitVKey kr crypto -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall h.
Crypto crypto =>
SignedDSIGN crypto (Hash crypto h)
-> Hash crypto (SignedDSIGN crypto (Hash crypto h))
forall crypto h.
Crypto crypto =>
SignedDSIGN crypto (Hash crypto h)
-> Hash crypto (SignedDSIGN crypto (Hash crypto h))
hashSignature @crypto (SignedDSIGN
   (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
 -> Hash
      (HASH crypto)
      (SignedDSIGN
         (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)))
-> (WitVKey kr crypto
    -> SignedDSIGN
         (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody))
-> WitVKey kr crypto
-> Hash
     (HASH crypto)
     (SignedDSIGN
        (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitVKey kr crypto
-> SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
forall (kr :: KeyRole) crypto.
WitVKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
wvkSig') WitVKey kr crypto
x WitVKey kr crypto
y

newtype StakeCreds crypto = StakeCreds
  { StakeCreds crypto -> Map (Credential 'Staking crypto) SlotNo
unStakeCreds :: Map (Credential 'Staking crypto) SlotNo
  }
  deriving (StakeCreds crypto -> StakeCreds crypto -> Bool
(StakeCreds crypto -> StakeCreds crypto -> Bool)
-> (StakeCreds crypto -> StakeCreds crypto -> Bool)
-> Eq (StakeCreds crypto)
forall crypto. StakeCreds crypto -> StakeCreds crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeCreds crypto -> StakeCreds crypto -> Bool
$c/= :: forall crypto. StakeCreds crypto -> StakeCreds crypto -> Bool
== :: StakeCreds crypto -> StakeCreds crypto -> Bool
$c== :: forall crypto. StakeCreds crypto -> StakeCreds crypto -> Bool
Eq, (forall x. StakeCreds crypto -> Rep (StakeCreds crypto) x)
-> (forall x. Rep (StakeCreds crypto) x -> StakeCreds crypto)
-> Generic (StakeCreds crypto)
forall x. Rep (StakeCreds crypto) x -> StakeCreds crypto
forall x. StakeCreds crypto -> Rep (StakeCreds crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (StakeCreds crypto) x -> StakeCreds crypto
forall crypto x. StakeCreds crypto -> Rep (StakeCreds crypto) x
$cto :: forall crypto x. Rep (StakeCreds crypto) x -> StakeCreds crypto
$cfrom :: forall crypto x. StakeCreds crypto -> Rep (StakeCreds crypto) x
Generic)
  deriving (Int -> StakeCreds crypto -> ShowS
[StakeCreds crypto] -> ShowS
StakeCreds crypto -> String
(Int -> StakeCreds crypto -> ShowS)
-> (StakeCreds crypto -> String)
-> ([StakeCreds crypto] -> ShowS)
-> Show (StakeCreds crypto)
forall crypto. Int -> StakeCreds crypto -> ShowS
forall crypto. [StakeCreds crypto] -> ShowS
forall crypto. StakeCreds crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeCreds crypto] -> ShowS
$cshowList :: forall crypto. [StakeCreds crypto] -> ShowS
show :: StakeCreds crypto -> String
$cshow :: forall crypto. StakeCreds crypto -> String
showsPrec :: Int -> StakeCreds crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> StakeCreds crypto -> ShowS
Show) via (Quiet (StakeCreds crypto))
  deriving newtype (StakeCreds crypto -> ()
(StakeCreds crypto -> ()) -> NFData (StakeCreds crypto)
forall crypto. StakeCreds crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: StakeCreds crypto -> ()
$crnf :: forall crypto. StakeCreds crypto -> ()
NFData, Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
Proxy (StakeCreds crypto) -> String
(Context -> StakeCreds crypto -> IO (Maybe ThunkInfo))
-> (Context -> StakeCreds crypto -> IO (Maybe ThunkInfo))
-> (Proxy (StakeCreds crypto) -> String)
-> NoThunks (StakeCreds crypto)
forall crypto. Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (StakeCreds crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (StakeCreds crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (StakeCreds crypto) -> String
wNoThunks :: Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> StakeCreds crypto -> IO (Maybe ThunkInfo)
NoThunks, [StakeCreds crypto] -> Encoding
[StakeCreds crypto] -> Value
StakeCreds crypto -> Encoding
StakeCreds crypto -> Value
(StakeCreds crypto -> Value)
-> (StakeCreds crypto -> Encoding)
-> ([StakeCreds crypto] -> Value)
-> ([StakeCreds crypto] -> Encoding)
-> ToJSON (StakeCreds crypto)
forall crypto. Crypto crypto => [StakeCreds crypto] -> Encoding
forall crypto. Crypto crypto => [StakeCreds crypto] -> Value
forall crypto. Crypto crypto => StakeCreds crypto -> Encoding
forall crypto. Crypto crypto => StakeCreds crypto -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StakeCreds crypto] -> Encoding
$ctoEncodingList :: forall crypto. Crypto crypto => [StakeCreds crypto] -> Encoding
toJSONList :: [StakeCreds crypto] -> Value
$ctoJSONList :: forall crypto. Crypto crypto => [StakeCreds crypto] -> Value
toEncoding :: StakeCreds crypto -> Encoding
$ctoEncoding :: forall crypto. Crypto crypto => StakeCreds crypto -> Encoding
toJSON :: StakeCreds crypto -> Value
$ctoJSON :: forall crypto. Crypto crypto => StakeCreds crypto -> Value
ToJSON, Value -> Parser [StakeCreds crypto]
Value -> Parser (StakeCreds crypto)
(Value -> Parser (StakeCreds crypto))
-> (Value -> Parser [StakeCreds crypto])
-> FromJSON (StakeCreds crypto)
forall crypto. Crypto crypto => Value -> Parser [StakeCreds crypto]
forall crypto. Crypto crypto => Value -> Parser (StakeCreds crypto)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StakeCreds crypto]
$cparseJSONList :: forall crypto. Crypto crypto => Value -> Parser [StakeCreds crypto]
parseJSON :: Value -> Parser (StakeCreds crypto)
$cparseJSON :: forall crypto. Crypto crypto => Value -> Parser (StakeCreds crypto)
FromJSON)

deriving newtype instance
  CC.Crypto crypto =>
  FromCBOR (StakeCreds crypto)

deriving newtype instance
  CC.Crypto crypto =>
  ToCBOR (StakeCreds crypto)

-- CBOR

instance
  CC.Crypto crypto =>
  ToCBOR (DCert crypto)
  where
  toCBOR :: DCert crypto -> Encoding
toCBOR = \case
    -- DCertDeleg
    DCertDeleg (RegKey StakeCredential crypto
cred) ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StakeCredential crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential crypto
cred
    DCertDeleg (DeRegKey StakeCredential crypto
cred) ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StakeCredential crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential crypto
cred
    DCertDeleg (Delegate (Delegation StakeCredential crypto
cred KeyHash 'StakePool crypto
poolkh)) ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StakeCredential crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential crypto
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'StakePool crypto
poolkh
    -- DCertPool
    DCertPool (RegPool PoolParams crypto
poolParams) ->
      Word -> Encoding
encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ PoolParams crypto -> Word
forall a. ToCBORGroup a => a -> Word
listLen PoolParams crypto
poolParams)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
3 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PoolParams crypto -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup PoolParams crypto
poolParams
    DCertPool (RetirePool KeyHash 'StakePool crypto
vk EpochNo
epoch) ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
4 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'StakePool crypto
vk
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR EpochNo
epoch
    -- DCertGenesis
    DCertGenesis (GenesisDelegCert KeyHash 'Genesis crypto
gk KeyHash 'GenesisDelegate crypto
kh Hash crypto (VerKeyVRF crypto)
vrf) ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
5 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'Genesis crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'Genesis crypto
gk
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'GenesisDelegate crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'GenesisDelegate crypto
kh
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash crypto (VerKeyVRF crypto) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash crypto (VerKeyVRF crypto)
vrf
    -- DCertMIR
    DCertMir MIRCert crypto
mir ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
6 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> MIRCert crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR MIRCert crypto
mir

instance
  CC.Crypto crypto =>
  FromCBOR (DCert crypto)
  where
  fromCBOR :: Decoder s (DCert crypto)
fromCBOR = String
-> (Word -> Decoder s (Int, DCert crypto))
-> Decoder s (DCert crypto)
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"DCert crypto" ((Word -> Decoder s (Int, DCert crypto))
 -> Decoder s (DCert crypto))
-> (Word -> Decoder s (Int, DCert crypto))
-> Decoder s (DCert crypto)
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> do
        StakeCredential crypto
x <- Decoder s (StakeCredential crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, DelegCert crypto -> DCert crypto
forall crypto. DelegCert crypto -> DCert crypto
DCertDeleg (DelegCert crypto -> DCert crypto)
-> (StakeCredential crypto -> DelegCert crypto)
-> StakeCredential crypto
-> DCert crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential crypto -> DelegCert crypto
forall crypto. StakeCredential crypto -> DelegCert crypto
RegKey (StakeCredential crypto -> DCert crypto)
-> StakeCredential crypto -> DCert crypto
forall a b. (a -> b) -> a -> b
$ StakeCredential crypto
x)
      Word
1 -> do
        StakeCredential crypto
x <- Decoder s (StakeCredential crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, DelegCert crypto -> DCert crypto
forall crypto. DelegCert crypto -> DCert crypto
DCertDeleg (DelegCert crypto -> DCert crypto)
-> (StakeCredential crypto -> DelegCert crypto)
-> StakeCredential crypto
-> DCert crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StakeCredential crypto -> DelegCert crypto
forall crypto. StakeCredential crypto -> DelegCert crypto
DeRegKey (StakeCredential crypto -> DCert crypto)
-> StakeCredential crypto -> DCert crypto
forall a b. (a -> b) -> a -> b
$ StakeCredential crypto
x)
      Word
2 -> do
        StakeCredential crypto
a <- Decoder s (StakeCredential crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        KeyHash 'StakePool crypto
b <- Decoder s (KeyHash 'StakePool crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, DelegCert crypto -> DCert crypto
forall crypto. DelegCert crypto -> DCert crypto
DCertDeleg (DelegCert crypto -> DCert crypto)
-> DelegCert crypto -> DCert crypto
forall a b. (a -> b) -> a -> b
$ Delegation crypto -> DelegCert crypto
forall crypto. Delegation crypto -> DelegCert crypto
Delegate (StakeCredential crypto
-> KeyHash 'StakePool crypto -> Delegation crypto
forall crypto.
StakeCredential crypto
-> KeyHash 'StakePool crypto -> Delegation crypto
Delegation StakeCredential crypto
a KeyHash 'StakePool crypto
b))
      Word
3 -> do
        PoolParams crypto
group <- Decoder s (PoolParams crypto)
forall a s. FromCBORGroup a => Decoder s a
fromCBORGroup
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PoolParams crypto -> Int
forall a. ToCBORGroup a => a -> Int
listLenInt PoolParams crypto
group), PoolCert crypto -> DCert crypto
forall crypto. PoolCert crypto -> DCert crypto
DCertPool (PoolParams crypto -> PoolCert crypto
forall crypto. PoolParams crypto -> PoolCert crypto
RegPool PoolParams crypto
group))
      Word
4 -> do
        KeyHash 'StakePool crypto
a <- Decoder s (KeyHash 'StakePool crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Word64
b <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, PoolCert crypto -> DCert crypto
forall crypto. PoolCert crypto -> DCert crypto
DCertPool (PoolCert crypto -> DCert crypto)
-> PoolCert crypto -> DCert crypto
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool crypto -> EpochNo -> PoolCert crypto
forall crypto.
KeyHash 'StakePool crypto -> EpochNo -> PoolCert crypto
RetirePool KeyHash 'StakePool crypto
a (Word64 -> EpochNo
EpochNo Word64
b))
      Word
5 -> do
        KeyHash 'Genesis crypto
a <- Decoder s (KeyHash 'Genesis crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        KeyHash 'GenesisDelegate crypto
b <- Decoder s (KeyHash 'GenesisDelegate crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        Hash (HASH crypto) (VerKeyVRF (VRF crypto))
c <- Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
4, GenesisDelegCert crypto -> DCert crypto
forall crypto. GenesisDelegCert crypto -> DCert crypto
DCertGenesis (GenesisDelegCert crypto -> DCert crypto)
-> GenesisDelegCert crypto -> DCert crypto
forall a b. (a -> b) -> a -> b
$ KeyHash 'Genesis crypto
-> KeyHash 'GenesisDelegate crypto
-> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
-> GenesisDelegCert crypto
forall crypto.
KeyHash 'Genesis crypto
-> KeyHash 'GenesisDelegate crypto
-> Hash crypto (VerKeyVRF crypto)
-> GenesisDelegCert crypto
GenesisDelegCert KeyHash 'Genesis crypto
a KeyHash 'GenesisDelegate crypto
b Hash (HASH crypto) (VerKeyVRF (VRF crypto))
c)
      Word
6 -> do
        MIRCert crypto
x <- Decoder s (MIRCert crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
        (Int, DCert crypto) -> Decoder s (Int, DCert crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, MIRCert crypto -> DCert crypto
forall crypto. MIRCert crypto -> DCert crypto
DCertMir MIRCert crypto
x)
      Word
k -> Word -> Decoder s (Int, DCert crypto)
forall s a. Word -> Decoder s a
invalidKey Word
k

instance-- use the weakest constraint necessary

  (Era era, TransTxOut ToCBOR era) =>
  ToCBOR (TxOut era)
  where
  toCBOR :: TxOut era -> Encoding
toCBOR (TxOutCompact CompactAddr (Crypto era)
addr CompactForm (Value era)
coin) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddr (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactAddr (Crypto era)
addr
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm (Value era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactForm (Value era)
coin

instance
  (Era era, TransTxOut DecodeNonNegative era, Show (Core.Value era)) =>
  FromCBOR (TxOut era)
  where
  fromCBOR :: Decoder s (TxOut era)
fromCBOR = Decoder s (TxOut era)
forall a s. FromSharedCBOR a => Decoder s a
fromNotSharedCBOR

-- This instance does not do any sharing and is isomorphic to FromCBOR
-- use the weakest constraint necessary
instance
  (Era era, TransTxOut DecodeNonNegative era, Show (Core.Value era)) =>
  FromSharedCBOR (TxOut era)
  where
  type Share (TxOut era) = Interns (Credential 'Staking (Crypto era))
  fromSharedCBOR :: Share (TxOut era) -> Decoder s (TxOut era)
fromSharedCBOR Share (TxOut era)
_ =
    Text
-> (TxOut era -> Int)
-> Decoder s (TxOut era)
-> Decoder s (TxOut era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"TxOut" (Int -> TxOut era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (TxOut era) -> Decoder s (TxOut era))
-> Decoder s (TxOut era) -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ do
      CompactAddr (Crypto era)
cAddr <- Decoder s (CompactAddr (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      CompactForm (Value era)
coin <- Decoder s (CompactForm (Value era))
forall v s. DecodeNonNegative v => Decoder s v
decodeNonNegative
      TxOut era -> Decoder s (TxOut era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut era -> Decoder s (TxOut era))
-> TxOut era -> Decoder s (TxOut era)
forall a b. (a -> b) -> a -> b
$ CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
forall era.
CompactAddr (Crypto era) -> CompactForm (Value era) -> TxOut era
TxOutCompact CompactAddr (Crypto era)
cAddr CompactForm (Value era)
coin

instance
  (Typeable kr, CC.Crypto crypto) =>
  ToCBOR (WitVKey kr crypto)
  where
  toCBOR :: WitVKey kr crypto -> Encoding
toCBOR = ByteString -> Encoding
encodePreEncoded (ByteString -> Encoding)
-> (WitVKey kr crypto -> ByteString)
-> WitVKey kr crypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (WitVKey kr crypto -> ByteString)
-> WitVKey kr crypto
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitVKey kr crypto -> ByteString
forall (kr :: KeyRole) crypto. WitVKey kr crypto -> ByteString
wvkBytes

instance
  (Typeable kr, CC.Crypto crypto) =>
  FromCBOR (Annotator (WitVKey kr crypto))
  where
  fromCBOR :: Decoder s (Annotator (WitVKey kr crypto))
fromCBOR =
    Decoder s (Annotator (ByteString -> WitVKey kr crypto))
-> Decoder s (Annotator (WitVKey kr crypto))
forall s a.
Decoder s (Annotator (ByteString -> a)) -> Decoder s (Annotator a)
annotatorSlice (Decoder s (Annotator (ByteString -> WitVKey kr crypto))
 -> Decoder s (Annotator (WitVKey kr crypto)))
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
-> Decoder s (Annotator (WitVKey kr crypto))
forall a b. (a -> b) -> a -> b
$
      Text
-> (Annotator (ByteString -> WitVKey kr crypto) -> Int)
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"WitVKey" (Int -> Annotator (ByteString -> WitVKey kr crypto) -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (Annotator (ByteString -> WitVKey kr crypto))
 -> Decoder s (Annotator (ByteString -> WitVKey kr crypto)))
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
forall a b. (a -> b) -> a -> b
$
        ((ByteString -> WitVKey kr crypto)
 -> Annotator (ByteString -> WitVKey kr crypto))
-> Decoder s (ByteString -> WitVKey kr crypto)
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> WitVKey kr crypto)
-> Annotator (ByteString -> WitVKey kr crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder s (ByteString -> WitVKey kr crypto)
 -> Decoder s (Annotator (ByteString -> WitVKey kr crypto)))
-> Decoder s (ByteString -> WitVKey kr crypto)
-> Decoder s (Annotator (ByteString -> WitVKey kr crypto))
forall a b. (a -> b) -> a -> b
$
          VKey kr crypto
-> SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
-> ByteString
-> WitVKey kr crypto
forall crypto (r :: KeyRole).
Crypto crypto =>
VKey r crypto
-> SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
-> ByteString
-> WitVKey r crypto
mkWitVKey (VKey kr crypto
 -> SignedDSIGN
      (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
 -> ByteString
 -> WitVKey kr crypto)
-> Decoder s (VKey kr crypto)
-> Decoder
     s
     (SignedDSIGN
        (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
      -> ByteString -> WitVKey kr crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VKey kr crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder
  s
  (SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
   -> ByteString -> WitVKey kr crypto)
-> Decoder
     s
     (SignedDSIGN
        (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody))
-> Decoder s (ByteString -> WitVKey kr crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder
  s
  (SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody))
forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
decodeSignedDSIGN
    where
      mkWitVKey :: VKey r crypto
-> SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
-> ByteString
-> WitVKey r crypto
mkWitVKey VKey r crypto
k SignedDSIGN
  (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
sig = VKey r crypto
-> SignedDSIGN
     (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
-> KeyHash 'Witness crypto
-> ByteString
-> WitVKey r crypto
forall (kr :: KeyRole) crypto.
VKey kr crypto
-> SignedDSIGN crypto (Hash crypto EraIndependentTxBody)
-> KeyHash 'Witness crypto
-> ByteString
-> WitVKey kr crypto
WitVKey' VKey r crypto
k SignedDSIGN
  (DSIGN crypto) (Hash (HASH crypto) EraIndependentTxBody)
sig (KeyHash r crypto -> KeyHash 'Witness crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto.
HasKeyRole a =>
a r crypto -> a 'Witness crypto
asWitness (KeyHash r crypto -> KeyHash 'Witness crypto)
-> KeyHash r crypto -> KeyHash 'Witness crypto
forall a b. (a -> b) -> a -> b
$ VKey r crypto -> KeyHash r crypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
hashKey VKey r crypto
k)

instance ToCBOR PoolMetadata where
  toCBOR :: PoolMetadata -> Encoding
toCBOR (PoolMetadata Url
u ByteString
h) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Url -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Url
u
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
h

instance FromCBOR PoolMetadata where
  fromCBOR :: Decoder s PoolMetadata
fromCBOR = do
    Text
-> (PoolMetadata -> Int)
-> Decoder s PoolMetadata
-> Decoder s PoolMetadata
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"PoolMetadata" (Int -> PoolMetadata -> Int
forall a b. a -> b -> a
const Int
2) (Url -> ByteString -> PoolMetadata
PoolMetadata (Url -> ByteString -> PoolMetadata)
-> Decoder s Url -> Decoder s (ByteString -> PoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Url
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (ByteString -> PoolMetadata)
-> Decoder s ByteString -> Decoder s PoolMetadata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR)

-- | The size of the '_poolOwners' 'Set'.  Only used to compute size of encoded
-- 'PoolParams'.
data SizeOfPoolOwners = SizeOfPoolOwners

instance ToCBOR SizeOfPoolOwners where
  toCBOR :: SizeOfPoolOwners -> Encoding
toCBOR = Text -> SizeOfPoolOwners -> Encoding
forall a. HasCallStack => Text -> a
panic Text
"The `SizeOfPoolOwners` type cannot be encoded!"

-- | The size of the '_poolRelays' 'Set'.  Only used to compute size of encoded
-- 'PoolParams'.
data SizeOfPoolRelays = SizeOfPoolRelays

instance ToCBOR SizeOfPoolRelays where
  toCBOR :: SizeOfPoolRelays -> Encoding
toCBOR = Text -> SizeOfPoolRelays -> Encoding
forall a. HasCallStack => Text -> a
panic Text
"The `SizeOfPoolRelays` type cannot be encoded!"

instance
  CC.Crypto crypto =>
  ToCBORGroup (PoolParams crypto)
  where
  toCBORGroup :: PoolParams crypto -> Encoding
toCBORGroup PoolParams crypto
poolParams =
    KeyHash 'StakePool crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> KeyHash 'StakePool crypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash (HASH crypto) (VerKeyVRF (VRF crypto)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolCost PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> UnitInterval
forall crypto. PoolParams crypto -> UnitInterval
_poolMargin PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardAcnt crypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams crypto -> RewardAcnt crypto
forall crypto. PoolParams crypto -> RewardAcnt crypto
_poolRAcnt PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (KeyHash 'Staking crypto) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners PoolParams crypto
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CborSeq StakePoolRelay -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Seq StakePoolRelay -> CborSeq StakePoolRelay
forall a. Seq a -> CborSeq a
CborSeq (StrictSeq StakePoolRelay -> Seq StakePoolRelay
forall a. StrictSeq a -> Seq a
StrictSeq.fromStrict (PoolParams crypto -> StrictSeq StakePoolRelay
forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
_poolRelays PoolParams crypto
poolParams)))
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (PoolMetadata -> Encoding) -> Maybe PoolMetadata -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe PoolMetadata -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (StrictMaybe PoolMetadata -> Maybe PoolMetadata
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (PoolParams crypto -> StrictMaybe PoolMetadata
forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
_poolMD PoolParams crypto
poolParams))

  encodedGroupSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams crypto) -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' Proxy (PoolParams crypto)
proxy =
    (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash 'StakePool crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> KeyHash 'StakePool crypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
_poolId (PoolParams crypto -> KeyHash 'StakePool crypto)
-> Proxy (PoolParams crypto) -> Proxy (KeyHash 'StakePool crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash (HASH crypto) (VerKeyVRF (VRF crypto))) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> Hash (HASH crypto) (VerKeyVRF (VRF crypto))
forall crypto. PoolParams crypto -> Hash crypto (VerKeyVRF crypto)
_poolVrf (PoolParams crypto -> Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
-> Proxy (PoolParams crypto)
-> Proxy (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolPledge (PoolParams crypto -> Coin)
-> Proxy (PoolParams crypto) -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> Coin
forall crypto. PoolParams crypto -> Coin
_poolCost (PoolParams crypto -> Coin)
-> Proxy (PoolParams crypto) -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy UnitInterval -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> UnitInterval
forall crypto. PoolParams crypto -> UnitInterval
_poolMargin (PoolParams crypto -> UnitInterval)
-> Proxy (PoolParams crypto) -> Proxy UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (RewardAcnt crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (PoolParams crypto -> RewardAcnt crypto
forall crypto. PoolParams crypto -> RewardAcnt crypto
_poolRAcnt (PoolParams crypto -> RewardAcnt crypto)
-> Proxy (PoolParams crypto) -> Proxy (RewardAcnt crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
2
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
poolSize Size -> Size -> Size
forall a. Num a => a -> a -> a
* (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash 'Staking crypto) -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (Proxy (Set (KeyHash 'Staking crypto))
-> Proxy (KeyHash 'Staking crypto)
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams crypto -> Set (KeyHash 'Staking crypto)
forall crypto. PoolParams crypto -> Set (KeyHash 'Staking crypto)
_poolOwners (PoolParams crypto -> Set (KeyHash 'Staking crypto))
-> Proxy (PoolParams crypto)
-> Proxy (Set (KeyHash 'Staking crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy))
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
2
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
relaySize Size -> Size -> Size
forall a. Num a => a -> a -> a
* (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy StakePoolRelay -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (Proxy (StrictSeq StakePoolRelay) -> Proxy StakePoolRelay
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams crypto -> StrictSeq StakePoolRelay
forall crypto. PoolParams crypto -> StrictSeq StakePoolRelay
_poolRelays (PoolParams crypto -> StrictSeq StakePoolRelay)
-> Proxy (PoolParams crypto) -> Proxy (StrictSeq StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy))
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ [Case Size] -> Size
szCases
        [ Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Nothing" Size
1,
          Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Just" (Size -> Case Size) -> Size -> Case Size
forall a b. (a -> b) -> a -> b
$ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy PoolMetadata -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' (Proxy (StrictMaybe PoolMetadata) -> Proxy PoolMetadata
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams crypto -> StrictMaybe PoolMetadata
forall crypto. PoolParams crypto -> StrictMaybe PoolMetadata
_poolMD (PoolParams crypto -> StrictMaybe PoolMetadata)
-> Proxy (PoolParams crypto) -> Proxy (StrictMaybe PoolMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams crypto)
proxy))
        ]
    where
      poolSize, relaySize :: Size
      poolSize :: Size
poolSize = Proxy SizeOfPoolOwners -> Size
forall t. ToCBOR t => Proxy t -> Size
size' (Proxy SizeOfPoolOwners
forall k (t :: k). Proxy t
Proxy @SizeOfPoolOwners)
      relaySize :: Size
relaySize = Proxy SizeOfPoolRelays -> Size
forall t. ToCBOR t => Proxy t -> Size
size' (Proxy SizeOfPoolRelays
forall k (t :: k). Proxy t
Proxy @SizeOfPoolRelays)
      elementProxy :: Proxy (f a) -> Proxy a
      elementProxy :: Proxy (f a) -> Proxy a
elementProxy Proxy (f a)
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

  listLen :: PoolParams crypto -> Word
listLen PoolParams crypto
_ = Word
9
  listLenBound :: Proxy (PoolParams crypto) -> Word
listLenBound Proxy (PoolParams crypto)
_ = Word
9

instance
  CC.Crypto crypto =>
  FromCBORGroup (PoolParams crypto)
  where
  fromCBORGroup :: Decoder s (PoolParams crypto)
fromCBORGroup = do
    KeyHash 'StakePool crypto
hk <- Decoder s (KeyHash 'StakePool crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Hash (HASH crypto) (VerKeyVRF (VRF crypto))
vrf <- Decoder s (Hash (HASH crypto) (VerKeyVRF (VRF crypto)))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Coin
pledge <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Coin
cost <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
    UnitInterval
margin <- Decoder s UnitInterval
forall a s. FromCBOR a => Decoder s a
fromCBOR
    RewardAcnt crypto
ra <- Decoder s (RewardAcnt crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Set (KeyHash 'Staking crypto)
owners <- Decoder s (KeyHash 'Staking crypto)
-> Decoder s (Set (KeyHash 'Staking crypto))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (KeyHash 'Staking crypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    StrictSeq StakePoolRelay
relays <- Decoder s StakePoolRelay -> Decoder s (StrictSeq StakePoolRelay)
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s StakePoolRelay
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Maybe PoolMetadata
md <- Decoder s PoolMetadata -> Decoder s (Maybe PoolMetadata)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s PoolMetadata
forall a s. FromCBOR a => Decoder s a
fromCBOR
    PoolParams crypto -> Decoder s (PoolParams crypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolParams crypto -> Decoder s (PoolParams crypto))
-> PoolParams crypto -> Decoder s (PoolParams crypto)
forall a b. (a -> b) -> a -> b
$
      PoolParams :: forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
PoolParams
        { _poolId :: KeyHash 'StakePool crypto
_poolId = KeyHash 'StakePool crypto
hk,
          _poolVrf :: Hash (HASH crypto) (VerKeyVRF (VRF crypto))
_poolVrf = Hash (HASH crypto) (VerKeyVRF (VRF crypto))
vrf,
          _poolPledge :: Coin
_poolPledge = Coin
pledge,
          _poolCost :: Coin
_poolCost = Coin
cost,
          _poolMargin :: UnitInterval
_poolMargin = UnitInterval
margin,
          _poolRAcnt :: RewardAcnt crypto
_poolRAcnt = RewardAcnt crypto
ra,
          _poolOwners :: Set (KeyHash 'Staking crypto)
_poolOwners = Set (KeyHash 'Staking crypto)
owners,
          _poolRelays :: StrictSeq StakePoolRelay
_poolRelays = StrictSeq StakePoolRelay
relays,
          _poolMD :: StrictMaybe PoolMetadata
_poolMD = Maybe PoolMetadata -> StrictMaybe PoolMetadata
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe PoolMetadata
md
        }