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

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

import Cardano.Api as Api
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger (StrictMaybe (..))
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Governance.Types (CostModelsFile (..))
import Cardano.CLI.Compatible.Json.Friendly
import Cardano.CLI.EraBased.Governance.Actions.Command
import Cardano.CLI.EraBased.Governance.Actions.Command qualified as Cmd
import Cardano.CLI.EraBased.Script.Proposal.Read
import Cardano.CLI.EraBased.Script.Proposal.Type
import Cardano.CLI.EraIndependent.Hash.Internal.Common (getByteStringFromURL, httpsAndIpfsSchemes)
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
  -> CIO e ()
runGovernanceActionCmds :: forall era e. GovernanceActionCmds era -> CIO e ()
runGovernanceActionCmds = \case
  GovernanceActionCreateConstitutionCmd GovernanceActionCreateConstitutionCmdArgs era
args ->
    GovernanceActionCreateConstitutionCmdArgs era -> CIO e ()
forall era e.
GovernanceActionCreateConstitutionCmdArgs era -> CIO e ()
runGovernanceActionCreateConstitutionCmd GovernanceActionCreateConstitutionCmdArgs era
args
  GovernanceActionProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
args ->
    GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
runGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
args
  GovernanceActionTreasuryWithdrawalCmd GovernanceActionTreasuryWithdrawalCmdArgs era
args ->
    GovernanceActionTreasuryWithdrawalCmdArgs era -> CIO e ()
forall era e.
GovernanceActionTreasuryWithdrawalCmdArgs era -> CIO e ()
runGovernanceActionTreasuryWithdrawalCmd GovernanceActionTreasuryWithdrawalCmdArgs era
args
  GovernanceActionUpdateCommitteeCmd GovernanceActionUpdateCommitteeCmdArgs era
args ->
    GovernanceActionUpdateCommitteeCmdArgs era -> CIO e ()
forall era e.
GovernanceActionUpdateCommitteeCmdArgs era -> CIO e ()
runGovernanceActionUpdateCommitteeCmd GovernanceActionUpdateCommitteeCmdArgs era
args
  GovernanceActionCreateNoConfidenceCmd GovernanceActionCreateNoConfidenceCmdArgs era
args ->
    GovernanceActionCreateNoConfidenceCmdArgs era -> CIO e ()
forall era e.
GovernanceActionCreateNoConfidenceCmdArgs era -> CIO e ()
runGovernanceActionCreateNoConfidenceCmd GovernanceActionCreateNoConfidenceCmdArgs era
args
  GovernanceActionHardforkInitCmd GovernanceActionHardforkInitCmdArgs era
args ->
    GovernanceActionHardforkInitCmdArgs era -> CIO e ()
forall era e. GovernanceActionHardforkInitCmdArgs era -> CIO e ()
runGovernanceActionHardforkInitCmd GovernanceActionHardforkInitCmdArgs era
args
  GovernanceActionInfoCmd GovernanceActionInfoCmdArgs era
args ->
    GovernanceActionInfoCmdArgs era -> CIO e ()
forall era e. GovernanceActionInfoCmdArgs era -> CIO e ()
runGovernanceActionInfoCmd GovernanceActionInfoCmdArgs era
args
  GovernanceActionViewCmd GovernanceActionViewCmdArgs era
args ->
    GovernanceActionViewCmdArgs era -> CIO e ()
forall era e. GovernanceActionViewCmdArgs era -> CIO e ()
runGovernanceActionViewCmd GovernanceActionViewCmdArgs era
args

runGovernanceActionViewCmd
  :: forall era e
   . GovernanceActionViewCmdArgs era
  -> CIO e ()
