{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Api.Internal.Governance.Actions.ProposalProcedure where

import Cardano.Api.Internal.Address
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.HasTypeProxy
import Cardano.Api.Internal.ProtocolParameters
import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
import Cardano.Api.Internal.Serialise.Cbor
import Cardano.Api.Internal.SerialiseTextEnvelope
import Cardano.Api.Internal.TxIn

import Cardano.Binary qualified as CBOR
import Cardano.Ledger.Address qualified as L
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Conway.Governance qualified as Gov
import Cardano.Ledger.Conway.Governance qualified as Ledger
import Cardano.Ledger.Core qualified as Shelley
import Cardano.Ledger.Credential qualified as L
import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole))

import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Type.Equality (TestEquality (..))
import Data.Typeable
import Data.Word
import GHC.Exts (IsList (..))

data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era)

-- TODO: Conway - Transitiion to Ledger.GovAction
data GovernanceAction era
  = MotionOfNoConfidence
      (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
  | ProposeNewConstitution
      (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era)))
      Ledger.Anchor
      (StrictMaybe Shelley.ScriptHash)
  | ProposeNewCommittee
      (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
      [L.Credential ColdCommitteeRole]
      -- ^ Old constitutional committee
      (Map (L.Credential ColdCommitteeRole) EpochNo)
      -- ^ New committee members with epoch number when each of them expires
      Rational
      -- ^ Quorum of the committee that is necessary for a successful vote
  | InfoAct
  | -- | Governance policy
    TreasuryWithdrawal
      [(Network, StakeCredential, L.Coin)]
      !(StrictMaybe Shelley.ScriptHash)
  | InitiateHardfork
      (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era)))
      ProtVer
  | -- | Governance policy
    UpdatePParams
      (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era)))
      (Ledger.PParamsUpdate (ShelleyLedgerEra era))
      !(StrictMaybe Shelley.ScriptHash)

toGovernanceAction
  :: ()
  => ShelleyBasedEra era
  -> GovernanceAction era
  -> Gov.GovAction (ShelleyLedgerEra era)
toGovernanceAction :: forall era.
ShelleyBasedEra era
-> GovernanceAction era -> GovAction (ShelleyLedgerEra era)
toGovernanceAction ShelleyBasedEra era
sbe =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    GovernanceAction era -> GovAction (ShelleyLedgerEra era))
-> GovernanceAction era
-> GovAction (ShelleyLedgerEra era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  GovernanceAction era -> GovAction (ShelleyLedgerEra era))
 -> GovernanceAction era -> GovAction (ShelleyLedgerEra era))
-> (ShelleyBasedEraConstraints era =>
    GovernanceAction era -> GovAction (ShelleyLedgerEra era))
