{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.CLI.EraBased.Governance.Actions.Run
  ( runGovernanceActionCmds
  , GovernanceActionsError (..)
  , addCostModelsToEraBasedProtocolParametersUpdate
  )
where

import Cardano.Api
import Cardano.Api.Ledger (StrictMaybe (..))
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Shelley

import Cardano.CLI.EraBased.Governance.Actions.Command
import Cardano.CLI.EraBased.Governance.Actions.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Hash.Internal.Common (getByteStringFromURL, httpsAndIpfsSchemes)
import Cardano.CLI.Json.Friendly
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.GovernanceActionsError
import Cardano.CLI.Type.Error.HashCmdError (FetchURLError)
import Cardano.CLI.Type.Key
import Cardano.Ledger.Hashes qualified as L

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 (ProposalScriptWitness era)) -> Proposal era)
-> ExceptT
     GovernanceActionsError
     IO
     (Proposal era, Maybe (ProposalScriptWitness 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 (ProposalScriptWitness era)) -> Proposal era
forall a b. (a, b) -> a
fst (ExceptT
   GovernanceActionsError
   IO
   (Proposal era, Maybe (ProposalScriptWitness era))
 -> ExceptT GovernanceActionsError IO (Proposal era))
-> (IO
      (Either
         ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
    -> ExceptT
         GovernanceActionsError
         IO
         (Proposal era, Maybe (ProposalScriptWitness era)))
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
-> ExceptT GovernanceActionsError IO (Proposal era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProposalError -> GovernanceActionsError)
-> ExceptT
     ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
-> ExceptT
     GovernanceActionsError
     IO
     (Proposal era, Maybe (ProposalScriptWitness 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 (ProposalScriptWitness era))
 -> ExceptT
      GovernanceActionsError
      IO
      (Proposal era, Maybe (ProposalScriptWitness era)))
-> (IO
      (Either
         ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
    -> ExceptT
         ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era)))
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
-> ExceptT
     GovernanceActionsError
     IO
     (Proposal era, Maybe (ProposalScriptWitness era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
-> ExceptT
     ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
 -> ExceptT GovernanceActionsError IO (Proposal era))
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
-> ExceptT GovernanceActionsError IO (Proposal era)
forall a b. (a -> b) -> a -> b
$
        ConwayEraOnwards era
-> (ProposalFile 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
forall era.
ConwayEraOnwards era
-> (ProposalFile 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
readProposal ConwayEraOnwards era
eon (ProposalFile 'In
actionFile, Maybe CliProposalScriptRequirements
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
  :: forall era
   . ()
  => 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 AnchorData
proposalHash :: SafeHash AnchorData
proposalHash :: forall era. GovernanceActionInfoCmdArgs era -> SafeHash 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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

    let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert 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
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
forall era. GovernanceAction era
govAction Anchor
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
  :: forall era
   . ()
  => 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 AnchorData
proposalHash :: SafeHash AnchorData
proposalHash :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era
-> SafeHash 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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

    let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert 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 (r :: GovActionPurpose) era.
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
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure
            ShelleyBasedEra era
sbe
            Network
networkId
            Lovelace
deposit
            StakeCredential
depositStakeCredential
            GovernanceAction era
previousGovernanceAction
            Anchor
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
  :: forall era
   . ()
  => 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 AnchorData
proposalHash :: SafeHash AnchorData
proposalHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> SafeHash 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 AnchorData
constitutionHash :: SafeHash AnchorData
constitutionHash :: forall era.
GovernanceActionCreateConstitutionCmdArgs era
-> SafeHash 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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
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 (r :: GovActionPurpose) era.
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
constitutionAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ConstitutionUrl -> Url
unConstitutionUrl ConstitutionUrl
constitutionUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
constitutionHash
            }
        govAct :: GovernanceAction era
govAct =
          StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
ProposeNewConstitution
            StrictMaybe
  (GovPurposeId 'ConstitutionPurpose (ShelleyLedgerEra era))
prevGovActId
            Anchor
constitutionAnchor
            (ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> ScriptHash)
-> StrictMaybe ScriptHash -> StrictMaybe ScriptHash
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
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
eon
        proposalProcedure :: Proposal era
proposalProcedure = ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
govAct Anchor
proposalAnchor

    MustCheckHash ConstitutionUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ConstitutionUrl
checkConstitutionHash Anchor
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
  :: forall era
   . ()
  => 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 AnchorData
proposalHash :: SafeHash AnchorData
proposalHash :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> SafeHash 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
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert 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 (r :: GovActionPurpose) era.
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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

    [Credential 'ColdCommitteeRole]
oldCommitteeKeyHashes <- [VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey]
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
    -> ExceptT
         GovernanceActionsError IO (Credential 'ColdCommitteeRole))
-> ExceptT
     GovernanceActionsError IO [Credential 'ColdCommitteeRole]
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))
 -> ExceptT
      GovernanceActionsError IO [Credential 'ColdCommitteeRole])
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
    -> ExceptT
         GovernanceActionsError IO (Credential 'ColdCommitteeRole))
-> ExceptT
     GovernanceActionsError IO [Credential 'ColdCommitteeRole]
forall a b. (a -> b) -> a -> b
$ \VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile ->
      (FileError InputDecodeError -> GovernanceActionsError)
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
-> ExceptT
     GovernanceActionsError IO (Credential 'ColdCommitteeRole)
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)
 -> ExceptT
      GovernanceActionsError IO (Credential 'ColdCommitteeRole))
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
-> ExceptT
     GovernanceActionsError IO (Credential 'ColdCommitteeRole)
forall a b. (a -> b) -> a -> b
$
        AsType CommitteeColdKey
-> (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash
          AsType CommitteeColdKey
AsCommitteeColdKey
          Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
unCommitteeColdKeyHash
          VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile

    [(Credential 'ColdCommitteeRole, EpochNo)]
newCommitteeKeyHashes <- [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
  EpochNo)]
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
     EpochNo)
    -> ExceptT
         GovernanceActionsError IO (Credential 'ColdCommitteeRole, EpochNo))
-> ExceptT
     GovernanceActionsError
     IO
     [(Credential 'ColdCommitteeRole, 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, EpochNo))
 -> ExceptT
      GovernanceActionsError
      IO
      [(Credential 'ColdCommitteeRole, EpochNo)])
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
     EpochNo)
    -> ExceptT
         GovernanceActionsError IO (Credential 'ColdCommitteeRole, EpochNo))
-> ExceptT
     GovernanceActionsError
     IO
     [(Credential 'ColdCommitteeRole, EpochNo)]
forall a b. (a -> b) -> a -> b
$ \(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile, EpochNo
expEpoch) -> do
      Credential 'ColdCommitteeRole
kh <-
        (FileError InputDecodeError -> GovernanceActionsError)
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
-> ExceptT
     GovernanceActionsError IO (Credential 'ColdCommitteeRole)
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)
 -> ExceptT
      GovernanceActionsError IO (Credential 'ColdCommitteeRole))
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
-> ExceptT
     GovernanceActionsError IO (Credential 'ColdCommitteeRole)
forall a b. (a -> b) -> a -> b
$
          AsType CommitteeColdKey
-> (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> ExceptT
     (FileError InputDecodeError) IO (Credential 'ColdCommitteeRole)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> t m (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash
            AsType CommitteeColdKey
AsCommitteeColdKey
            Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
unCommitteeColdKeyHash
            VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile
      (Credential 'ColdCommitteeRole, EpochNo)
-> ExceptT
     GovernanceActionsError IO (Credential 'ColdCommitteeRole, EpochNo)
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'ColdCommitteeRole
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]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
-> [Credential 'ColdCommitteeRole]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
ProposeNewCommittee
            StrictMaybe (GovPurposeId 'CommitteePurpose (ShelleyLedgerEra era))
govActIdentifier
            [Credential 'ColdCommitteeRole]
oldCommitteeKeyHashes
            ([Item (Map (Credential 'ColdCommitteeRole) EpochNo)]
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall l. IsList l => [Item l] -> l
fromList [(Credential 'ColdCommitteeRole, EpochNo)]
[Item (Map (Credential 'ColdCommitteeRole) EpochNo)]
newCommitteeKeyHashes)
            Rational
thresholdRational
        proposal :: Proposal era
proposal =
          ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure
            ShelleyBasedEra era
sbe
            Network
networkId
            Lovelace
deposit
            StakeCredential
depositStakeCredential
            GovernanceAction era
proposeNewCommittee
            Anchor
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
  :: forall era
   . ()
  => 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 (ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert 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 (ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
conwayOnwards)

        UpdateProtocolParametersConwayOnwards
          ConwayEraOnwards era
_cOnwards
          Network
network
          Lovelace
deposit
          StakeIdentifier
returnAddr
          ProposalUrl
proposalUrl
          SafeHash 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 (r :: GovActionPurpose) era.
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
proposalAnchor =
              L.Anchor
                { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
                , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
                }

        MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

        let govAct :: GovernanceAction era
govAct =
              StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
forall era.
StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
UpdatePParams
                StrictMaybe
  (GovPurposeId 'PParamUpdatePurpose (ShelleyLedgerEra era))
prevGovActId
                PParamsUpdate (ShelleyLedgerEra era)
updateProtocolParams
                (ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> ScriptHash)
-> StrictMaybe ScriptHash -> StrictMaybe ScriptHash
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
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
network Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
govAct Anchor
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
  :: forall era
   . ()
  => 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 AnchorData
proposalHash :: SafeHash AnchorData
proposalHash :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era
-> SafeHash 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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
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
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
eon
        treasuryWithdrawals :: GovernanceAction era
treasuryWithdrawals =
          [(Network, StakeCredential, Lovelace)]
-> StrictMaybe ScriptHash -> GovernanceAction era
forall era.
[(Network, StakeCredential, Lovelace)]
-> StrictMaybe ScriptHash -> GovernanceAction era
TreasuryWithdrawal
            [(Network, StakeCredential, Lovelace)]
withdrawals
            (ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> ScriptHash)
-> StrictMaybe ScriptHash -> StrictMaybe ScriptHash
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
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure
            ShelleyBasedEra era
sbe
            Network
networkId
            Lovelace
deposit
            StakeCredential
depositStakeCredential
            GovernanceAction era
treasuryWithdrawals
            Anchor
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
  :: forall era
   . ()
  => 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 AnchorData
Cmd.proposalHash = SafeHash 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
proposalAnchor =
          L.Anchor
            { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
            , SafeHash AnchorData
anchorDataHash :: SafeHash AnchorData
anchorDataHash :: SafeHash AnchorData
L.anchorDataHash
            }

    MustCheckHash ProposalUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ProposalUrl
checkProposalHash Anchor
proposalAnchor AnchorDataTypeCheck
ProposalCheck

    let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert 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 (r :: GovActionPurpose) era.
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
-> Proposal era
forall era.
ShelleyBasedEra era
-> Network
-> Lovelace
-> StakeCredential
-> GovernanceAction era
-> Anchor
-> Proposal era
createProposalProcedure ShelleyBasedEra era
sbe Network
networkId Lovelace
deposit StakeCredential
depositStakeCredential GovernanceAction era
initHardfork Anchor
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
  -- ^ 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
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash a
checkHash Anchor
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
            (SupportedSchemes -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL SupportedSchemes
httpsAndIpfsSchemes (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 -> Url
L.anchorUrl Anchor
anchor)
      let hash :: SafeHash AnchorData
hash = AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated AnchorData
anchorData
      Bool
-> ExceptT GovernanceActionsError IO ()
-> ExceptT GovernanceActionsError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SafeHash AnchorData
hash SafeHash AnchorData -> SafeHash AnchorData -> Bool
forall a. Eq a => a -> a -> Bool
/= Anchor -> SafeHash AnchorData
L.anchorDataHash Anchor
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 AnchorData
-> SafeHash AnchorData
-> GovernanceActionsError
GovernanceActionsMismatchedHashError AnchorDataTypeCheck
checkType (Anchor -> SafeHash AnchorData
L.anchorDataHash Anchor
anchor) SafeHash AnchorData
hash
    MustCheckHash a
TrustHash -> () -> ExceptT GovernanceActionsError IO ()
forall a. a -> ExceptT GovernanceActionsError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()