runGovernanceActionViewCmd :: forall era e. GovernanceActionViewCmdArgs era -> CIO e ()
runGovernanceActionViewCmd
  Cmd.GovernanceActionViewCmdArgs
    { ProposalFile 'In
actionFile :: ProposalFile 'In
actionFile :: forall era. GovernanceActionViewCmdArgs era -> ProposalFile 'In
Cmd.actionFile
    , Vary '[FormatJson, FormatYaml]
outputFormat :: Vary '[FormatJson, FormatYaml]
outputFormat :: forall era.
GovernanceActionViewCmdArgs era -> Vary '[FormatJson, FormatYaml]
Cmd.outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. GovernanceActionViewCmdArgs era -> Maybe (File () 'Out)
Cmd.mOutFile
    , Era era
era :: Era era
era :: forall era. GovernanceActionViewCmdArgs era -> Era era
Cmd.era
    } = Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    (Proposal era, Maybe (ProposalScriptWitness era))
proposal :: (Proposal era, Maybe (ProposalScriptWitness era)) <-
      (ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, Maybe (ProposalScriptWitness era))
forall era e.
IsEra era =>
(ProposalFile 'In, Maybe (ScriptRequirements 'ProposalItem))
-> CIO e (Proposal era, Maybe (ProposalScriptWitness era))
readProposal (ProposalFile 'In
actionFile, Maybe (ScriptRequirements 'ProposalItem)
forall a. Maybe a
Nothing)

    RIO e (Either (FileError Any) ()) -> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO e (Either (FileError Any) ()) -> RIO e ())
