{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.CLI.EraBased.Run.Governance.Actions
( runGovernanceActionCmds
, GovernanceActionsError (..)
, addCostModelsToEraBasedProtocolParametersUpdate
)
where
import Cardano.Api
import Cardano.Api.Ledger (StrictMaybe (..))
import qualified Cardano.Api.Ledger as L
import Cardano.Api.Shelley
import Cardano.CLI.EraBased.Commands.Governance.Actions
import qualified Cardano.CLI.EraBased.Commands.Governance.Actions as Cmd
import Cardano.CLI.Json.Friendly
import Cardano.CLI.Read
import Cardano.CLI.Run.Hash (getByteStringFromURL, httpsAndIpfsSchemas)
import Cardano.CLI.Types.Common
import Cardano.CLI.Types.Errors.GovernanceActionsError
import Cardano.CLI.Types.Errors.HashCmdError (FetchURLError)
import Cardano.CLI.Types.Key
import Control.Monad
import GHC.Exts (IsList (..))
runGovernanceActionCmds
:: ()
=> GovernanceActionCmds era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCmds :: forall era.
GovernanceActionCmds era -> ExceptT GovernanceActionsError IO ()
runGovernanceActionCmds = \case
GovernanceActionCreateConstitutionCmd GovernanceActionCreateConstitutionCmdArgs era
args ->
GovernanceActionCreateConstitutionCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateConstitutionCmd GovernanceActionCreateConstitutionCmdArgs era
args
GovernanceActionProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
args ->
GovernanceActionProtocolParametersUpdateCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
args
GovernanceActionTreasuryWithdrawalCmd GovernanceActionTreasuryWithdrawalCmdArgs era
args ->
GovernanceActionTreasuryWithdrawalCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionTreasuryWithdrawalCmd GovernanceActionTreasuryWithdrawalCmdArgs era
args
GovernanceActionUpdateCommitteeCmd GovernanceActionUpdateCommitteeCmdArgs era
args ->
GovernanceActionUpdateCommitteeCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionUpdateCommitteeCmd GovernanceActionUpdateCommitteeCmdArgs era
args
GovernanceActionCreateNoConfidenceCmd GovernanceActionCreateNoConfidenceCmdArgs era
args ->
GovernanceActionCreateNoConfidenceCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateNoConfidenceCmd GovernanceActionCreateNoConfidenceCmdArgs era
args
GovernanceActionHardforkInitCmd GovernanceActionHardforkInitCmdArgs era
args ->
GovernanceActionHardforkInitCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionHardforkInitCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionHardforkInitCmd GovernanceActionHardforkInitCmdArgs era
args
GovernanceActionInfoCmd GovernanceActionInfoCmdArgs era
args ->
GovernanceActionInfoCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionInfoCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionInfoCmd GovernanceActionInfoCmdArgs era
args
GovernanceActionViewCmd GovernanceActionViewCmdArgs era
args ->
GovernanceActionViewCmdArgs era
-> ExceptT GovernanceActionsError IO ()
forall era.
GovernanceActionViewCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionViewCmd GovernanceActionViewCmdArgs era
args
runGovernanceActionViewCmd
:: ()
=> GovernanceActionViewCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionViewCmd :: forall era.
GovernanceActionViewCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionViewCmd
Cmd.GovernanceActionViewCmdArgs
{ ViewOutputFormat
outFormat :: ViewOutputFormat
outFormat :: forall era. GovernanceActionViewCmdArgs era -> ViewOutputFormat
Cmd.outFormat
, ProposalFile 'In
actionFile :: ProposalFile 'In
actionFile :: forall era. GovernanceActionViewCmdArgs era -> ProposalFile 'In
Cmd.actionFile
, Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. GovernanceActionViewCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
, ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. GovernanceActionViewCmdArgs era -> ConwayEraOnwards era
Cmd.eon
} = do
Proposal era
proposal <-
((Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> Proposal era)
-> ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT GovernanceActionsError IO (Proposal era)
forall a b.
(a -> b)
-> ExceptT GovernanceActionsError IO a
-> ExceptT GovernanceActionsError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> Proposal era
forall a b. (a, b) -> a
fst (ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT GovernanceActionsError IO (Proposal era))
-> (IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT GovernanceActionsError IO (Proposal era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProposalError -> GovernanceActionsError)
-> ExceptT
ProposalError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ProposalError -> GovernanceActionsError
GovernanceActionsCmdProposalError (ExceptT
ProposalError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> (IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
ProposalError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
GovernanceActionsError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
ProposalError
IO
(Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT GovernanceActionsError IO (Proposal era))
-> IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT GovernanceActionsError IO (Proposal era)
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ProposalFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall era.
ConwayEraOnwards era
-> (ProposalFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
(Either
ProposalError
(Proposal era, Maybe (ScriptWitness WitCtxStake era)))
readProposal ConwayEraOnwards era
eon (ProposalFile 'In
actionFile, Maybe (ScriptWitnessFiles WitCtxStake)
forall a. Maybe a
Nothing)
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
FriendlyFormat
-> Maybe (File () 'Out)
-> ConwayEraOnwards era
-> Proposal era
-> IO (Either (FileError ()) ())
forall (m :: * -> *) era e.
MonadIO m =>
FriendlyFormat
-> Maybe (File () 'Out)
-> ConwayEraOnwards era
-> Proposal era
-> m (Either (FileError e) ())
friendlyProposal
( case ViewOutputFormat
outFormat of
ViewOutputFormat
ViewOutputFormatJson -> FriendlyFormat
FriendlyJson
ViewOutputFormat
ViewOutputFormatYaml -> FriendlyFormat
FriendlyYaml
)
Maybe (File () 'Out)
mOutFile
ConwayEraOnwards era
eon
Proposal era
proposal
runGovernanceActionInfoCmd
:: ()
=> GovernanceActionInfoCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionInfoCmd :: forall era.
GovernanceActionInfoCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionInfoCmd
Cmd.GovernanceActionInfoCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era. GovernanceActionInfoCmdArgs era -> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era. GovernanceActionInfoCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era. GovernanceActionInfoCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
returnStakeAddress :: StakeIdentifier
returnStakeAddress :: forall era. GovernanceActionInfoCmdArgs era -> StakeIdentifier
Cmd.returnStakeAddress
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era. GovernanceActionInfoCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, SafeHash StandardCrypto AnchorData
proposalHash :: SafeHash StandardCrypto AnchorData
proposalHash :: forall era.
GovernanceActionInfoCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionInfoCmdArgs era -> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, File () 'Out
outFile :: File () 'Out
outFile :: forall era. GovernanceActionInfoCmdArgs era -> File () 'Out
Cmd.outFile
} = do
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnStakeAddress
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
govAction :: GovernanceAction era
govAction = GovernanceAction era
forall era. GovernanceAction era
InfoAct
proposalProcedure :: Proposal era
proposalProcedure = ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
forall era. GovernanceAction era
govAction Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
outFile (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Info proposal") Proposal era
proposalProcedure
fetchURLErrorToGovernanceActionError
:: AnchorDataTypeCheck -> ExceptT FetchURLError IO a -> ExceptT GovernanceActionsError IO a
fetchURLErrorToGovernanceActionError :: forall a.
AnchorDataTypeCheck
-> ExceptT FetchURLError IO a
-> ExceptT GovernanceActionsError IO a
fetchURLErrorToGovernanceActionError AnchorDataTypeCheck
adt = (FetchURLError -> GovernanceActionsError)
-> ExceptT FetchURLError IO a
-> ExceptT GovernanceActionsError IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT (AnchorDataTypeCheck -> FetchURLError -> GovernanceActionsError
GovernanceActionsProposalFetchURLError AnchorDataTypeCheck
adt)
runGovernanceActionCreateNoConfidenceCmd
:: ()
=> GovernanceActionCreateNoConfidenceCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateNoConfidenceCmd :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateNoConfidenceCmd
Cmd.GovernanceActionCreateNoConfidenceCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
returnStakeAddress :: StakeIdentifier
returnStakeAddress :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> StakeIdentifier
Cmd.returnStakeAddress
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, SafeHash StandardCrypto AnchorData
proposalHash :: SafeHash StandardCrypto AnchorData
proposalHash :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, Maybe (TxId, Word16)
mPrevGovernanceActionId :: Maybe (TxId, Word16)
mPrevGovernanceActionId :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> Maybe (TxId, Word16)
Cmd.mPrevGovernanceActionId
, File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> File () 'Out
Cmd.outFile
} = do
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnStakeAddress
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
previousGovernanceAction :: GovernanceAction era
previousGovernanceAction =
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era
MotionOfNoConfidence (StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era)
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> GovernanceAction era
forall a b. (a -> b) -> a -> b
$
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
(TxId
-> Word16 -> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> (TxId, Word16)
-> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId
-> Word16 -> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)
forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId ((TxId, Word16)
-> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> Maybe (TxId, Word16)
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxId, Word16)
mPrevGovernanceActionId
proposalProcedure :: Proposal era
proposalProcedure =
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure
ShelleyBasedEra era
sbe
Network
networkId
Lovelace
deposit
StakeCredential
depositStakeCredential
GovernanceAction era
previousGovernanceAction
Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
outFile (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Motion of no confidence proposal") Proposal era
proposalProcedure
runGovernanceActionCreateConstitutionCmd
:: ()
=> GovernanceActionCreateConstitutionCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateConstitutionCmd :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateConstitutionCmd
Cmd.GovernanceActionCreateConstitutionCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
stakeCredential :: StakeIdentifier
stakeCredential :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> StakeIdentifier
Cmd.stakeCredential
, Maybe (TxId, Word16)
mPrevGovernanceActionId :: Maybe (TxId, Word16)
mPrevGovernanceActionId :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> Maybe (TxId, Word16)
Cmd.mPrevGovernanceActionId
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, SafeHash StandardCrypto AnchorData
proposalHash :: SafeHash StandardCrypto AnchorData
proposalHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, ConstitutionUrl
constitutionUrl :: ConstitutionUrl
constitutionUrl :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> ConstitutionUrl
Cmd.constitutionUrl
, SafeHash StandardCrypto AnchorData
constitutionHash :: SafeHash StandardCrypto AnchorData
constitutionHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.constitutionHash
, Maybe ScriptHash
constitutionScript :: Maybe ScriptHash
constitutionScript :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> Maybe ScriptHash
Cmd.constitutionScript
, MustCheckHash ConstitutionUrl
checkConstitutionHash :: MustCheckHash ConstitutionUrl
checkConstitutionHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> MustCheckHash ConstitutionUrl
Cmd.checkConstitutionHash
, File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> File () 'Out
Cmd.outFile
} = do
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeCredential
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
let prevGovActId :: StrictMaybe
(GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovActId =
Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)))
-> Maybe
(GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
(TxId
-> Word16
-> GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> (TxId, Word16)
-> GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId
-> Word16
-> GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era)
forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId ((TxId, Word16)
-> GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Maybe (TxId, Word16)
-> Maybe (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxId, Word16)
mPrevGovernanceActionId
constitutionAnchor :: Anchor StandardCrypto
constitutionAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ConstitutionUrl -> Url
unConstitutionUrl ConstitutionUrl
constitutionUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
constitutionHash
}
govAct :: GovernanceAction era
govAct =
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))
prevGovActId
Anchor StandardCrypto
constitutionAnchor
(ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash -> ScriptHash StandardCrypto)
-> StrictMaybe ScriptHash
-> StrictMaybe (ScriptHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash -> StrictMaybe ScriptHash
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe Maybe ScriptHash
constitutionScript)
sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
proposalProcedure :: Proposal era
proposalProcedure = ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
govAct Anchor StandardCrypto
proposalAnchor
MustCheckHash ConstitutionUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ConstitutionUrl
checkConstitutionHash Anchor StandardCrypto
constitutionAnchor AnchorDataTypeCheck
ConstitutionCheck
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope
File () 'Out
outFile
(TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Update to the Constitution or policy proposal")
Proposal era
proposalProcedure
runGovernanceActionUpdateCommitteeCmd
:: ()
=> GovernanceActionUpdateCommitteeCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionUpdateCommitteeCmd :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionUpdateCommitteeCmd
Cmd.GovernanceActionUpdateCommitteeCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era. GovernanceActionUpdateCommitteeCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era. GovernanceActionUpdateCommitteeCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
returnAddress :: StakeIdentifier
returnAddress :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> StakeIdentifier
Cmd.returnAddress
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, SafeHash StandardCrypto AnchorData
proposalHash :: SafeHash StandardCrypto AnchorData
proposalHash :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
oldCommitteeVkeySource :: [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
oldCommitteeVkeySource :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
Cmd.oldCommitteeVkeySource
, [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)]
newCommitteeVkeySource :: [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)]
newCommitteeVkeySource :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era
-> [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)]
Cmd.newCommitteeVkeySource
, Rational
requiredThreshold :: Rational
requiredThreshold :: forall era. GovernanceActionUpdateCommitteeCmdArgs era -> Rational
Cmd.requiredThreshold
, Maybe (TxId, Word16)
mPrevGovernanceActionId :: Maybe (TxId, Word16)
mPrevGovernanceActionId :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> Maybe (TxId, Word16)
Cmd.mPrevGovernanceActionId
, File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> File () 'Out
Cmd.outFile
} = do
let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
govActIdentifier :: StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
govActIdentifier =
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
(TxId
-> Word16 -> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> (TxId, Word16)
-> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId
-> Word16 -> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era)
forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId ((TxId, Word16)
-> GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> Maybe (TxId, Word16)
-> Maybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxId, Word16)
mPrevGovernanceActionId
thresholdRational :: Rational
thresholdRational = Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
requiredThreshold
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
[Credential 'ColdCommitteeRole StandardCrypto]
oldCommitteeKeyHashes <- [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
GovernanceActionsError
IO
[Credential 'ColdCommitteeRole StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
oldCommitteeVkeySource ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
GovernanceActionsError
IO
[Credential 'ColdCommitteeRole StandardCrypto])
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
GovernanceActionsError
IO
[Credential 'ColdCommitteeRole StandardCrypto]
forall a b. (a -> b) -> a -> b
$ \VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile ->
(FileError InputDecodeError -> GovernanceActionsError)
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> GovernanceActionsError
GovernanceActionsCmdReadFileError (ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$
AsType CommitteeColdKey
-> (Hash CommitteeColdKey
-> KeyHash 'ColdCommitteeRole StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
(kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeyOrHashOrFileOrScriptHash
AsType CommitteeColdKey
AsCommitteeColdKey
Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole StandardCrypto
unCommitteeColdKeyHash
VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile
[(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)]
newCommitteeKeyHashes <- [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)]
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto, EpochNo))
-> ExceptT
GovernanceActionsError
IO
[(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)]
newCommitteeVkeySource (((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto, EpochNo))
-> ExceptT
GovernanceActionsError
IO
[(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)])
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
EpochNo)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto, EpochNo))
-> ExceptT
GovernanceActionsError
IO
[(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)]
forall a b. (a -> b) -> a -> b
$ \(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile, EpochNo
expEpoch) -> do
Credential 'ColdCommitteeRole StandardCrypto
kh <-
(FileError InputDecodeError -> GovernanceActionsError)
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> GovernanceActionsError
GovernanceActionsCmdReadFileError (ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto))
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$
AsType CommitteeColdKey
-> (Hash CommitteeColdKey
-> KeyHash 'ColdCommitteeRole StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
(FileError InputDecodeError)
IO
(Credential 'ColdCommitteeRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
(kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeyOrHashOrFileOrScriptHash
AsType CommitteeColdKey
AsCommitteeColdKey
Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole StandardCrypto
unCommitteeColdKeyHash
VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile
(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)
-> ExceptT
GovernanceActionsError
IO
(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'ColdCommitteeRole StandardCrypto
kh, EpochNo
expEpoch)
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddress
let proposeNewCommittee :: GovernanceAction era
proposeNewCommittee =
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))
govActIdentifier
[Credential 'ColdCommitteeRole StandardCrypto]
oldCommitteeKeyHashes
([Item (Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo)]
-> Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
forall l. IsList l => [Item l] -> l
fromList [(Credential 'ColdCommitteeRole StandardCrypto, EpochNo)]
[Item (Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo)]
newCommitteeKeyHashes)
Rational
thresholdRational
proposal :: Proposal era
proposal =
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure
ShelleyBasedEra era
sbe
Network
networkId
Lovelace
deposit
StakeCredential
depositStakeCredential
GovernanceAction era
proposeNewCommittee
Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope
File () 'Out
outFile
(TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"New constitutional committee and/or threshold and/or terms proposal")
Proposal era
proposal
runGovernanceActionCreateProtocolParametersUpdateCmd
:: ()
=> Cmd.GovernanceActionProtocolParametersUpdateCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateProtocolParametersUpdateCmd :: forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams' = do
let sbe :: ShelleyBasedEra era
sbe = GovernanceActionProtocolParametersUpdateCmdArgs era
-> ShelleyBasedEra era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> ShelleyBasedEra era
uppShelleyBasedEra GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
(ShelleyToBabbageEraConstraints era =>
ShelleyToBabbageEra era -> ExceptT GovernanceActionsError IO ())
-> (ConwayEraOnwardsConstraints era =>
ConwayEraOnwards era -> ExceptT GovernanceActionsError IO ())
-> ShelleyBasedEra era
-> ExceptT GovernanceActionsError IO ()
forall era a.
(ShelleyToBabbageEraConstraints era =>
ShelleyToBabbageEra era -> a)
-> (ConwayEraOnwardsConstraints era => ConwayEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToBabbageOrConwayEraOnwards
( \ShelleyToBabbageEra era
sToB -> do
let oFp :: File () 'Out
oFp = GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
uppFilePath GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
anyEra :: AnyShelleyBasedEra
anyEra = ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra (ShelleyBasedEra era -> AnyShelleyBasedEra)
-> ShelleyBasedEra era -> AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
shelleyToBabbageEraToShelleyBasedEra ShelleyToBabbageEra era
sToB
UpdateProtocolParametersPreConway ShelleyToBabbageEra era
_stB EpochNo
expEpoch [VerificationKeyFile 'In]
genesisVerKeys <-
GovernanceActionsError
-> Maybe (UpdateProtocolParametersPreConway era)
-> ExceptT
GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyShelleyBasedEra -> GovernanceActionsError
GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra
anyEra) (Maybe (UpdateProtocolParametersPreConway era)
-> ExceptT
GovernanceActionsError IO (UpdateProtocolParametersPreConway era))
-> Maybe (UpdateProtocolParametersPreConway era)
-> ExceptT
GovernanceActionsError IO (UpdateProtocolParametersPreConway era)
forall a b. (a -> b) -> a -> b
$
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersPreConway era)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersPreConway era)
uppPreConway GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
EraBasedProtocolParametersUpdate era
eraBasedPParams <- ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
theUpdate
let updateProtocolParams :: PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams = ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
eraBasedPParams
apiUpdateProtocolParamsType :: ProtocolParametersUpdate
apiUpdateProtocolParamsType = ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
forall era.
ShelleyBasedEra era
-> PParamsUpdate (ShelleyLedgerEra era) -> ProtocolParametersUpdate
fromLedgerPParamsUpdate ShelleyBasedEra era
sbe PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams
[VerificationKey GenesisKey]
genVKeys <-
[ExceptT GovernanceActionsError IO (VerificationKey GenesisKey)]
-> ExceptT GovernanceActionsError IO [VerificationKey GenesisKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ (FileError TextEnvelopeError -> GovernanceActionsError)
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
-> ExceptT GovernanceActionsError IO (VerificationKey GenesisKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GovernanceActionsError
GovernanceActionsCmdReadTextEnvelopeFileError (ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
-> ExceptT GovernanceActionsError IO (VerificationKey GenesisKey))
-> (IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT GovernanceActionsError IO (VerificationKey GenesisKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT GovernanceActionsError IO (VerificationKey GenesisKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT GovernanceActionsError IO (VerificationKey GenesisKey)
forall a b. (a -> b) -> a -> b
$
AsType (VerificationKey GenesisKey)
-> VerificationKeyFile 'In
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey) VerificationKeyFile 'In
vkeyFile
| VerificationKeyFile 'In
vkeyFile <- [VerificationKeyFile 'In]
genesisVerKeys
]
let genKeyHashes :: [Hash GenesisKey]
genKeyHashes = (VerificationKey GenesisKey -> Hash GenesisKey)
-> [VerificationKey GenesisKey] -> [Hash GenesisKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey GenesisKey]
genVKeys
upProp :: UpdateProposal
upProp = ProtocolParametersUpdate
-> [Hash GenesisKey] -> EpochNo -> UpdateProposal
makeShelleyUpdateProposal ProtocolParametersUpdate
apiUpdateProtocolParamsType [Hash GenesisKey]
genKeyHashes EpochNo
expEpoch
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
oFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr -> UpdateProposal -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing UpdateProposal
upProp
)
( \ConwayEraOnwards era
conwayOnwards -> do
let oFp :: File () 'Out
oFp = GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
uppFilePath GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
anyEra :: AnyShelleyBasedEra
anyEra = ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra (ShelleyBasedEra era -> AnyShelleyBasedEra)
-> ShelleyBasedEra era -> AnyShelleyBasedEra
forall a b. (a -> b) -> a -> b
$ ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
conwayOnwards
UpdateProtocolParametersConwayOnwards
ConwayEraOnwards era
_cOnwards
Network
network
Lovelace
deposit
StakeIdentifier
returnAddr
ProposalUrl
proposalUrl
SafeHash StandardCrypto AnchorData
proposalHash
MustCheckHash ProposalUrl
checkProposalHash
Maybe (TxId, Word16)
mPrevGovActId
Maybe ScriptHash
mConstitutionalScriptHash <-
GovernanceActionsError
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> ExceptT
GovernanceActionsError
IO
(UpdateProtocolParametersConwayOnwards era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe (AnyShelleyBasedEra -> GovernanceActionsError
GovernanceActionsValueUpdateProtocolParametersNotFound AnyShelleyBasedEra
anyEra) (Maybe (UpdateProtocolParametersConwayOnwards era)
-> ExceptT
GovernanceActionsError
IO
(UpdateProtocolParametersConwayOnwards era))
-> Maybe (UpdateProtocolParametersConwayOnwards era)
-> ExceptT
GovernanceActionsError
IO
(UpdateProtocolParametersConwayOnwards era)
forall a b. (a -> b) -> a -> b
$
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersConwayOnwards era)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (UpdateProtocolParametersConwayOnwards era)
uppConwayOnwards GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
EraBasedProtocolParametersUpdate era
eraBasedPParams <- ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
theUpdate
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddr
let updateProtocolParams :: PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams = ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
forall era.
ShelleyBasedEra era
-> EraBasedProtocolParametersUpdate era
-> PParamsUpdate (ShelleyLedgerEra era)
createEraBasedProtocolParamUpdate ShelleyBasedEra era
sbe EraBasedProtocolParametersUpdate era
eraBasedPParams
prevGovActId :: StrictMaybe
(GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovActId = Maybe (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ (TxId
-> Word16
-> GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> (TxId, Word16)
-> GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId
-> Word16
-> GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era)
forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId ((TxId, Word16)
-> GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> Maybe (TxId, Word16)
-> Maybe (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxId, Word16)
mPrevGovActId
proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
let govAct :: GovernanceAction era
govAct =
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))
prevGovActId
PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams
(ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash -> ScriptHash StandardCrypto)
-> StrictMaybe ScriptHash
-> StrictMaybe (ScriptHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash -> StrictMaybe ScriptHash
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe Maybe ScriptHash
mConstitutionalScriptHash)
let proposalProcedure :: Proposal era
proposalProcedure = ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
network Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
govAct Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
conwayOnwards ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
oFp (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Update protocol parameters proposal") Proposal era
proposalProcedure
)
ShelleyBasedEra era
sbe
where
theUpdate :: ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
theUpdate =
case GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (CostModelsFile era)
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> Maybe (CostModelsFile era)
uppCostModelsFile GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams' of
Maybe (CostModelsFile era)
Nothing -> EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era))
-> EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
forall a b. (a -> b) -> a -> b
$ GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
uppNewPParams GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
Just (Cmd.CostModelsFile AlonzoEraOnwards era
alonzoOnwards File CostModels 'In
costModelsFile) -> do
CostModels
costModels <-
(CostModelsError -> GovernanceActionsError)
-> ExceptT CostModelsError IO CostModels
-> ExceptT GovernanceActionsError IO CostModels
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT CostModelsError -> GovernanceActionsError
GovernanceActionsCmdCostModelsError (ExceptT CostModelsError IO CostModels
-> ExceptT GovernanceActionsError IO CostModels)
-> ExceptT CostModelsError IO CostModels
-> ExceptT GovernanceActionsError IO CostModels
forall a b. (a -> b) -> a -> b
$
File CostModels 'In -> ExceptT CostModelsError IO CostModels
readCostModels File CostModels 'In
costModelsFile
EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era))
-> (EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era)
-> EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoEraOnwards era
-> CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
forall era.
AlonzoEraOnwards era
-> CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
addCostModelsToEraBasedProtocolParametersUpdate AlonzoEraOnwards era
alonzoOnwards CostModels
costModels (EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era))
-> EraBasedProtocolParametersUpdate era
-> ExceptT
GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
forall a b. (a -> b) -> a -> b
$
GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> EraBasedProtocolParametersUpdate era
uppNewPParams GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
addCostModelsToEraBasedProtocolParametersUpdate
:: AlonzoEraOnwards era
-> L.CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
addCostModelsToEraBasedProtocolParametersUpdate :: forall era.
AlonzoEraOnwards era
-> CostModels
-> EraBasedProtocolParametersUpdate era
-> EraBasedProtocolParametersUpdate era
addCostModelsToEraBasedProtocolParametersUpdate
AlonzoEraOnwards era
AlonzoEraOnwardsAlonzo
CostModels
cmdls
(AlonzoEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common ShelleyToAlonzoPParams AlonzoEra
sTa AlonzoOnwardsPParams AlonzoEra
aOn DeprecatedAfterBabbagePParams ShelleyEra
depAfterB) =
CommonProtocolParametersUpdate
-> ShelleyToAlonzoPParams AlonzoEra
-> AlonzoOnwardsPParams AlonzoEra
-> DeprecatedAfterBabbagePParams ShelleyEra
-> EraBasedProtocolParametersUpdate AlonzoEra
AlonzoEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common ShelleyToAlonzoPParams AlonzoEra
sTa (AlonzoOnwardsPParams AlonzoEra
aOn{alCostModels = SJust cmdls}) DeprecatedAfterBabbagePParams ShelleyEra
depAfterB
addCostModelsToEraBasedProtocolParametersUpdate
AlonzoEraOnwards era
AlonzoEraOnwardsBabbage
CostModels
cmdls
(BabbageEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common AlonzoOnwardsPParams BabbageEra
aOn DeprecatedAfterBabbagePParams ShelleyEra
depAfterB IntroducedInBabbagePParams BabbageEra
inB) =
CommonProtocolParametersUpdate
-> AlonzoOnwardsPParams BabbageEra
-> DeprecatedAfterBabbagePParams ShelleyEra
-> IntroducedInBabbagePParams BabbageEra
-> EraBasedProtocolParametersUpdate BabbageEra
BabbageEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common (AlonzoOnwardsPParams BabbageEra
aOn{alCostModels = SJust cmdls}) DeprecatedAfterBabbagePParams ShelleyEra
depAfterB IntroducedInBabbagePParams BabbageEra
inB
addCostModelsToEraBasedProtocolParametersUpdate
AlonzoEraOnwards era
AlonzoEraOnwardsConway
CostModels
cmdls
(ConwayEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common AlonzoOnwardsPParams ConwayEra
aOn IntroducedInBabbagePParams ConwayEra
inB IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
inC) =
CommonProtocolParametersUpdate
-> AlonzoOnwardsPParams ConwayEra
-> IntroducedInBabbagePParams ConwayEra
-> IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
-> EraBasedProtocolParametersUpdate ConwayEra
ConwayEraBasedProtocolParametersUpdate CommonProtocolParametersUpdate
common (AlonzoOnwardsPParams ConwayEra
aOn{alCostModels = SJust cmdls}) IntroducedInBabbagePParams ConwayEra
inB IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra)
inC
runGovernanceActionTreasuryWithdrawalCmd
:: ()
=> GovernanceActionTreasuryWithdrawalCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionTreasuryWithdrawalCmd :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionTreasuryWithdrawalCmd
Cmd.GovernanceActionTreasuryWithdrawalCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
returnAddr :: StakeIdentifier
returnAddr :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> StakeIdentifier
Cmd.returnAddr
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, SafeHash StandardCrypto AnchorData
proposalHash :: SafeHash StandardCrypto AnchorData
proposalHash :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, [(StakeIdentifier, Lovelace)]
treasuryWithdrawal :: [(StakeIdentifier, Lovelace)]
treasuryWithdrawal :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> [(StakeIdentifier, Lovelace)]
Cmd.treasuryWithdrawal
, Maybe ScriptHash
constitutionScriptHash :: Maybe ScriptHash
constitutionScriptHash :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> Maybe ScriptHash
Cmd.constitutionScriptHash
, File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> File () 'Out
Cmd.outFile
} = do
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash = SafeHash StandardCrypto AnchorData
proposalHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddr
[(Network, StakeCredential, Lovelace)]
withdrawals <- [(StakeIdentifier, Lovelace)]
-> ((StakeIdentifier, Lovelace)
-> ExceptT
GovernanceActionsError IO (Network, StakeCredential, Lovelace))
-> ExceptT
GovernanceActionsError IO [(Network, StakeCredential, Lovelace)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(StakeIdentifier, Lovelace)]
treasuryWithdrawal (((StakeIdentifier, Lovelace)
-> ExceptT
GovernanceActionsError IO (Network, StakeCredential, Lovelace))
-> ExceptT
GovernanceActionsError IO [(Network, StakeCredential, Lovelace)])
-> ((StakeIdentifier, Lovelace)
-> ExceptT
GovernanceActionsError IO (Network, StakeCredential, Lovelace))
-> ExceptT
GovernanceActionsError IO [(Network, StakeCredential, Lovelace)]
forall a b. (a -> b) -> a -> b
$ \(StakeIdentifier
stakeIdentifier, Lovelace
lovelace) -> do
StakeCredential
stakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$ StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeIdentifier
(Network, StakeCredential, Lovelace)
-> ExceptT
GovernanceActionsError IO (Network, StakeCredential, Lovelace)
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
networkId, StakeCredential
stakeCredential, Lovelace
lovelace)
let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
treasuryWithdrawals :: GovernanceAction era
treasuryWithdrawals =
[(Network, StakeCredential, Lovelace)]
-> StrictMaybe (ScriptHash StandardCrypto) -> GovernanceAction era
forall era.
[(Network, StakeCredential, Lovelace)]
-> StrictMaybe (ScriptHash StandardCrypto) -> GovernanceAction era
TreasuryWithdrawal
[(Network, StakeCredential, Lovelace)]
withdrawals
(ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash -> ScriptHash StandardCrypto)
-> StrictMaybe ScriptHash
-> StrictMaybe (ScriptHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ScriptHash -> StrictMaybe ScriptHash
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe Maybe ScriptHash
constitutionScriptHash)
proposal :: Proposal era
proposal =
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure
ShelleyBasedEra era
sbe
Network
networkId
Lovelace
deposit
StakeCredential
depositStakeCredential
GovernanceAction era
treasuryWithdrawals
Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
outFile (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Treasury withdrawal proposal") Proposal era
proposal
runGovernanceActionHardforkInitCmd
:: ()
=> GovernanceActionHardforkInitCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionHardforkInitCmd :: forall era.
GovernanceActionHardforkInitCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionHardforkInitCmd
Cmd.GovernanceActionHardforkInitCmdArgs
{ ConwayEraOnwards era
eon :: ConwayEraOnwards era
eon :: forall era.
GovernanceActionHardforkInitCmdArgs era -> ConwayEraOnwards era
Cmd.eon
, Network
networkId :: Network
networkId :: forall era. GovernanceActionHardforkInitCmdArgs era -> Network
Cmd.networkId
, Lovelace
deposit :: Lovelace
deposit :: forall era. GovernanceActionHardforkInitCmdArgs era -> Lovelace
Cmd.deposit
, StakeIdentifier
returnStakeAddress :: StakeIdentifier
returnStakeAddress :: forall era.
GovernanceActionHardforkInitCmdArgs era -> StakeIdentifier
Cmd.returnStakeAddress
, Maybe (TxId, Word16)
mPrevGovernanceActionId :: Maybe (TxId, Word16)
mPrevGovernanceActionId :: forall era.
GovernanceActionHardforkInitCmdArgs era -> Maybe (TxId, Word16)
Cmd.mPrevGovernanceActionId
, ProposalUrl
proposalUrl :: ProposalUrl
proposalUrl :: forall era. GovernanceActionHardforkInitCmdArgs era -> ProposalUrl
Cmd.proposalUrl
, proposalHash :: forall era.
GovernanceActionHardforkInitCmdArgs era
-> SafeHash StandardCrypto AnchorData
Cmd.proposalHash = SafeHash StandardCrypto AnchorData
anchorDataHash
, MustCheckHash ProposalUrl
checkProposalHash :: MustCheckHash ProposalUrl
checkProposalHash :: forall era.
GovernanceActionHardforkInitCmdArgs era
-> MustCheckHash ProposalUrl
Cmd.checkProposalHash
, ProtVer
protVer :: ProtVer
protVer :: forall era. GovernanceActionHardforkInitCmdArgs era -> ProtVer
Cmd.protVer
, File () 'Out
outFile :: File () 'Out
outFile :: forall era. GovernanceActionHardforkInitCmdArgs era -> File () 'Out
Cmd.outFile
} = do
StakeCredential
depositStakeCredential <-
(StakeCredentialError -> GovernanceActionsError)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeCredentialError -> GovernanceActionsError
GovernanceActionsReadStakeCredErrror (ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT GovernanceActionsError IO StakeCredential
forall a b. (a -> b) -> a -> b
$
StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnStakeAddress
let proposalAnchor :: Anchor StandardCrypto
proposalAnchor =
L.Anchor
{ anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
, SafeHash StandardCrypto AnchorData
anchorDataHash :: SafeHash StandardCrypto AnchorData
anchorDataHash :: SafeHash StandardCrypto AnchorData
L.anchorDataHash
}
MustCheckHash ProposalUrl
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor StandardCrypto
proposalAnchor AnchorDataTypeCheck
ProposalCheck
let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
conwayEraOnwardsToShelleyBasedEra ConwayEraOnwards era
eon
govActIdentifier :: StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
govActIdentifier =
Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> StrictMaybe
(GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)))
-> (ShelleyBasedEraConstraints era =>
Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)))
-> Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$
(TxId
-> Word16 -> GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> (TxId, Word16)
-> GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxId
-> Word16 -> GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era)
forall era (r :: GovActionPurpose).
(EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) =>
TxId -> Word16 -> GovPurposeId r (ShelleyLedgerEra era)
createPreviousGovernanceActionId ((TxId, Word16)
-> GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> Maybe (TxId, Word16)
-> Maybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxId, Word16)
mPrevGovernanceActionId
initHardfork :: GovernanceAction era
initHardfork =
StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> ProtVer -> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
-> ProtVer -> GovernanceAction era
InitiateHardfork
StrictMaybe (GovPurposeId 'HardForkPurpose (ShelleyLedgerEra era))
govActIdentifier
ProtVer
protVer
proposalProcedure :: Proposal era
proposalProcedure = ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor StandardCrypto
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
initHardfork Anchor StandardCrypto
proposalAnchor
(FileError () -> GovernanceActionsError)
-> ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceActionsError
GovernanceActionsCmdWriteFileError (ExceptT (FileError ()) IO ()
-> ExceptT GovernanceActionsError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ()))
-> (ConwayEraOnwardsConstraints era =>
IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
File () 'Out
-> Maybe TextEnvelopeDescr
-> Proposal era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope File () 'Out
outFile (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Hardfork initiation proposal") Proposal era
proposalProcedure
carryHashChecks
:: MustCheckHash a
-> L.Anchor L.StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks :: forall a.
MustCheckHash a
-> Anchor StandardCrypto
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash a
checkHash Anchor StandardCrypto
anchor AnchorDataTypeCheck
checkType =
case MustCheckHash a
checkHash of
MustCheckHash a
CheckHash -> do
AnchorData
anchorData <-
ByteString -> AnchorData
L.AnchorData
(ByteString -> AnchorData)
-> ExceptT GovernanceActionsError IO ByteString
-> ExceptT GovernanceActionsError IO AnchorData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnchorDataTypeCheck
-> ExceptT FetchURLError IO ByteString
-> ExceptT GovernanceActionsError IO ByteString
forall a.
AnchorDataTypeCheck
-> ExceptT FetchURLError IO a
-> ExceptT GovernanceActionsError IO a
fetchURLErrorToGovernanceActionError
AnchorDataTypeCheck
checkType
([SupportedSchemas] -> Url -> ExceptT FetchURLError IO ByteString
getByteStringFromURL [SupportedSchemas]
httpsAndIpfsSchemas (Url -> ExceptT FetchURLError IO ByteString)
-> Url -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ Anchor StandardCrypto -> Url
forall c. Anchor c -> Url
L.anchorUrl Anchor StandardCrypto
anchor)
let hash :: SafeHash StandardCrypto AnchorData
hash = AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
L.hashAnchorData AnchorData
anchorData
Bool
-> ExceptT GovernanceActionsError IO ()
-> ExceptT GovernanceActionsError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SafeHash StandardCrypto AnchorData
hash SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto AnchorData -> Bool
forall a. Eq a => a -> a -> Bool
/= Anchor StandardCrypto -> SafeHash StandardCrypto AnchorData
forall c. Anchor c -> SafeHash c AnchorData
L.anchorDataHash Anchor StandardCrypto
anchor) (ExceptT GovernanceActionsError IO ()
-> ExceptT GovernanceActionsError IO ())
-> ExceptT GovernanceActionsError IO ()
-> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
GovernanceActionsError -> ExceptT GovernanceActionsError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (GovernanceActionsError -> ExceptT GovernanceActionsError IO ())
-> GovernanceActionsError -> ExceptT GovernanceActionsError IO ()
forall a b. (a -> b) -> a -> b
$
AnchorDataTypeCheck
-> SafeHash StandardCrypto AnchorData
-> SafeHash StandardCrypto AnchorData
-> GovernanceActionsError
GovernanceActionsMismatchedHashError AnchorDataTypeCheck
checkType (Anchor StandardCrypto -> SafeHash StandardCrypto AnchorData
forall c. Anchor c -> SafeHash c AnchorData
L.anchorDataHash Anchor StandardCrypto
anchor) SafeHash StandardCrypto AnchorData
hash
MustCheckHash a
TrustHash -> () -> ExceptT GovernanceActionsError IO ()
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()