{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Conway.Governance.Procedures (
  VotingProcedures (..),
  VotingProcedure (..),
  foldlVotingProcedures,
  foldrVotingProcedures,
  ProposalProcedure (..),
  Anchor (..),
  AnchorData (..),
  Vote (..),
  Voter (..),
  Committee (..),
  GovAction (..),
  GovActionId (..),
  GovActionIx (..),
  GovPurposeId (..),
  GovActionPurpose (..),
  ToGovActionPurpose,
  isGovActionWithPurpose,
  GovRelation (..),
  grPParamUpdateL,
  grHardForkL,
  grCommitteeL,
  grConstitutionL,
  hoistGovRelation,
  withGovActionParent,
  GovActionState (..),
  govActionIdToText,
  indexedGovProps,
  Constitution (..),
  constitutionAnchorL,
  constitutionScriptL,
  showGovActionType,
  -- Lenses
  pProcDepositL,
  pProcGovActionL,
  pProcReturnAddrL,
  pProcAnchorL,
  committeeMembersL,
  committeeThresholdL,
  gasDRepVotesL,
  gasStakePoolVotesL,
  gasCommitteeVotesL,
  gasExpiresAfterL,
  gasProposalProcedureL,
  gasActionL,
  gasReturnAddrL,
  gasProposedInL,
  gasIdL,
  gasDepositL,
  gasDeposit,
  gasAction,
  gasReturnAddr,
) where

import Cardano.Crypto.Hash (hashToTextAsHex)
import Cardano.Ledger.Address (RewardAccount)
import Cardano.Ledger.Alonzo.TxBody (Indexable (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.BaseTypes (
  Anchor (..),
  AnchorData (..),
  ProtVer,
  UnitInterval,
  maybeToStrictMaybe,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecShareCBOR (..),
  EncCBOR (..),
  FromCBOR (fromCBOR),
  Interns,
  ToCBOR (toCBOR),
  decNoShareCBOR,
  decodeEnumBounded,
  decodeMapByKey,
  decodeNullStrictMaybe,
  decodeRecordNamed,
  decodeRecordNamedT,
  encodeEnum,
  encodeListLen,
  encodeNullStrictMaybe,
  encodeWord8,
  internsFromMap,
  invalidKey,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  decodeRecordSum,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Credential (Credential (..), credToText)
import Cardano.Ledger.Shelley.RewardProvenance ()
import Cardano.Ledger.TxIn (TxId (..))
import Cardano.Slotting.Slot (EpochNo)
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad (when)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.State.Strict (get, put)
import Data.Aeson (
  FromJSON (..),
  KeyValue (..),
  ToJSON (..),
  ToJSONKey (..),
  object,
  pairs,
  withObject,
  (.:),
  (.:?),
 )
import Data.Aeson.Types (toJSONKeyText)
import Data.Data (Typeable)
import Data.Default
import Data.Kind
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.OMap.Strict as OMap
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Text as Text
import Data.Unit.Strict (forceElemsToWHNF)
import Data.Word (Word16)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.))
import NoThunks.Class (NoThunks)

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

data GovActionId = GovActionId
  { GovActionId -> TxId
gaidTxId :: !TxId
  , GovActionId -> GovActionIx
gaidGovActionIx :: !GovActionIx
  }
  deriving ((forall x. GovActionId -> Rep GovActionId x)
-> (forall x. Rep GovActionId x -> GovActionId)
-> Generic GovActionId
forall x. Rep GovActionId x -> GovActionId
forall x. GovActionId -> Rep GovActionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GovActionId -> Rep GovActionId x
from :: forall x. GovActionId -> Rep GovActionId x
$cto :: forall x. Rep GovActionId x -> GovActionId
to :: forall x. Rep GovActionId x -> GovActionId
Generic, Int -> GovActionId -> ShowS
[GovActionId] -> ShowS
GovActionId -> String
(Int -> GovActionId -> ShowS)
-> (GovActionId -> String)
-> ([GovActionId] -> ShowS)
-> Show GovActionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovActionId -> ShowS
showsPrec :: Int -> GovActionId -> ShowS
$cshow :: GovActionId -> String
show :: GovActionId -> String
$cshowList :: [GovActionId] -> ShowS
showList :: [GovActionId] -> ShowS
Show, GovActionId -> GovActionId -> Bool
(GovActionId -> GovActionId -> Bool)
-> (GovActionId -> GovActionId -> Bool) -> Eq GovActionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovActionId -> GovActionId -> Bool
== :: GovActionId -> GovActionId -> Bool
$c/= :: GovActionId -> GovActionId -> Bool
/= :: GovActionId -> GovActionId -> Bool
Eq, Eq GovActionId
Eq GovActionId =>
(GovActionId -> GovActionId -> Ordering)
-> (GovActionId -> GovActionId -> Bool)
-> (GovActionId -> GovActionId -> Bool)
-> (GovActionId -> GovActionId -> Bool)
-> (GovActionId -> GovActionId -> Bool)
-> (GovActionId -> GovActionId -> GovActionId)
-> (GovActionId -> GovActionId -> GovActionId)
-> Ord GovActionId
GovActionId -> GovActionId -> Bool
GovActionId -> GovActionId -> Ordering
GovActionId -> GovActionId -> GovActionId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GovActionId -> GovActionId -> Ordering
compare :: GovActionId -> GovActionId -> Ordering
$c< :: GovActionId -> GovActionId -> Bool
< :: GovActionId -> GovActionId -> Bool
$c<= :: GovActionId -> GovActionId -> Bool
<= :: GovActionId -> GovActionId -> Bool
$c> :: GovActionId -> GovActionId -> Bool
> :: GovActionId -> GovActionId -> Bool
$c>= :: GovActionId -> GovActionId -> Bool
>= :: GovActionId -> GovActionId -> Bool
$cmax :: GovActionId -> GovActionId -> GovActionId
max :: GovActionId -> GovActionId -> GovActionId
$cmin :: GovActionId -> GovActionId -> GovActionId
min :: GovActionId -> GovActionId -> GovActionId
Ord)

instance DecCBOR GovActionId where
  decCBOR :: forall s. Decoder s GovActionId
decCBOR =
    Decode ('Closed 'Dense) GovActionId -> Decoder s GovActionId
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) GovActionId -> Decoder s GovActionId)
-> Decode ('Closed 'Dense) GovActionId -> Decoder s GovActionId
forall a b. (a -> b) -> a -> b
$
      (TxId -> GovActionIx -> GovActionId)
-> Decode ('Closed 'Dense) (TxId -> GovActionIx -> GovActionId)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxId -> GovActionIx -> GovActionId
GovActionId
        Decode ('Closed 'Dense) (TxId -> GovActionIx -> GovActionId)
-> Decode ('Closed Any) TxId
-> Decode ('Closed 'Dense) (GovActionIx -> GovActionId)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) TxId
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (GovActionIx -> GovActionId)
-> Decode ('Closed Any) GovActionIx
-> Decode ('Closed 'Dense) GovActionId
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) GovActionIx
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR GovActionId where
  encCBOR :: GovActionId -> Encoding
encCBOR GovActionId {TxId
GovActionIx
gaidTxId :: GovActionId -> TxId
gaidGovActionIx :: GovActionId -> GovActionIx
gaidTxId :: TxId
gaidGovActionIx :: GovActionIx
..} =
    Encode ('Closed 'Dense) GovActionId -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) GovActionId -> Encoding)
-> Encode ('Closed 'Dense) GovActionId -> Encoding
forall a b. (a -> b) -> a -> b
$
      (TxId -> GovActionIx -> GovActionId)
-> Encode ('Closed 'Dense) (TxId -> GovActionIx -> GovActionId)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxId -> GovActionIx -> GovActionId
GovActionId
        Encode ('Closed 'Dense) (TxId -> GovActionIx -> GovActionId)
-> Encode ('Closed 'Dense) TxId
-> Encode ('Closed 'Dense) (GovActionIx -> GovActionId)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> TxId -> Encode ('Closed 'Dense) TxId
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxId
gaidTxId
        Encode ('Closed 'Dense) (GovActionIx -> GovActionId)
-> Encode ('Closed 'Dense) GovActionIx
-> Encode ('Closed 'Dense) GovActionId
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> GovActionIx -> Encode ('Closed 'Dense) GovActionIx
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovActionIx
gaidGovActionIx

instance NoThunks GovActionId

instance NFData GovActionId

instance ToJSON GovActionId where
  toJSON :: GovActionId -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (GovActionId -> [Pair]) -> GovActionId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionId -> [Pair]
forall e a. KeyValue e a => GovActionId -> [a]
toGovActionIdPairs
  toEncoding :: GovActionId -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (GovActionId -> Series) -> GovActionId -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (GovActionId -> [Series]) -> GovActionId -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionId -> [Series]
forall e a. KeyValue e a => GovActionId -> [a]
toGovActionIdPairs

toGovActionIdPairs :: KeyValue e a => GovActionId -> [a]
toGovActionIdPairs :: forall e a. KeyValue e a => GovActionId -> [a]
toGovActionIdPairs gaid :: GovActionId
gaid@(GovActionId TxId
_ GovActionIx
_) =
  let GovActionId {TxId
GovActionIx
gaidTxId :: GovActionId -> TxId
gaidGovActionIx :: GovActionId -> GovActionIx
gaidTxId :: TxId
gaidGovActionIx :: GovActionIx
..} = GovActionId
gaid
   in [ Key
"txId" Key -> TxId -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxId
gaidTxId
      , Key
"govActionIx" Key -> GovActionIx -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovActionIx
gaidGovActionIx
      ]

instance ToJSONKey GovActionId where
  toJSONKey :: ToJSONKeyFunction GovActionId
toJSONKey = (GovActionId -> Text) -> ToJSONKeyFunction GovActionId
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText GovActionId -> Text
govActionIdToText

govActionIdToText :: GovActionId -> Text.Text
govActionIdToText :: GovActionId -> Text
govActionIdToText (GovActionId (TxId SafeHash EraIndependentTxBody
txidHash) (GovActionIx Word16
ix)) =
  Hash HASH EraIndependentTxBody -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxBody
txidHash)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
"#"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Word16 -> String
forall a. Show a => a -> String
show Word16
ix)

