{-# 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)

-- TODO: Conway era - update with new ledger types from cardano-ledger-conway-1.7.0.0
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

-- TODO: Conway era - After ledger bump update this function
-- with the new ledger types
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

-- | Check the hash of the anchor data against the hash in the anchor if
-- checkHash is set to CheckHash.
carryHashChecks
  :: MustCheckHash a
  -- ^ Whether to check the hash or not (CheckHash for checking or TrustHash for not checking)
  -> L.Anchor L.StandardCrypto
  -- ^ The anchor data whose hash is to be checked
  -> AnchorDataTypeCheck
  -- ^ The type of anchor data to check (for error reporting purpouses)
  -> 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] -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL [SupportedSchemas]
httpsAndIpfsSchemas (Text -> ExceptT FetchURLError IO ByteString)
-> Text -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$ Url -> Text
L.urlToText (Url -> Text) -> Url -> Text
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 ()