{-# 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.Governance.Actions.ProposalProcedure where

import           Cardano.Api.Address
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.ProtocolParameters
import qualified Cardano.Api.ReexposeLedger as Ledger
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.TxIn

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

import           Data.ByteString (ByteString)
import           Data.Map.Strict (Map)
import           Data.Maybe (fromMaybe)
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 StandardCrypto)
      (StrictMaybe (Shelley.ScriptHash StandardCrypto))
  | ProposeNewCommittee
      (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
      [L.Credential ColdCommitteeRole StandardCrypto]
      -- ^ Old constitutional committee
      (Map (L.Credential ColdCommitteeRole StandardCrypto) 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 StandardCrypto))
  | 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 StandardCrypto))

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 StandardCrypto
anchor StrictMaybe (ScriptHash StandardCrypto)
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 (EraCrypto (ShelleyLedgerEra era))
Gov.constitutionAnchor = Anchor (EraCrypto (ShelleyLedgerEra era))
Anchor StandardCrypto
anchor
          , constitutionScript :: StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
Gov.constitutionScript = StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (ScriptHash StandardCrypto)
mConstitutionScriptHash
          }
    ProposeNewCommittee StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId [Credential 'ColdCommitteeRole StandardCrypto]
oldCommitteeMembers Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
newCommitteeMembers Rational
quor ->
      StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> Set
     (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
     EpochNo
-> UnitInterval
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
Gov.UpdateCommittee
        StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId -- previous governance action id
        ([Item (Set (Credential 'ColdCommitteeRole StandardCrypto))]
-> Set (Credential 'ColdCommitteeRole StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList [Item (Set (Credential 'ColdCommitteeRole StandardCrypto))]
[Credential 'ColdCommitteeRole StandardCrypto]
oldCommitteeMembers) -- members to remove
        Map
  (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
  EpochNo
Map (Credential 'ColdCommitteeRole StandardCrypto) 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 StandardCrypto)
govPol ->
      let m :: Map (RewardAccount StandardCrypto) Coin
m = [Item (Map (RewardAccount StandardCrypto) Coin)]
-> Map (RewardAccount StandardCrypto) Coin
forall l. IsList l => [Item l] -> l
fromList [(Network
-> Credential 'Staking StandardCrypto
-> RewardAccount StandardCrypto
forall c. Network -> Credential 'Staking c -> RewardAccount c
L.RewardAccount Network
nw (StakeCredential -> Credential 'Staking StandardCrypto
toShelleyStakeCredential StakeCredential
sc), Coin
l) | (Network
nw, StakeCredential
sc, Coin
l) <- [(Network, StakeCredential, Coin)]
withdrawals]
       in Map (RewardAccount (EraCrypto (ShelleyLedgerEra era))) Coin
-> StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
-> GovAction (ShelleyLedgerEra era)
forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
Gov.TreasuryWithdrawals Map (RewardAccount (EraCrypto (ShelleyLedgerEra era))) Coin
Map (RewardAccount StandardCrypto) Coin
m StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (ScriptHash StandardCrypto)
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 StandardCrypto)
govPol ->
      StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
-> GovAction (ShelleyLedgerEra era)
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
Gov.ParameterChange StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
preGovId PParamsUpdate (ShelleyLedgerEra era)
ppup StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (ScriptHash StandardCrypto)
govPol

fromGovernanceAction
  :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
  => Gov.GovAction (ShelleyLedgerEra era)
  -> GovernanceAction era
fromGovernanceAction :: forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
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 StandardCrypto
-> StrictMaybe (ScriptHash StandardCrypto)
-> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Anchor StandardCrypto
-> StrictMaybe (ScriptHash StandardCrypto)
-> GovernanceAction era
ProposeNewConstitution
      StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovId
      (Constitution (ShelleyLedgerEra era)
-> Anchor (EraCrypto (ShelleyLedgerEra era))
forall era. Constitution era -> Anchor (EraCrypto era)
Gov.constitutionAnchor Constitution (ShelleyLedgerEra era)
constitution)
      (Constitution (ShelleyLedgerEra era)
-> StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
forall era.
Constitution era -> StrictMaybe (ScriptHash (EraCrypto era))
Gov.constitutionScript Constitution (ShelleyLedgerEra era)
constitution)
  Gov.ParameterChange StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovId PParamsUpdate (ShelleyLedgerEra era)
pparams StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
govPolicy ->
    StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe (ScriptHash StandardCrypto)
-> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe (ScriptHash StandardCrypto)
-> GovernanceAction era
UpdatePParams StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovId PParamsUpdate (ShelleyLedgerEra era)
pparams StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (ScriptHash StandardCrypto)
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 (EraCrypto (ShelleyLedgerEra era))) Coin
withdrawlMap StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
govPolicy ->
    let res :: [(Network, StakeCredential, Coin)]
res =
          [ (RewardAccount StandardCrypto -> Network
forall c. RewardAccount c -> Network
L.raNetwork RewardAccount StandardCrypto
rwdAcnt, Credential 'Staking StandardCrypto -> StakeCredential
fromShelleyStakeCredential (RewardAccount StandardCrypto -> Credential 'Staking StandardCrypto
forall c. RewardAccount c -> Credential 'Staking c
L.raCredential RewardAccount StandardCrypto
rwdAcnt), Coin
coin)
          | (RewardAccount StandardCrypto
rwdAcnt, Coin
coin) <- Map (RewardAccount StandardCrypto) Coin
-> [Item (Map (RewardAccount StandardCrypto) Coin)]
forall l. IsList l => l -> [Item l]
toList Map (RewardAccount (EraCrypto (ShelleyLedgerEra era))) Coin
Map (RewardAccount StandardCrypto) Coin
withdrawlMap
          ]
     in [(Network, StakeCredential, Coin)]
-> StrictMaybe (ScriptHash StandardCrypto) -> GovernanceAction era
forall era.
[(Network, StakeCredential, Coin)]
-> StrictMaybe (ScriptHash StandardCrypto) -> GovernanceAction era
TreasuryWithdrawal [(Network, StakeCredential, Coin)]
res StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
StrictMaybe (ScriptHash StandardCrypto)
govPolicy
  Gov.UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId Set
  (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
oldCommitteeMembers Map
  (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
  EpochNo
newCommitteeMembers UnitInterval
quor ->
    StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> [Credential 'ColdCommitteeRole StandardCrypto]
-> Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
-> Rational
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> [Credential 'ColdCommitteeRole StandardCrypto]
-> Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
-> Rational
-> GovernanceAction era
ProposeNewCommittee
      StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
prevGovId
      (Set (Credential 'ColdCommitteeRole StandardCrypto)
-> [Item (Set (Credential 'ColdCommitteeRole StandardCrypto))]
forall l. IsList l => l -> [Item l]
toList Set
  (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
Set (Credential 'ColdCommitteeRole StandardCrypto)
oldCommitteeMembers)
      Map
  (Credential 'ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)))
  EpochNo
Map (Credential 'ColdCommitteeRole StandardCrypto) 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

newtype Proposal era = Proposal {forall era.
Proposal era -> ProposalProcedure (ShelleyLedgerEra era)
unProposal :: Gov.ProposalProcedure (ShelleyLedgerEra era)}

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 {unProposal = " [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 => 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 @Conway.Conway 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.
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 @Conway.Conway)

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 StandardCrypto
  -> Proposal era
createProposalProcedure :: forall era.
ShelleyBasedEra era
-> Network
-> Coin
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
nw Coin
dep StakeCredential
cred GovernanceAction era
govAct Anchor StandardCrypto
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.
ProposalProcedure (ShelleyLedgerEra era) -> Proposal era
Proposal
      Gov.ProposalProcedure
        { pProcDeposit :: Coin
Gov.pProcDeposit = Coin
dep
        , pProcReturnAddr :: RewardAccount (EraCrypto (ShelleyLedgerEra era))
Gov.pProcReturnAddr = Network
-> Credential 'Staking StandardCrypto
-> RewardAccount StandardCrypto
forall c. Network -> Credential 'Staking c -> RewardAccount c
L.RewardAccount Network
nw (Credential 'Staking StandardCrypto
 -> RewardAccount StandardCrypto)
-> Credential 'Staking StandardCrypto
-> RewardAccount StandardCrypto
forall a b. (a -> b) -> a -> b
$ StakeCredential -> Credential 'Staking StandardCrypto
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 (EraCrypto (ShelleyLedgerEra era))
Gov.pProcAnchor = Anchor (EraCrypto (ShelleyLedgerEra era))
Anchor StandardCrypto
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 StandardCrypto -> StakeCredential
fromShelleyStakeCredential (RewardAccount StandardCrypto -> Credential 'Staking StandardCrypto
forall c. RewardAccount c -> Credential 'Staking c
L.raCredential (ProposalProcedure (ShelleyLedgerEra era)
-> RewardAccount (EraCrypto (ShelleyLedgerEra era))
forall era. ProposalProcedure era -> RewardAccount (EraCrypto era)
Gov.pProcReturnAddr ProposalProcedure (ShelleyLedgerEra era)
pp))
    , GovAction (ShelleyLedgerEra era) -> GovernanceAction era
forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
GovAction (ShelleyLedgerEra era) -> GovernanceAction era
fromGovernanceAction (ProposalProcedure (ShelleyLedgerEra era)
-> GovAction (ShelleyLedgerEra era)
forall era. ProposalProcedure era -> GovAction era
Gov.pProcGovAction ProposalProcedure (ShelleyLedgerEra era)
pp)
    )

createPreviousGovernanceActionId
  :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
  => TxId
  -> Word16
  -- ^ Governance action transation index
  -> Ledger.GovPurposeId (r :: Ledger.GovActionPurpose) (ShelleyLedgerEra era)
createPreviousGovernanceActionId :: forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId TxId
txid Word16
index =
  GovActionId (EraCrypto (ShelleyLedgerEra era))
-> GovPurposeId r (ShelleyLedgerEra era)
forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
Ledger.GovPurposeId (GovActionId (EraCrypto (ShelleyLedgerEra era))
 -> GovPurposeId r (ShelleyLedgerEra era))
-> GovActionId (EraCrypto (ShelleyLedgerEra era))
-> GovPurposeId r (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ TxId -> Word16 -> GovActionId StandardCrypto
createGovernanceActionId TxId
txid Word16
index

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

createAnchor :: Url -> ByteString -> Anchor StandardCrypto
createAnchor :: Url -> ByteString -> Anchor StandardCrypto
createAnchor Url
url ByteString
anchorData =
  Ledger.Anchor
    { anchorUrl :: Url
anchorUrl = Url
url
    , anchorDataHash :: SafeHash StandardCrypto AnchorData
anchorDataHash = AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
hashAnchorData (AnchorData -> SafeHash StandardCrypto AnchorData)
-> AnchorData -> SafeHash StandardCrypto 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
  :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
  => Gov.GovAction (ShelleyLedgerEra era)
  -> Maybe (Ledger.Anchor StandardCrypto)
getAnchorDataFromGovernanceAction :: forall era.
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
GovAction (ShelleyLedgerEra era) -> Maybe (Anchor StandardCrypto)
getAnchorDataFromGovernanceAction GovAction (ShelleyLedgerEra era)
govAction =
  case GovAction (ShelleyLedgerEra era)
govAction of
    Gov.ParameterChange{} -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    Gov.HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
_ ProtVer
_ -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    Gov.TreasuryWithdrawals Map (RewardAccount (EraCrypto (ShelleyLedgerEra era))) Coin
_ StrictMaybe (ScriptHash (EraCrypto (ShelleyLedgerEra era)))
_ -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    Gov.NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
_ -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    Gov.UpdateCommittee{} -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing
    Gov.NewConstitution StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
_ Constitution (ShelleyLedgerEra era)
constitution -> Anchor StandardCrypto -> Maybe (Anchor StandardCrypto)
forall a. a -> Maybe a
Just (Anchor StandardCrypto -> Maybe (Anchor StandardCrypto))
-> Anchor StandardCrypto -> Maybe (Anchor StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Constitution (ShelleyLedgerEra era)
-> Anchor (EraCrypto (ShelleyLedgerEra era))
forall era. Constitution era -> Anchor (EraCrypto era)
Ledger.constitutionAnchor Constitution (ShelleyLedgerEra era)
constitution
    GovAction (ShelleyLedgerEra era)
Gov.InfoAction -> Maybe (Anchor StandardCrypto)
forall a. Maybe a
Nothing