{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Shelley.Spec.Ledger.TxBody
  ( DCert (..),
    DelegCert (..),
    Delegation (..),
    GenesisDelegCert (..),
    Ix,
    MIRCert (..),
    MIRPot (..),
    PoolCert (..),
    PoolMetaData (..),
    PoolParams (..),
    Ptr (..),
    RewardAcnt (..),
    StakeCreds (..),
    StakePoolRelay (..),
    TxBody
      ( TxBody,
        TxBodyY,
        _inputs,
        _outputs,
        _certs,
        _wdrls,
        _txfee,
        _ttl,
        _txUpdate,
        _mdHash
      ),
    --  TxBodyY(TxBodyZ,..),
    TxId (..),
    TxIn (TxIn, ..),
    EraIndependentTxBody,
    eraIndTxBodyHash,
    TxOut (TxOut, TxOutCompact),
    Url,
    Wdrl (..),
    WitVKey (WitVKey, wvkBytes),
    --
    witKeyHash,
    --
    SizeOfPoolOwners (..),
    SizeOfPoolRelays (..),
  )
where

import Cardano.Binary
  ( Annotator (..),
    Case (..),
    FromCBOR (fromCBOR),
    Size,
    ToCBOR (..),
    annotatorSlice,
    decodeWord,
    encodeListLen,
    encodePreEncoded,
    serializeEncoding,
    szCases,
  )
import Cardano.Ledger.Compactible
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era
import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra)
import Cardano.Ledger.Val (Val)
import Cardano.Prelude
  ( decodeEitherBase16,
    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 Base16
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as BSL
import Data.Coders
  ( Decode (..),
    Density (..),
    Dual (..),
    Encode (..),
    Field (..),
    Wrapped (..),
    decode,
    encode,
    (!>),
  )
import Data.Coerce (coerce)
import Data.Foldable (asum)
import Data.IP (IPv4, IPv6)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
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 qualified Data.Text.Encoding as Text
import Data.Typeable (Typeable)
import Data.Word (Word64, Word8)
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class (AllowThunksIn (..), InspectHeapNamed (..), NoThunks (..))
import Numeric.Natural (Natural)
import Quiet
import Shelley.Spec.Ledger.Address
  ( Addr (..),
    RewardAcnt (..),
  )
import Shelley.Spec.Ledger.BaseTypes
  ( DnsName,
    Port,
    StrictMaybe (..),
    UnitInterval,
    Url,
    invalidKey,
    maybeToStrictMaybe,
    strictMaybeToMaybe,
  )
import Shelley.Spec.Ledger.Coin (Coin (..))
import Shelley.Spec.Ledger.CompactAddr
  ( CompactAddr,
    compactAddr,
    decompactAddr,
  )
import Shelley.Spec.Ledger.Credential
  ( Credential (..),
    Ix,
    Ptr (..),
    StakeCredential,
  )
import Shelley.Spec.Ledger.Hashing
import Shelley.Spec.Ledger.Keys
  ( Hash,
    KeyHash (..),
    KeyRole (..),
    SignedDSIGN,
    VKey,
    VerKeyVRF,
    asWitness,
    decodeSignedDSIGN,
    encodeSignedDSIGN,
    hashKey,
  )
import Shelley.Spec.Ledger.MetaData (MetaDataHash)
import Shelley.Spec.Ledger.Orphans ()
import Shelley.Spec.Ledger.PParams (Update)
import Shelley.Spec.Ledger.Serialization
  ( CBORGroup (..),
    CborSeq (..),
    FromCBORGroup (..),
    ToCBORGroup (..),
    decodeNullMaybe,
    decodeRecordNamed,
    decodeRecordSum,
    decodeSet,
    decodeStrictSeq,
    encodeFoldable,
    encodeNullMaybe,
    ipv4FromCBOR,
    ipv4ToCBOR,
    ipv6FromCBOR,
    ipv6ToCBOR,
    listLenInt,
    mapFromCBOR,
    mapToCBOR,
  )
import Shelley.Spec.Ledger.Slot (EpochNo (..), SlotNo (..))

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

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) =>
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 era = Delegation
  { Delegation era -> StakeCredential era
_delegator :: !(StakeCredential era),
    Delegation era -> KeyHash 'StakePool (Crypto era)
_delegatee :: !(KeyHash 'StakePool (Crypto era))
  }
  deriving (Delegation era -> Delegation era -> Bool
(Delegation era -> Delegation era -> Bool)
-> (Delegation era -> Delegation era -> Bool)
-> Eq (Delegation era)
forall era. Delegation era -> Delegation era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delegation era -> Delegation era -> Bool
$c/= :: forall era. Delegation era -> Delegation era -> Bool
== :: Delegation era -> Delegation era -> Bool
$c== :: forall era. Delegation era -> Delegation era -> Bool
Eq, (forall x. Delegation era -> Rep (Delegation era) x)
-> (forall x. Rep (Delegation era) x -> Delegation era)
-> Generic (Delegation era)
forall x. Rep (Delegation era) x -> Delegation era
forall x. Delegation era -> Rep (Delegation era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Delegation era) x -> Delegation era
forall era x. Delegation era -> Rep (Delegation era) x
$cto :: forall era x. Rep (Delegation era) x -> Delegation era
$cfrom :: forall era x. Delegation era -> Rep (Delegation era) x
Generic, Int -> Delegation era -> ShowS
[Delegation era] -> ShowS
Delegation era -> String
(Int -> Delegation era -> ShowS)
-> (Delegation era -> String)
-> ([Delegation era] -> ShowS)
-> Show (Delegation era)
forall era. Int -> Delegation era -> ShowS
forall era. [Delegation era] -> ShowS
forall era. Delegation era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delegation era] -> ShowS
$cshowList :: forall era. [Delegation era] -> ShowS
show :: Delegation era -> String
$cshow :: forall era. Delegation era -> String
showsPrec :: Int -> Delegation era -> ShowS
$cshowsPrec :: forall era. Int -> Delegation era -> ShowS
Show)

instance NoThunks (Delegation era)

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
      [ Text
"url" Text -> Url -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PoolMetaData -> Url
_poolMDUrl PoolMetaData
pmd,
        Text
"hash" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.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 -> Text -> Parser Url
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"
      ByteString
hash <- (Value -> Parser ByteString) -> Object -> Text -> Parser ByteString
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField Value -> Parser ByteString
parseJsonBase16 Object
obj Text
"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
decodeEitherBase16 (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 -> Text -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser1 Object
obj Text
"single host address",
          (Value -> Parser StakePoolRelay)
-> Object -> Text -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser2 Object
obj Text
"single host name",
          (Value -> Parser StakePoolRelay)
-> Object -> Text -> Parser StakePoolRelay
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
explicitParseField Value -> Parser StakePoolRelay
parser3 Object
obj Text
"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 -> Text -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe (StrictMaybe IPv4))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe (StrictMaybe IPv6))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser (Maybe (StrictMaybe Port))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"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 -> Text -> Parser DnsName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser DnsName
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"dnsName"

instance ToJSON StakePoolRelay where
  toJSON :: StakePoolRelay -> Value
toJSON (SingleHostAddr StrictMaybe Port
port StrictMaybe IPv4
ipv4 StrictMaybe IPv6
ipv6) =
    [Pair] -> Value
Aeson.object
      [ Text
"single host address"
          Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Text
"port" Text -> StrictMaybe Port -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StrictMaybe Port
port,
              Text
"IPv4" Text -> StrictMaybe IPv4 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StrictMaybe IPv4
ipv4,
              Text
"IPv6" Text -> StrictMaybe IPv6 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StrictMaybe IPv6
ipv6
            ]
      ]
  toJSON (SingleHostName StrictMaybe Port
port DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Text
"single host name"
          Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Text
"port" Text -> StrictMaybe Port -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StrictMaybe Port
port,
              Text
"dnsName" Text -> DnsName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DnsName
dnsName
            ]
      ]
  toJSON (MultiHostName DnsName
dnsName) =
    [Pair] -> Value