data GovActionState era = GovActionState
  { forall era. GovActionState era -> GovActionId
gasId :: !GovActionId
  , forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes :: !(Map (Credential 'HotCommitteeRole) Vote)
  , forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes :: !(Map (Credential 'DRepRole) Vote)
  , forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasStakePoolVotes :: !(Map (KeyHash 'StakePool) Vote)
  , forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure :: !(ProposalProcedure era)
  , forall era. GovActionState era -> EpochNo
gasProposedIn :: !EpochNo
  , forall era. GovActionState era -> EpochNo
gasExpiresAfter :: !EpochNo
  }
  deriving (Eq (GovActionState era)
Eq (GovActionState era) =>
(GovActionState era -> GovActionState era -> Ordering)
-> (GovActionState era -> GovActionState era -> Bool)
-> (GovActionState era -> GovActionState era -> Bool)
-> (GovActionState era -> GovActionState era -> Bool)
-> (GovActionState era -> GovActionState era -> Bool)
-> (GovActionState era -> GovActionState era -> GovActionState era)
-> (GovActionState era -> GovActionState era -> GovActionState era)
-> Ord (GovActionState era)
GovActionState era -> GovActionState era -> Bool
GovActionState era -> GovActionState era -> Ordering
GovActionState era -> GovActionState era -> GovActionState 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. EraPParams era => Eq (GovActionState era)
forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Bool
forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Ordering
forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> GovActionState era
$ccompare :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Ordering
compare :: GovActionState era -> GovActionState era -> Ordering
$c< :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Bool
< :: GovActionState era -> GovActionState era -> Bool
$c<= :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Bool
<= :: GovActionState era -> GovActionState era -> Bool
$c> :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Bool
> :: GovActionState era -> GovActionState era -> Bool
$c>= :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> Bool
>= :: GovActionState era -> GovActionState era -> Bool
$cmax :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> GovActionState era
max :: GovActionState era -> GovActionState era -> GovActionState era
$cmin :: forall era.
EraPParams era =>
GovActionState era -> GovActionState era -> GovActionState era
min :: GovActionState era -> GovActionState era -> GovActionState era
Ord, (forall x. GovActionState era -> Rep (GovActionState era) x)
-> (forall x. Rep (GovActionState era) x -> GovActionState era)
-> Generic (GovActionState era)
forall x. Rep (GovActionState era) x -> GovActionState era
forall x. GovActionState era -> Rep (GovActionState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (GovActionState era) x -> GovActionState era
forall era x. GovActionState era -> Rep (GovActionState era) x
$cfrom :: forall era x. GovActionState era -> Rep (GovActionState era) x
from :: forall x. GovActionState era -> Rep (GovActionState era) x
$cto :: forall era x. Rep (GovActionState era) x -> GovActionState era
to :: forall x. Rep (GovActionState era) x -> GovActionState era
Generic)

gasIdL :: Lens' (GovActionState era) GovActionId
gasIdL :: forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL = (GovActionState era -> GovActionId)
-> (GovActionState era -> GovActionId -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (GovActionId -> f GovActionId)
   -> GovActionState era -> f (GovActionState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId ((GovActionState era -> GovActionId -> GovActionState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (GovActionId -> f GovActionId)
    -> GovActionState era -> f (GovActionState era))
-> (GovActionState era -> GovActionId -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (GovActionId -> f GovActionId)
   -> GovActionState era -> f (GovActionState era)
forall a b. (a -> b) -> a -> b
$ \GovActionState era
x GovActionId
y -> GovActionState era
x {gasId = y}

gasCommitteeVotesL ::
  Lens' (GovActionState era) (Map (Credential 'HotCommitteeRole) Vote)
gasCommitteeVotesL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'HotCommitteeRole) Vote
 -> f (Map (Credential 'HotCommitteeRole) Vote))
-> GovActionState era -> f (GovActionState era)
gasCommitteeVotesL = (GovActionState era -> Map (Credential 'HotCommitteeRole) Vote)
-> (GovActionState era
    -> Map (Credential 'HotCommitteeRole) Vote -> GovActionState era)
-> Lens
     (GovActionState era)
     (GovActionState era)
     (Map (Credential 'HotCommitteeRole) Vote)
     (Map (Credential 'HotCommitteeRole) Vote)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes (\GovActionState era
x Map (Credential 'HotCommitteeRole) Vote
y -> GovActionState era
x {gasCommitteeVotes = y})

gasDRepVotesL :: Lens' (GovActionState era) (Map (Credential 'DRepRole) Vote)
gasDRepVotesL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) Vote
 -> f (Map (Credential 'DRepRole) Vote))
-> GovActionState era -> f (GovActionState era)
gasDRepVotesL = (GovActionState era -> Map (Credential 'DRepRole) Vote)
-> (GovActionState era
    -> Map (Credential 'DRepRole) Vote -> GovActionState era)
-> Lens
     (GovActionState era)
     (GovActionState era)
     (Map (Credential 'DRepRole) Vote)
     (Map (Credential 'DRepRole) Vote)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> Map (Credential 'DRepRole) Vote
forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasDRepVotes (\GovActionState era
x Map (Credential 'DRepRole) Vote
y -> GovActionState era
x {gasDRepVotes = y})

gasStakePoolVotesL :: Lens' (GovActionState era) (Map (KeyHash 'StakePool) Vote)
gasStakePoolVotesL :: forall era (f :: * -> *).
Functor f =>
(Map (KeyHash 'StakePool) Vote
 -> f (Map (KeyHash 'StakePool) Vote))
-> GovActionState era -> f (GovActionState era)
gasStakePoolVotesL = (GovActionState era -> Map (KeyHash 'StakePool) Vote)
-> (GovActionState era
    -> Map (KeyHash 'StakePool) Vote -> GovActionState era)
-> Lens
     (GovActionState era)
     (GovActionState era)
     (Map (KeyHash 'StakePool) Vote)
     (Map (KeyHash 'StakePool) Vote)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> Map (KeyHash 'StakePool) Vote
forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasStakePoolVotes (\GovActionState era
x Map (KeyHash 'StakePool) Vote
y -> GovActionState era
x {gasStakePoolVotes = y})

gasProposalProcedureL :: Lens' (GovActionState era) (ProposalProcedure era)
gasProposalProcedureL :: forall era (f :: * -> *).
Functor f =>
(ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
gasProposalProcedureL = (GovActionState era -> ProposalProcedure era)
-> (GovActionState era
    -> ProposalProcedure era -> GovActionState era)
-> Lens
     (GovActionState era)
     (GovActionState era)
     (ProposalProcedure era)
     (ProposalProcedure era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> ProposalProcedure era
forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure (\GovActionState era
x ProposalProcedure era
y -> GovActionState era
x {gasProposalProcedure = y})

gasDepositL :: Lens' (GovActionState era) Coin
gasDepositL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin) -> GovActionState era -> f (GovActionState era)
gasDepositL = (ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
gasProposalProcedureL ((ProposalProcedure era -> f (ProposalProcedure era))
 -> GovActionState era -> f (GovActionState era))
-> ((Coin -> f Coin)
    -> ProposalProcedure era -> f (ProposalProcedure era))
-> (Coin -> f Coin)
-> GovActionState era
-> f (GovActionState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> f Coin)
-> ProposalProcedure era -> f (ProposalProcedure era)
forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcDepositL

gasDeposit :: GovActionState era -> Coin
gasDeposit :: forall era. GovActionState era -> Coin
gasDeposit = ProposalProcedure era -> Coin
forall era. ProposalProcedure era -> Coin
pProcDeposit (ProposalProcedure era -> Coin)
-> (GovActionState era -> ProposalProcedure era)
-> GovActionState era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> ProposalProcedure era
forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure

gasReturnAddrL :: Lens' (GovActionState era) RewardAccount
gasReturnAddrL :: forall era (f :: * -> *).
Functor f =>
(RewardAccount -> f RewardAccount)
-> GovActionState era -> f (GovActionState era)
gasReturnAddrL = (ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
gasProposalProcedureL ((ProposalProcedure era -> f (ProposalProcedure era))
 -> GovActionState era -> f (GovActionState era))
-> ((RewardAccount -> f RewardAccount)
    -> ProposalProcedure era -> f (ProposalProcedure era))
-> (RewardAccount -> f RewardAccount)
-> GovActionState era
-> f (GovActionState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RewardAccount -> f RewardAccount)
-> ProposalProcedure era -> f (ProposalProcedure era)
forall era (f :: * -> *).
Functor f =>
(RewardAccount -> f RewardAccount)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcReturnAddrL

gasReturnAddr :: GovActionState era -> RewardAccount
gasReturnAddr :: forall era. GovActionState era -> RewardAccount
gasReturnAddr = ProposalProcedure era -> RewardAccount
forall era. ProposalProcedure era -> RewardAccount
pProcReturnAddr (ProposalProcedure era -> RewardAccount)
-> (GovActionState era -> ProposalProcedure era)
-> GovActionState era
-> RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> ProposalProcedure era
forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure

gasActionL :: Lens' (GovActionState era) (GovAction era)
gasActionL :: forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL = (ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(ProposalProcedure era -> f (ProposalProcedure era))
-> GovActionState era -> f (GovActionState era)
gasProposalProcedureL ((ProposalProcedure era -> f (ProposalProcedure era))
 -> GovActionState era -> f (GovActionState era))
-> ((GovAction era -> f (GovAction era))
    -> ProposalProcedure era -> f (ProposalProcedure era))
-> (GovAction era -> f (GovAction era))
-> GovActionState era
-> f (GovActionState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovAction era -> f (GovAction era))
-> ProposalProcedure era -> f (ProposalProcedure era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcGovActionL

gasAction :: GovActionState era -> GovAction era
gasAction :: forall era. GovActionState era -> GovAction era
gasAction = ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction (ProposalProcedure era -> GovAction era)
-> (GovActionState era -> ProposalProcedure era)
-> GovActionState era
-> GovAction era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> ProposalProcedure era
forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure

gasProposedInL :: Lens' (GovActionState era) EpochNo
gasProposedInL :: forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> GovActionState era -> f (GovActionState era)
gasProposedInL = (GovActionState era -> EpochNo)
-> (GovActionState era -> EpochNo -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochNo -> f EpochNo)
   -> GovActionState era -> f (GovActionState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> EpochNo
forall era. GovActionState era -> EpochNo
gasProposedIn ((GovActionState era -> EpochNo -> GovActionState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (EpochNo -> f EpochNo)
    -> GovActionState era -> f (GovActionState era))
-> (GovActionState era -> EpochNo -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochNo -> f EpochNo)
   -> GovActionState era -> f (GovActionState era)
forall a b. (a -> b) -> a -> b
$ \GovActionState era
x EpochNo
y -> GovActionState era
x {gasProposedIn = y}

gasExpiresAfterL :: Lens' (GovActionState era) EpochNo
gasExpiresAfterL :: forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> GovActionState era -> f (GovActionState era)
gasExpiresAfterL = (GovActionState era -> EpochNo)
-> (GovActionState era -> EpochNo -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochNo -> f EpochNo)
   -> GovActionState era -> f (GovActionState era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> EpochNo
forall era. GovActionState era -> EpochNo
gasExpiresAfter ((GovActionState era -> EpochNo -> GovActionState era)
 -> forall {f :: * -> *}.
    Functor f =>
    (EpochNo -> f EpochNo)
    -> GovActionState era -> f (GovActionState era))
-> (GovActionState era -> EpochNo -> GovActionState era)
-> forall {f :: * -> *}.
   Functor f =>
   (EpochNo -> f EpochNo)
   -> GovActionState era -> f (GovActionState era)
forall a b. (a -> b) -> a -> b
$ \GovActionState era
x EpochNo
y -> GovActionState era
x {gasExpiresAfter = y}

instance EraPParams era => ToJSON (GovActionState era) where
  toJSON :: GovActionState era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (GovActionState era -> [Pair]) -> GovActionState era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> [Pair]
forall e a era.
(KeyValue e a, EraPParams era) =>
GovActionState era -> [a]
toGovActionStatePairs
  toEncoding :: GovActionState era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (GovActionState era -> Series) -> GovActionState era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (GovActionState era -> [Series]) -> GovActionState era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovActionState era -> [Series]
forall e a era.
(KeyValue e a, EraPParams era) =>
GovActionState era -> [a]
toGovActionStatePairs

toGovActionStatePairs :: (KeyValue e a, EraPParams era) => GovActionState era -> [a]
toGovActionStatePairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
GovActionState era -> [a]
toGovActionStatePairs gas :: GovActionState era
gas@(GovActionState GovActionId
_ Map (Credential 'HotCommitteeRole) Vote
_ Map (Credential 'DRepRole) Vote
_ Map (KeyHash 'StakePool) Vote
_ ProposalProcedure era
_ EpochNo
_ EpochNo
_) =
  let GovActionState {Map (KeyHash 'StakePool) Vote
Map (Credential 'DRepRole) Vote
Map (Credential 'HotCommitteeRole) Vote
EpochNo
ProposalProcedure era
GovActionId
gasId :: forall era. GovActionState era -> GovActionId
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposedIn :: forall era. GovActionState era -> EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasId :: GovActionId
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: ProposalProcedure era
gasProposedIn :: EpochNo
gasExpiresAfter :: EpochNo
..} = GovActionState era
gas
   in [ Key
"actionId" Key -> GovActionId -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovActionId
gasId
      , Key
"committeeVotes" Key -> Map (Credential 'HotCommitteeRole) Vote -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes
      , Key
"dRepVotes" Key -> Map (Credential 'DRepRole) Vote -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'DRepRole) Vote
gasDRepVotes
      , Key
"stakePoolVotes" Key -> Map (KeyHash 'StakePool) Vote -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'StakePool) Vote
gasStakePoolVotes
      , Key
"proposalProcedure" Key -> ProposalProcedure era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ProposalProcedure era
gasProposalProcedure
      , Key
"proposedIn" Key -> EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
gasProposedIn
      , Key
"expiresAfter" Key -> EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
gasExpiresAfter
      ]

deriving instance EraPParams era => Eq (GovActionState era)

deriving instance EraPParams era => Show (GovActionState era)

instance EraPParams era => NoThunks (GovActionState era)

instance EraPParams era => NFData (GovActionState era)

instance EraPParams era => DecShareCBOR (GovActionState era) where
  type
    Share (GovActionState era) =
      ( Interns (Credential 'Staking)
      , Interns (KeyHash 'StakePool)
      , Interns (Credential 'DRepRole)
      , Interns (Credential 'HotCommitteeRole)
      )
  decSharePlusCBOR :: forall s.
StateT
  (Share (GovActionState era)) (Decoder s) (GovActionState era)
decSharePlusCBOR =
    Text
-> (GovActionState era -> Int)
-> StateT
     (Share (GovActionState era)) (Decoder s) (GovActionState era)
-> StateT
     (Share (GovActionState era)) (Decoder s) (GovActionState era)
forall (m :: (* -> *) -> * -> *) s a.
(MonadTrans m, Monad (m (Decoder s))) =>
Text -> (a -> Int) -> m (Decoder s) a -> m (Decoder s) a
decodeRecordNamedT Text
"GovActionState" (Int -> GovActionState era -> Int
forall a b. a -> b -> a
const Int
7) (StateT
   (Share (GovActionState era)) (Decoder s) (GovActionState era)
 -> StateT
      (Share (GovActionState era)) (Decoder s) (GovActionState era))
-> StateT
     (Share (GovActionState era)) (Decoder s) (GovActionState era)
-> StateT
     (Share (GovActionState era)) (Decoder s) (GovActionState era)
forall a b. (a -> b) -> a -> b
$ do
      GovActionId
gasId <- Decoder s GovActionId
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     GovActionId
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s GovActionId
forall s. Decoder s GovActionId
forall a s. DecCBOR a => Decoder s a
decCBOR

      (Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
ch) <- StateT
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
  (Decoder s)
  (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
   Interns (Credential 'DRepRole),
   Interns (Credential 'HotCommitteeRole))
forall (m :: * -> *) s. Monad m => StateT s m s
get
      Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes <- Decoder s (Map (Credential 'HotCommitteeRole) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (Credential 'HotCommitteeRole) Vote)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Decoder s (Map (Credential 'HotCommitteeRole) Vote)
 -> StateT
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole),
       Interns (Credential 'HotCommitteeRole))
      (Decoder s)
      (Map (Credential 'HotCommitteeRole) Vote))
-> Decoder s (Map (Credential 'HotCommitteeRole) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (Credential 'HotCommitteeRole) Vote)
forall a b. (a -> b) -> a -> b
$ Share (Map (Credential 'HotCommitteeRole) Vote)
-> Decoder s (Map (Credential 'HotCommitteeRole) Vote)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (Map (Credential 'HotCommitteeRole) Vote)
-> Decoder s (Map (Credential 'HotCommitteeRole) Vote)
decShareCBOR (Interns (Credential 'HotCommitteeRole)
ch, Interns Vote
forall a. Monoid a => a
mempty)
      Map (Credential 'DRepRole) Vote
gasDRepVotes <- Decoder s (Map (Credential 'DRepRole) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (Credential 'DRepRole) Vote)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Decoder s (Map (Credential 'DRepRole) Vote)
 -> StateT
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole),
       Interns (Credential 'HotCommitteeRole))
      (Decoder s)
      (Map (Credential 'DRepRole) Vote))
-> Decoder s (Map (Credential 'DRepRole) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (Credential 'DRepRole) Vote)
forall a b. (a -> b) -> a -> b
$ Share (Map (Credential 'DRepRole) Vote)
-> Decoder s (Map (Credential 'DRepRole) Vote)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (Map (Credential 'DRepRole) Vote)
-> Decoder s (Map (Credential 'DRepRole) Vote)
decShareCBOR (Interns (Credential 'DRepRole)
cd, Interns Vote
forall a. Monoid a => a
mempty)
      Map (KeyHash 'StakePool) Vote
gasStakePoolVotes <- Decoder s (Map (KeyHash 'StakePool) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (KeyHash 'StakePool) Vote)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Decoder s (Map (KeyHash 'StakePool) Vote)
 -> StateT
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
       Interns (Credential 'DRepRole),
       Interns (Credential 'HotCommitteeRole))
      (Decoder s)
      (Map (KeyHash 'StakePool) Vote))
-> Decoder s (Map (KeyHash 'StakePool) Vote)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (Map (KeyHash 'StakePool) Vote)
forall a b. (a -> b) -> a -> b
$ Share (Map (KeyHash 'StakePool) Vote)
-> Decoder s (Map (KeyHash 'StakePool) Vote)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (Map (KeyHash 'StakePool) Vote)
-> Decoder s (Map (KeyHash 'StakePool) Vote)
decShareCBOR (Interns (KeyHash 'StakePool)
ks, Interns Vote
forall a. Monoid a => a
mempty)

      -- DRep votes do not contain any new credentials, thus only additon of interns for SPOs and CCs
      (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
 Interns (Credential 'DRepRole),
 Interns (Credential 'HotCommitteeRole))
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Interns (Credential 'Staking)
cs, Interns (KeyHash 'StakePool)
ks Interns (KeyHash 'StakePool)
-> Interns (KeyHash 'StakePool) -> Interns (KeyHash 'StakePool)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) Vote -> Interns (KeyHash 'StakePool)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (KeyHash 'StakePool) Vote
gasStakePoolVotes, Interns (Credential 'DRepRole)
cd, Interns (Credential 'HotCommitteeRole)
ch Interns (Credential 'HotCommitteeRole)
-> Interns (Credential 'HotCommitteeRole)
-> Interns (Credential 'HotCommitteeRole)
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'HotCommitteeRole) Vote
-> Interns (Credential 'HotCommitteeRole)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes)

      ProposalProcedure era
gasProposalProcedure <- Decoder s (ProposalProcedure era)
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (ProposalProcedure era)
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s (ProposalProcedure era)
forall s. Decoder s (ProposalProcedure era)
forall a s. DecCBOR a => Decoder s a
decCBOR
      EpochNo
gasProposedIn <- Decoder s EpochNo
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     EpochNo
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s EpochNo
forall s. Decoder s EpochNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      EpochNo
gasExpiresAfter <- Decoder s EpochNo
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     EpochNo
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Decoder s EpochNo
forall s. Decoder s EpochNo
forall a s. DecCBOR a => Decoder s a
decCBOR
      GovActionState era
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     (GovActionState era)
forall a.
a
-> StateT
     (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
      Interns (Credential 'DRepRole),
      Interns (Credential 'HotCommitteeRole))
     (Decoder s)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionState {Map (KeyHash 'StakePool) Vote
Map (Credential 'DRepRole) Vote
Map (Credential 'HotCommitteeRole) Vote
EpochNo
ProposalProcedure era
GovActionId
gasId :: GovActionId
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: ProposalProcedure era
gasProposedIn :: EpochNo
gasExpiresAfter :: EpochNo
gasId :: GovActionId
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: ProposalProcedure era
gasProposedIn :: EpochNo
gasExpiresAfter :: EpochNo
..}

instance EraPParams era => DecCBOR (GovActionState era) where
  decCBOR :: forall s. Decoder s (GovActionState era)
decCBOR = Decoder s (GovActionState era)
forall a s. DecShareCBOR a => Decoder s a
decNoShareCBOR

instance EraPParams era => EncCBOR (GovActionState era) where
  encCBOR :: GovActionState era -> Encoding
encCBOR GovActionState {Map (KeyHash 'StakePool) Vote
Map (Credential 'DRepRole) Vote
Map (Credential 'HotCommitteeRole) Vote
EpochNo
ProposalProcedure era
GovActionId
gasId :: forall era. GovActionState era -> GovActionId
gasCommitteeVotes :: forall era.
GovActionState era -> Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: forall era. GovActionState era -> Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: forall era. GovActionState era -> Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposedIn :: forall era. GovActionState era -> EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasId :: GovActionId
gasCommitteeVotes :: Map (Credential 'HotCommitteeRole) Vote
gasDRepVotes :: Map (Credential 'DRepRole) Vote
gasStakePoolVotes :: Map (KeyHash 'StakePool) Vote
gasProposalProcedure :: ProposalProcedure era
gasProposedIn :: EpochNo
gasExpiresAfter :: EpochNo
..} =
    Encode ('Closed 'Dense) (GovActionState era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (GovActionState era) -> Encoding)
-> Encode ('Closed 'Dense) (GovActionState era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (GovActionId
 -> Map (Credential 'HotCommitteeRole) Vote
 -> Map (Credential 'DRepRole) Vote
 -> Map (KeyHash 'StakePool) Vote
 -> ProposalProcedure era
 -> EpochNo
 -> EpochNo
 -> GovActionState era)
-> Encode
     ('Closed 'Dense)
     (GovActionId
      -> Map (Credential 'HotCommitteeRole) Vote
      -> Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall t. t -> Encode ('Closed 'Dense) t
Rec GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
forall era.
GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
GovActionState
        Encode
  ('Closed 'Dense)
  (GovActionId
   -> Map (Credential 'HotCommitteeRole) Vote
   -> Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Encode ('Closed 'Dense) GovActionId
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'HotCommitteeRole) Vote
      -> Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> GovActionId -> Encode ('Closed 'Dense) GovActionId
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovActionId
gasId
        Encode
  ('Closed 'Dense)
  (Map (Credential 'HotCommitteeRole) Vote
   -> Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Encode
     ('Closed 'Dense) (Map (Credential 'HotCommitteeRole) Vote)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'HotCommitteeRole) Vote
-> Encode
     ('Closed 'Dense) (Map (Credential 'HotCommitteeRole) Vote)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'HotCommitteeRole) Vote
gasCommitteeVotes
        Encode
  ('Closed 'Dense)
  (Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) Vote)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'DRepRole) Vote
-> Encode ('Closed 'Dense) (Map (Credential 'DRepRole) Vote)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'DRepRole) Vote
gasDRepVotes
        Encode
  ('Closed 'Dense)
  (Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) Vote)
-> Encode
     ('Closed 'Dense)
     (ProposalProcedure era -> EpochNo -> EpochNo -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'StakePool) Vote
-> Encode ('Closed 'Dense) (Map (KeyHash 'StakePool) Vote)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'StakePool) Vote
gasStakePoolVotes
        Encode
  ('Closed 'Dense)
  (ProposalProcedure era -> EpochNo -> EpochNo -> GovActionState era)
-> Encode ('Closed 'Dense) (ProposalProcedure era)
-> Encode
     ('Closed 'Dense) (EpochNo -> EpochNo -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ProposalProcedure era
-> Encode ('Closed 'Dense) (ProposalProcedure era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProposalProcedure era
gasProposalProcedure
        Encode ('Closed 'Dense) (EpochNo -> EpochNo -> GovActionState era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode ('Closed 'Dense) (EpochNo -> GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
gasProposedIn
        Encode ('Closed 'Dense) (EpochNo -> GovActionState era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode ('Closed 'Dense) (GovActionState era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
gasExpiresAfter

instance OMap.HasOKey GovActionId (GovActionState era) where
  okeyL :: Lens' (GovActionState era) GovActionId
okeyL = (GovActionState era -> GovActionId)
-> (GovActionState era -> GovActionId -> GovActionState era)
-> Lens' (GovActionState era) GovActionId
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId ((GovActionState era -> GovActionId -> GovActionState era)
 -> Lens' (GovActionState era) GovActionId)
-> (GovActionState era -> GovActionId -> GovActionState era)
-> Lens' (GovActionState era) GovActionId
forall a b. (a -> b) -> a -> b
$ \GovActionState era
gas GovActionId
gi -> GovActionState era
gas {gasId = gi}

data Voter
  = CommitteeVoter !(Credential 'HotCommitteeRole)
  | DRepVoter !(Credential 'DRepRole)
  | StakePoolVoter !(KeyHash 'StakePool)
  deriving ((forall x. Voter -> Rep Voter x)
-> (forall x. Rep Voter x -> Voter) -> Generic Voter
forall x. Rep Voter x -> Voter
forall x. Voter -> Rep Voter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Voter -> Rep Voter x
from :: forall x. Voter -> Rep Voter x
$cto :: forall x. Rep Voter x -> Voter
to :: forall x. Rep Voter x -> Voter
Generic, Voter -> Voter -> Bool
(Voter -> Voter -> Bool) -> (Voter -> Voter -> Bool) -> Eq Voter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Voter -> Voter -> Bool
== :: Voter -> Voter -> Bool
$c/= :: Voter -> Voter -> Bool
/= :: Voter -> Voter -> Bool
Eq, Eq Voter
Eq Voter =>
(Voter -> Voter -> Ordering)
-> (Voter -> Voter -> Bool)
-> (Voter -> Voter -> Bool)
-> (Voter -> Voter -> Bool)
-> (Voter -> Voter -> Bool)
-> (Voter -> Voter -> Voter)
-> (Voter -> Voter -> Voter)
-> Ord Voter
Voter -> Voter -> Bool
Voter -> Voter -> Ordering
Voter -> Voter -> Voter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Voter -> Voter -> Ordering
compare :: Voter -> Voter -> Ordering
$c< :: Voter -> Voter -> Bool
< :: Voter -> Voter -> Bool
$c<= :: Voter -> Voter -> Bool
<= :: Voter -> Voter -> Bool
$c> :: Voter -> Voter -> Bool
> :: Voter -> Voter -> Bool
$c>= :: Voter -> Voter -> Bool
>= :: Voter -> Voter -> Bool
$cmax :: Voter -> Voter -> Voter
max :: Voter -> Voter -> Voter
$cmin :: Voter -> Voter -> Voter
min :: Voter -> Voter -> Voter
Ord, Int -> Voter -> ShowS
[Voter] -> ShowS
Voter -> String
(Int -> Voter -> ShowS)
-> (Voter -> String) -> ([Voter] -> ShowS) -> Show Voter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Voter -> ShowS
showsPrec :: Int -> Voter -> ShowS
$cshow :: Voter -> String
show :: Voter -> String
$cshowList :: [Voter] -> ShowS
showList :: [Voter] -> ShowS
Show)

instance ToJSON Voter

instance ToJSONKey Voter where
  toJSONKey :: ToJSONKeyFunction Voter
toJSONKey = (Voter -> Text) -> ToJSONKeyFunction Voter
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((Voter -> Text) -> ToJSONKeyFunction Voter)
-> (Voter -> Text) -> ToJSONKeyFunction Voter
forall a b. (a -> b) -> a -> b
$ \case
    CommitteeVoter Credential 'HotCommitteeRole
cred ->
      Text
"committee-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credential 'HotCommitteeRole -> Text
forall (kr :: KeyRole). Credential kr -> Text
credToText Credential 'HotCommitteeRole
cred
    DRepVoter Credential 'DRepRole
cred ->
      Text
"drep-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> Text
forall (kr :: KeyRole). Credential kr -> Text
credToText Credential 'DRepRole
cred
    StakePoolVoter KeyHash 'StakePool
kh ->
      Text
"stakepool-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Credential 'StakePool -> Text
forall (kr :: KeyRole). Credential kr -> Text
credToText (KeyHash 'StakePool -> Credential 'StakePool
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'StakePool
kh)

instance DecCBOR Voter where
  decCBOR :: forall s. Decoder s Voter
decCBOR = Text -> (Word -> Decoder s (Int, Voter)) -> Decoder s Voter
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"Voter" ((Word -> Decoder s (Int, Voter)) -> Decoder s Voter)
-> (Word -> Decoder s (Int, Voter)) -> Decoder s Voter
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (Int
2,) (Voter -> (Int, Voter))
-> (KeyHash 'HotCommitteeRole -> Voter)
-> KeyHash 'HotCommitteeRole
-> (Int, Voter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'HotCommitteeRole -> Voter
CommitteeVoter (Credential 'HotCommitteeRole -> Voter)
-> (KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole)
-> KeyHash 'HotCommitteeRole
-> Voter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'HotCommitteeRole -> Credential 'HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'HotCommitteeRole -> (Int, Voter))
-> Decoder s (KeyHash 'HotCommitteeRole) -> Decoder s (Int, Voter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'HotCommitteeRole)
forall s. Decoder s (KeyHash 'HotCommitteeRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word
1 -> (Int
2,) (Voter -> (Int, Voter))
-> (ScriptHash -> Voter) -> ScriptHash -> (Int, Voter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'HotCommitteeRole -> Voter
CommitteeVoter (Credential 'HotCommitteeRole -> Voter)
-> (ScriptHash -> Credential 'HotCommitteeRole)
-> ScriptHash
-> Voter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential 'HotCommitteeRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> (Int, Voter))
-> Decoder s ScriptHash -> Decoder s (Int, Voter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word
2 -> (Int
2,) (Voter -> (Int, Voter))
-> (KeyHash 'DRepRole -> Voter)
-> KeyHash 'DRepRole
-> (Int, Voter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'DRepRole -> Voter
DRepVoter (Credential 'DRepRole -> Voter)
-> (KeyHash 'DRepRole -> Credential 'DRepRole)
-> KeyHash 'DRepRole
-> Voter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> (Int, Voter))
-> Decoder s (KeyHash 'DRepRole) -> Decoder s (Int, Voter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'DRepRole)
forall s. Decoder s (KeyHash 'DRepRole)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word
3 -> (Int
2,) (Voter -> (Int, Voter))
-> (ScriptHash -> Voter) -> ScriptHash -> (Int, Voter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'DRepRole -> Voter
DRepVoter (Credential 'DRepRole -> Voter)
-> (ScriptHash -> Credential 'DRepRole) -> ScriptHash -> Voter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential 'DRepRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> (Int, Voter))
-> Decoder s ScriptHash -> Decoder s (Int, Voter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word
4 -> (Int
2,) (Voter -> (Int, Voter))
-> (KeyHash 'StakePool -> Voter)
-> KeyHash 'StakePool
-> (Int, Voter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'StakePool -> Voter
StakePoolVoter (KeyHash 'StakePool -> (Int, Voter))
-> Decoder s (KeyHash 'StakePool) -> Decoder s (Int, Voter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Word
5 -> String -> Decoder s (Int, Voter)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Script objects are not allowed for StakePool votes"
    Word
t -> Word -> Decoder s (Int, Voter)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
t

instance EncCBOR Voter where
  encCBOR :: Voter -> Encoding
encCBOR = \case
    CommitteeVoter (KeyHashObj KeyHash 'HotCommitteeRole
keyHash) ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'HotCommitteeRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'HotCommitteeRole
keyHash
    CommitteeVoter (ScriptHashObj ScriptHash
scriptHash) ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ScriptHash
scriptHash
    DRepVoter (KeyHashObj KeyHash 'DRepRole
keyHash) ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'DRepRole -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'DRepRole
keyHash
    DRepVoter (ScriptHashObj ScriptHash
scriptHash) ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ScriptHash
scriptHash
    StakePoolVoter KeyHash 'StakePool
keyHash ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
encodeWord8 Word8
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash 'StakePool
keyHash

instance NoThunks Voter

instance NFData Voter

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

instance ToJSON Vote

instance NoThunks Vote

instance NFData Vote

instance DecCBOR Vote where
  decCBOR :: forall s. Decoder s Vote
decCBOR = Decoder s Vote
forall a s. (Enum a, Bounded a, Typeable a) => Decoder s a
decodeEnumBounded

instance EncCBOR Vote where
  encCBOR :: Vote -> Encoding
encCBOR = Vote -> Encoding
forall a. Enum a => a -> Encoding
encodeEnum

newtype VotingProcedures era = VotingProcedures
  { forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures :: Map Voter (Map GovActionId (VotingProcedure era))
  }
  deriving stock ((forall x. VotingProcedures era -> Rep (VotingProcedures era) x)
-> (forall x. Rep (VotingProcedures era) x -> VotingProcedures era)
-> Generic (VotingProcedures era)
forall x. Rep (VotingProcedures era) x -> VotingProcedures era
forall x. VotingProcedures era -> Rep (VotingProcedures era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (VotingProcedures era) x -> VotingProcedures era
forall era x. VotingProcedures era -> Rep (VotingProcedures era) x
$cfrom :: forall era x. VotingProcedures era -> Rep (VotingProcedures era) x
from :: forall x. VotingProcedures era -> Rep (VotingProcedures era) x
$cto :: forall era x. Rep (VotingProcedures era) x -> VotingProcedures era
to :: forall x. Rep (VotingProcedures era) x -> VotingProcedures era
Generic, VotingProcedures era -> VotingProcedures era -> Bool
(VotingProcedures era -> VotingProcedures era -> Bool)
-> (VotingProcedures era -> VotingProcedures era -> Bool)
-> Eq (VotingProcedures era)
forall era. VotingProcedures era -> VotingProcedures era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. VotingProcedures era -> VotingProcedures era -> Bool
== :: VotingProcedures era -> VotingProcedures era -> Bool
$c/= :: forall era. VotingProcedures era -> VotingProcedures era -> Bool
/= :: VotingProcedures era -> VotingProcedures era -> Bool
Eq, Int -> VotingProcedures era -> ShowS
[VotingProcedures era] -> ShowS
VotingProcedures era -> String
(Int -> VotingProcedures era -> ShowS)
-> (VotingProcedures era -> String)
-> ([VotingProcedures era] -> ShowS)
-> Show (VotingProcedures era)
forall era. Int -> VotingProcedures era -> ShowS
forall era. [VotingProcedures era] -> ShowS
forall era. VotingProcedures era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> VotingProcedures era -> ShowS
showsPrec :: Int -> VotingProcedures era -> ShowS
$cshow :: forall era. VotingProcedures era -> String
show :: VotingProcedures era -> String
$cshowList :: forall era. [VotingProcedures era] -> ShowS
showList :: [VotingProcedures era] -> ShowS
Show)
  deriving newtype (Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
Proxy (VotingProcedures era) -> String
(Context -> VotingProcedures era -> IO (Maybe ThunkInfo))
-> (Context -> VotingProcedures era -> IO (Maybe ThunkInfo))
-> (Proxy (VotingProcedures era) -> String)
-> NoThunks (VotingProcedures era)
forall era. Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
forall era. Proxy (VotingProcedures era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall era. Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
noThunks :: Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VotingProcedures era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (VotingProcedures era) -> String
showTypeOf :: Proxy (VotingProcedures era) -> String
NoThunks, Typeable (VotingProcedures era)
Typeable (VotingProcedures era) =>
(VotingProcedures era -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (VotingProcedures era) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [VotingProcedures era] -> Size)
-> EncCBOR (VotingProcedures era)
VotingProcedures era -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VotingProcedures era] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VotingProcedures era) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall era. Era era => Typeable (VotingProcedures era)
forall era. Era era => VotingProcedures era -> Encoding
forall era.
Era era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VotingProcedures era] -> Size
forall era.
Era era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VotingProcedures era) -> Size
$cencCBOR :: forall era. Era era => VotingProcedures era -> Encoding
encCBOR :: VotingProcedures era -> Encoding
$cencodedSizeExpr :: forall era.
Era era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VotingProcedures era) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VotingProcedures era) -> Size
$cencodedListSizeExpr :: forall era.
Era era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VotingProcedures era] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VotingProcedures era] -> Size
EncCBOR, [VotingProcedures era] -> Value
[VotingProcedures era] -> Encoding
VotingProcedures era -> Bool
VotingProcedures era -> Value
VotingProcedures era -> Encoding
(VotingProcedures era -> Value)
-> (VotingProcedures era -> Encoding)
-> ([VotingProcedures era] -> Value)
-> ([VotingProcedures era] -> Encoding)
-> (VotingProcedures era -> Bool)
-> ToJSON (VotingProcedures era)
forall era. EraPParams era => [VotingProcedures era] -> Value
forall era. EraPParams era => [VotingProcedures era] -> Encoding
forall era. EraPParams era => VotingProcedures era -> Bool
forall era. EraPParams era => VotingProcedures era -> Value
forall era. EraPParams era => VotingProcedures era -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall era. EraPParams era => VotingProcedures era -> Value
toJSON :: VotingProcedures era -> Value
$ctoEncoding :: forall era. EraPParams era => VotingProcedures era -> Encoding
toEncoding :: VotingProcedures era -> Encoding
$ctoJSONList :: forall era. EraPParams era => [VotingProcedures era] -> Value
toJSONList :: [VotingProcedures era] -> Value
$ctoEncodingList :: forall era. EraPParams era => [VotingProcedures era] -> Encoding
toEncodingList :: [VotingProcedures era] -> Encoding
$comitField :: forall era. EraPParams era => VotingProcedures era -> Bool
omitField :: VotingProcedures era -> Bool
ToJSON)

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

instance Era era => DecCBOR (VotingProcedures era) where
  decCBOR :: forall s. Decoder s (VotingProcedures era)
decCBOR =
    (Map Voter (Map GovActionId (VotingProcedure era))
 -> VotingProcedures era)
-> Decoder s (Map Voter (Map GovActionId (VotingProcedure era)))
-> Decoder s (VotingProcedures era)
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures (Decoder s (Map Voter (Map GovActionId (VotingProcedure era)))
 -> Decoder s (VotingProcedures era))
-> Decoder s (Map Voter (Map GovActionId (VotingProcedure era)))
-> Decoder s (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$ Decoder s Voter
-> (Voter -> Decoder s (Map GovActionId (VotingProcedure era)))
-> Decoder s (Map Voter (Map GovActionId (VotingProcedure era)))
forall k s v.
Ord k =>
Decoder s k -> (k -> Decoder s v) -> Decoder s (Map k v)
decodeMapByKey Decoder s Voter
forall s. Decoder s Voter
forall a s. DecCBOR a => Decoder s a
decCBOR ((Voter -> Decoder s (Map GovActionId (VotingProcedure era)))
 -> Decoder s (Map Voter (Map GovActionId (VotingProcedure era))))
-> (Voter -> Decoder s (Map GovActionId (VotingProcedure era)))
-> Decoder s (Map Voter (Map GovActionId (VotingProcedure era)))
forall a b. (a -> b) -> a -> b
$ \Voter
voter -> do
      Map GovActionId (VotingProcedure era)
subMap <- Decoder s (Map GovActionId (VotingProcedure era))
forall s. Decoder s (Map GovActionId (VotingProcedure era))
forall a s. DecCBOR a => Decoder s a
decCBOR
      Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map GovActionId (VotingProcedure era) -> Bool
forall a. Map GovActionId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map GovActionId (VotingProcedure era)
subMap) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
          String
"VotingProcedures require votes, but Voter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Voter -> String
forall a. Show a => a -> String
show Voter
voter String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" didn't have any"
      Map GovActionId (VotingProcedure era)
-> Decoder s (Map GovActionId (VotingProcedure era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map GovActionId (VotingProcedure era)
subMap
  {-# INLINE decCBOR #-}

foldlVotingProcedures ::
  -- | Accumulating function
  (c -> Voter -> GovActionId -> VotingProcedure era -> c) ->
  -- | Initial accumulator
  c ->
  -- | Procedures to fold over
  VotingProcedures era ->
  c
foldlVotingProcedures :: forall c era.
(c -> Voter -> GovActionId -> VotingProcedure era -> c)
-> c -> VotingProcedures era -> c
foldlVotingProcedures c -> Voter -> GovActionId -> VotingProcedure era -> c
f c
initAcc =
  let fVotes :: c -> Voter -> Map GovActionId (VotingProcedure era) -> c
fVotes c
initVotesAcc Voter
voter =
        (c -> GovActionId -> VotingProcedure era -> c)
-> c -> Map GovActionId (VotingProcedure era) -> c
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\c
acc -> c -> Voter -> GovActionId -> VotingProcedure era -> c
f c
acc Voter
voter) c
initVotesAcc
   in (c -> Voter -> Map GovActionId (VotingProcedure era) -> c)
-> c -> Map Voter (Map GovActionId (VotingProcedure era)) -> c
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' c -> Voter -> Map GovActionId (VotingProcedure era) -> c
fVotes c
initAcc (Map Voter (Map GovActionId (VotingProcedure era)) -> c)
-> (VotingProcedures era
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> VotingProcedures era
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures

foldrVotingProcedures ::
  -- | Accumulating function
  (Voter -> GovActionId -> VotingProcedure era -> c -> c) ->
  -- | Initial accumulator
  c ->
  -- | Procedures to fold over
  VotingProcedures era ->
  c
foldrVotingProcedures :: forall era c.
(Voter -> GovActionId -> VotingProcedure era -> c -> c)
-> c -> VotingProcedures era -> c
foldrVotingProcedures Voter -> GovActionId -> VotingProcedure era -> c -> c
f c
initAcc =
  let fVotes :: Voter -> Map GovActionId (VotingProcedure era) -> c -> c
fVotes Voter
voter Map GovActionId (VotingProcedure era)
votes c
acc =
        (GovActionId -> VotingProcedure era -> c -> c)
-> c -> Map GovActionId (VotingProcedure era) -> c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' (Voter -> GovActionId -> VotingProcedure era -> c -> c
f Voter
voter) c
acc Map GovActionId (VotingProcedure era)
votes
   in (Voter -> Map GovActionId (VotingProcedure era) -> c -> c)
-> c -> Map Voter (Map GovActionId (VotingProcedure era)) -> c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' Voter -> Map GovActionId (VotingProcedure era) -> c -> c
fVotes c
initAcc (Map Voter (Map GovActionId (VotingProcedure era)) -> c)
-> (VotingProcedures era
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> VotingProcedures era
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures

deriving instance Indexable Voter (VotingProcedures era)

data VotingProcedure era = VotingProcedure
  { forall era. VotingProcedure era -> Vote
vProcVote :: !Vote
  , forall era. VotingProcedure era -> StrictMaybe Anchor
vProcAnchor :: !(StrictMaybe Anchor)
  }
  deriving ((forall x. VotingProcedure era -> Rep (VotingProcedure era) x)
-> (forall x. Rep (VotingProcedure era) x -> VotingProcedure era)
-> Generic (VotingProcedure era)
forall x. Rep (VotingProcedure era) x -> VotingProcedure era
forall x. VotingProcedure era -> Rep (VotingProcedure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (VotingProcedure era) x -> VotingProcedure era
forall era x. VotingProcedure era -> Rep (VotingProcedure era) x
$cfrom :: forall era x. VotingProcedure era -> Rep (VotingProcedure era) x
from :: forall x. VotingProcedure era -> Rep (VotingProcedure era) x
$cto :: forall era x. Rep (VotingProcedure era) x -> VotingProcedure era
to :: forall x. Rep (VotingProcedure era) x -> VotingProcedure era
Generic, VotingProcedure era -> VotingProcedure era -> Bool
(VotingProcedure era -> VotingProcedure era -> Bool)
-> (VotingProcedure era -> VotingProcedure era -> Bool)
-> Eq (VotingProcedure era)
forall era. VotingProcedure era -> VotingProcedure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. VotingProcedure era -> VotingProcedure era -> Bool
== :: VotingProcedure era -> VotingProcedure era -> Bool
$c/= :: forall era. VotingProcedure era -> VotingProcedure era -> Bool
/= :: VotingProcedure era -> VotingProcedure era -> Bool
Eq, Int -> VotingProcedure era -> ShowS
[VotingProcedure era] -> ShowS
VotingProcedure era -> String
(Int -> VotingProcedure era -> ShowS)
-> (VotingProcedure era -> String)
-> ([VotingProcedure era] -> ShowS)
-> Show (VotingProcedure era)
forall era. Int -> VotingProcedure era -> ShowS
forall era. [VotingProcedure era] -> ShowS
forall era. VotingProcedure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> VotingProcedure era -> ShowS
showsPrec :: Int -> VotingProcedure era -> ShowS
$cshow :: forall era. VotingProcedure era -> String
show :: VotingProcedure era -> String
$cshowList :: forall era. [VotingProcedure era] -> ShowS
showList :: [VotingProcedure era] -> ShowS
Show)

instance NoThunks (VotingProcedure era)

instance NFData (VotingProcedure era)

instance Era era => DecCBOR (VotingProcedure era) where
  decCBOR :: forall s. Decoder s (VotingProcedure era)
decCBOR =
    Decode ('Closed 'Dense) (VotingProcedure era)
-> Decoder s (VotingProcedure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (VotingProcedure era)
 -> Decoder s (VotingProcedure era))
-> Decode ('Closed 'Dense) (VotingProcedure era)
-> Decoder s (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$
      (Vote -> StrictMaybe Anchor -> VotingProcedure era)
-> Decode
     ('Closed 'Dense)
     (Vote -> StrictMaybe Anchor -> VotingProcedure era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure
        Decode
  ('Closed 'Dense)
  (Vote -> StrictMaybe Anchor -> VotingProcedure era)
-> Decode ('Closed Any) Vote
-> Decode
     ('Closed 'Dense) (StrictMaybe Anchor -> VotingProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Vote
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (StrictMaybe Anchor -> VotingProcedure era)
-> Decode ('Closed 'Dense) (StrictMaybe Anchor)
-> Decode ('Closed 'Dense) (VotingProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe Anchor))
-> Decode ('Closed 'Dense) (StrictMaybe Anchor)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s Anchor -> Decoder s (StrictMaybe Anchor)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s Anchor
forall s. Decoder s Anchor
forall a s. DecCBOR a => Decoder s a
decCBOR)
  {-# INLINE decCBOR #-}

instance Era era => EncCBOR (VotingProcedure era) where
  encCBOR :: VotingProcedure era -> Encoding
encCBOR VotingProcedure {StrictMaybe Anchor
Vote
vProcVote :: forall era. VotingProcedure era -> Vote
vProcAnchor :: forall era. VotingProcedure era -> StrictMaybe Anchor
vProcVote :: Vote
vProcAnchor :: StrictMaybe Anchor
..} =
    Encode ('Closed 'Dense) (VotingProcedure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (VotingProcedure era) -> Encoding)
-> Encode ('Closed 'Dense) (VotingProcedure era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Vote -> StrictMaybe Anchor -> VotingProcedure era)
-> Encode
     ('Closed 'Dense)
     (Vote -> StrictMaybe Anchor -> VotingProcedure era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure @era)
        Encode
  ('Closed 'Dense)
  (Vote -> StrictMaybe Anchor -> VotingProcedure era)
-> Encode ('Closed 'Dense) Vote
-> Encode
     ('Closed 'Dense) (StrictMaybe Anchor -> VotingProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Vote -> Encode ('Closed 'Dense) Vote
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Vote
vProcVote
        Encode ('Closed 'Dense) (StrictMaybe Anchor -> VotingProcedure era)
-> Encode ('Closed 'Dense) (StrictMaybe Anchor)
-> Encode ('Closed 'Dense) (VotingProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe Anchor -> Encoding)
-> StrictMaybe Anchor
-> Encode ('Closed 'Dense) (StrictMaybe Anchor)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((Anchor -> Encoding) -> StrictMaybe Anchor -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe Anchor -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe Anchor
vProcAnchor

instance EraPParams era => ToJSON (VotingProcedure era) where
  toJSON :: VotingProcedure era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (VotingProcedure era -> [Pair]) -> VotingProcedure era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedure era -> [Pair]
forall e a era. KeyValue e a => VotingProcedure era -> [a]
toVotingProcedurePairs
  toEncoding :: VotingProcedure era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (VotingProcedure era -> Series)
-> VotingProcedure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (VotingProcedure era -> [Series])
-> VotingProcedure era
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedure era -> [Series]
forall e a era. KeyValue e a => VotingProcedure era -> [a]
toVotingProcedurePairs

toVotingProcedurePairs :: KeyValue e a => VotingProcedure era -> [a]
toVotingProcedurePairs :: forall e a era. KeyValue e a => VotingProcedure era -> [a]
toVotingProcedurePairs vProc :: VotingProcedure era
vProc@(VotingProcedure Vote
_ StrictMaybe Anchor
_) =
  let VotingProcedure {StrictMaybe Anchor
Vote
vProcVote :: forall era. VotingProcedure era -> Vote
vProcAnchor :: forall era. VotingProcedure era -> StrictMaybe Anchor
vProcVote :: Vote
vProcAnchor :: StrictMaybe Anchor
..} = VotingProcedure era
vProc
   in [ Key
"anchor" Key -> StrictMaybe Anchor -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe Anchor
vProcAnchor
      , Key
"decision" Key -> Vote -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Vote
vProcVote
      ]

-- | Attaches indices to a sequence of proposal procedures. The indices grow
-- from left to right.
indexedGovProps ::
  Seq.Seq (ProposalProcedure era) ->
  Seq.Seq (GovActionIx, ProposalProcedure era)
indexedGovProps :: forall era.
Seq (ProposalProcedure era)
-> Seq (GovActionIx, ProposalProcedure era)
indexedGovProps = Word16
-> Seq (ProposalProcedure era)
-> Seq (GovActionIx, ProposalProcedure era)
forall {b}. Word16 -> Seq b -> Seq (GovActionIx, b)
enumerateProps Word16
0
  where
    enumerateProps :: Word16 -> Seq b -> Seq (GovActionIx, b)
enumerateProps Word16
_ Seq b
Seq.Empty = Seq (GovActionIx, b)
forall a. Seq a
Seq.Empty
    enumerateProps !Word16
n (b
x Seq.:<| Seq b
xs) = (Word16 -> GovActionIx
GovActionIx Word16
n, b
x) (GovActionIx, b) -> Seq (GovActionIx, b) -> Seq (GovActionIx, b)
forall a. a -> Seq a -> Seq a
Seq.:<| Word16 -> Seq b -> Seq (GovActionIx, b)
enumerateProps (Word16 -> Word16
forall a. Enum a => a -> a
succ Word16
n) Seq b
xs

data ProposalProcedure era = ProposalProcedure
  { forall era. ProposalProcedure era -> Coin
pProcDeposit :: !Coin
  , forall era. ProposalProcedure era -> RewardAccount
pProcReturnAddr :: !RewardAccount
  , forall era. ProposalProcedure era -> GovAction era
pProcGovAction :: !(GovAction era)
  , forall era. ProposalProcedure era -> Anchor
pProcAnchor :: !Anchor
  }
  deriving ((forall x. ProposalProcedure era -> Rep (ProposalProcedure era) x)
-> (forall x.
    Rep (ProposalProcedure era) x -> ProposalProcedure era)
-> Generic (ProposalProcedure era)
forall x. Rep (ProposalProcedure era) x -> ProposalProcedure era
forall x. ProposalProcedure era -> Rep (ProposalProcedure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ProposalProcedure era) x -> ProposalProcedure era
forall era x.
ProposalProcedure era -> Rep (ProposalProcedure era) x
$cfrom :: forall era x.
ProposalProcedure era -> Rep (ProposalProcedure era) x
from :: forall x. ProposalProcedure era -> Rep (ProposalProcedure era) x
$cto :: forall era x.
Rep (ProposalProcedure era) x -> ProposalProcedure era
to :: forall x. Rep (ProposalProcedure era) x -> ProposalProcedure era
Generic, ProposalProcedure era -> ProposalProcedure era -> Bool
(ProposalProcedure era -> ProposalProcedure era -> Bool)
-> (ProposalProcedure era -> ProposalProcedure era -> Bool)
-> Eq (ProposalProcedure era)
forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
== :: ProposalProcedure era -> ProposalProcedure era -> Bool
$c/= :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
/= :: ProposalProcedure era -> ProposalProcedure era -> Bool
Eq, Int -> ProposalProcedure era -> ShowS
[ProposalProcedure era] -> ShowS
ProposalProcedure era -> String
(Int -> ProposalProcedure era -> ShowS)
-> (ProposalProcedure era -> String)
-> ([ProposalProcedure era] -> ShowS)
-> Show (ProposalProcedure era)
forall era. EraPParams era => Int -> ProposalProcedure era -> ShowS
forall era. EraPParams era => [ProposalProcedure era] -> ShowS
forall era. EraPParams era => ProposalProcedure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. EraPParams era => Int -> ProposalProcedure era -> ShowS
showsPrec :: Int -> ProposalProcedure era -> ShowS
$cshow :: forall era. EraPParams era => ProposalProcedure era -> String
show :: ProposalProcedure era -> String
$cshowList :: forall era. EraPParams era => [ProposalProcedure era] -> ShowS
showList :: [ProposalProcedure era] -> ShowS
Show, Eq (ProposalProcedure era)
Eq (ProposalProcedure era) =>
(ProposalProcedure era -> ProposalProcedure era -> Ordering)
-> (ProposalProcedure era -> ProposalProcedure era -> Bool)
-> (ProposalProcedure era -> ProposalProcedure era -> Bool)
-> (ProposalProcedure era -> ProposalProcedure era -> Bool)
-> (ProposalProcedure era -> ProposalProcedure era -> Bool)
-> (ProposalProcedure era
    -> ProposalProcedure era -> ProposalProcedure era)
-> (ProposalProcedure era
    -> ProposalProcedure era -> ProposalProcedure era)
-> Ord (ProposalProcedure era)
ProposalProcedure era -> ProposalProcedure era -> Bool
ProposalProcedure era -> ProposalProcedure era -> Ordering
ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure 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. EraPParams era => Eq (ProposalProcedure era)
forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Ordering
forall era.
EraPParams era =>
ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure era
$ccompare :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Ordering
compare :: ProposalProcedure era -> ProposalProcedure era -> Ordering
$c< :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
< :: ProposalProcedure era -> ProposalProcedure era -> Bool
$c<= :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
<= :: ProposalProcedure era -> ProposalProcedure era -> Bool
$c> :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
> :: ProposalProcedure era -> ProposalProcedure era -> Bool
$c>= :: forall era.
EraPParams era =>
ProposalProcedure era -> ProposalProcedure era -> Bool
>= :: ProposalProcedure era -> ProposalProcedure era -> Bool
$cmax :: forall era.
EraPParams era =>
ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure era
max :: ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure era
$cmin :: forall era.
EraPParams era =>
ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure era
min :: ProposalProcedure era
-> ProposalProcedure era -> ProposalProcedure era
Ord)

pProcDepositL :: Lens' (ProposalProcedure era) Coin
pProcDepositL :: forall era (f :: * -> *).
Functor f =>
(Coin -> f Coin)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcDepositL = (ProposalProcedure era -> Coin)
-> (ProposalProcedure era -> Coin -> ProposalProcedure era)
-> Lens (ProposalProcedure era) (ProposalProcedure era) Coin Coin
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProposalProcedure era -> Coin
forall era. ProposalProcedure era -> Coin
pProcDeposit (\ProposalProcedure era
p Coin
x -> ProposalProcedure era
p {pProcDeposit = x})

pProcReturnAddrL :: Lens' (ProposalProcedure era) RewardAccount
pProcReturnAddrL :: forall era (f :: * -> *).
Functor f =>
(RewardAccount -> f RewardAccount)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcReturnAddrL = (ProposalProcedure era -> RewardAccount)
-> (ProposalProcedure era
    -> RewardAccount -> ProposalProcedure era)
-> Lens
     (ProposalProcedure era)
     (ProposalProcedure era)
     RewardAccount
     RewardAccount
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProposalProcedure era -> RewardAccount
forall era. ProposalProcedure era -> RewardAccount
pProcReturnAddr (\ProposalProcedure era
p RewardAccount
x -> ProposalProcedure era
p {pProcReturnAddr = x})

pProcGovActionL :: Lens' (ProposalProcedure era) (GovAction era)
pProcGovActionL :: forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcGovActionL = (ProposalProcedure era -> GovAction era)
-> (ProposalProcedure era
    -> GovAction era -> ProposalProcedure era)
-> forall {f :: * -> *}.
   Functor f =>
   (GovAction era -> f (GovAction era))
   -> ProposalProcedure era -> f (ProposalProcedure era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction ((ProposalProcedure era -> GovAction era -> ProposalProcedure era)
 -> forall {f :: * -> *}.
    Functor f =>
    (GovAction era -> f (GovAction era))
    -> ProposalProcedure era -> f (ProposalProcedure era))
-> (ProposalProcedure era
    -> GovAction era -> ProposalProcedure era)
-> forall {f :: * -> *}.
   Functor f =>
   (GovAction era -> f (GovAction era))
   -> ProposalProcedure era -> f (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ \ProposalProcedure era
x GovAction era
y -> ProposalProcedure era
x {pProcGovAction = y}

pProcAnchorL :: Lens' (ProposalProcedure era) Anchor
pProcAnchorL :: forall era (f :: * -> *).
Functor f =>
(Anchor -> f Anchor)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcAnchorL = (ProposalProcedure era -> Anchor)
-> (ProposalProcedure era -> Anchor -> ProposalProcedure era)
-> forall {f :: * -> *}.
   Functor f =>
   (Anchor -> f Anchor)
   -> ProposalProcedure era -> f (ProposalProcedure era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProposalProcedure era -> Anchor
forall era. ProposalProcedure era -> Anchor
pProcAnchor ((ProposalProcedure era -> Anchor -> ProposalProcedure era)
 -> forall {f :: * -> *}.
    Functor f =>
    (Anchor -> f Anchor)
    -> ProposalProcedure era -> f (ProposalProcedure era))
-> (ProposalProcedure era -> Anchor -> ProposalProcedure era)
-> forall {f :: * -> *}.
   Functor f =>
   (Anchor -> f Anchor)
   -> ProposalProcedure era -> f (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$ \ProposalProcedure era
x Anchor
y -> ProposalProcedure era
x {pProcAnchor = y}

instance EraPParams era => NoThunks (ProposalProcedure era)

instance EraPParams era => NFData (ProposalProcedure era)

instance EraPParams era => DecCBOR (ProposalProcedure era) where
  decCBOR :: forall s. Decoder s (ProposalProcedure era)
decCBOR =
    Decode ('Closed 'Dense) (ProposalProcedure era)
-> Decoder s (ProposalProcedure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ProposalProcedure era)
 -> Decoder s (ProposalProcedure era))
-> Decode ('Closed 'Dense) (ProposalProcedure era)
-> Decoder s (ProposalProcedure era)
forall a b. (a -> b) -> a -> b
$
      (Coin
 -> RewardAccount
 -> GovAction era
 -> Anchor
 -> ProposalProcedure era)
-> Decode
     ('Closed 'Dense)
     (Coin
      -> RewardAccount
      -> GovAction era
      -> Anchor
      -> ProposalProcedure era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
ProposalProcedure
        Decode
  ('Closed 'Dense)
  (Coin
   -> RewardAccount
   -> GovAction era
   -> Anchor
   -> ProposalProcedure era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
-> Decode ('Closed Any) RewardAccount
-> Decode
     ('Closed 'Dense) (GovAction era -> Anchor -> ProposalProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) RewardAccount
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (GovAction era -> Anchor -> ProposalProcedure era)
-> Decode ('Closed Any) (GovAction era)
-> Decode ('Closed 'Dense) (Anchor -> ProposalProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (GovAction era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (Anchor -> ProposalProcedure era)
-> Decode ('Closed Any) Anchor
-> Decode ('Closed 'Dense) (ProposalProcedure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Anchor
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
  {-# INLINE decCBOR #-}

instance EraPParams era => EncCBOR (ProposalProcedure era) where
  encCBOR :: ProposalProcedure era -> Encoding
encCBOR ProposalProcedure {Anchor
Coin
RewardAccount
GovAction era
pProcDeposit :: forall era. ProposalProcedure era -> Coin
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcAnchor :: forall era. ProposalProcedure era -> Anchor
pProcDeposit :: Coin
pProcReturnAddr :: RewardAccount
pProcGovAction :: GovAction era
pProcAnchor :: Anchor
..} =
    Encode ('Closed 'Dense) (ProposalProcedure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ProposalProcedure era) -> Encoding)
-> Encode ('Closed 'Dense) (ProposalProcedure era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Coin
 -> RewardAccount
 -> GovAction era
 -> Anchor
 -> ProposalProcedure era)
-> Encode
     ('Closed 'Dense)
     (Coin
      -> RewardAccount
      -> GovAction era
      -> Anchor
      -> ProposalProcedure era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
ProposalProcedure @era)
        Encode
  ('Closed 'Dense)
  (Coin
   -> RewardAccount
   -> GovAction era
   -> Anchor
   -> ProposalProcedure era)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
pProcDeposit
        Encode
  ('Closed 'Dense)
  (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
-> Encode ('Closed 'Dense) RewardAccount
-> Encode
     ('Closed 'Dense) (GovAction era -> Anchor -> ProposalProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> RewardAccount -> Encode ('Closed 'Dense) RewardAccount
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAccount
pProcReturnAddr
        Encode
  ('Closed 'Dense) (GovAction era -> Anchor -> ProposalProcedure era)
-> Encode ('Closed 'Dense) (GovAction era)
-> Encode ('Closed 'Dense) (Anchor -> ProposalProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> GovAction era -> Encode ('Closed 'Dense) (GovAction era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovAction era
pProcGovAction
        Encode ('Closed 'Dense) (Anchor -> ProposalProcedure era)
-> Encode ('Closed 'Dense) Anchor
-> Encode ('Closed 'Dense) (ProposalProcedure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Anchor -> Encode ('Closed 'Dense) Anchor
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Anchor
pProcAnchor

instance EraPParams era => ToJSON (ProposalProcedure era) where
  toJSON :: ProposalProcedure era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (ProposalProcedure era -> [Pair])
-> ProposalProcedure era
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era -> [Pair]
forall e a era.
(KeyValue e a, EraPParams era) =>
ProposalProcedure era -> [a]
toProposalProcedurePairs
  toEncoding :: ProposalProcedure era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (ProposalProcedure era -> Series)
-> ProposalProcedure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ProposalProcedure era -> [Series])
-> ProposalProcedure era
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProposalProcedure era -> [Series]
forall e a era.
(KeyValue e a, EraPParams era) =>
ProposalProcedure era -> [a]
toProposalProcedurePairs

toProposalProcedurePairs :: (KeyValue e a, EraPParams era) => ProposalProcedure era -> [a]
toProposalProcedurePairs :: forall e a era.
(KeyValue e a, EraPParams era) =>
ProposalProcedure era -> [a]
toProposalProcedurePairs proposalProcedure :: ProposalProcedure era
proposalProcedure@(ProposalProcedure Coin
_ RewardAccount
_ GovAction era
_ Anchor
_) =
  let ProposalProcedure {Anchor
Coin
RewardAccount
GovAction era
pProcDeposit :: forall era. ProposalProcedure era -> Coin
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcAnchor :: forall era. ProposalProcedure era -> Anchor
pProcDeposit :: Coin
pProcReturnAddr :: RewardAccount
pProcGovAction :: GovAction era
pProcAnchor :: Anchor
..} = ProposalProcedure era
proposalProcedure
   in [ Key
"deposit" Key -> Coin -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin
pProcDeposit
      , Key
"returnAddr" Key -> RewardAccount -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RewardAccount
pProcReturnAddr
      , Key
"govAction" Key -> GovAction era -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= GovAction era
pProcGovAction
      , Key
"anchor" Key -> Anchor -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Anchor
pProcAnchor
      ]

data Committee era = Committee
  { forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers :: !(Map (Credential 'ColdCommitteeRole) EpochNo)
  -- ^ Committee members with epoch number when each of them expires
  , forall era. Committee era -> UnitInterval
committeeThreshold :: !UnitInterval
  -- ^ Threshold of the committee that is necessary for a successful vote
  }
  deriving (Committee era -> Committee era -> Bool
(Committee era -> Committee era -> Bool)
-> (Committee era -> Committee era -> Bool) -> Eq (Committee era)
forall era. Committee era -> Committee era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. Committee era -> Committee era -> Bool
== :: Committee era -> Committee era -> Bool
$c/= :: forall era. Committee era -> Committee era -> Bool
/= :: Committee era -> Committee era -> Bool
Eq, Int -> Committee era -> ShowS
[Committee era] -> ShowS
Committee era -> String
(Int -> Committee era -> ShowS)
-> (Committee era -> String)
-> ([Committee era] -> ShowS)
-> Show (Committee era)
forall era. Int -> Committee era -> ShowS
forall era. [Committee era] -> ShowS
forall era. Committee era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> Committee era -> ShowS
showsPrec :: Int -> Committee era -> ShowS
$cshow :: forall era. Committee era -> String
show :: Committee era -> String
$cshowList :: forall era. [Committee era] -> ShowS
showList :: [Committee era] -> ShowS
Show, (forall x. Committee era -> Rep (Committee era) x)
-> (forall x. Rep (Committee era) x -> Committee era)
-> Generic (Committee era)
forall x. Rep (Committee era) x -> Committee era
forall x. Committee era -> Rep (Committee era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Committee era) x -> Committee era
forall era x. Committee era -> Rep (Committee era) x
$cfrom :: forall era x. Committee era -> Rep (Committee era) x
from :: forall x. Committee era -> Rep (Committee era) x
$cto :: forall era x. Rep (Committee era) x -> Committee era
to :: forall x. Rep (Committee era) x -> Committee era
Generic)

instance Era era => NoThunks (Committee era)

instance Era era => NFData (Committee era)

instance Default (Committee era) where
  def :: Committee era
def = Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee Map (Credential 'ColdCommitteeRole) EpochNo
forall a. Monoid a => a
mempty UnitInterval
forall a. Bounded a => a
minBound

committeeMembersL ::
  Lens' (Committee era) (Map (Credential 'ColdCommitteeRole) EpochNo)
committeeMembersL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) EpochNo
 -> f (Map (Credential 'ColdCommitteeRole) EpochNo))
-> Committee era -> f (Committee era)
committeeMembersL = (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> (Committee era
    -> Map (Credential 'ColdCommitteeRole) EpochNo -> Committee era)
-> Lens
     (Committee era)
     (Committee era)
     (Map (Credential 'ColdCommitteeRole) EpochNo)
     (Map (Credential 'ColdCommitteeRole) EpochNo)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers (\Committee era
c Map (Credential 'ColdCommitteeRole) EpochNo
m -> Committee era
c {committeeMembers = m})

committeeThresholdL :: Lens' (Committee era) UnitInterval
committeeThresholdL :: forall era (f :: * -> *).
Functor f =>
(UnitInterval -> f UnitInterval)
-> Committee era -> f (Committee era)
committeeThresholdL = (Committee era -> UnitInterval)
-> (Committee era -> UnitInterval -> Committee era)
-> Lens (Committee era) (Committee era) UnitInterval UnitInterval
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Committee era -> UnitInterval
forall era. Committee era -> UnitInterval
committeeThreshold (\Committee era
c UnitInterval
q -> Committee era
c {committeeThreshold = q})

instance Era era => DecCBOR (Committee era) where
  decCBOR :: forall s. Decoder s (Committee era)
decCBOR =
    Decode ('Closed 'Dense) (Committee era)
-> Decoder s (Committee era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Committee era)
 -> Decoder s (Committee era))
-> Decode ('Closed 'Dense) (Committee era)
-> Decoder s (Committee era)
forall a b. (a -> b) -> a -> b
$
      (Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval -> Committee era)
-> Decode
     ('Closed 'Dense)
     (Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval -> Committee era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee
        Decode
  ('Closed 'Dense)
  (Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval -> Committee era)
-> Decode
     ('Closed Any) (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Decode ('Closed 'Dense) (UnitInterval -> Committee era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (Credential 'ColdCommitteeRole) EpochNo)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode ('Closed 'Dense) (UnitInterval -> Committee era)
-> Decode ('Closed Any) UnitInterval
-> Decode ('Closed 'Dense) (Committee era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
  {-# INLINE decCBOR #-}

instance Era era => EncCBOR (Committee era) where
  encCBOR :: Committee era -> Encoding
encCBOR Committee {Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers :: forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers, UnitInterval
committeeThreshold :: forall era. Committee era -> UnitInterval
committeeThreshold :: UnitInterval
committeeThreshold} =
    Encode ('Closed 'Dense) (Committee era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (Committee era) -> Encoding)
-> Encode ('Closed 'Dense) (Committee era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval -> Committee era)
-> Encode
     ('Closed 'Dense)
     (Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval -> Committee era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee @era)
        Encode
  ('Closed 'Dense)
  (Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval -> Committee era)
-> Encode
     ('Closed 'Dense) (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Encode ('Closed 'Dense) (UnitInterval -> Committee era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'ColdCommitteeRole) EpochNo
-> Encode
     ('Closed 'Dense) (Map (Credential 'ColdCommitteeRole) EpochNo)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers
        Encode ('Closed 'Dense) (UnitInterval -> Committee era)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode ('Closed 'Dense) (Committee era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
committeeThreshold

instance EraPParams era => ToJSON (Committee era) where
  toJSON :: Committee era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (Committee era -> [Pair]) -> Committee era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committee era -> [Pair]
forall e a era. KeyValue e a => Committee era -> [a]
toCommitteePairs
  toEncoding :: Committee era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (Committee era -> Series) -> Committee era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (Committee era -> [Series]) -> Committee era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committee era -> [Series]
forall e a era. KeyValue e a => Committee era -> [a]
toCommitteePairs

instance Era era => FromJSON (Committee era) where
  parseJSON :: Value -> Parser (Committee era)
parseJSON = String
-> (Object -> Parser (Committee era))
-> Value
-> Parser (Committee era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Committee" Object -> Parser (Committee era)
forall {era}. Object -> Parser (Committee era)
parseCommittee
    where
      parseCommittee :: Object -> Parser (Committee era)
parseCommittee Object
o =
        Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee
          (Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval -> Committee era)
-> Parser (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Parser (UnitInterval -> Committee era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map (Credential 'ColdCommitteeRole) EpochNo
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall (t :: * -> *) a. Foldable t => t a -> t a
forceElemsToWHNF (Map (Credential 'ColdCommitteeRole) EpochNo
 -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> Parser (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Parser (Map (Credential 'ColdCommitteeRole) EpochNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> Key -> Parser (Map (Credential 'ColdCommitteeRole) EpochNo)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members")
          Parser (UnitInterval -> Committee era)
-> Parser UnitInterval -> Parser (Committee era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser UnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"threshold"

toCommitteePairs :: KeyValue e a => Committee era -> [a]
toCommitteePairs :: forall e a era. KeyValue e a => Committee era -> [a]
toCommitteePairs committee :: Committee era
committee@(Committee Map (Credential 'ColdCommitteeRole) EpochNo
_ UnitInterval
_) =
  let Committee {Map (Credential 'ColdCommitteeRole) EpochNo
UnitInterval
committeeMembers :: forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeThreshold :: forall era. Committee era -> UnitInterval
committeeMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
committeeThreshold :: UnitInterval
..} = Committee era
committee
   in [ Key
"members" Key -> Map (Credential 'ColdCommitteeRole) EpochNo -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers
      , Key
"threshold" Key -> UnitInterval -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UnitInterval
committeeThreshold
      ]

data GovActionPurpose
  = PParamUpdatePurpose
  | HardForkPurpose
  | CommitteePurpose
  | ConstitutionPurpose
  deriving (GovActionPurpose -> GovActionPurpose -> Bool
(GovActionPurpose -> GovActionPurpose -> Bool)
-> (GovActionPurpose -> GovActionPurpose -> Bool)
-> Eq GovActionPurpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovActionPurpose -> GovActionPurpose -> Bool
== :: GovActionPurpose -> GovActionPurpose -> Bool
$c/= :: GovActionPurpose -> GovActionPurpose -> Bool
/= :: GovActionPurpose -> GovActionPurpose -> Bool
Eq, Int -> GovActionPurpose -> ShowS
[GovActionPurpose] -> ShowS
GovActionPurpose -> String
(Int -> GovActionPurpose -> ShowS)
-> (GovActionPurpose -> String)
-> ([GovActionPurpose] -> ShowS)
-> Show GovActionPurpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovActionPurpose -> ShowS
showsPrec :: Int -> GovActionPurpose -> ShowS
$cshow :: GovActionPurpose -> String
show :: GovActionPurpose -> String
$cshowList :: [GovActionPurpose] -> ShowS
showList :: [GovActionPurpose] -> ShowS
Show, (forall x. GovActionPurpose -> Rep GovActionPurpose x)
-> (forall x. Rep GovActionPurpose x -> GovActionPurpose)
-> Generic GovActionPurpose
forall x. Rep GovActionPurpose x -> GovActionPurpose
forall x. GovActionPurpose -> Rep GovActionPurpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GovActionPurpose -> Rep GovActionPurpose x
from :: forall x. GovActionPurpose -> Rep GovActionPurpose x
$cto :: forall x. Rep GovActionPurpose x -> GovActionPurpose
to :: forall x. Rep GovActionPurpose x -> GovActionPurpose
Generic)

class ToGovActionPurpose (p :: GovActionPurpose) where
  toGovActionPurpose :: GovActionPurpose

instance ToGovActionPurpose 'PParamUpdatePurpose where
  toGovActionPurpose :: GovActionPurpose
toGovActionPurpose = GovActionPurpose
PParamUpdatePurpose

instance ToGovActionPurpose 'HardForkPurpose where
  toGovActionPurpose :: GovActionPurpose
toGovActionPurpose = GovActionPurpose
HardForkPurpose

instance ToGovActionPurpose 'CommitteePurpose where
  toGovActionPurpose :: GovActionPurpose
toGovActionPurpose = GovActionPurpose
CommitteePurpose

instance ToGovActionPurpose 'ConstitutionPurpose where
  toGovActionPurpose :: GovActionPurpose
toGovActionPurpose = GovActionPurpose
ConstitutionPurpose

isGovActionWithPurpose :: forall p era. ToGovActionPurpose p => GovAction era -> Bool
isGovActionWithPurpose :: forall (p :: GovActionPurpose) era.
ToGovActionPurpose p =>
GovAction era -> Bool
isGovActionWithPurpose GovAction era
govAction =
  case GovAction era
govAction of
    ParameterChange {} -> forall (p :: GovActionPurpose).
ToGovActionPurpose p =>
GovActionPurpose
toGovActionPurpose @p GovActionPurpose -> GovActionPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionPurpose
PParamUpdatePurpose
    HardForkInitiation {} -> forall (p :: GovActionPurpose).
ToGovActionPurpose p =>
GovActionPurpose
toGovActionPurpose @p GovActionPurpose -> GovActionPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionPurpose
HardForkPurpose
    TreasuryWithdrawals {} -> Bool
False
    NoConfidence {} -> forall (p :: GovActionPurpose).
ToGovActionPurpose p =>
GovActionPurpose
toGovActionPurpose @p GovActionPurpose -> GovActionPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionPurpose
CommitteePurpose
    UpdateCommittee {} -> forall (p :: GovActionPurpose).
ToGovActionPurpose p =>
GovActionPurpose
toGovActionPurpose @p GovActionPurpose -> GovActionPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionPurpose
CommitteePurpose
    NewConstitution {} -> forall (p :: GovActionPurpose).
ToGovActionPurpose p =>
GovActionPurpose
toGovActionPurpose @p GovActionPurpose -> GovActionPurpose -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionPurpose
ConstitutionPurpose
    GovAction era
InfoAction -> Bool
False

newtype GovPurposeId (p :: GovActionPurpose) era = GovPurposeId
  { forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovActionId
unGovPurposeId :: GovActionId
  }
  deriving (GovPurposeId p era -> GovPurposeId p era -> Bool
(GovPurposeId p era -> GovPurposeId p era -> Bool)
-> (GovPurposeId p era -> GovPurposeId p era -> Bool)
-> Eq (GovPurposeId p era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
$c== :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
== :: GovPurposeId p era -> GovPurposeId p era -> Bool
$c/= :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
/= :: GovPurposeId p era -> GovPurposeId p era -> Bool
Eq, Eq (GovPurposeId p era)
Eq (GovPurposeId p era) =>
(GovPurposeId p era -> GovPurposeId p era -> Ordering)
-> (GovPurposeId p era -> GovPurposeId p era -> Bool)
-> (GovPurposeId p era -> GovPurposeId p era -> Bool)
-> (GovPurposeId p era -> GovPurposeId p era -> Bool)
-> (GovPurposeId p era -> GovPurposeId p era -> Bool)
-> (GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era)
-> (GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era)
-> Ord (GovPurposeId p era)
GovPurposeId p era -> GovPurposeId p era -> Bool
GovPurposeId p era -> GovPurposeId p era -> Ordering
GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p 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 (p :: GovActionPurpose) era. Eq (GovPurposeId p era)
forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Ordering
forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era
$ccompare :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Ordering
compare :: GovPurposeId p era -> GovPurposeId p era -> Ordering
$c< :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
< :: GovPurposeId p era -> GovPurposeId p era -> Bool
$c<= :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
<= :: GovPurposeId p era -> GovPurposeId p era -> Bool
$c> :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
> :: GovPurposeId p era -> GovPurposeId p era -> Bool
$c>= :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> Bool
>= :: GovPurposeId p era -> GovPurposeId p era -> Bool
$cmax :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era
max :: GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era
$cmin :: forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era
min :: GovPurposeId p era -> GovPurposeId p era -> GovPurposeId p era
Ord, (forall x. GovPurposeId p era -> Rep (GovPurposeId p era) x)
-> (forall x. Rep (GovPurposeId p era) x -> GovPurposeId p era)
-> Generic (GovPurposeId p era)
forall x. Rep (GovPurposeId p era) x -> GovPurposeId p era
forall x. GovPurposeId p era -> Rep (GovPurposeId p era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (p :: GovActionPurpose) era x.
Rep (GovPurposeId p era) x -> GovPurposeId p era
forall (p :: GovActionPurpose) era x.
GovPurposeId p era -> Rep (GovPurposeId p era) x
$cfrom :: forall (p :: GovActionPurpose) era x.
GovPurposeId p era -> Rep (GovPurposeId p era) x
from :: forall x. GovPurposeId p era -> Rep (GovPurposeId p era) x
$cto :: forall (p :: GovActionPurpose) era x.
Rep (GovPurposeId p era) x -> GovPurposeId p era
to :: forall x. Rep (GovPurposeId p era) x -> GovPurposeId p era
Generic)

type role GovPurposeId nominal nominal

deriving newtype instance
  (Era era, Typeable p) => EncCBOR (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance
  (Era era, Typeable p) => DecCBOR (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance Era era => NoThunks (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance Era era => NFData (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance Era era => ToJSONKey (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance Era era => ToJSON (GovPurposeId (p :: GovActionPurpose) era)

deriving newtype instance Era era => Show (GovPurposeId (p :: GovActionPurpose) era)

-- | Abstract data type for representing relationship of governance action with the same purpose
data GovRelation (f :: Type -> Type) era = GovRelation
  { forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate :: !(f (GovPurposeId 'PParamUpdatePurpose era))
  , forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork :: !(f (GovPurposeId 'HardForkPurpose era))
  , forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee :: !(f (GovPurposeId 'CommitteePurpose era))
  , forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution :: !(f (GovPurposeId 'ConstitutionPurpose era))
  }
  deriving ((forall x. GovRelation f era -> Rep (GovRelation f era) x)
-> (forall x. Rep (GovRelation f era) x -> GovRelation f era)
-> Generic (GovRelation f era)
forall x. Rep (GovRelation f era) x -> GovRelation f era
forall x. GovRelation f era -> Rep (GovRelation f era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) era x.
Rep (GovRelation f era) x -> GovRelation f era
forall (f :: * -> *) era x.
GovRelation f era -> Rep (GovRelation f era) x
$cfrom :: forall (f :: * -> *) era x.
GovRelation f era -> Rep (GovRelation f era) x
from :: forall x. GovRelation f era -> Rep (GovRelation f era) x
$cto :: forall (f :: * -> *) era x.
Rep (GovRelation f era) x -> GovRelation f era
to :: forall x. Rep (GovRelation f era) x -> GovRelation f era
Generic)

deriving instance
  (forall p. Eq (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  Eq (GovRelation f era)

deriving instance
  (forall p. Show (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  Show (GovRelation f era)

instance
  (forall p. NoThunks (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  NoThunks (GovRelation f era)

instance
  (forall p. Default (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  Default (GovRelation f era)

instance
  (forall p. NFData (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  NFData (GovRelation f era)
  where
  rnf :: GovRelation f era -> ()
rnf (GovRelation f (GovPurposeId 'PParamUpdatePurpose era)
a f (GovPurposeId 'HardForkPurpose era)
b f (GovPurposeId 'CommitteePurpose era)
c f (GovPurposeId 'ConstitutionPurpose era)
d) = f (GovPurposeId 'PParamUpdatePurpose era)
a f (GovPurposeId 'PParamUpdatePurpose era) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` f (GovPurposeId 'HardForkPurpose era)
b f (GovPurposeId 'HardForkPurpose era) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` f (GovPurposeId 'CommitteePurpose era)
c f (GovPurposeId 'CommitteePurpose era) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` f (GovPurposeId 'ConstitutionPurpose era) -> ()
forall a. NFData a => a -> ()
rnf f (GovPurposeId 'ConstitutionPurpose era)
d

instance
  (forall p. Semigroup (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  Semigroup (GovRelation f era)
  where
  <> :: GovRelation f era -> GovRelation f era -> GovRelation f era
(<>) GovRelation f era
p1 GovRelation f era
p2 =
    GovRelation
      { grPParamUpdate :: f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate = GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate GovRelation f era
p1 f (GovPurposeId 'PParamUpdatePurpose era)
-> f (GovPurposeId 'PParamUpdatePurpose era)
-> f (GovPurposeId 'PParamUpdatePurpose era)
forall a. Semigroup a => a -> a -> a
<> GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate GovRelation f era
p2
      , grHardFork :: f (GovPurposeId 'HardForkPurpose era)
grHardFork = GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork GovRelation f era
p1 f (GovPurposeId 'HardForkPurpose era)
-> f (GovPurposeId 'HardForkPurpose era)
-> f (GovPurposeId 'HardForkPurpose era)
forall a. Semigroup a => a -> a -> a
<> GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork GovRelation f era
p2
      , grCommittee :: f (GovPurposeId 'CommitteePurpose era)
grCommittee = GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee GovRelation f era
p1 f (GovPurposeId 'CommitteePurpose era)
-> f (GovPurposeId 'CommitteePurpose era)
-> f (GovPurposeId 'CommitteePurpose era)
forall a. Semigroup a => a -> a -> a
<> GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee GovRelation f era
p2
      , grConstitution :: f (GovPurposeId 'ConstitutionPurpose era)
grConstitution = GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution GovRelation f era
p1 f (GovPurposeId 'ConstitutionPurpose era)
-> f (GovPurposeId 'ConstitutionPurpose era)
-> f (GovPurposeId 'ConstitutionPurpose era)
forall a. Semigroup a => a -> a -> a
<> GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution GovRelation f era
p2
      }

instance
  (forall p. Monoid (f (GovPurposeId (p :: GovActionPurpose) era))) =>
  Monoid (GovRelation f era)
  where
  mempty :: GovRelation f era
mempty =
    GovRelation
      { grPParamUpdate :: f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate = f (GovPurposeId 'PParamUpdatePurpose era)
forall a. Monoid a => a
mempty
      , grHardFork :: f (GovPurposeId 'HardForkPurpose era)
grHardFork = f (GovPurposeId 'HardForkPurpose era)
forall a. Monoid a => a
mempty
      , grCommittee :: f (GovPurposeId 'CommitteePurpose era)
grCommittee = f (GovPurposeId 'CommitteePurpose era)
forall a. Monoid a => a
mempty
      , grConstitution :: f (GovPurposeId 'ConstitutionPurpose era)
grConstitution = f (GovPurposeId 'ConstitutionPurpose era)
forall a. Monoid a => a
mempty
      }

instance
  ( Era era
  , Typeable f
  , (forall p. Typeable p => DecCBOR (f (GovPurposeId (p :: GovActionPurpose) era)))
  ) =>
  DecCBOR (GovRelation f era)
  where
  decCBOR :: forall s. Decoder s (GovRelation f era)
decCBOR =
    Text
-> (GovRelation f era -> Int)
-> Decoder s (GovRelation f era)
-> Decoder s (GovRelation f era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed
      Text
"GovRelation"
      (Int -> GovRelation f era -> Int
forall a b. a -> b -> a
const Int
4)
      (f (GovPurposeId 'PParamUpdatePurpose era)
-> f (GovPurposeId 'HardForkPurpose era)
-> f (GovPurposeId 'CommitteePurpose era)
-> f (GovPurposeId 'ConstitutionPurpose era)
-> GovRelation f era
forall (f :: * -> *) era.
f (GovPurposeId 'PParamUpdatePurpose era)
-> f (GovPurposeId 'HardForkPurpose era)
-> f (GovPurposeId 'CommitteePurpose era)
-> f (GovPurposeId 'ConstitutionPurpose era)
-> GovRelation f era
GovRelation (f (GovPurposeId 'PParamUpdatePurpose era)
 -> f (GovPurposeId 'HardForkPurpose era)
 -> f (GovPurposeId 'CommitteePurpose era)
 -> f (GovPurposeId 'ConstitutionPurpose era)
 -> GovRelation f era)
-> Decoder s (f (GovPurposeId 'PParamUpdatePurpose era))
-> Decoder
     s
     (f (GovPurposeId 'HardForkPurpose era)
      -> f (GovPurposeId 'CommitteePurpose era)
      -> f (GovPurposeId 'ConstitutionPurpose era)
      -> GovRelation f era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f (GovPurposeId 'PParamUpdatePurpose era))
forall s. Decoder s (f (GovPurposeId 'PParamUpdatePurpose era))
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder
  s
  (f (GovPurposeId 'HardForkPurpose era)
   -> f (GovPurposeId 'CommitteePurpose era)
   -> f (GovPurposeId 'ConstitutionPurpose era)
   -> GovRelation f era)
-> Decoder s (f (GovPurposeId 'HardForkPurpose era))
-> Decoder
     s
     (f (GovPurposeId 'CommitteePurpose era)
      -> f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (f (GovPurposeId 'HardForkPurpose era))
forall s. Decoder s (f (GovPurposeId 'HardForkPurpose era))
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder
  s
  (f (GovPurposeId 'CommitteePurpose era)
   -> f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
-> Decoder s (f (GovPurposeId 'CommitteePurpose era))
-> Decoder
     s (f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (f (GovPurposeId 'CommitteePurpose era))
forall s. Decoder s (f (GovPurposeId 'CommitteePurpose era))
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder
  s (f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
-> Decoder s (f (GovPurposeId 'ConstitutionPurpose era))
-> Decoder s (GovRelation f era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (f (GovPurposeId 'ConstitutionPurpose era))
forall s. Decoder s (f (GovPurposeId 'ConstitutionPurpose era))
forall a s. DecCBOR a => Decoder s a
decCBOR)

instance
  ( Era era
  , Typeable f
  , (forall p. Typeable p => EncCBOR (f (GovPurposeId (p :: GovActionPurpose) era)))
  ) =>
  EncCBOR (GovRelation f era)
  where
  encCBOR :: GovRelation f era -> Encoding
encCBOR govPurpose :: GovRelation f era
govPurpose@(GovRelation f (GovPurposeId 'PParamUpdatePurpose era)
_ f (GovPurposeId 'HardForkPurpose era)
_ f (GovPurposeId 'CommitteePurpose era)
_ f (GovPurposeId 'ConstitutionPurpose era)
_) =
    let GovRelation {f (GovPurposeId 'PParamUpdatePurpose era)
f (GovPurposeId 'HardForkPurpose era)
f (GovPurposeId 'CommitteePurpose era)
f (GovPurposeId 'ConstitutionPurpose era)
grPParamUpdate :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grHardFork :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grCommittee :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grConstitution :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grPParamUpdate :: f (GovPurposeId 'PParamUpdatePurpose era)
grHardFork :: f (GovPurposeId 'HardForkPurpose era)
grCommittee :: f (GovPurposeId 'CommitteePurpose era)
grConstitution :: f (GovPurposeId 'ConstitutionPurpose era)
..} = GovRelation f era
govPurpose
     in Word -> Encoding
encodeListLen Word
4
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f (GovPurposeId 'PParamUpdatePurpose era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f (GovPurposeId 'HardForkPurpose era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR f (GovPurposeId 'HardForkPurpose era)
grHardFork
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f (GovPurposeId 'CommitteePurpose era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR f (GovPurposeId 'CommitteePurpose era)
grCommittee
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f (GovPurposeId 'ConstitutionPurpose era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR f (GovPurposeId 'ConstitutionPurpose era)
grConstitution

toPrevGovActionIdsPairs ::
  ( KeyValue e a
  , (forall p. ToJSON (f (GovPurposeId (p :: GovActionPurpose) era)))
  ) =>
  GovRelation f era ->
  [a]
toPrevGovActionIdsPairs :: forall e a (f :: * -> *) era.
(KeyValue e a,
 forall (p :: GovActionPurpose). ToJSON (f (GovPurposeId p era))) =>
GovRelation f era -> [a]
toPrevGovActionIdsPairs govPurpose :: GovRelation f era
govPurpose@(GovRelation f (GovPurposeId 'PParamUpdatePurpose era)
_ f (GovPurposeId 'HardForkPurpose era)
_ f (GovPurposeId 'CommitteePurpose era)
_ f (GovPurposeId 'ConstitutionPurpose era)
_) =
  let GovRelation {f (GovPurposeId 'PParamUpdatePurpose era)
f (GovPurposeId 'HardForkPurpose era)
f (GovPurposeId 'CommitteePurpose era)
f (GovPurposeId 'ConstitutionPurpose era)
grPParamUpdate :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grHardFork :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grCommittee :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grConstitution :: forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grPParamUpdate :: f (GovPurposeId 'PParamUpdatePurpose era)
grHardFork :: f (GovPurposeId 'HardForkPurpose era)
grCommittee :: f (GovPurposeId 'CommitteePurpose era)
grConstitution :: f (GovPurposeId 'ConstitutionPurpose era)
..} = GovRelation f era
govPurpose
   in [ Key
"PParamUpdate" Key -> f (GovPurposeId 'PParamUpdatePurpose era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate
      , Key
"HardFork" Key -> f (GovPurposeId 'HardForkPurpose era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= f (GovPurposeId 'HardForkPurpose era)
grHardFork
      , Key
"Committee" Key -> f (GovPurposeId 'CommitteePurpose era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= f (GovPurposeId 'CommitteePurpose era)
grCommittee
      , Key
"Constitution" Key -> f (GovPurposeId 'ConstitutionPurpose era) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= f (GovPurposeId 'ConstitutionPurpose era)
grConstitution
      ]

instance
  (Era era, (forall p. ToJSON (f (GovPurposeId (p :: GovActionPurpose) era)))) =>
  ToJSON (GovRelation f era)
  where
  toJSON :: GovRelation f era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (GovRelation f era -> [Pair]) -> GovRelation f era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovRelation f era -> [Pair]
forall e a (f :: * -> *) era.
(KeyValue e a,
 forall (p :: GovActionPurpose). ToJSON (f (GovPurposeId p era))) =>
GovRelation f era -> [a]
toPrevGovActionIdsPairs
  toEncoding :: GovRelation f era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (GovRelation f era -> Series) -> GovRelation f era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (GovRelation f era -> [Series]) -> GovRelation f era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovRelation f era -> [Series]
forall e a (f :: * -> *) era.
(KeyValue e a,
 forall (p :: GovActionPurpose). ToJSON (f (GovPurposeId p era))) =>
GovRelation f era -> [a]
toPrevGovActionIdsPairs

grPParamUpdateL :: Lens' (GovRelation f era) (f (GovPurposeId 'PParamUpdatePurpose era))
grPParamUpdateL :: forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'PParamUpdatePurpose era)
 -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grPParamUpdateL = (GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era))
-> (GovRelation f era
    -> f (GovPurposeId 'PParamUpdatePurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'PParamUpdatePurpose era)
    -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate ((GovRelation f era
  -> f (GovPurposeId 'PParamUpdatePurpose era) -> GovRelation f era)
 -> forall {f :: * -> *}.
    Functor f =>
    (f (GovPurposeId 'PParamUpdatePurpose era)
     -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
    -> GovRelation f era -> f (GovRelation f era))
-> (GovRelation f era
    -> f (GovPurposeId 'PParamUpdatePurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'PParamUpdatePurpose era)
    -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall a b. (a -> b) -> a -> b
$ \GovRelation f era
x f (GovPurposeId 'PParamUpdatePurpose era)
y -> GovRelation f era
x {grPParamUpdate = y}

grHardForkL :: Lens' (GovRelation f era) (f (GovPurposeId 'HardForkPurpose era))
grHardForkL :: forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'HardForkPurpose era)
 -> f (f (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grHardForkL = (GovRelation f era -> f (GovPurposeId 'HardForkPurpose era))
-> (GovRelation f era
    -> f (GovPurposeId 'HardForkPurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'HardForkPurpose era)
    -> f (f (GovPurposeId 'HardForkPurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork ((GovRelation f era
  -> f (GovPurposeId 'HardForkPurpose era) -> GovRelation f era)
 -> forall {f :: * -> *}.
    Functor f =>
    (f (GovPurposeId 'HardForkPurpose era)
     -> f (f (GovPurposeId 'HardForkPurpose era)))
    -> GovRelation f era -> f (GovRelation f era))
-> (GovRelation f era
    -> f (GovPurposeId 'HardForkPurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'HardForkPurpose era)
    -> f (f (GovPurposeId 'HardForkPurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall a b. (a -> b) -> a -> b
$ \GovRelation f era
x f (GovPurposeId 'HardForkPurpose era)
y -> GovRelation f era
x {grHardFork = y}

grCommitteeL :: Lens' (GovRelation f era) (f (GovPurposeId 'CommitteePurpose era))
grCommitteeL :: forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grCommitteeL = (GovRelation f era -> f (GovPurposeId 'CommitteePurpose era))
-> (GovRelation f era
    -> f (GovPurposeId 'CommitteePurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'CommitteePurpose era)
    -> f (f (GovPurposeId 'CommitteePurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee ((GovRelation f era
  -> f (GovPurposeId 'CommitteePurpose era) -> GovRelation f era)
 -> forall {f :: * -> *}.
    Functor f =>
    (f (GovPurposeId 'CommitteePurpose era)
     -> f (f (GovPurposeId 'CommitteePurpose era)))
    -> GovRelation f era -> f (GovRelation f era))
-> (GovRelation f era
    -> f (GovPurposeId 'CommitteePurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'CommitteePurpose era)
    -> f (f (GovPurposeId 'CommitteePurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall a b. (a -> b) -> a -> b
$ \GovRelation f era
x f (GovPurposeId 'CommitteePurpose era)
y -> GovRelation f era
x {grCommittee = y}

grConstitutionL :: Lens' (GovRelation f era) (f (GovPurposeId 'ConstitutionPurpose era))
grConstitutionL :: forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'ConstitutionPurpose era)
 -> f (f (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grConstitutionL = (GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era))
-> (GovRelation f era
    -> f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'ConstitutionPurpose era)
    -> f (f (GovPurposeId 'ConstitutionPurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution ((GovRelation f era
  -> f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
 -> forall {f :: * -> *}.
    Functor f =>
    (f (GovPurposeId 'ConstitutionPurpose era)
     -> f (f (GovPurposeId 'ConstitutionPurpose era)))
    -> GovRelation f era -> f (GovRelation f era))
-> (GovRelation f era
    -> f (GovPurposeId 'ConstitutionPurpose era) -> GovRelation f era)
-> forall {f :: * -> *}.
   Functor f =>
   (f (GovPurposeId 'ConstitutionPurpose era)
    -> f (f (GovPurposeId 'ConstitutionPurpose era)))
   -> GovRelation f era -> f (GovRelation f era)
forall a b. (a -> b) -> a -> b
$ \GovRelation f era
x f (GovPurposeId 'ConstitutionPurpose era)
y -> GovRelation f era
x {grConstitution = y}

hoistGovRelation :: (forall a. f a -> g a) -> GovRelation f era -> GovRelation g era
hoistGovRelation :: forall (f :: * -> *) (g :: * -> *) era.
(forall a. f a -> g a) -> GovRelation f era -> GovRelation g era
hoistGovRelation forall a. f a -> g a
f GovRelation f era
gr =
  GovRelation
    { grPParamUpdate :: g (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate = f (GovPurposeId 'PParamUpdatePurpose era)
-> g (GovPurposeId 'PParamUpdatePurpose era)
forall a. f a -> g a
f (GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'PParamUpdatePurpose era)
grPParamUpdate GovRelation f era
gr)
    , grHardFork :: g (GovPurposeId 'HardForkPurpose era)
grHardFork = f (GovPurposeId 'HardForkPurpose era)
-> g (GovPurposeId 'HardForkPurpose era)
forall a. f a -> g a
f (GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'HardForkPurpose era)
grHardFork GovRelation f era
gr)
    , grCommittee :: g (GovPurposeId 'CommitteePurpose era)
grCommittee = f (GovPurposeId 'CommitteePurpose era)
-> g (GovPurposeId 'CommitteePurpose era)
forall a. f a -> g a
f (GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'CommitteePurpose era)
grCommittee GovRelation f era
gr)
    , grConstitution :: g (GovPurposeId 'ConstitutionPurpose era)
grConstitution = f (GovPurposeId 'ConstitutionPurpose era)
-> g (GovPurposeId 'ConstitutionPurpose era)
forall a. f a -> g a
f (GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
forall (f :: * -> *) era.
GovRelation f era -> f (GovPurposeId 'ConstitutionPurpose era)
grConstitution GovRelation f era
gr)
    }

-- | Apply a function to a GovAction that can have a parent.
withGovActionParent ::
  GovActionState era ->
  -- | The result to be used for governance actions that can't have a parent
  a ->
  -- | Function that will be applied to a lens and a parent
  ( forall p.
    (forall f. Lens' (GovRelation f era) (f (GovPurposeId p era))) ->
    StrictMaybe (GovPurposeId p era) -> -- GovAction Parent
    GovPurposeId p era ->
    a
  ) ->
  a
withGovActionParent :: forall era a.
GovActionState era
-> a
-> (forall (p :: GovActionPurpose).
    (forall (f :: * -> *) (f :: * -> *).
     Functor f =>
     (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
     -> GovRelation f era -> f (GovRelation f era))
    -> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a)
-> a
withGovActionParent GovActionState era
gas a
noParent forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f =
  case GovActionState era
gas GovActionState era
-> Getting (GovAction era) (GovActionState era) (GovAction era)
-> GovAction era
forall s a. s -> Getting a s a -> a
^. Getting (GovAction era) (GovActionState era) (GovAction era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL of
    ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
parent PParamsUpdate era
_ StrictMaybe ScriptHash
_ -> (forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId 'PParamUpdatePurpose era)
  -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> GovPurposeId 'PParamUpdatePurpose era
-> a
forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f (f (GovPurposeId 'PParamUpdatePurpose era)
 -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'PParamUpdatePurpose era)
 -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId 'PParamUpdatePurpose era)
 -> f (f (GovPurposeId 'PParamUpdatePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grPParamUpdateL StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
parent (GovActionId -> GovPurposeId 'PParamUpdatePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionState era
gas GovActionState era
-> Getting GovActionId (GovActionState era) GovActionId
-> GovActionId
forall s a. s -> Getting a s a -> a
^. Getting GovActionId (GovActionState era) GovActionId
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL))
    HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
parent ProtVer
_ -> (forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId 'HardForkPurpose era)
  -> f (f (GovPurposeId 'HardForkPurpose era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> GovPurposeId 'HardForkPurpose era
-> a
forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f (f (GovPurposeId 'HardForkPurpose era)
 -> f (f (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'HardForkPurpose era)
 -> f (f (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId 'HardForkPurpose era)
 -> f (f (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grHardForkL StrictMaybe (GovPurposeId 'HardForkPurpose era)
parent (GovActionId -> GovPurposeId 'HardForkPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionState era
gas GovActionState era
-> Getting GovActionId (GovActionState era) GovActionId
-> GovActionId
forall s a. s -> Getting a s a -> a
^. Getting GovActionId (GovActionState era) GovActionId
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL))
    TreasuryWithdrawals Map RewardAccount Coin
_ StrictMaybe ScriptHash
_ -> a
noParent
    NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
parent -> (forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId 'CommitteePurpose era)
  -> f (f (GovPurposeId 'CommitteePurpose era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> GovPurposeId 'CommitteePurpose era
-> a
forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f (f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grCommitteeL StrictMaybe (GovPurposeId 'CommitteePurpose era)
parent (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionState era
gas GovActionState era
-> Getting GovActionId (GovActionState era) GovActionId
-> GovActionId
forall s a. s -> Getting a s a -> a
^. Getting GovActionId (GovActionState era) GovActionId
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL))
    UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
parent Set (Credential 'ColdCommitteeRole)
_ Map (Credential 'ColdCommitteeRole) EpochNo
_ UnitInterval
_ -> (forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId 'CommitteePurpose era)
  -> f (f (GovPurposeId 'CommitteePurpose era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> GovPurposeId 'CommitteePurpose era
-> a
forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f (f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId 'CommitteePurpose era)
 -> f (f (GovPurposeId 'CommitteePurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grCommitteeL StrictMaybe (GovPurposeId 'CommitteePurpose era)
parent (GovActionId -> GovPurposeId 'CommitteePurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionState era
gas GovActionState era
-> Getting GovActionId (GovActionState era) GovActionId
-> GovActionId
forall s a. s -> Getting a s a -> a
^. Getting GovActionId (GovActionState era) GovActionId
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL))
    NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
parent Constitution era
_ -> (forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId 'ConstitutionPurpose era)
  -> f (f (GovPurposeId 'ConstitutionPurpose era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> GovPurposeId 'ConstitutionPurpose era
-> a
forall (p :: GovActionPurpose).
(forall (f :: * -> *) (f :: * -> *).
 Functor f =>
 (f (GovPurposeId p era) -> f (f (GovPurposeId p era)))
 -> GovRelation f era -> f (GovRelation f era))
-> StrictMaybe (GovPurposeId p era) -> GovPurposeId p era -> a
f (f (GovPurposeId 'ConstitutionPurpose era)
 -> f (f (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) era (f :: * -> *).
Functor f =>
(f (GovPurposeId 'ConstitutionPurpose era)
 -> f (f (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
forall (f :: * -> *) (f :: * -> *).
Functor f =>
(f (GovPurposeId 'ConstitutionPurpose era)
 -> f (f (GovPurposeId 'ConstitutionPurpose era)))
-> GovRelation f era -> f (GovRelation f era)
grConstitutionL StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
parent (GovActionId -> GovPurposeId 'ConstitutionPurpose era
forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId (GovActionState era
gas GovActionState era
-> Getting GovActionId (GovActionState era) GovActionId
-> GovActionId
forall s a. s -> Getting a s a -> a
^. Getting GovActionId (GovActionState era) GovActionId
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL))
    GovAction era
InfoAction -> a
noParent

-- | Note that the previous governance action id is only optional for the very first
-- governance action of the same purpose.
data GovAction era
  = ParameterChange
      -- | Previous governance action id of `ParameterChange` type, which corresponds to
      -- `PParamUpdatePurpose`.
      !(StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
      -- | Proposed changes to PParams
      !(PParamsUpdate era)
      -- | Policy hash protection
      !(StrictMaybe ScriptHash)
  | HardForkInitiation
      -- | Previous governance action id of `HardForkInitiation` type, which corresponds
      -- to `HardForkPurpose`
      !(StrictMaybe (GovPurposeId 'HardForkPurpose era))
      -- | Proposed new protocol version
      !ProtVer
  | TreasuryWithdrawals
      -- | Proposed treasury withdrawals
      !(Map RewardAccount Coin)
      -- | Policy hash protection
      !(StrictMaybe ScriptHash)
  | NoConfidence
      -- | Previous governance action id of `NoConfidence` or `UpdateCommittee` type, which
      -- corresponds to `CommitteePurpose`
      !(StrictMaybe (GovPurposeId 'CommitteePurpose era))
  | UpdateCommittee
      -- | Previous governance action id of `UpdateCommittee` or `NoConfidence` type, which
      -- corresponds to `CommitteePurpose`
      !(StrictMaybe (GovPurposeId 'CommitteePurpose era))
      -- | Constitutional Committe members to be removed
      !(Set (Credential 'ColdCommitteeRole))
      -- | Constitutional committee members to be added
      !(Map (Credential 'ColdCommitteeRole) EpochNo)
      -- | New Threshold
      !UnitInterval
  | NewConstitution
      -- | Previous governance action id of `NewConstitution` type, which corresponds to
      -- `ConstitutionPurpose`
      !(StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
      !(Constitution era)
  | InfoAction
  deriving ((forall x. GovAction era -> Rep (GovAction era) x)
-> (forall x. Rep (GovAction era) x -> GovAction era)
-> Generic (GovAction era)
forall x. Rep (GovAction era) x -> GovAction era
forall x. GovAction era -> Rep (GovAction era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (GovAction era) x -> GovAction era
forall era x. GovAction era -> Rep (GovAction era) x
$cfrom :: forall era x. GovAction era -> Rep (GovAction era) x
from :: forall x. GovAction era -> Rep (GovAction era) x
$cto :: forall era x. Rep (GovAction era) x -> GovAction era
to :: forall x. Rep (GovAction era) x -> GovAction era
Generic, Eq (GovAction era)
Eq (GovAction era) =>
(GovAction era -> GovAction era -> Ordering)
-> (GovAction era -> GovAction era -> Bool)
-> (GovAction era -> GovAction era -> Bool)
-> (GovAction era -> GovAction era -> Bool)
-> (GovAction era -> GovAction era -> Bool)
-> (GovAction era -> GovAction era -> GovAction era)
-> (GovAction era -> GovAction era -> GovAction era)
-> Ord (GovAction era)
GovAction era -> GovAction era -> Bool
GovAction era -> GovAction era -> Ordering
GovAction era -> GovAction era -> GovAction 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. EraPParams era => Eq (GovAction era)
forall era.
EraPParams era =>
GovAction era -> GovAction era -> Bool
forall era.
EraPParams era =>
GovAction era -> GovAction era -> Ordering
forall era.
EraPParams era =>
GovAction era -> GovAction era -> GovAction era
$ccompare :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> Ordering
compare :: GovAction era -> GovAction era -> Ordering
$c< :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> Bool
< :: GovAction era -> GovAction era -> Bool
$c<= :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> Bool
<= :: GovAction era -> GovAction era -> Bool
$c> :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> Bool
> :: GovAction era -> GovAction era -> Bool
$c>= :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> Bool
>= :: GovAction era -> GovAction era -> Bool
$cmax :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> GovAction era
max :: GovAction era -> GovAction era -> GovAction era
$cmin :: forall era.
EraPParams era =>
GovAction era -> GovAction era -> GovAction era
min :: GovAction era -> GovAction era -> GovAction era
Ord)

showGovActionType :: GovAction era -> String
showGovActionType :: forall era. GovAction era -> String
showGovActionType NewConstitution {} = String
"NewConstitution"
showGovActionType ParameterChange {} = String
"ParameterChange"
showGovActionType HardForkInitiation {} = String
"HardForkInitiation"
showGovActionType TreasuryWithdrawals {} = String
"TreasuryWithdrawals"
showGovActionType NoConfidence {} = String
"NoConfidence"
showGovActionType UpdateCommittee {} = String
"UpdateCommittee"
showGovActionType InfoAction {} = String
"InfoAction"

deriving instance EraPParams era => Show (GovAction era)

deriving instance EraPParams era => Eq (GovAction era)

instance EraPParams era => NoThunks (GovAction era)

instance EraPParams era => NFData (GovAction era)

instance EraPParams era => ToJSON (GovAction era)

instance EraPParams era => DecCBOR (GovAction era) where
  decCBOR :: forall s. Decoder s (GovAction era)
decCBOR =
    Decode ('Closed 'Dense) (GovAction era)
-> Decoder s (GovAction era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (GovAction era)
 -> Decoder s (GovAction era))
-> Decode ('Closed 'Dense) (GovAction era)
-> Decoder s (GovAction era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode 'Open (GovAction era))
-> Decode ('Closed 'Dense) (GovAction era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"GovAction" ((Word -> Decode 'Open (GovAction era))
 -> Decode ('Closed 'Dense) (GovAction era))
-> (Word -> Decode 'Open (GovAction era))
-> Decode ('Closed 'Dense) (GovAction era)
forall a b. (a -> b) -> a -> b
$ \case
      Word
0 ->
        (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
 -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
      -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange
          Decode
  'Open
  (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
   -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Decode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> Decode
     'Open
     (PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)))
-> Decode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovPurposeId 'PParamUpdatePurpose era)
-> Decoder s (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (GovPurposeId 'PParamUpdatePurpose era)
forall s. Decoder s (GovPurposeId 'PParamUpdatePurpose era)
forall a s. DecCBOR a => Decoder s a
decCBOR)
          Decode
  'Open
  (PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Decode ('Closed Any) (PParamsUpdate era)
-> Decode 'Open (StrictMaybe ScriptHash -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PParamsUpdate era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
          Decode 'Open (StrictMaybe ScriptHash -> GovAction era)
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe ScriptHash))
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s ScriptHash -> Decoder s (StrictMaybe ScriptHash)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR)
      Word
1 -> (StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> ProtVer -> GovAction era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose era)
      -> ProtVer -> GovAction era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation Decode
  'Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose era)
   -> ProtVer -> GovAction era)
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> Decode 'Open (ProtVer -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (StrictMaybe (GovPurposeId 'HardForkPurpose era)))
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovPurposeId 'HardForkPurpose era)
-> Decoder s (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (GovPurposeId 'HardForkPurpose era)
forall s. Decoder s (GovPurposeId 'HardForkPurpose era)
forall a s. DecCBOR a => Decoder s a
decCBOR) Decode 'Open (ProtVer -> GovAction era)
-> Decode ('Closed Any) ProtVer -> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
-> Decode
     'Open
     (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
forall t. t -> Decode 'Open t
SumD Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals Decode
  'Open
  (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
-> Decode ('Closed Any) (Map RewardAccount Coin)
-> Decode 'Open (StrictMaybe ScriptHash -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map RewardAccount Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (StrictMaybe ScriptHash -> GovAction era)
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe ScriptHash))
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s ScriptHash -> Decoder s (StrictMaybe ScriptHash)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR)
      Word
3 -> (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence Decode
  'Open
  (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovPurposeId 'CommitteePurpose era)
-> Decoder s (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (GovPurposeId 'CommitteePurpose era)
forall s. Decoder s (GovPurposeId 'CommitteePurpose era)
forall a s. DecCBOR a => Decoder s a
decCBOR)
      Word
4 -> (StrictMaybe (GovPurposeId 'CommitteePurpose era)
 -> Set (Credential 'ColdCommitteeRole)
 -> Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval
 -> GovAction era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'CommitteePurpose era)
      -> Set (Credential 'ColdCommitteeRole)
      -> Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval
      -> GovAction era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee Decode
  'Open
  (StrictMaybe (GovPurposeId 'CommitteePurpose era)
   -> Set (Credential 'ColdCommitteeRole)
   -> Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval
   -> GovAction era)
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Decode
     'Open
     (Set (Credential 'ColdCommitteeRole)
      -> Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval
      -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (StrictMaybe (GovPurposeId 'CommitteePurpose era)))
-> Decode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovPurposeId 'CommitteePurpose era)
-> Decoder s (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (GovPurposeId 'CommitteePurpose era)
forall s. Decoder s (GovPurposeId 'CommitteePurpose era)
forall a s. DecCBOR a => Decoder s a
decCBOR) Decode
  'Open
  (Set (Credential 'ColdCommitteeRole)
   -> Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval
   -> GovAction era)
-> Decode ('Closed Any) (Set (Credential 'ColdCommitteeRole))
-> Decode
     'Open
     (Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set (Credential 'ColdCommitteeRole))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode
  'Open
  (Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval -> GovAction era)
-> Decode
     ('Closed Any) (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Decode 'Open (UnitInterval -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (Credential 'ColdCommitteeRole) EpochNo)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (UnitInterval -> GovAction era)
-> Decode ('Closed Any) UnitInterval
-> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
5 -> (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> Constitution era -> GovAction era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
      -> Constitution era -> GovAction era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution Decode
  'Open
  (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
   -> Constitution era -> GovAction era)
-> Decode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> Decode 'Open (Constitution era -> GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s.
 Decoder s (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)))
-> Decode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s (GovPurposeId 'ConstitutionPurpose era)
-> Decoder s (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s (GovPurposeId 'ConstitutionPurpose era)
forall s. Decoder s (GovPurposeId 'ConstitutionPurpose era)
forall a s. DecCBOR a => Decoder s a
decCBOR) Decode 'Open (Constitution era -> GovAction era)
-> Decode ('Closed Any) (Constitution era)
-> Decode 'Open (GovAction era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Constitution era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
6 -> GovAction era -> Decode 'Open (GovAction era)
forall t. t -> Decode 'Open t
SumD GovAction era
forall era. GovAction era
InfoAction
      Word
k -> Word -> Decode 'Open (GovAction era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k
  {-# INLINE decCBOR #-}

instance EraPParams era => EncCBOR (GovAction era) where
  encCBOR :: GovAction era -> Encoding
encCBOR =
    Encode 'Open (GovAction era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (GovAction era) -> Encoding)
-> (GovAction era -> Encode 'Open (GovAction era))
-> GovAction era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
gid PParamsUpdate era
ppup StrictMaybe ScriptHash
pol ->
        (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
 -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
      -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange Word
0
          Encode
  'Open
  (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
   -> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
-> Encode
     'Open
     (PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era) -> Encoding)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((GovPurposeId 'PParamUpdatePurpose era -> Encoding)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe GovPurposeId 'PParamUpdatePurpose era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
gid
          Encode
  'Open
  (PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Encode ('Closed 'Dense) (PParamsUpdate era)
-> Encode 'Open (StrictMaybe ScriptHash -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParamsUpdate era -> Encode ('Closed 'Dense) (PParamsUpdate era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParamsUpdate era
ppup
          Encode 'Open (StrictMaybe ScriptHash -> GovAction era)
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe ScriptHash -> Encoding)
-> StrictMaybe ScriptHash
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((ScriptHash -> Encoding) -> StrictMaybe ScriptHash -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe ScriptHash
pol
      HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
gid ProtVer
pv ->
        (StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> ProtVer -> GovAction era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose era)
      -> ProtVer -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation Word
1 Encode
  'Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose era)
   -> ProtVer -> GovAction era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> Encode 'Open (ProtVer -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (GovPurposeId 'HardForkPurpose era) -> Encoding)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((GovPurposeId 'HardForkPurpose era -> Encoding)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe GovPurposeId 'HardForkPurpose era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe (GovPurposeId 'HardForkPurpose era)
gid Encode 'Open (ProtVer -> GovAction era)
-> Encode ('Closed 'Dense) ProtVer -> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ProtVer -> Encode ('Closed 'Dense) ProtVer
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProtVer
pv
      TreasuryWithdrawals Map RewardAccount Coin
ws StrictMaybe ScriptHash
pol ->
        (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
-> Word
-> Encode
     'Open
     (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals Word
2 Encode
  'Open
  (Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era)
-> Encode ('Closed 'Dense) (Map RewardAccount Coin)
-> Encode 'Open (StrictMaybe ScriptHash -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map RewardAccount Coin
-> Encode ('Closed 'Dense) (Map RewardAccount Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map RewardAccount Coin
ws Encode 'Open (StrictMaybe ScriptHash -> GovAction era)
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe ScriptHash -> Encoding)
-> StrictMaybe ScriptHash
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((ScriptHash -> Encoding) -> StrictMaybe ScriptHash -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe ScriptHash
pol
      NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
gid ->
        (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence Word
3 Encode
  'Open
  (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> Encoding)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((GovPurposeId 'CommitteePurpose era -> Encoding)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe GovPurposeId 'CommitteePurpose era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe (GovPurposeId 'CommitteePurpose era)
gid
      UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
gid Set (Credential 'ColdCommitteeRole)
old Map (Credential 'ColdCommitteeRole) EpochNo
new UnitInterval
q ->
        (StrictMaybe (GovPurposeId 'CommitteePurpose era)
 -> Set (Credential 'ColdCommitteeRole)
 -> Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval
 -> GovAction era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'CommitteePurpose era)
      -> Set (Credential 'ColdCommitteeRole)
      -> Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval
      -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee Word
4 Encode
  'Open
  (StrictMaybe (GovPurposeId 'CommitteePurpose era)
   -> Set (Credential 'ColdCommitteeRole)
   -> Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval
   -> GovAction era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Encode
     'Open
     (Set (Credential 'ColdCommitteeRole)
      -> Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval
      -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> Encoding)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'CommitteePurpose era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((GovPurposeId 'CommitteePurpose era -> Encoding)
-> StrictMaybe (GovPurposeId 'CommitteePurpose era) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe GovPurposeId 'CommitteePurpose era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe (GovPurposeId 'CommitteePurpose era)
gid Encode
  'Open
  (Set (Credential 'ColdCommitteeRole)
   -> Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval
   -> GovAction era)
-> Encode ('Closed 'Dense) (Set (Credential 'ColdCommitteeRole))
-> Encode
     'Open
     (Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set (Credential 'ColdCommitteeRole)
-> Encode ('Closed 'Dense) (Set (Credential 'ColdCommitteeRole))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (Credential 'ColdCommitteeRole)
old Encode
  'Open
  (Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval -> GovAction era)
-> Encode
     ('Closed 'Dense) (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Encode 'Open (UnitInterval -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (Credential 'ColdCommitteeRole) EpochNo
-> Encode
     ('Closed 'Dense) (Map (Credential 'ColdCommitteeRole) EpochNo)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'ColdCommitteeRole) EpochNo
new Encode 'Open (UnitInterval -> GovAction era)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
q
      NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
gid Constitution era
c ->
        (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
 -> Constitution era -> GovAction era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
      -> Constitution era -> GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution Word
5 Encode
  'Open
  (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
   -> Constitution era -> GovAction era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
-> Encode 'Open (Constitution era -> GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe (GovPurposeId 'ConstitutionPurpose era) -> Encoding)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (GovPurposeId 'ConstitutionPurpose era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((GovPurposeId 'ConstitutionPurpose era -> Encoding)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe GovPurposeId 'ConstitutionPurpose era -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
gid Encode 'Open (Constitution era -> GovAction era)
-> Encode ('Closed 'Dense) (Constitution era)
-> Encode 'Open (GovAction era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Constitution era -> Encode ('Closed 'Dense) (Constitution era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Constitution era
c
      GovAction era
InfoAction ->
        GovAction era -> Word -> Encode 'Open (GovAction era)
forall t. t -> Word -> Encode 'Open t
Sum GovAction era
forall era. GovAction era
InfoAction Word
6

data Constitution era = Constitution
  { forall era. Constitution era -> Anchor
constitutionAnchor :: !Anchor
  , forall era. Constitution era -> StrictMaybe ScriptHash
constitutionScript :: !(StrictMaybe ScriptHash)
  }
  deriving ((forall x. Constitution era -> Rep (Constitution era) x)
-> (forall x. Rep (Constitution era) x -> Constitution era)
-> Generic (Constitution era)
forall x. Rep (Constitution era) x -> Constitution era
forall x. Constitution era -> Rep (Constitution era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Constitution era) x -> Constitution era
forall era x. Constitution era -> Rep (Constitution era) x
$cfrom :: forall era x. Constitution era -> Rep (Constitution era) x
from :: forall x. Constitution era -> Rep (Constitution era) x
$cto :: forall era x. Rep (Constitution era) x -> Constitution era
to :: forall x. Rep (Constitution era) x -> Constitution era
Generic, Eq (Constitution era)
Eq (Constitution era) =>
(Constitution era -> Constitution era -> Ordering)
-> (Constitution era -> Constitution era -> Bool)
-> (Constitution era -> Constitution era -> Bool)
-> (Constitution era -> Constitution era -> Bool)
-> (Constitution era -> Constitution era -> Bool)
-> (Constitution era -> Constitution era -> Constitution era)
-> (Constitution era -> Constitution era -> Constitution era)
-> Ord (Constitution era)
Constitution era -> Constitution era -> Bool
Constitution era -> Constitution era -> Ordering
Constitution era -> Constitution era -> Constitution era
forall era. Eq (Constitution 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. Constitution era -> Constitution era -> Bool
forall era. Constitution era -> Constitution era -> Ordering
forall era.
Constitution era -> Constitution era -> Constitution era
$ccompare :: forall era. Constitution era -> Constitution era -> Ordering
compare :: Constitution era -> Constitution era -> Ordering
$c< :: forall era. Constitution era -> Constitution era -> Bool
< :: Constitution era -> Constitution era -> Bool
$c<= :: forall era. Constitution era -> Constitution era -> Bool
<= :: Constitution era -> Constitution era -> Bool
$c> :: forall era. Constitution era -> Constitution era -> Bool
> :: Constitution era -> Constitution era -> Bool
$c>= :: forall era. Constitution era -> Constitution era -> Bool
>= :: Constitution era -> Constitution era -> Bool
$cmax :: forall era.
Constitution era -> Constitution era -> Constitution era
max :: Constitution era -> Constitution era -> Constitution era
$cmin :: forall era.
Constitution era -> Constitution era -> Constitution era
min :: Constitution era -> Constitution era -> Constitution era
Ord)

constitutionAnchorL :: Lens' (Constitution era) Anchor
constitutionAnchorL :: forall era (f :: * -> *).
Functor f =>
(Anchor -> f Anchor) -> Constitution era -> f (Constitution era)
constitutionAnchorL = (Constitution era -> Anchor)
-> (Constitution era -> Anchor -> Constitution era)
-> Lens (Constitution era) (Constitution era) Anchor Anchor
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Constitution era -> Anchor
forall era. Constitution era -> Anchor
constitutionAnchor (\Constitution era
x Anchor
y -> Constitution era
x {constitutionAnchor = y})

constitutionScriptL :: Lens' (Constitution era) (StrictMaybe ScriptHash)
constitutionScriptL :: forall era (f :: * -> *).
Functor f =>
(StrictMaybe ScriptHash -> f (StrictMaybe ScriptHash))
-> Constitution era -> f (Constitution era)
constitutionScriptL = (Constitution era -> StrictMaybe ScriptHash)
-> (Constitution era -> StrictMaybe ScriptHash -> Constitution era)
-> Lens
     (Constitution era)
     (Constitution era)
     (StrictMaybe ScriptHash)
     (StrictMaybe ScriptHash)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Constitution era -> StrictMaybe ScriptHash
forall era. Constitution era -> StrictMaybe ScriptHash
constitutionScript (\Constitution era
x StrictMaybe ScriptHash
y -> Constitution era
x {constitutionScript = y})

instance Era era => ToJSON (Constitution era) where
  toJSON :: Constitution era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (Constitution era -> [Pair]) -> Constitution era -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constitution era -> [Pair]
forall e a era. KeyValue e a => Constitution era -> [a]
toConstitutionPairs
  toEncoding :: Constitution era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (Constitution era -> Series) -> Constitution era -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (Constitution era -> [Series]) -> Constitution era -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constitution era -> [Series]
forall e a era. KeyValue e a => Constitution era -> [a]
toConstitutionPairs

instance Era era => FromJSON (Constitution era) where
  parseJSON :: Value -> Parser (Constitution era)
parseJSON = String
-> (Object -> Parser (Constitution era))
-> Value
-> Parser (Constitution era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Constitution" ((Object -> Parser (Constitution era))
 -> Value -> Parser (Constitution era))
-> (Object -> Parser (Constitution era))
-> Value
-> Parser (Constitution era)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Anchor -> StrictMaybe ScriptHash -> Constitution era
forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution
      (Anchor -> StrictMaybe ScriptHash -> Constitution era)
-> Parser Anchor
-> Parser (StrictMaybe ScriptHash -> Constitution era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Anchor
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"anchor"
      Parser (StrictMaybe ScriptHash -> Constitution era)
-> Parser (StrictMaybe ScriptHash) -> Parser (Constitution era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe ScriptHash -> StrictMaybe ScriptHash
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe ScriptHash -> StrictMaybe ScriptHash)
-> Parser (Maybe ScriptHash) -> Parser (StrictMaybe ScriptHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe ScriptHash)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"script"))

toConstitutionPairs :: KeyValue e a => Constitution era -> [a]
toConstitutionPairs :: forall e a era. KeyValue e a => Constitution era -> [a]
toConstitutionPairs c :: Constitution era
c@(Constitution Anchor
_ StrictMaybe ScriptHash
_) =
  let Constitution {StrictMaybe ScriptHash
Anchor
constitutionAnchor :: forall era. Constitution era -> Anchor
constitutionScript :: forall era. Constitution era -> StrictMaybe ScriptHash
constitutionAnchor :: Anchor
constitutionScript :: StrictMaybe ScriptHash
..} = Constitution era
c
   in [Key
"anchor" Key -> Anchor -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Anchor
constitutionAnchor]
        [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [Key
"script" Key -> ScriptHash -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
cScript | SJust ScriptHash
cScript <- [StrictMaybe ScriptHash
constitutionScript]]

deriving instance Eq (Constitution era)

deriving instance Show (Constitution era)

instance Era era => Default (Constitution era) where
  def :: Constitution era
def = Anchor -> StrictMaybe ScriptHash -> Constitution era
forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution Anchor
forall a. Default a => a
def StrictMaybe ScriptHash
forall a. Default a => a
def

instance Era era => DecCBOR (Constitution era) where
  decCBOR :: forall s. Decoder s (Constitution era)
decCBOR =
    Decode ('Closed 'Dense) (Constitution era)
-> Decoder s (Constitution era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Constitution era)
 -> Decoder s (Constitution era))
-> Decode ('Closed 'Dense) (Constitution era)
-> Decoder s (Constitution era)
forall a b. (a -> b) -> a -> b
$
      (Anchor -> StrictMaybe ScriptHash -> Constitution era)
-> Decode
     ('Closed 'Dense)
     (Anchor -> StrictMaybe ScriptHash -> Constitution era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Anchor -> StrictMaybe ScriptHash -> Constitution era
forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution
        Decode
  ('Closed 'Dense)
  (Anchor -> StrictMaybe ScriptHash -> Constitution era)
-> Decode ('Closed Any) Anchor
-> Decode
     ('Closed 'Dense) (StrictMaybe ScriptHash -> Constitution era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Anchor
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense) (StrictMaybe ScriptHash -> Constitution era)
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Decode ('Closed 'Dense) (Constitution era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s (StrictMaybe ScriptHash))
-> Decode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Decoder s ScriptHash -> Decoder s (StrictMaybe ScriptHash)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe Decoder s ScriptHash
forall s. Decoder s ScriptHash
forall a s. DecCBOR a => Decoder s a
decCBOR)

instance Era era => EncCBOR (Constitution era) where
  encCBOR :: Constitution era -> Encoding
encCBOR Constitution {StrictMaybe ScriptHash
Anchor
constitutionAnchor :: forall era. Constitution era -> Anchor
constitutionScript :: forall era. Constitution era -> StrictMaybe ScriptHash
constitutionAnchor :: Anchor
constitutionScript :: StrictMaybe ScriptHash
..} =
    Encode ('Closed 'Dense) (Constitution era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (Constitution era) -> Encoding)
-> Encode ('Closed 'Dense) (Constitution era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Anchor -> StrictMaybe ScriptHash -> Constitution era)
-> Encode
     ('Closed 'Dense)
     (Anchor -> StrictMaybe ScriptHash -> Constitution era)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era. Anchor -> StrictMaybe ScriptHash -> Constitution era
Constitution @era)
        Encode
  ('Closed 'Dense)
  (Anchor -> StrictMaybe ScriptHash -> Constitution era)
-> Encode ('Closed 'Dense) Anchor
-> Encode
     ('Closed 'Dense) (StrictMaybe ScriptHash -> Constitution era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Anchor -> Encode ('Closed 'Dense) Anchor
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Anchor
constitutionAnchor
        Encode
  ('Closed 'Dense) (StrictMaybe ScriptHash -> Constitution era)
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Encode ('Closed 'Dense) (Constitution era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictMaybe ScriptHash -> Encoding)
-> StrictMaybe ScriptHash
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ((ScriptHash -> Encoding) -> StrictMaybe ScriptHash -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe ScriptHash -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR) StrictMaybe ScriptHash
constitutionScript

instance Era era => ToCBOR (Constitution era) where
  toCBOR :: Constitution era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance Era era => FromCBOR (Constitution era) where
  fromCBOR :: forall s. Decoder s (Constitution era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

instance Era era => NFData (Constitution era)

instance Era era => NoThunks (Constitution era)