-> RIO e (Either (FileError Any) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> Proposal era
-> RIO e (Either (FileError Any) ())
forall (m :: * -> *) era e.
(MonadIO m, IsEra era) =>
Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> Proposal era
-> m (Either (FileError e) ())
friendlyProposal Vary '[FormatJson, FormatYaml]
outputFormat Maybe (File () 'Out)
mOutFile (Proposal era -> RIO e (Either (FileError Any) ()))
-> Proposal era -> RIO e (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$ (Proposal era, Maybe (ProposalScriptWitness era)) -> Proposal era
forall a b. (a, b) -> a
fst (Proposal era, Maybe (ProposalScriptWitness era))
proposal

runGovernanceActionInfoCmd
  :: forall era e
   . ()
  => GovernanceActionInfoCmdArgs era
  -> CIO e ()
runGovernanceActionInfoCmd :: forall era e. GovernanceActionInfoCmdArgs era -> CIO e ()
runGovernanceActionInfoCmd
  Cmd.GovernanceActionInfoCmdArgs
    { Era era
era :: Era era
era :: forall era. GovernanceActionInfoCmdArgs era -> Era era
Cmd.era
    , 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 <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e 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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        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

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' 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 e
   . ()
  => GovernanceActionCreateNoConfidenceCmdArgs era
  -> CIO e ()
runGovernanceActionCreateNoConfidenceCmd :: forall era e.
GovernanceActionCreateNoConfidenceCmdArgs era -> CIO e ()
runGovernanceActionCreateNoConfidenceCmd
  Cmd.GovernanceActionCreateNoConfidenceCmdArgs
    { Era era
era :: Era era
era :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> Era era
Cmd.era
    , 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 GovActionId
mPrevGovernanceActionId :: Maybe GovActionId
mPrevGovernanceActionId :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> Maybe GovActionId
Cmd.mPrevGovernanceActionId
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionCreateNoConfidenceCmdArgs era -> File () 'Out
Cmd.outFile
    } = do
    StakeCredential
depositStakeCredential <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e 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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        previousGovernanceAction :: GovernanceAction era
previousGovernanceAction =
          StrictMaybe (GovPurposeId 'CommitteePurpose)
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> GovernanceAction era
MotionOfNoConfidence (StrictMaybe (GovPurposeId 'CommitteePurpose)
 -> GovernanceAction era)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
-> GovernanceAction era
forall a b. (a -> b) -> a -> b
$
            Maybe (GovPurposeId 'CommitteePurpose)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'CommitteePurpose)
 -> StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Maybe (GovPurposeId 'CommitteePurpose)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a b. (a -> b) -> a -> b
$
              Era era
-> (EraCommonConstraints era =>
    Maybe (GovPurposeId 'CommitteePurpose))
-> Maybe (GovPurposeId 'CommitteePurpose)
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  Maybe (GovPurposeId 'CommitteePurpose))
 -> Maybe (GovPurposeId 'CommitteePurpose))
-> (EraCommonConstraints era =>
    Maybe (GovPurposeId 'CommitteePurpose))
-> Maybe (GovPurposeId 'CommitteePurpose)
forall a b. (a -> b) -> a -> b
$
                GovActionId -> GovPurposeId 'CommitteePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'CommitteePurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'CommitteePurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
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

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 e
   . ()
  => GovernanceActionCreateConstitutionCmdArgs era
  -> CIO e ()
runGovernanceActionCreateConstitutionCmd :: forall era e.
GovernanceActionCreateConstitutionCmdArgs era -> CIO e ()
runGovernanceActionCreateConstitutionCmd
  Cmd.GovernanceActionCreateConstitutionCmdArgs
    { Era era
era :: Era era
era :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> Era era
Cmd.era
    , 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 GovActionId
mPrevGovernanceActionId :: Maybe GovActionId
mPrevGovernanceActionId :: forall era.
GovernanceActionCreateConstitutionCmdArgs era -> Maybe GovActionId
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 <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e 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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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)
prevGovActId =
          Maybe (GovPurposeId 'ConstitutionPurpose)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'ConstitutionPurpose)
 -> StrictMaybe (GovPurposeId 'ConstitutionPurpose))
-> Maybe (GovPurposeId 'ConstitutionPurpose)
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose)
forall a b. (a -> b) -> a -> b
$
            GovActionId -> GovPurposeId 'ConstitutionPurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'ConstitutionPurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'ConstitutionPurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
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)
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Anchor -> StrictMaybe ScriptHash -> GovernanceAction era
ProposeNewConstitution
            StrictMaybe (GovPurposeId 'ConstitutionPurpose)
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 = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        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

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ MustCheckHash ConstitutionUrl
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
forall a.
MustCheckHash a
-> Anchor
-> AnchorDataTypeCheck
-> ExceptT GovernanceActionsError IO ()
carryHashChecks MustCheckHash ConstitutionUrl
checkConstitutionHash Anchor
constitutionAnchor AnchorDataTypeCheck
ConstitutionCheck

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 e
   . ()
  => GovernanceActionUpdateCommitteeCmdArgs era
  -> CIO e ()
runGovernanceActionUpdateCommitteeCmd :: forall era e.
GovernanceActionUpdateCommitteeCmdArgs era -> CIO e ()
runGovernanceActionUpdateCommitteeCmd
  Cmd.GovernanceActionUpdateCommitteeCmdArgs
    { Era era
era :: Era era
era :: forall era. GovernanceActionUpdateCommitteeCmdArgs era -> Era era
Cmd.era
    , 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 GovActionId
mPrevGovernanceActionId :: Maybe GovActionId
mPrevGovernanceActionId :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> Maybe GovActionId
Cmd.mPrevGovernanceActionId
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceActionUpdateCommitteeCmdArgs era -> File () 'Out
Cmd.outFile
    } = do
    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        govActIdentifier :: StrictMaybe (GovPurposeId 'CommitteePurpose)
govActIdentifier =
          Maybe (GovPurposeId 'CommitteePurpose)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'CommitteePurpose)
 -> StrictMaybe (GovPurposeId 'CommitteePurpose))
-> Maybe (GovPurposeId 'CommitteePurpose)
-> StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a b. (a -> b) -> a -> b
$
            GovActionId -> GovPurposeId 'CommitteePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'CommitteePurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'CommitteePurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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
    -> RIO e (Credential 'ColdCommitteeRole))
-> RIO e [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
  -> RIO e (Credential 'ColdCommitteeRole))
 -> RIO e [Credential 'ColdCommitteeRole])
-> (VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
    -> RIO e (Credential 'ColdCommitteeRole))
-> RIO e [Credential 'ColdCommitteeRole]
forall a b. (a -> b) -> a -> b
$ \VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile ->
      (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
forall keyrole (kr :: KeyRole) e.
Key keyrole =>
(Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> CIO e (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash
        Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
unCommitteeColdKeyHash
        VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile

    [(Credential 'ColdCommitteeRole, EpochNo)]
newCommitteeKeyHashes <- [(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
  EpochNo)]
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
     EpochNo)
    -> RIO e (Credential 'ColdCommitteeRole, EpochNo))
-> RIO e [(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)
  -> RIO e (Credential 'ColdCommitteeRole, EpochNo))
 -> RIO e [(Credential 'ColdCommitteeRole, EpochNo)])
-> ((VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey,
     EpochNo)
    -> RIO e (Credential 'ColdCommitteeRole, EpochNo))
-> RIO e [(Credential 'ColdCommitteeRole, EpochNo)]
forall a b. (a -> b) -> a -> b
$ \(VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile, EpochNo
expEpoch) -> do
      Credential 'ColdCommitteeRole
kh <-
        (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
-> CIO e (Credential 'ColdCommitteeRole)
forall keyrole (kr :: KeyRole) e.
Key keyrole =>
(Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScriptHash keyrole
-> CIO e (Credential kr)
readVerificationKeyOrHashOrFileOrScriptHash
          Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
unCommitteeColdKeyHash
          VerificationKeyOrHashOrFileOrScriptHash CommitteeColdKey
vkeyOrHashOrTextFile
      (Credential 'ColdCommitteeRole, EpochNo)
-> RIO e (Credential 'ColdCommitteeRole, EpochNo)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'ColdCommitteeRole
kh, EpochNo
expEpoch)

    StakeCredential
depositStakeCredential <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddress

    let proposeNewCommittee :: GovernanceAction era
proposeNewCommittee =
          StrictMaybe (GovPurposeId 'CommitteePurpose)
-> [Credential 'ColdCommitteeRole]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose)
-> [Credential 'ColdCommitteeRole]
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> Rational
-> GovernanceAction era
ProposeNewCommittee
            StrictMaybe (GovPurposeId 'CommitteePurpose)
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

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 e
   . ()
  => Cmd.GovernanceActionProtocolParametersUpdateCmdArgs era
  -> CIO e ()
runGovernanceActionCreateProtocolParametersUpdateCmd :: forall era e.
GovernanceActionProtocolParametersUpdateCmdArgs era -> CIO e ()
runGovernanceActionCreateProtocolParametersUpdateCmd GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams' = do
  let era :: Era era
era = GovernanceActionProtocolParametersUpdateCmdArgs era -> Era era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> Era era
uppShelleyBasedEra GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
      sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
      oFp :: File () 'Out
oFp = GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era -> File () 'Out
uppFilePath GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'
      UpdateProtocolParametersConwayOnwards
        Era era
_cOnwards
        Network
network
        Lovelace
deposit
        StakeIdentifier
returnAddr
        ProposalUrl
proposalUrl
        SafeHash AnchorData
proposalHash
        MustCheckHash ProposalUrl
checkProposalHash
        Maybe GovActionId
mPrevGovActId
        Maybe ScriptHash
mConstitutionalScriptHash = GovernanceActionProtocolParametersUpdateCmdArgs era
-> UpdateProtocolParametersConwayOnwards era
forall era.
GovernanceActionProtocolParametersUpdateCmdArgs era
-> UpdateProtocolParametersConwayOnwards era
uppConwayOnwards GovernanceActionProtocolParametersUpdateCmdArgs era
eraBasedPParams'

  EraBasedProtocolParametersUpdate era
eraBasedPParams <- ExceptT
  GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
-> RIO e (EraBasedProtocolParametersUpdate era)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli ExceptT
  GovernanceActionsError IO (EraBasedProtocolParametersUpdate era)
theUpdate

  StakeCredential
depositStakeCredential <-
    StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e 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)
prevGovActId = Maybe (GovPurposeId 'PParamUpdatePurpose)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'PParamUpdatePurpose)
 -> StrictMaybe (GovPurposeId 'PParamUpdatePurpose))
-> Maybe (GovPurposeId 'PParamUpdatePurpose)
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovPurposeId 'PParamUpdatePurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'PParamUpdatePurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'PParamUpdatePurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
mPrevGovActId
      proposalAnchor :: Anchor
proposalAnchor =
        L.Anchor
          { anchorUrl :: Url
L.anchorUrl = ProposalUrl -> Url
unProposalUrl ProposalUrl
proposalUrl
          , anchorDataHash :: SafeHash AnchorData
L.anchorDataHash = SafeHash AnchorData
proposalHash
          }

  ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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)
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate (ShelleyLedgerEra era)
-> StrictMaybe ScriptHash
-> GovernanceAction era
UpdatePParams
          StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
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

  forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    Era era
-> (EraCommonConstraints era => IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (EraCommonConstraints 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
 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 (CostModelsFile AlonzoEraOnwards era
alonzoOnwards File CostModels 'In
costModelsFile) -> do
        CostModels
costModels <-
          (CostModelsError -> GovernanceActionsError)
-> ExceptT CostModelsError IO CostModels
-> ExceptT GovernanceActionsError IO CostModels
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' 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
addCostModelsToEraBasedProtocolParametersUpdate
  AlonzoEraOnwards era
AlonzoEraOnwardsDijkstra
  CostModels
_
  EraBasedProtocolParametersUpdate era
_ =
    -- TODO: Dijkstra
    -- Add new protocol parameters from
    -- https://github.com/IntersectMBO/cardano-ledger/blob/master/eras/dijkstra/src/Cardano/Ledger/Dijkstra/PParams.hs#L75
    -- to
    -- https://github.com/IntersectMBO/cardano-api/blob/master/cardano-api/src/Cardano/Api/ProtocolParameters.hs#L190
    -- and remove this `error`
    [Char] -> EraBasedProtocolParametersUpdate era
forall a. HasCallStack => [Char] -> a
error [Char]
"addCostModelsToEraBasedProtocolParametersUpdate: Dijkstra not supported yet"

runGovernanceActionTreasuryWithdrawalCmd
  :: forall era e
   . ()
  => GovernanceActionTreasuryWithdrawalCmdArgs era
  -> CIO e ()
runGovernanceActionTreasuryWithdrawalCmd :: forall era e.
GovernanceActionTreasuryWithdrawalCmdArgs era -> CIO e ()
runGovernanceActionTreasuryWithdrawalCmd
  Cmd.GovernanceActionTreasuryWithdrawalCmdArgs
    { Era era
era :: Era era
era :: forall era.
GovernanceActionTreasuryWithdrawalCmdArgs era -> Era era
Cmd.era
    , 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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
returnAddr

    [(Network, StakeCredential, Lovelace)]
withdrawals <- [(StakeIdentifier, Lovelace)]
-> ((StakeIdentifier, Lovelace)
    -> RIO e (Network, StakeCredential, Lovelace))
-> RIO e [(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)
  -> RIO e (Network, StakeCredential, Lovelace))
 -> RIO e [(Network, StakeCredential, Lovelace)])
-> ((StakeIdentifier, Lovelace)
    -> RIO e (Network, StakeCredential, Lovelace))
-> RIO e [(Network, StakeCredential, Lovelace)]
forall a b. (a -> b) -> a -> b
$ \(StakeIdentifier
stakeIdentifier, Lovelace
lovelace) -> do
      StakeCredential
stakeCredential <-
        StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e StakeCredential
getStakeCredentialFromIdentifier StakeIdentifier
stakeIdentifier
      (Network, StakeCredential, Lovelace)
-> RIO e (Network, StakeCredential, Lovelace)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network
networkId, StakeCredential
stakeCredential, Lovelace
lovelace)

    let sbe :: ShelleyBasedEra era
sbe = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        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

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 e
   . ()
  => GovernanceActionHardforkInitCmdArgs era
  -> CIO e ()
runGovernanceActionHardforkInitCmd :: forall era e. GovernanceActionHardforkInitCmdArgs era -> CIO e ()
runGovernanceActionHardforkInitCmd
  Cmd.GovernanceActionHardforkInitCmdArgs
    { Era era
era :: Era era
era :: forall era. GovernanceActionHardforkInitCmdArgs era -> Era era
Cmd.era
    , 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 GovActionId
mPrevGovernanceActionId :: Maybe GovActionId
mPrevGovernanceActionId :: forall era.
GovernanceActionHardforkInitCmdArgs era -> Maybe GovActionId
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 <-
      StakeIdentifier -> CIO e StakeCredential
forall e. StakeIdentifier -> CIO e 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
            }

    ExceptT GovernanceActionsError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceActionsError IO () -> RIO e ())
-> ExceptT GovernanceActionsError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 = Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
era
        govActIdentifier :: StrictMaybe (GovPurposeId 'HardForkPurpose)
govActIdentifier =
          Maybe (GovPurposeId 'HardForkPurpose)
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. Maybe a -> StrictMaybe a
L.maybeToStrictMaybe (Maybe (GovPurposeId 'HardForkPurpose)
 -> StrictMaybe (GovPurposeId 'HardForkPurpose))
-> Maybe (GovPurposeId 'HardForkPurpose)
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a b. (a -> b) -> a -> b
$
            GovActionId -> GovPurposeId 'HardForkPurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
L.GovPurposeId (GovActionId -> GovPurposeId 'HardForkPurpose)
-> Maybe GovActionId -> Maybe (GovPurposeId 'HardForkPurpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GovActionId
mPrevGovernanceActionId
        initHardfork :: GovernanceAction era
initHardfork =
          StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovernanceAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovernanceAction era
InitiateHardfork
            StrictMaybe (GovPurposeId 'HardForkPurpose)
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

    Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      IO (Either (FileError ()) ()) -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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 ()