Aeson.object
      [ Text
"multi host name"
          Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Text
"dnsName" Text -> DnsName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 era = PoolParams
  { PoolParams era -> KeyHash 'StakePool (Crypto era)
_poolId :: !(KeyHash 'StakePool (Crypto era)),
    PoolParams era -> Hash (Crypto era) (VerKeyVRF (Crypto era))
_poolVrf :: !(Hash (Crypto era) (VerKeyVRF (Crypto era))),
    PoolParams era -> Coin
_poolPledge :: !Coin,
    PoolParams era -> Coin
_poolCost :: !Coin,
    PoolParams era -> UnitInterval
_poolMargin :: !UnitInterval,
    PoolParams era -> RewardAcnt era
_poolRAcnt :: !(RewardAcnt era),
    PoolParams era -> Set (KeyHash 'Staking (Crypto era))
_poolOwners :: !(Set (KeyHash 'Staking (Crypto era))),
    PoolParams era -> StrictSeq StakePoolRelay
_poolRelays :: !(StrictSeq StakePoolRelay),
    PoolParams era -> StrictMaybe PoolMetaData
_poolMD :: !(StrictMaybe PoolMetaData)
  }
  deriving (Int -> PoolParams era -> ShowS
[PoolParams era] -> ShowS
PoolParams era -> String
(Int -> PoolParams era -> ShowS)
-> (PoolParams era -> String)
-> ([PoolParams era] -> ShowS)
-> Show (PoolParams era)
forall era. Int -> PoolParams era -> ShowS
forall era. [PoolParams era] -> ShowS
forall era. PoolParams era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PoolParams era] -> ShowS
$cshowList :: forall era. [PoolParams era] -> ShowS
show :: PoolParams era -> String
$cshow :: forall era. PoolParams era -> String
showsPrec :: Int -> PoolParams era -> ShowS
$cshowsPrec :: forall era. Int -> PoolParams era -> ShowS
Show, (forall x. PoolParams era -> Rep (PoolParams era) x)
-> (forall x. Rep (PoolParams era) x -> PoolParams era)
-> Generic (PoolParams era)
forall x. Rep (PoolParams era) x -> PoolParams era
forall x. PoolParams era -> Rep (PoolParams era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PoolParams era) x -> PoolParams era
forall era x. PoolParams era -> Rep (PoolParams era) x
$cto :: forall era x. Rep (PoolParams era) x -> PoolParams era
$cfrom :: forall era x. PoolParams era -> Rep (PoolParams era) x
Generic, PoolParams era -> PoolParams era -> Bool
(PoolParams era -> PoolParams era -> Bool)
-> (PoolParams era -> PoolParams era -> Bool)
-> Eq (PoolParams era)
forall era. PoolParams era -> PoolParams era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoolParams era -> PoolParams era -> Bool
$c/= :: forall era. PoolParams era -> PoolParams era -> Bool
== :: PoolParams era -> PoolParams era -> Bool
$c== :: forall era. PoolParams era -> PoolParams era -> Bool
Eq, Eq (PoolParams era)
Eq (PoolParams era)
-> (PoolParams era -> PoolParams era -> Ordering)
-> (PoolParams era -> PoolParams era -> Bool)
-> (PoolParams era -> PoolParams era -> Bool)
-> (PoolParams era -> PoolParams era -> Bool)
-> (PoolParams era -> PoolParams era -> Bool)
-> (PoolParams era -> PoolParams era -> PoolParams era)
-> (PoolParams era -> PoolParams era -> PoolParams era)
-> Ord (PoolParams era)
PoolParams era -> PoolParams era -> Bool
PoolParams era -> PoolParams era -> Ordering
PoolParams era -> PoolParams era -> PoolParams era
forall era. Eq (PoolParams era)
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 era. PoolParams era -> PoolParams era -> Bool
forall era. PoolParams era -> PoolParams era -> Ordering
forall era. PoolParams era -> PoolParams era -> PoolParams era
min :: PoolParams era -> PoolParams era -> PoolParams era
$cmin :: forall era. PoolParams era -> PoolParams era -> PoolParams era
max :: PoolParams era -> PoolParams era -> PoolParams era
$cmax :: forall era. PoolParams era -> PoolParams era -> PoolParams era
>= :: PoolParams era -> PoolParams era -> Bool
$c>= :: forall era. PoolParams era -> PoolParams era -> Bool
> :: PoolParams era -> PoolParams era -> Bool
$c> :: forall era. PoolParams era -> PoolParams era -> Bool
<= :: PoolParams era -> PoolParams era -> Bool
$c<= :: forall era. PoolParams era -> PoolParams era -> Bool
< :: PoolParams era -> PoolParams era -> Bool
$c< :: forall era. PoolParams era -> PoolParams era -> Bool
compare :: PoolParams era -> PoolParams era -> Ordering
$ccompare :: forall era. PoolParams era -> PoolParams era -> Ordering
$cp1Ord :: forall era. Eq (PoolParams era)
Ord)
  deriving (Typeable (PoolParams era)
Typeable (PoolParams era)
-> (PoolParams era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (PoolParams era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PoolParams era] -> Size)
-> ToCBOR (PoolParams era)
PoolParams era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams era) -> 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 era. Era era => Typeable (PoolParams era)
forall era. Era era => PoolParams era -> Encoding
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams era] -> Size
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams era] -> Size
$cencodedListSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PoolParams era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams era) -> Size
$cencodedSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams era) -> Size
toCBOR :: PoolParams era -> Encoding
$ctoCBOR :: forall era. Era era => PoolParams era -> Encoding
$cp1ToCBOR :: forall era. Era era => Typeable (PoolParams era)
ToCBOR) via CBORGroup (PoolParams era)
  deriving (Typeable (PoolParams era)
Decoder s (PoolParams era)
Typeable (PoolParams era)
-> (forall s. Decoder s (PoolParams era))
-> (Proxy (PoolParams era) -> Text)
-> FromCBOR (PoolParams era)
Proxy (PoolParams era) -> Text
forall s. Decoder s (PoolParams era)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall era. Era era => Typeable (PoolParams era)
forall era. Era era => Proxy (PoolParams era) -> Text
forall era s. Era era => Decoder s (PoolParams era)
label :: Proxy (PoolParams era) -> Text
$clabel :: forall era. Era era => Proxy (PoolParams era) -> Text
fromCBOR :: Decoder s (PoolParams era)
$cfromCBOR :: forall era s. Era era => Decoder s (PoolParams era)
$cp1FromCBOR :: forall era. Era era => Typeable (PoolParams era)
FromCBOR) via CBORGroup (PoolParams era)