-> GovernanceAction era
-> GovAction (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ \case
    MotionOfNoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId ->
      StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
Gov.NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId
    ProposeNewConstitution StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovAction Anchor
anchor StrictMaybe ScriptHash
mConstitutionScriptHash ->
      StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Constitution (ShelleyLedgerEra era)
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
Gov.NewConstitution
        StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovAction
        Gov.Constitution
          { constitutionAnchor :: Anchor
Gov.constitutionAnchor = Anchor
anchor
          , constitutionScript :: StrictMaybe ScriptHash
Gov.constitutionScript = StrictMaybe ScriptHash
mConstitutionScriptHash
          }
    ProposeNewCommittee StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId [Credential 'ColdCommitteeRole]
oldCommitteeMembers Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteeMembers Rational
quor ->
      StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
Gov.UpdateCommittee
        StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId -- previous governance action id
        ([Item (Set (Credential 'ColdCommitteeRole))]
-> Set (Credential 'ColdCommitteeRole)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (Credential 'ColdCommitteeRole))]
[Credential 'ColdCommitteeRole]
oldCommitteeMembers) -- members to remove
        Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteeMembers -- members to add
        ( UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe
            ( [Char] -> UnitInterval
forall a. HasCallStack => [Char] -> a
error ([Char] -> UnitInterval) -> [Char] -> UnitInterval
forall a b. (a -> b) -> a -> b
$
                [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
                  [ [Char]
"toGovernanceAction: the given quorum "
                  , Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
quor
                  , [Char]
" was outside of the unit interval!"
                  ]
            )
            (Maybe UnitInterval -> UnitInterval)
-> Maybe UnitInterval -> UnitInterval
forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational @UnitInterval Rational
quor
        )
    GovernanceAction era
InfoAct ->
      GovAction (ShelleyLedgerEra era)
forall era. GovAction era
Gov.InfoAction
    TreasuryWithdrawal [(Network, StakeCredential, Coin)]
withdrawals StrictMaybe ScriptHash
govPol ->
      let m :: Map RewardAccount Coin
m = [Item (Map RewardAccount Coin)] -> Map RewardAccount Coin
forall l. IsList l => [Item l] -> l
fromList [(Network -> Credential 'Staking -> RewardAccount
L.RewardAccount Network
nw (StakeCredential -> Credential 'Staking
toShelleyStakeCredential StakeCredential
sc), Coin
l) | (Network
nw, StakeCredential
sc, Coin
l) <- [(Network, StakeCredential, Coin)]
withdrawals]
       in Map RewardAccount Coin
-> StrictMaybe ScriptHash -> GovAction (ShelleyLedgerEra era)
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
Gov.TreasuryWithdrawals Map RewardAccount Coin
m StrictMaybe ScriptHash
govPol
    InitiateHardfork StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
prevGovId ProtVer
pVer ->
      StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> ProtVer -> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
Gov.HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
prevGovId ProtVer
pVer
    UpdatePParams StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
preGovId PParamsUpdate (ShelleyLedgerEra era)
ppup StrictMaybe ScriptHash
govPol ->
      StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
Gov.ParameterChange StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
preGovId PParamsUpdate (ShelleyLedgerEra era)
ppup StrictMaybe ScriptHash
govPol

fromGovernanceAction
  :: Gov.GovAction (ShelleyLedgerEra era)
  -> GovernanceAction era
fromGovernanceAction :: forall era.
GovAction (ShelleyLedgerEra era) -> GovernanceAction era
fromGovernanceAction = \case
  Gov.NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId ->
    StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era
MotionOfNoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId
  Gov.NewConstitution StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovId Constitution (ShelleyLedgerEra era)
constitution ->
    StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
ProposeNewConstitution
      StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovId
      (Constitution (ShelleyLedgerEra era) -> Anchor
forall era. Constitution era -> Anchor
Gov.constitutionAnchor Constitution (ShelleyLedgerEra era)
constitution)
      (Constitution (ShelleyLedgerEra era) -> StrictMaybe ScriptHash
forall era. Constitution era -> StrictMaybe ScriptHash
Gov.constitutionScript Constitution (ShelleyLedgerEra era)
constitution)
  Gov.ParameterChange StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovId PParamsUpdate (ShelleyLedgerEra era)
pparams StrictMaybe ScriptHash
govPolicy ->
    StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
UpdatePParams StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovId PParamsUpdate (ShelleyLedgerEra era)
pparams StrictMaybe ScriptHash
govPolicy
  Gov.HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
prevGovId ProtVer
pVer ->
    StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> ProtVer -> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> ProtVer -> GovernanceAction era
InitiateHardfork StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
prevGovId ProtVer
pVer
  Gov.TreasuryWithdrawals Map RewardAccount Coin
withdrawlMap StrictMaybe ScriptHash
govPolicy ->
    let res :: [(Network, StakeCredential, Coin)]
res =
          [ (RewardAccount -> Network
L.raNetwork RewardAccount
rwdAcnt, Credential 'Staking -> StakeCredential
fromShelleyStakeCredential (RewardAccount -> Credential 'Staking
L.raCredential RewardAccount
rwdAcnt), Coin
coin)
          | (RewardAccount
rwdAcnt, Coin
coin) <- Map RewardAccount Coin -> [Item (Map RewardAccount Coin)]
forall l. IsList l => l -> [Item l]
toList Map RewardAccount Coin
withdrawlMap
          ]
     in [(Network, StakeCredential, Coin)]
-> StrictMaybe ScriptHash -> GovernanceAction era
forall era.
[(Network, StakeCredential, Coin)]
-> StrictMaybe ScriptHash -> GovernanceAction era
TreasuryWithdrawal [(Network, StakeCredential, Coin)]
res StrictMaybe ScriptHash
govPolicy
  Gov.UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId Set (Credential 'ColdCommitteeRole)
oldCommitteeMembers Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteeMembers UnitInterval
quor ->
    StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> [Credential 'ColdCommitteeRole]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> [Credential 'ColdCommitteeRole]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
ProposeNewCommittee
      StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId
      (Set (Credential 'ColdCommitteeRole)
-> [Item (Set (Credential 'ColdCommitteeRole))]
forall l. IsList l => l -> [Item l]
toList Set (Credential 'ColdCommitteeRole)
oldCommitteeMembers)
      Map (Credential 'ColdCommitteeRole) EpochNo
newCommitteeMembers
      (UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
unboundRational UnitInterval
quor)
  GovAction (ShelleyLedgerEra era)
Gov.InfoAction ->
    GovernanceAction era
forall era. GovernanceAction era
InfoAct

data Proposal era where
  Proposal :: Typeable era => Gov.ProposalProcedure (ShelleyLedgerEra era) -> Proposal era

instance TestEquality Proposal where
  testEquality :: forall a b. Proposal a -> Proposal b -> Maybe (a :~: b)
testEquality (Proposal ProposalProcedure (ShelleyLedgerEra a)
v) (Proposal ProposalProcedure (ShelleyLedgerEra b)
v') =
    ProposalProcedure (ShelleyLedgerEra a)
-> ProposalProcedure (ShelleyLedgerEra b) -> Maybe (a :~: b)
forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ProposalProcedure (ShelleyLedgerEra eraA)
-> ProposalProcedure (ShelleyLedgerEra eraB)
-> Maybe (eraA :~: eraB)
proposalTypeEquality ProposalProcedure (ShelleyLedgerEra a)
v ProposalProcedure (ShelleyLedgerEra b)
v'

proposalTypeEquality
  :: (Typeable eraA, Typeable eraB)
  => Gov.ProposalProcedure (ShelleyLedgerEra eraA)
  -> Gov.ProposalProcedure (ShelleyLedgerEra eraB)
  -> Maybe (eraA :~: eraB)
proposalTypeEquality :: forall eraA eraB.
(Typeable eraA, Typeable eraB) =>
ProposalProcedure (ShelleyLedgerEra eraA)
-> ProposalProcedure (ShelleyLedgerEra eraB)
-> Maybe (eraA :~: eraB)
proposalTypeEquality ProposalProcedure (ShelleyLedgerEra eraA)
_ ProposalProcedure (ShelleyLedgerEra eraB)
_ = Maybe (eraA :~: eraB)
forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT

instance IsShelleyBasedEra era => Show (Proposal era) where
  show :: Proposal era -> [Char]
show (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp) = do
    let ppStr :: [Char]
ppStr = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => [Char]) -> [Char]
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => [Char]) -> [Char])
-> (ShelleyBasedEraConstraints era => [Char]) -> [Char]
forall a b. (a -> b) -> a -> b
$ ProposalProcedure (ShelleyLedgerEra era) -> [Char]
forall a. Show a => a -> [Char]
show ProposalProcedure (ShelleyLedgerEra era)
pp
    [Char]
"Proposal " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ppStr [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"

instance IsShelleyBasedEra era => Eq (Proposal era) where
  (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp1) == :: Proposal era -> Proposal era -> Bool
== (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp2) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Bool) -> Bool)
-> (ShelleyBasedEraConstraints era => Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ProposalProcedure (ShelleyLedgerEra era)
pp1 ProposalProcedure (ShelleyLedgerEra era)
-> ProposalProcedure (ShelleyLedgerEra era) -> Bool
forall a. Eq a => a -> a -> Bool
== ProposalProcedure (ShelleyLedgerEra era)
pp2

instance IsShelleyBasedEra era => Ord (Proposal era) where
  compare :: Proposal era -> Proposal era -> Ordering
compare (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp1) (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp2) =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Ordering) -> Ordering
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Ordering) -> Ordering)
-> (ShelleyBasedEraConstraints era => Ordering) -> Ordering
forall a b. (a -> b) -> a -> b
$ ProposalProcedure (ShelleyLedgerEra era)
-> ProposalProcedure (ShelleyLedgerEra era) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ProposalProcedure (ShelleyLedgerEra era)
pp1 ProposalProcedure (ShelleyLedgerEra era)
pp2

instance IsShelleyBasedEra era => ToCBOR (Proposal era) where
  toCBOR :: Proposal era -> Encoding
toCBOR (Proposal ProposalProcedure (ShelleyLedgerEra era)
vp) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Encoding) -> Encoding)
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall a b. (a -> b) -> a -> b
$ forall era t. (Era era, EncCBOR t) => t -> Encoding
Shelley.toEraCBOR @(ShelleyLedgerEra era) ProposalProcedure (ShelleyLedgerEra era)
vp

instance IsShelleyBasedEra era => FromCBOR (Proposal era) where
  fromCBOR :: forall s. Decoder s (Proposal era)
fromCBOR =
    ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
forall era.
Typeable era =>
ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
Proposal
      (ProposalProcedure (ShelleyLedgerEra era) -> Proposal era)
-> Decoder s (ProposalProcedure (ShelleyLedgerEra era))
-> Decoder s (Proposal era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Decoder s (ProposalProcedure (ShelleyLedgerEra era)))
-> Decoder s (ProposalProcedure (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) (forall era t s. (Era era, DecCBOR t) => Decoder s t
Shelley.fromEraCBOR @(ShelleyLedgerEra era))

instance IsShelleyBasedEra era => SerialiseAsCBOR (Proposal era) where
  serialiseToCBOR :: Proposal era -> ByteString
serialiseToCBOR = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Proposal era -> ByteString)
-> Proposal era
-> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era => Proposal era -> ByteString
Proposal era -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromCBOR :: AsType (Proposal era)
-> ByteString -> Either DecoderError (Proposal era)
deserialiseFromCBOR AsType (Proposal era)
_proxy = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ByteString -> Either DecoderError (Proposal era))
-> ByteString
-> Either DecoderError (Proposal era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era =>
ByteString -> Either DecoderError (Proposal era)
ByteString -> Either DecoderError (Proposal era)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance IsShelleyBasedEra era => HasTextEnvelope (Proposal era) where
  textEnvelopeType :: AsType (Proposal era) -> TextEnvelopeType
textEnvelopeType AsType (Proposal era)
_ = TextEnvelopeType
"Governance proposal"

instance HasTypeProxy era => HasTypeProxy (Proposal era) where
  data AsType (Proposal era) = AsProposal
  proxyToAsType :: Proxy (Proposal era) -> AsType (Proposal era)
proxyToAsType Proxy (Proposal era)
_ = AsType (Proposal era)
forall era. AsType (Proposal era)
AsProposal

createProposalProcedure
  :: ShelleyBasedEra era
  -> Network
  -> L.Coin
  -- ^ Deposit
  -> StakeCredential
  -- ^ Credential to return the deposit to.
  -> GovernanceAction era
  -> Ledger.Anchor
  -> Proposal era
createProposalProcedure :: forall era.
ShelleyBasedEra era
-> Network
-> Coin
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
nw Coin
dep StakeCredential
cred GovernanceAction era
govAct Anchor
anchor =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Proposal era) -> Proposal era
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Proposal era) -> Proposal era)
-> (ShelleyBasedEraConstraints era => Proposal era) -> Proposal era
forall a b. (a -> b) -> a -> b
$
    ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
forall era.
Typeable era =>
ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
Proposal
      Gov.ProposalProcedure
        { pProcDeposit :: Coin
Gov.pProcDeposit = Coin
dep
        , pProcReturnAddr :: RewardAccount
Gov.pProcReturnAddr = Network -> Credential 'Staking -> RewardAccount
L.RewardAccount Network
nw (Credential 'Staking -> RewardAccount)
-> Credential 'Staking -> RewardAccount
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Credential 'Staking
toShelleyStakeCredential StakeCredential
cred
        , pProcGovAction :: GovAction (ShelleyLedgerEra era)
Gov.pProcGovAction = ShelleyBasedEra era
-> GovernanceAction era -> GovAction (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> GovernanceAction era -> GovAction (ShelleyLedgerEra era)
toGovernanceAction ShelleyBasedEra era
sbe GovernanceAction era
govAct
        , pProcAnchor :: Anchor
Gov.pProcAnchor = Anchor
anchor
        }

fromProposalProcedure
  :: ShelleyBasedEra era
  -> Proposal era
  -> (L.Coin, StakeCredential, GovernanceAction era)
fromProposalProcedure :: forall era.
ShelleyBasedEra era
-> Proposal era -> (Coin, StakeCredential, GovernanceAction era)
fromProposalProcedure ShelleyBasedEra era
sbe (Proposal ProposalProcedure (ShelleyLedgerEra era)
pp) =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    (Coin, StakeCredential, GovernanceAction era))
-> (Coin, StakeCredential, GovernanceAction era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints
    ShelleyBasedEra era
sbe
    ( ProposalProcedure (ShelleyLedgerEra era) -> Coin
forall era. ProposalProcedure era -> Coin
Gov.pProcDeposit ProposalProcedure (ShelleyLedgerEra era)
pp
    , Credential 'Staking -> StakeCredential
fromShelleyStakeCredential (RewardAccount -> Credential 'Staking
L.raCredential (ProposalProcedure (ShelleyLedgerEra era) -> RewardAccount
forall era. ProposalProcedure era -> RewardAccount
Gov.pProcReturnAddr ProposalProcedure (ShelleyLedgerEra era)
pp))
    , GovAction (ShelleyLedgerEra era) -> GovernanceAction era
forall era.
GovAction (ShelleyLedgerEra era) -> GovernanceAction era
fromGovernanceAction (ProposalProcedure (ShelleyLedgerEra era)
-> GovAction (ShelleyLedgerEra era)
forall era. ProposalProcedure era -> GovAction era
Gov.pProcGovAction ProposalProcedure (ShelleyLedgerEra era)
pp)
    )

createGovernanceActionId :: TxId -> Word16 -> Gov.GovActionId
createGovernanceActionId :: TxId -> Word16 -> GovActionId
createGovernanceActionId TxId
txid Word16
index =
  Ledger.GovActionId
    { gaidTxId :: TxId
Ledger.gaidTxId = TxId -> TxId
toShelleyTxId TxId
txid
    , gaidGovActionIx :: GovActionIx
Ledger.gaidGovActionIx = Word16 -> GovActionIx
Ledger.GovActionIx Word16
index
    }

createAnchor :: Url -> ByteString -> Anchor
createAnchor :: Url -> ByteString -> Anchor
createAnchor Url
url ByteString
anchorData =
  Ledger.Anchor
    { anchorUrl :: Url
anchorUrl = Url
url
    , anchorDataHash :: SafeHash AnchorData
anchorDataHash = AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
Shelley.hashAnnotated (AnchorData -> SafeHash AnchorData)
-> AnchorData -> SafeHash AnchorData
forall a b. (a -> b) -> a -> b
$ ByteString -> AnchorData
Ledger.AnchorData ByteString
anchorData
    }

-- | Get anchor data url and hash from a governance action. A return value of `Nothing`
-- means that the governance action does not contain anchor data.
getAnchorDataFromGovernanceAction
  :: Gov.GovAction (ShelleyLedgerEra era)
  -> Maybe Ledger.Anchor
getAnchorDataFromGovernanceAction :: forall era. GovAction (ShelleyLedgerEra era) -> Maybe Anchor
getAnchorDataFromGovernanceAction GovAction (ShelleyLedgerEra era)
govAction =
  case GovAction (ShelleyLedgerEra era)
govAction of
    Gov.ParameterChange{} -> Maybe Anchor
forall a. Maybe a
Nothing
    Gov.HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
_ ProtVer
_ -> Maybe Anchor
forall a. Maybe a
Nothing
    Gov.TreasuryWithdrawals Map RewardAccount Coin
_ StrictMaybe ScriptHash
_ -> Maybe Anchor
forall a. Maybe a
Nothing
    Gov.NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
_ -> Maybe Anchor
forall a. Maybe a
Nothing
    Gov.UpdateCommittee{} -> Maybe Anchor
forall a. Maybe a
Nothing
    Gov.NewConstitution StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
_ Constitution (ShelleyLedgerEra era)
constitution -> Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just (Anchor -> Maybe Anchor) -> Anchor -> Maybe Anchor
forall a b. (a -> b) -> a -> b
$ Constitution (ShelleyLedgerEra era) -> Anchor
forall era. Constitution era -> Anchor
Ledger.constitutionAnchor Constitution (ShelleyLedgerEra era)
constitution
    GovAction (ShelleyLedgerEra era)
Gov.InfoAction -> Maybe Anchor
forall a. Maybe a
Nothing