instance NoThunks (PoolParams era)

deriving instance NFData (PoolParams era)

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

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

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

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

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

-- ===================================================================================
-- Because we expect other Era's to import and use TxId, TxIn, TxOut, we use the weakest
-- constraint possible when deriving their instances. A Stronger constraint, Gathering
-- many constraints together, like:  type Strong = (C1 x, C2 x, ..., Cn x)
-- may make this file look systematic by having things like:
-- derving instance (Strong x) => Foo x,  for many Foo (Eq, Show, NfData, etc) BUT this
-- forces unnecessary requirements on any new Era which tries to embed one of these
-- types in their own datatypes, if they then try and derive (Foo TheirDataType).
-- ====================================================================================

-- | A unique ID of a transaction, which is computable from the transaction.
newtype TxId era = TxId {TxId era -> Hash (Crypto era) EraIndependentTxBody
_unTxId :: Hash (Crypto era) EraIndependentTxBody}
  deriving (Int -> TxId era -> ShowS
[TxId era] -> ShowS
TxId era -> String
(Int -> TxId era -> ShowS)
-> (TxId era -> String) -> ([TxId era] -> ShowS) -> Show (TxId era)
forall era. Int -> TxId era -> ShowS
forall era. [TxId era] -> ShowS
forall era. TxId era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId era] -> ShowS
$cshowList :: forall era. [TxId era] -> ShowS
show :: TxId era -> String
$cshow :: forall era. TxId era -> String
showsPrec :: Int -> TxId era -> ShowS
$cshowsPrec :: forall era. Int -> TxId era -> ShowS
Show, TxId era -> TxId era -> Bool
(TxId era -> TxId era -> Bool)
-> (TxId era -> TxId era -> Bool) -> Eq (TxId era)
forall era. TxId era -> TxId era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId era -> TxId era -> Bool
$c/= :: forall era. TxId era -> TxId era -> Bool
== :: TxId era -> TxId era -> Bool
$c== :: forall era. TxId era -> TxId era -> Bool
Eq, Eq (TxId era)
Eq (TxId era)
-> (TxId era -> TxId era -> Ordering)
-> (TxId era -> TxId era -> Bool)
-> (TxId era -> TxId era -> Bool)
-> (TxId era -> TxId era -> Bool)
-> (TxId era -> TxId era -> Bool)
-> (TxId era -> TxId era -> TxId era)
-> (TxId era -> TxId era -> TxId era)
-> Ord (TxId era)
TxId era -> TxId era -> Bool
TxId era -> TxId era -> Ordering
TxId era -> TxId era -> TxId era
forall era. Eq (TxId era)
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 era. TxId era -> TxId era -> Bool
forall era. TxId era -> TxId era -> Ordering
forall era. TxId era -> TxId era -> TxId era
min :: TxId era -> TxId era -> TxId era
$cmin :: forall era. TxId era -> TxId era -> TxId era
max :: TxId era -> TxId era -> TxId era
$cmax :: forall era. TxId era -> TxId era -> TxId era
>= :: TxId era -> TxId era -> Bool
$c>= :: forall era. TxId era -> TxId era -> Bool
> :: TxId era -> TxId era -> Bool
$c> :: forall era. TxId era -> TxId era -> Bool
<= :: TxId era -> TxId era -> Bool
$c<= :: forall era. TxId era -> TxId era -> Bool
< :: TxId era -> TxId era -> Bool
$c< :: forall era. TxId era -> TxId era -> Bool
compare :: TxId era -> TxId era -> Ordering
$ccompare :: forall era. TxId era -> TxId era -> Ordering
$cp1Ord :: forall era. Eq (TxId era)
Ord, (forall x. TxId era -> Rep (TxId era) x)
-> (forall x. Rep (TxId era) x -> TxId era) -> Generic (TxId era)
forall x. Rep (TxId era) x -> TxId era
forall x. TxId era -> Rep (TxId era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxId era) x -> TxId era
forall era x. TxId era -> Rep (TxId era) x
$cto :: forall era x. Rep (TxId era) x -> TxId era
$cfrom :: forall era x. TxId era -> Rep (TxId era) x
Generic)
  deriving newtype (Context -> TxId era -> IO (Maybe ThunkInfo)
Proxy (TxId era) -> String
(Context -> TxId era -> IO (Maybe ThunkInfo))
-> (Context -> TxId era -> IO (Maybe ThunkInfo))
-> (Proxy (TxId era) -> String)
-> NoThunks (TxId era)
forall era. Context -> TxId era -> IO (Maybe ThunkInfo)
forall era. Proxy (TxId era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxId era) -> String
$cshowTypeOf :: forall era. Proxy (TxId era) -> String
wNoThunks :: Context -> TxId era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> TxId era -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> TxId era -> IO (Maybe ThunkInfo)
NoThunks)

deriving newtype instance
  (Era era) => -- weakest constraint
  ToCBOR (TxId era)

deriving newtype instance
  (Era era) => -- weakest constraint
  FromCBOR (TxId era)

deriving newtype instance (Era era) => NFData (TxId era)

-- | The input of a UTxO.
data TxIn era = TxInCompact {-# UNPACK #-} !(TxId era) {-# UNPACK #-} !Word64
  deriving ((forall x. TxIn era -> Rep (TxIn era) x)
-> (forall x. Rep (TxIn era) x -> TxIn era) -> Generic (TxIn era)
forall x. Rep (TxIn era) x -> TxIn era
forall x. TxIn era -> Rep (TxIn era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxIn era) x -> TxIn era
forall era x. TxIn era -> Rep (TxIn era) x
$cto :: forall era x. Rep (TxIn era) x -> TxIn era
$cfrom :: forall era x. TxIn era -> Rep (TxIn era) x
Generic)

-- TODO: We will also want to have the TxId be compact, but the representation
-- depends on the era. NOT SURE ABOUT this. The TxId is always a Hash, Can't get more compact than that.

pattern TxIn ::
  Era era =>
  TxId era ->
  Natural -> -- TODO We might want to change this to Word64 generally
  TxIn era
pattern $bTxIn :: TxId era -> Natural -> TxIn era
$mTxIn :: forall r era.
Era era =>
TxIn era -> (TxId era -> Natural -> r) -> (Void# -> r) -> r
TxIn addr index <-
  TxInCompact addr (fromIntegral -> index)
  where
    TxIn TxId era
addr Natural
index =
      TxId era -> Word64 -> TxIn era
forall era. TxId era -> Word64 -> TxIn era
TxInCompact TxId era
addr (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
index)

{-# COMPLETE TxIn #-}

deriving instance Ord (TxIn era)

deriving instance Eq (TxIn era)

deriving instance Show (TxIn era)

deriving instance Era era => NFData (TxIn era)

instance NoThunks (TxIn era)

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

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

deriving stock instance
  -- weakest constraint
  (Eq (Core.Value era), Compactible (Core.Value 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 ::
  ShelleyBased era =>
  Addr era ->
  Core.Value era ->
  TxOut era
pattern $bTxOut :: Addr era -> Value era -> TxOut era
$mTxOut :: forall r era.
ShelleyBased era =>
TxOut era -> (Addr era -> Value era -> r) -> (Void# -> r) -> r
TxOut addr vl <-
  (viewCompactTxOut -> (addr, vl))
  where
    TxOut Addr era
addr Value era
vl =
      CompactAddr era -> CompactForm (Value era) -> TxOut era
forall era. CompactAddr era -> CompactForm (Value era) -> TxOut era
TxOutCompact (Addr era -> CompactAddr era
forall era. Addr era -> CompactAddr era
compactAddr Addr era
addr) (Value era -> CompactForm (Value era)
forall a. Compactible a => a -> CompactForm a
toCompact Value era
vl)

{-# COMPLETE TxOut #-}

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

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

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

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

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)

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

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

instance
  (Era era, Typeable (Core.Script era), FromCBOR (Annotator (Core.Script era))) =>
  FromCBOR (MIRCert era)
  where
  fromCBOR :: Decoder s (MIRCert era)
fromCBOR = Text
-> (MIRCert era -> Int)
-> Decoder s (MIRCert era)
-> Decoder s (MIRCert era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"SingleHostAddr" (Int -> MIRCert era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (MIRCert era) -> Decoder s (MIRCert era))
-> Decoder s (MIRCert era) -> Decoder s (MIRCert era)
forall a b. (a -> b) -> a -> b
$ do
    MIRPot
pot <- Decoder s MIRPot
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Map (Credential 'Staking era) Coin
values <- Decoder s (Map (Credential 'Staking era) Coin)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR
    MIRCert era -> Decoder s (MIRCert era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MIRCert era -> Decoder s (MIRCert era))
-> MIRCert era -> Decoder s (MIRCert era)
forall a b. (a -> b) -> a -> b
$ MIRPot -> Map (Credential 'Staking era) Coin -> MIRCert era
forall era.
MIRPot -> Map (Credential 'Staking era) Coin -> MIRCert era
MIRCert MIRPot
pot Map (Credential 'Staking era) Coin
values

instance
  (Era era, ToCBOR (Core.Script era)) =>
  ToCBOR (MIRCert era)
  where
  toCBOR :: MIRCert era -> Encoding
toCBOR (MIRCert MIRPot
pot Map (Credential 'Staking era) Coin
values) =
    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
<> Map (Credential 'Staking era) Coin -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map (Credential 'Staking era) Coin
values

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

instance NoThunks (DelegCert era)

instance NoThunks (PoolCert era)

instance NoThunks (GenesisDelegCert era)

instance NoThunks (MIRCert era)

instance NoThunks (DCert era)

-- ===========================================================================
-- Since TxBody has fees (which are Values) and Scripts (inside hashes),
-- and both are type families, we need to ensure that these families have
-- the minimum amount of properties, to make the correct instances for TxBody

-- | Needed for Show, Eq etc instances
type ProperVal era =
  ( Era era,
    Compactible (Core.Value era),
    Show (Core.Value era),
    Eq (Core.Value era),
    Val (Core.Value era)
  )

-- | Needed for FromCBOR instances
type ProperFrom era =
  ( Era era,
    Typeable era,
    FromCBOR (Core.Value era),
    Typeable (Core.Script era),
    FromCBOR (CompactForm (Core.Value era)),
    FromCBOR (Annotator (Core.Script era))
  )

-- | Needed for ToCBOR instances
type ProperTo era =
  ( Era era,
    ToCBOR (Core.Value era),
    ToCBOR (Core.Script era),
    ToCBOR (CompactForm (Core.Value era))
  )

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

data TxBodyX era = TxBodyX
  { TxBodyX era -> Set (TxIn era)
_inputsX :: !(Set (TxIn era)),
    TxBodyX era -> StrictSeq (TxOut era)
_outputsX :: !(StrictSeq (TxOut era)),
    TxBodyX era -> StrictSeq (DCert era)
_certsX :: !(StrictSeq (DCert era)),
    TxBodyX era -> Wdrl era
_wdrlsX :: !(Wdrl era),
    TxBodyX era -> Coin
_txfeeX :: !Coin,
    TxBodyX era -> SlotNo
_ttlX :: !SlotNo,
    TxBodyX era -> StrictMaybe (Update era)
_txUpdateX :: !(StrictMaybe (Update era)),
    TxBodyX era -> StrictMaybe (MetaDataHash era)
_mdHashX :: !(StrictMaybe (MetaDataHash era))
  }
  deriving ((forall x. TxBodyX era -> Rep (TxBodyX era) x)
-> (forall x. Rep (TxBodyX era) x -> TxBodyX era)
-> Generic (TxBodyX era)
forall x. Rep (TxBodyX era) x -> TxBodyX era
forall x. TxBodyX era -> Rep (TxBodyX era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (TxBodyX era) x -> TxBodyX era
forall era x. TxBodyX era -> Rep (TxBodyX era) x
$cto :: forall era x. Rep (TxBodyX era) x -> TxBodyX era
$cfrom :: forall era x. TxBodyX era -> Rep (TxBodyX era) x
Generic, Context -> TxBodyX era -> IO (Maybe ThunkInfo)
Proxy (TxBodyX era) -> String
(Context -> TxBodyX era -> IO (Maybe ThunkInfo))
-> (Context -> TxBodyX era -> IO (Maybe ThunkInfo))
-> (Proxy (TxBodyX era) -> String)
-> NoThunks (TxBodyX era)
forall era. Context -> TxBodyX era -> IO (Maybe ThunkInfo)
forall era. Proxy (TxBodyX era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxBodyX era) -> String
$cshowTypeOf :: forall era. Proxy (TxBodyX era) -> String
wNoThunks :: Context -> TxBodyX era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> TxBodyX era -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxBodyX era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> TxBodyX era -> IO (Maybe ThunkInfo)
NoThunks, Typeable)

deriving instance (Era era, ProperVal era) => Eq (TxBodyX era)

deriving instance (Era era, ProperVal era) => Show (TxBodyX era)

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

instance ProperFrom era => FromCBOR (Annotator (TxBodyX era)) where
  fromCBOR :: Decoder s (Annotator (TxBodyX era))
fromCBOR = TxBodyX era -> Annotator (TxBodyX era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxBodyX era -> Annotator (TxBodyX era))
-> Decoder s (TxBodyX era) -> Decoder s (Annotator (TxBodyX era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TxBodyX 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.

-- | This Dual follows strategy of the the old code, for backward compatibility,
--   of serializing StrictMaybe values. The strategy is to serialise only the
--   value: 'x' in a (SJust x). The SNothing and the SJust part are never
--   written to the serialised bytes but are supplied by the Omit capability.
--   Be sure and wrap a (Omit isNothing (Key v _)) around use of this Dual.
--   Like this: (Omit isNothing (Key v (ED omitStrictNothingDual x))).
--   Neither the Omit or the key is needed for Decoders.
omitStrictNothingDual :: (FromCBOR t, ToCBOR t) => Dual (StrictMaybe t)
omitStrictNothingDual :: Dual (StrictMaybe t)
omitStrictNothingDual = (StrictMaybe t -> Encoding)
-> (forall s. Decoder s (StrictMaybe t)) -> Dual (StrictMaybe t)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual (t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (t -> Encoding)
-> (StrictMaybe t -> t) -> StrictMaybe t -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe t -> t
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe t -> t) -> (StrictMaybe t -> Maybe t) -> StrictMaybe t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe t -> Maybe t
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe) (t -> StrictMaybe t
forall a. a -> StrictMaybe a
SJust (t -> StrictMaybe t) -> Decoder s t -> Decoder s (StrictMaybe t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s t
forall a s. FromCBOR a => Decoder s a
fromCBOR)

isSNothing :: StrictMaybe a -> Bool
isSNothing :: StrictMaybe a -> Bool
isSNothing StrictMaybe a
SNothing = Bool
True
isSNothing StrictMaybe a
_ = Bool
False

-- | 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 :: ProperFrom era => Word -> Field (TxBodyX era)
boxBody :: Word -> Field (TxBodyX era)
boxBody Word
0 = (Set (TxIn era) -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed 'Dense) (Set (TxIn era)) -> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\Set (TxIn era)
x TxBodyX era
tx -> TxBodyX era
tx {_inputsX :: Set (TxIn era)
_inputsX = Set (TxIn era)
x}) ((forall s. Decoder s (Set (TxIn era)))
-> Decode ('Closed 'Dense) (Set (TxIn era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (TxIn era) -> Decoder s (Set (TxIn era))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (TxIn era)
forall a s. FromCBOR a => Decoder s a
fromCBOR))
boxBody Word
1 = (StrictSeq (TxOut era) -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed 'Dense) (StrictSeq (TxOut era))
-> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\StrictSeq (TxOut era)
x TxBodyX era
tx -> TxBodyX 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 era) -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed 'Dense) (StrictSeq (DCert era))
-> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\StrictSeq (DCert era)
x TxBodyX era
tx -> TxBodyX era
tx {_certsX :: StrictSeq (DCert era)
_certsX = StrictSeq (DCert era)
x}) ((forall s. Decoder s (StrictSeq (DCert era)))
-> Decode ('Closed 'Dense) (StrictSeq (DCert era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (DCert era) -> Decoder s (StrictSeq (DCert era))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (DCert era)
forall a s. FromCBOR a => Decoder s a
fromCBOR))
boxBody Word
5 = (Wdrl era -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed Any) (Wdrl era) -> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\Wdrl era
x TxBodyX era
tx -> TxBodyX era
tx {_wdrlsX :: Wdrl era
_wdrlsX = Wdrl era
x}) Decode ('Closed Any) (Wdrl era)
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
boxBody Word
2 = (Coin -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed Any) Coin -> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\Coin
x TxBodyX era
tx -> TxBodyX 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 -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed Any) SlotNo -> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\SlotNo
x TxBodyX era
tx -> TxBodyX 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) -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed 'Dense) (StrictMaybe (Update era))
-> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\StrictMaybe (Update era)
x TxBodyX era
tx -> TxBodyX era
tx {_txUpdateX :: StrictMaybe (Update era)
_txUpdateX = StrictMaybe (Update era)
x}) (Dual (StrictMaybe (Update era))
-> Decode ('Closed 'Dense) (StrictMaybe (Update era))
forall t. Dual t -> Decode ('Closed 'Dense) t
DD Dual (StrictMaybe (Update era))
forall t. (FromCBOR t, ToCBOR t) => Dual (StrictMaybe t)
omitStrictNothingDual)
boxBody Word
7 = (StrictMaybe (MetaDataHash era) -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed 'Dense) (StrictMaybe (MetaDataHash era))
-> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\StrictMaybe (MetaDataHash era)
x TxBodyX era
tx -> TxBodyX era
tx {_mdHashX :: StrictMaybe (MetaDataHash era)
_mdHashX = StrictMaybe (MetaDataHash era)
x}) (Dual (StrictMaybe (MetaDataHash era))
-> Decode ('Closed 'Dense) (StrictMaybe (MetaDataHash era))
forall t. Dual t -> Decode ('Closed 'Dense) t
DD Dual (StrictMaybe (MetaDataHash era))
forall t. (FromCBOR t, ToCBOR t) => Dual (StrictMaybe t)
omitStrictNothingDual)
boxBody Word
n = (Any -> TxBodyX era -> TxBodyX era)
-> Decode ('Closed Any) Any -> Field (TxBodyX era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
Field (\Any
_ TxBodyX era
t -> TxBodyX era
t) (Word -> Decode ('Closed Any) Any
forall (w :: Wrapped) t. Word -> Decode w t
Invalid 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 :: ProperTo era => TxBodyX era -> Encode ( 'Closed 'Sparse) (TxBodyX era)
txSparse :: TxBodyX era -> Encode ('Closed 'Sparse) (TxBodyX era)
txSparse (TxBodyX Set (TxIn era)
input StrictSeq (TxOut era)
output StrictSeq (DCert era)
cert Wdrl era
wdrl Coin
fee SlotNo
ttl StrictMaybe (Update era)
update StrictMaybe (MetaDataHash era)
hash) =
  (Set (TxIn era)
 -> StrictSeq (TxOut era)
 -> Coin
 -> SlotNo
 -> StrictSeq (DCert era)
 -> Wdrl era
 -> StrictMaybe (Update era)
 -> StrictMaybe (MetaDataHash era)
 -> TxBodyX era)
-> Encode
     ('Closed 'Sparse)
     (Set (TxIn era)
      -> StrictSeq (TxOut era)
      -> Coin
      -> SlotNo
      -> StrictSeq (DCert era)
      -> Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed (\Set (TxIn era)
i StrictSeq (TxOut era)
o Coin
f SlotNo
t StrictSeq (DCert era)
c Wdrl era
w StrictMaybe (Update era)
u StrictMaybe (MetaDataHash era)
h -> Set (TxIn era)
-> StrictSeq (TxOut era)
-> StrictSeq (DCert era)
-> Wdrl era
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (MetaDataHash era)
-> TxBodyX era
forall era.
Set (TxIn era)
-> StrictSeq (TxOut era)
-> StrictSeq (DCert era)
-> Wdrl era
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (MetaDataHash era)
-> TxBodyX era
TxBodyX Set (TxIn era)
i StrictSeq (TxOut era)
o StrictSeq (DCert era)
c Wdrl era
w Coin
f SlotNo
t StrictMaybe (Update era)
u StrictMaybe (MetaDataHash era)
h)
    Encode
  ('Closed 'Sparse)
  (Set (TxIn era)
   -> StrictSeq (TxOut era)
   -> Coin
   -> SlotNo
   -> StrictSeq (DCert era)
   -> Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) (Set (TxIn era))
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (TxOut era)
      -> Coin
      -> SlotNo
      -> StrictSeq (DCert era)
      -> Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX 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 era))
-> Encode ('Closed 'Sparse) (Set (TxIn era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 ((Set (TxIn era) -> Encoding)
-> Set (TxIn era) -> Encode ('Closed 'Dense) (Set (TxIn era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Set (TxIn era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (TxIn era)
input) -- We don't have to send these in TxBodyX order
    Encode
  ('Closed 'Sparse)
  (StrictSeq (TxOut era)
   -> Coin
   -> SlotNo
   -> StrictSeq (DCert era)
   -> Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) (StrictSeq (TxOut era))
-> Encode
     ('Closed 'Sparse)
     (Coin
      -> SlotNo
      -> StrictSeq (DCert era)
      -> Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX 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 era)
   -> Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) Coin
-> Encode
     ('Closed 'Sparse)
     (SlotNo
      -> StrictSeq (DCert era)
      -> Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX 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 era)
   -> Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) SlotNo
-> Encode
     ('Closed 'Sparse)
     (StrictSeq (DCert era)
      -> Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX 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 era)
   -> Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert era))
-> Encode
     ('Closed 'Sparse)
     (Wdrl era
      -> StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era)
      -> TxBodyX era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (DCert era) -> Bool)
-> Encode ('Closed 'Sparse) (StrictSeq (DCert era))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictSeq (DCert era) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (StrictSeq (DCert era))
-> Encode ('Closed 'Sparse) (StrictSeq (DCert era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
4 ((StrictSeq (DCert era) -> Encoding)
-> StrictSeq (DCert era)
-> Encode ('Closed 'Dense) (StrictSeq (DCert era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (DCert era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (DCert era)
cert))
    Encode
  ('Closed 'Sparse)
  (Wdrl era
   -> StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era)
   -> TxBodyX era)
-> Encode ('Closed 'Sparse) (Wdrl era)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe (Update era)
      -> StrictMaybe (MetaDataHash era) -> TxBodyX era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Wdrl era -> Bool)
-> Encode ('Closed 'Sparse) (Wdrl era)
-> Encode ('Closed 'Sparse) (Wdrl era)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Map (RewardAcnt era) Coin -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map (RewardAcnt era) Coin -> Bool)
-> (Wdrl era -> Map (RewardAcnt era) Coin) -> Wdrl era -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl era -> Map (RewardAcnt era) Coin
forall era. Wdrl era -> Map (RewardAcnt era) Coin
unWdrl) (Word
-> Encode ('Closed 'Dense) (Wdrl era)
-> Encode ('Closed 'Sparse) (Wdrl era)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
5 (Wdrl era -> Encode ('Closed 'Dense) (Wdrl era)
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Wdrl era
wdrl))
    Encode
  ('Closed 'Sparse)
  (StrictMaybe (Update era)
   -> StrictMaybe (MetaDataHash era) -> TxBodyX era)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
-> Encode
     ('Closed 'Sparse) (StrictMaybe (MetaDataHash era) -> TxBodyX era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (Update era) -> Bool)
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictMaybe (Update era) -> Bool
forall a. StrictMaybe a -> Bool
isSNothing (Word
-> Encode ('Closed 'Dense) (StrictMaybe (Update era))
-> Encode ('Closed 'Sparse) (StrictMaybe (Update era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
6 (Dual (StrictMaybe (Update era))
-> StrictMaybe (Update era)
-> Encode ('Closed 'Dense) (StrictMaybe (Update era))
forall t. Dual t -> t -> Encode ('Closed 'Dense) t
ED Dual (StrictMaybe (Update era))
forall t. (FromCBOR t, ToCBOR t) => Dual (StrictMaybe t)
omitStrictNothingDual StrictMaybe (Update era)
update))
    Encode
  ('Closed 'Sparse) (StrictMaybe (MetaDataHash era) -> TxBodyX era)
-> Encode ('Closed 'Sparse) (StrictMaybe (MetaDataHash era))
-> Encode ('Closed 'Sparse) (TxBodyX era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (MetaDataHash era) -> Bool)
-> Encode ('Closed 'Sparse) (StrictMaybe (MetaDataHash era))
-> Encode ('Closed 'Sparse) (StrictMaybe (MetaDataHash era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictMaybe (MetaDataHash era) -> Bool
forall a. StrictMaybe a -> Bool
isSNothing (Word
-> Encode ('Closed 'Dense) (StrictMaybe (MetaDataHash era))
-> Encode ('Closed 'Sparse) (StrictMaybe (MetaDataHash era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
7 (Dual (StrictMaybe (MetaDataHash era))
-> StrictMaybe (MetaDataHash era)
-> Encode ('Closed 'Dense) (StrictMaybe (MetaDataHash era))
forall t. Dual t -> t -> Encode ('Closed 'Dense) t
ED Dual (StrictMaybe (MetaDataHash era))
forall t. (FromCBOR t, ToCBOR t) => Dual (StrictMaybe t)
omitStrictNothingDual StrictMaybe (MetaDataHash 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.
baseTxBodyX :: TxBodyX era
baseTxBodyX :: TxBodyX era
baseTxBodyX =
  TxBodyX :: forall era.
Set (TxIn era)
-> StrictSeq (TxOut era)
-> StrictSeq (DCert era)
-> Wdrl era
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (MetaDataHash era)
-> TxBodyX era
TxBodyX
    { _inputsX :: Set (TxIn era)
_inputsX = Set (TxIn 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 era)
_certsX = StrictSeq (DCert era)
forall a. StrictSeq a
StrictSeq.empty,
      _wdrlsX :: Wdrl era
_wdrlsX = Map (RewardAcnt era) Coin -> Wdrl era
forall era. Map (RewardAcnt era) Coin -> Wdrl era
Wdrl Map (RewardAcnt 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 (MetaDataHash era)
_mdHashX = StrictMaybe (MetaDataHash era)
forall a. StrictMaybe a
SNothing
    }

instance ProperTo era => ToCBOR (TxBodyX era) where
  toCBOR :: TxBodyX era -> Encoding
toCBOR TxBodyX era
x = Encode ('Closed 'Sparse) (TxBodyX era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (TxBodyX era -> Encode ('Closed 'Sparse) (TxBodyX era)
forall era.
ProperTo era =>
TxBodyX era -> Encode ('Closed 'Sparse) (TxBodyX era)
txSparse TxBodyX era
x)

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

newtype TxBody era = TxBodyY (MemoBytes (TxBodyX 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 (Context -> TxBody era -> IO (Maybe ThunkInfo)
Proxy (TxBody era) -> String
(Context -> TxBody era -> IO (Maybe ThunkInfo))
-> (Context -> TxBody era -> IO (Maybe ThunkInfo))
-> (Proxy (TxBody era) -> String)
-> NoThunks (TxBody era)
forall era.
Typeable era =>
Context -> TxBody era -> IO (Maybe ThunkInfo)
forall era. Typeable era => Proxy (TxBody era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxBody era) -> String
$cshowTypeOf :: forall era. Typeable era => Proxy (TxBody era) -> String
wNoThunks :: Context -> TxBody era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Typeable era =>
Context -> TxBody era -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxBody era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Typeable era =>
Context -> TxBody era -> IO (Maybe ThunkInfo)
NoThunks)

deriving instance ProperVal era => Show (TxBody era)

deriving instance ProperVal era => Eq (TxBody era)

deriving via
  (Mem (TxBodyX era))
  instance
    (ProperFrom era) =>
    FromCBOR (Annotator (TxBody era))

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

{-# COMPLETE TxBody #-}

instance Era era => HashAnnotated (TxBody era) era where
  type HashIndex (TxBody era) = EraIndependentTxBody

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

-- ==========================================================================
-- Here is where we declare that in the (ShelleyEra c) The abstract type family
-- Core.TxBody is set to THIS TxBody,The one we defined a few lines above.

type instance Core.TxBody (ShelleyEra c) = TxBody (ShelleyEra c)

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

instance HasField "inputs" (TxBody e) (Set (TxIn e)) where
  getField :: TxBody e -> Set (TxIn e)
getField (TxBodyY (Memo TxBodyX e
m ShortByteString
_)) = TxBodyX e -> Set (TxIn e)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_inputsX" TxBodyX e
m

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

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

instance HasField "wdrls" (TxBody era) (Wdrl era) where
  getField :: TxBody era -> Wdrl era
getField (TxBodyY (Memo TxBodyX era
m ShortByteString
_)) = TxBodyX era -> Wdrl era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_wdrlsX" TxBodyX era
m

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

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

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

instance HasField "mdHash" (TxBody era) (StrictMaybe (MetaDataHash era)) where
  getField :: TxBody era -> StrictMaybe (MetaDataHash era)
getField (TxBodyY (Memo TxBodyX era
m ShortByteString
_)) = TxBodyX era -> StrictMaybe (MetaDataHash era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_mdHashX" TxBodyX era
m

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

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

deriving instance (Era era) => Show (WitVKey kr era)

deriving instance (Era era) => Eq (WitVKey kr era)

deriving via
  (AllowThunksIn '["wvkBytes"] (WitVKey kr era))
  instance
    (Era era, Typeable kr) => NoThunks (WitVKey kr era)

instance (Era era, Typeable kr) => HashAnnotated (WitVKey kr era) era where
  type HashIndex (WitVKey kr era) = EraIndependentWitVKey

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

-- | Compute an era-independent transaction body hash
eraIndTxBodyHash ::
  forall era.
  (Era era) =>
  TxBody era ->
  Hash (Crypto era) EraIndependentTxBody
eraIndTxBodyHash :: TxBody era -> Hash (Crypto era) EraIndependentTxBody
eraIndTxBodyHash = Hash (Crypto era) EraIndependentTxBody
-> Hash (Crypto era) EraIndependentTxBody
coerce (Hash (Crypto era) EraIndependentTxBody
 -> Hash (Crypto era) EraIndependentTxBody)
-> (TxBody era -> Hash (Crypto era) EraIndependentTxBody)
-> TxBody era
-> Hash (Crypto era) EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Hash (Crypto era) EraIndependentTxBody
forall a e.
HashAnnotated a e =>
a -> Hash (HASH (Crypto e)) (HashIndex a)
hashAnnotated

{-# COMPLETE WitVKey #-}

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

instance
  forall era kr.
  (Typeable kr, Era era) =>
  Ord (WitVKey kr era)
  where
  compare :: WitVKey kr era -> WitVKey kr era -> Ordering
compare = (WitVKey kr era -> KeyHash 'Witness (Crypto era))
-> WitVKey kr era -> WitVKey kr era -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing WitVKey kr era -> KeyHash 'Witness (Crypto era)
forall (kr :: KeyRole) era.
WitVKey kr era -> KeyHash 'Witness (Crypto era)
wvkKeyHash

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

deriving newtype instance
  (Era era, Typeable (Core.Script era)) =>
  FromCBOR (StakeCreds era)

deriving newtype instance
  (Era era, ToCBOR (Core.Script era)) =>
  ToCBOR (StakeCreds era)

-- CBOR

instance-- use the weakest predicate

  (Era era, ToCBOR (Core.Script era)) =>
  ToCBOR (DCert era)
  where
  toCBOR :: DCert era -> Encoding
toCBOR = \case
    -- DCertDeleg
    DCertDeleg (RegKey StakeCredential era
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 era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential era
cred
    DCertDeleg (DeRegKey StakeCredential era
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 era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential era
cred
    DCertDeleg (Delegate (Delegation StakeCredential era
cred KeyHash 'StakePool (Crypto era)
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 era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR StakeCredential era
cred
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'StakePool (Crypto era)
poolkh
    -- DCertPool
    DCertPool (RegPool PoolParams era
poolParams) ->
      Word -> Encoding
encodeListLen (Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ PoolParams era -> Word
forall a. ToCBORGroup a => a -> Word
listLen PoolParams era
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 era -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup PoolParams era
poolParams
    DCertPool (RetirePool KeyHash 'StakePool (Crypto era)
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 era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'StakePool (Crypto era)
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 era)
gk KeyHash 'GenesisDelegate (Crypto era)
kh Hash (Crypto era) (VerKeyVRF (Crypto era))
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 era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'Genesis (Crypto era)
gk
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'GenesisDelegate (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash 'GenesisDelegate (Crypto era)
kh
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash (Crypto era) (VerKeyVRF (Crypto era)) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Hash (Crypto era) (VerKeyVRF (Crypto era))
vrf
    -- DCertMIR
    DCertMir MIRCert era
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 era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR MIRCert era
mir

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

instance
  (Era era) =>
  ToCBOR (TxIn era)
  where
  toCBOR :: TxIn era -> Encoding
toCBOR (TxInCompact TxId era
txId Word64
index) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxId era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxId era
txId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
index

instance
  (Era era) =>
  FromCBOR (TxIn era)
  where
  fromCBOR :: Decoder s (TxIn era)
fromCBOR = do
    Text
-> (TxIn era -> Int)
-> Decoder s (TxIn era)
-> Decoder s (TxIn era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"TxIn" (Int -> TxIn era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (TxIn era) -> Decoder s (TxIn era))
-> Decoder s (TxIn era) -> Decoder s (TxIn era)
forall a b. (a -> b) -> a -> b
$ do
      TxId era
a <- Decoder s (TxId era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word64
b <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      TxIn era -> Decoder s (TxIn era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn era -> Decoder s (TxIn era))
-> TxIn era -> Decoder s (TxIn era)
forall a b. (a -> b) -> a -> b
$ TxId era -> Word64 -> TxIn era
forall era. TxId era -> Word64 -> TxIn era
TxInCompact TxId era
a Word64
b

instance-- use the weakest constraint necessary

  (Era era, ToCBOR (Core.Value era), ToCBOR (CompactForm (Core.Value era))) =>
  ToCBOR (TxOut era)
  where
  toCBOR :: TxOut era -> Encoding
toCBOR (TxOutCompact CompactAddr era
addr CompactForm (Value era)
coin) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactAddr era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR CompactAddr 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-- use the weakest constraint necessary

  (Era era, FromCBOR (Core.Value era), FromCBOR (CompactForm (Core.Value era))) =>
  FromCBOR (TxOut era)
  where
  fromCBOR :: Decoder s (TxOut era)
fromCBOR = 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 era
cAddr <- Decoder s (CompactAddr era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    CompactForm (Value era)
coin <- Decoder s (CompactForm (Value era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    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 era -> CompactForm (Value era) -> TxOut era
forall era. CompactAddr era -> CompactForm (Value era) -> TxOut era
TxOutCompact CompactAddr era
cAddr CompactForm (Value era)
coin

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

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

-- | 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
  (Era era) =>
  ToCBORGroup (PoolParams era)
  where
  toCBORGroup :: PoolParams era -> Encoding
toCBORGroup PoolParams era
poolParams =
    KeyHash 'StakePool (Crypto era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era -> KeyHash 'StakePool (Crypto era)
forall era. PoolParams era -> KeyHash 'StakePool (Crypto era)
_poolId PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era))) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era
-> Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era)))
forall era.
PoolParams era -> Hash (Crypto era) (VerKeyVRF (Crypto era))
_poolVrf PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era -> Coin
forall era. PoolParams era -> Coin
_poolPledge PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era -> Coin
forall era. PoolParams era -> Coin
_poolCost PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era -> UnitInterval
forall era. PoolParams era -> UnitInterval
_poolMargin PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> RewardAcnt era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PoolParams era -> RewardAcnt era
forall era. PoolParams era -> RewardAcnt era
_poolRAcnt PoolParams era
poolParams)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (KeyHash 'Staking (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (PoolParams era -> Set (KeyHash 'Staking (Crypto era))
forall era. PoolParams era -> Set (KeyHash 'Staking (Crypto era))
_poolOwners PoolParams era
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.getSeq (PoolParams era -> StrictSeq StakePoolRelay
forall era. PoolParams era -> StrictSeq StakePoolRelay
_poolRelays PoolParams era
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 era -> StrictMaybe PoolMetaData
forall era. PoolParams era -> StrictMaybe PoolMetaData
_poolMD PoolParams era
poolParams))

  encodedGroupSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PoolParams era) -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size' Proxy (PoolParams era)
proxy =
    (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (KeyHash 'StakePool (Crypto era)) -> 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 era -> KeyHash 'StakePool (Crypto era)
forall era. PoolParams era -> KeyHash 'StakePool (Crypto era)
_poolId (PoolParams era -> KeyHash 'StakePool (Crypto era))
-> Proxy (PoolParams era)
-> Proxy (KeyHash 'StakePool (Crypto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era))))
-> 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 era
-> Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era)))
forall era.
PoolParams era -> Hash (Crypto era) (VerKeyVRF (Crypto era))
_poolVrf (PoolParams era
 -> Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era))))
-> Proxy (PoolParams era)
-> Proxy (Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> Coin
forall era. PoolParams era -> Coin
_poolPledge (PoolParams era -> Coin) -> Proxy (PoolParams era) -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> Coin
forall era. PoolParams era -> Coin
_poolCost (PoolParams era -> Coin) -> Proxy (PoolParams era) -> Proxy Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> UnitInterval
forall era. PoolParams era -> UnitInterval
_poolMargin (PoolParams era -> UnitInterval)
-> Proxy (PoolParams era) -> Proxy UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (RewardAcnt era) -> 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 era -> RewardAcnt era
forall era. PoolParams era -> RewardAcnt era
_poolRAcnt (PoolParams era -> RewardAcnt era)
-> Proxy (PoolParams era) -> Proxy (RewardAcnt era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era)) -> 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 era)))
-> Proxy (KeyHash 'Staking (Crypto era))
forall (f :: * -> *) a. Proxy (f a) -> Proxy a
elementProxy (PoolParams era -> Set (KeyHash 'Staking (Crypto era))
forall era. PoolParams era -> Set (KeyHash 'Staking (Crypto era))
_poolOwners (PoolParams era -> Set (KeyHash 'Staking (Crypto era)))
-> Proxy (PoolParams era)
-> Proxy (Set (KeyHash 'Staking (Crypto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> StrictSeq StakePoolRelay
forall era. PoolParams era -> StrictSeq StakePoolRelay
_poolRelays (PoolParams era -> StrictSeq StakePoolRelay)
-> Proxy (PoolParams era) -> Proxy (StrictSeq StakePoolRelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> StrictMaybe PoolMetaData
forall era. PoolParams era -> StrictMaybe PoolMetaData
_poolMD (PoolParams era -> StrictMaybe PoolMetaData)
-> Proxy (PoolParams era) -> Proxy (StrictMaybe PoolMetaData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (PoolParams era)
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 era -> Word
listLen PoolParams era
_ = Word
9
  listLenBound :: Proxy (PoolParams era) -> Word
listLenBound Proxy (PoolParams era)
_ = Word
9

instance
  (Era era) =>
  FromCBORGroup (PoolParams era)
  where
  fromCBORGroup :: Decoder s (PoolParams era)
fromCBORGroup = do
    KeyHash 'StakePool (Crypto era)
hk <- Decoder s (KeyHash 'StakePool (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era)))
vrf <- Decoder s (Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era))))
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 era
ra <- Decoder s (RewardAcnt era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Set (KeyHash 'Staking (Crypto era))
owners <- Decoder s (KeyHash 'Staking (Crypto era))
-> Decoder s (Set (KeyHash 'Staking (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (KeyHash 'Staking (Crypto era))
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 era -> Decoder s (PoolParams era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PoolParams era -> Decoder s (PoolParams era))
-> PoolParams era -> Decoder s (PoolParams era)
forall a b. (a -> b) -> a -> b
$
      PoolParams :: forall era.
KeyHash 'StakePool (Crypto era)
-> Hash (Crypto era) (VerKeyVRF (Crypto era))
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt era
-> Set (KeyHash 'Staking (Crypto era))
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetaData
-> PoolParams era
PoolParams
        { _poolId :: KeyHash 'StakePool (Crypto era)
_poolId = KeyHash 'StakePool (Crypto era)
hk,
          _poolVrf :: Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era)))
_poolVrf = Hash (HASH (Crypto era)) (VerKeyVRF (VRF (Crypto era)))
vrf,
          _poolPledge :: Coin
_poolPledge = Coin
pledge,
          _poolCost :: Coin
_poolCost = Coin
cost,
          _poolMargin :: UnitInterval
_poolMargin = UnitInterval
margin,
          _poolRAcnt :: RewardAcnt era
_poolRAcnt = RewardAcnt era
ra,
          _poolOwners :: Set (KeyHash 'Staking (Crypto era))
_poolOwners = Set (KeyHash 'Staking (Crypto era))
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
        }