-- | This module exposes the generation of proposal procedures
module Cooked.MockChain.GenerateTx.Proposal (toProposalProcedures) where

import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Ledger.BaseTypes qualified as C.Ledger
import Cardano.Ledger.Conway.Core qualified as Conway
import Cardano.Ledger.Conway.Governance qualified as Conway
import Cardano.Ledger.Conway.PParams qualified as Conway
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Monad
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Anchor
import Cooked.MockChain.GenerateTx.Credential
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.Read
import Cooked.Skeleton.Proposal
import Cooked.Skeleton.User
import Data.Coerce
import Data.Map qualified as Map
import Data.Map.Ordered.Strict qualified as OMap
import Data.Maybe
import Data.Maybe.Strict
import Ledger.Tx.CardanoAPI qualified as P.Ledger
import Lens.Micro qualified as Microlens
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import Polysemy
import Polysemy.Error

-- | Transorms a `Cooked.Skeleton.Proposal.ParamChange` into an actual change
-- over a Cardano parameter update
toPParamsUpdate ::
  forall effs.
  (Member (Error MockChainError) effs) =>
  ParamChange ->
  Conway.PParamsUpdate Emulator.EmulatorEra ->
  Sem effs (Conway.PParamsUpdate Emulator.EmulatorEra)
toPParamsUpdate :: forall (effs :: EffectRow).
Member (Error MockChainError) effs =>
ParamChange
-> PParamsUpdate EmulatorEra
-> Sem effs (PParamsUpdate EmulatorEra)
toPParamsUpdate ParamChange
pChange PParamsUpdate EmulatorEra
ppu =
  -- From rational to bounded rational
  let toBR :: (C.Ledger.BoundedRational r) => Rational -> r
      toBR :: forall r. BoundedRational r => Rational -> r
toBR = r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe r
forall a. Bounded a => a
minBound (Maybe r -> r) -> (Rational -> Maybe r) -> Rational -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Maybe r
forall r. BoundedRational r => Rational -> Maybe r
C.Ledger.boundRational
      -- Helper to set one of the param update with a lens. The explicit
      -- signature is needed so that it stays polymorphic in @a@ under
      -- @MonoLocalBinds@ despite closing over @effs@ and @ppu@.
      setL :: forall a. Microlens.ASetter' (Conway.PParamsUpdate Emulator.EmulatorEra) (StrictMaybe a) -> a -> Sem effs (Conway.PParamsUpdate Emulator.EmulatorEra)
      setL :: forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
l a
v = PParamsUpdate EmulatorEra -> Sem effs (PParamsUpdate EmulatorEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (PParamsUpdate EmulatorEra -> Sem effs (PParamsUpdate EmulatorEra))
-> PParamsUpdate EmulatorEra
-> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> StrictMaybe a
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall s t a b. ASetter s t a b -> b -> s -> t
Microlens.set ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
l (a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust a
v) PParamsUpdate EmulatorEra
ppu
   in case ParamChange
pChange of
        FeePerByte Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinFeeAL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        FeeFixed Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinFeeBL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        MaxBlockBodySize Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
-> Word32 -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
Conway.ppuMaxBBSizeL (Word32 -> Sem effs (PParamsUpdate EmulatorEra))
-> Word32 -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        MaxTxSize Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
-> Word32 -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
Conway.ppuMaxTxSizeL (Word32 -> Sem effs (PParamsUpdate EmulatorEra))
-> Word32 -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        MaxBlockHeaderSize Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
-> Word16 -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
Conway.ppuMaxBHSizeL (Word16 -> Sem effs (PParamsUpdate EmulatorEra))
-> Word16 -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        KeyDeposit Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuKeyDepositL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        PoolDeposit Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuPoolDepositL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        PoolRetirementMaxEpoch Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuEMaxL (EpochInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
C.Ledger.EpochInterval (Word32 -> EpochInterval) -> Word32 -> EpochInterval
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        PoolNumber Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
-> Word16 -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
Conway.ppuNOptL (Word16 -> Sem effs (PParamsUpdate EmulatorEra))
-> Word16 -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        PoolInfluence Rational
q -> ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
-> NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
Conway.ppuA0L (NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ NonNegativeInterval
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> Maybe a -> a
fromMaybe NonNegativeInterval
forall a. Bounded a => a
minBound (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
C.Ledger.boundRational Rational
q
        MonetaryExpansion Rational
q -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
-> UnitInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
Conway.ppuRhoL (UnitInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> UnitInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ UnitInterval -> Maybe UnitInterval -> UnitInterval
forall a. a -> Maybe a -> a
fromMaybe UnitInterval
forall a. Bounded a => a
minBound (Maybe UnitInterval -> UnitInterval)
-> Maybe UnitInterval -> UnitInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
C.Ledger.boundRational Rational
q
        TreasuryCut Rational
q -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
-> UnitInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
Conway.ppuTauL (UnitInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> UnitInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
q
        MinPoolCost Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinPoolCostL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        CoinsPerUTxOByte Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe CoinPerByte)
-> CoinPerByte -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe CoinPerByte)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe CoinPerByte)
Conway.ppuCoinsPerUTxOByteL (CoinPerByte -> Sem effs (PParamsUpdate EmulatorEra))
-> CoinPerByte -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Coin -> CoinPerByte
Conway.CoinPerByte (Coin -> CoinPerByte) -> Coin -> CoinPerByte
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        CostModels [Integer]
_pv1 [Integer]
_pv2 [Integer]
_pv3 -> MockChainError -> Sem effs (PParamsUpdate EmulatorEra)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs (PParamsUpdate EmulatorEra))
-> MockChainError -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
MCEUnsupportedFeature String
"CostModels"
        Prices Rational
q Rational
r -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Prices)
-> Prices -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Prices)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Prices)
Conway.ppuPricesL (Prices -> Sem effs (PParamsUpdate EmulatorEra))
-> Prices -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ NonNegativeInterval -> NonNegativeInterval -> Prices
Cardano.Prices (Rational -> NonNegativeInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
q) (Rational -> NonNegativeInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
r)
        MaxTxExUnits Integer
n Integer
m -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
-> ExUnits -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
Conway.ppuMaxTxExUnitsL (ExUnits -> Sem effs (PParamsUpdate EmulatorEra))
-> ExUnits -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
Cardano.ExUnits (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)
        MaxBlockExUnits Integer
n Integer
m -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
-> ExUnits -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
Conway.ppuMaxBlockExUnitsL (ExUnits -> Sem effs (PParamsUpdate EmulatorEra))
-> ExUnits -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExUnits
Cardano.ExUnits (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)
        MaxValSize Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuMaxValSizeL (Natural -> Sem effs (PParamsUpdate EmulatorEra))
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        CollateralPercentage Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuCollateralPercentageL (Natural -> Sem effs (PParamsUpdate EmulatorEra))
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        MaxCollateralInputs Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuMaxCollateralInputsL (Natural -> Sem effs (PParamsUpdate EmulatorEra))
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        PoolVotingThresholds Rational
a Rational
b Rational
c Rational
d Rational
e ->
          ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe PoolVotingThresholds)
-> PoolVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe PoolVotingThresholds)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
Lens'
  (PParamsUpdate EmulatorEra) (StrictMaybe PoolVotingThresholds)
Conway.ppuPoolVotingThresholdsL (PoolVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra))
-> PoolVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$
            UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> PoolVotingThresholds
Conway.PoolVotingThresholds (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
a) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
b) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
c) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
d) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
e)
        DRepVotingThresholds Rational
a Rational
b Rational
c Rational
d Rational
e Rational
f Rational
g Rational
h Rational
i Rational
j ->
          ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe DRepVotingThresholds)
-> DRepVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe DRepVotingThresholds)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
Lens'
  (PParamsUpdate EmulatorEra) (StrictMaybe DRepVotingThresholds)
Conway.ppuDRepVotingThresholdsL (DRepVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra))
-> DRepVotingThresholds -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$
            UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> DRepVotingThresholds
Conway.DRepVotingThresholds (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
a) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
b) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
c) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
d) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
e) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
f) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
g) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
h) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
i) (Rational -> UnitInterval
forall r. BoundedRational r => Rational -> r
toBR Rational
j)
        CommitteeMinSize Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuCommitteeMinSizeL (Natural -> Sem effs (PParamsUpdate EmulatorEra))
-> Natural -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        CommitteeMaxTermLength Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuCommitteeMaxTermLengthL (EpochInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
C.Ledger.EpochInterval (Word32 -> EpochInterval) -> Word32 -> EpochInterval
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        GovActionLifetime Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuGovActionLifetimeL (EpochInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
C.Ledger.EpochInterval (Word32 -> EpochInterval) -> Word32 -> EpochInterval
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        GovActionDeposit Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuGovActionDepositL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        DRepRegistrationDeposit Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuDRepDepositL (Coin -> Sem effs (PParamsUpdate EmulatorEra))
-> Coin -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        DRepActivity Integer
n -> ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuDRepActivityL (EpochInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> EpochInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
C.Ledger.EpochInterval (Word32 -> EpochInterval) -> Word32 -> EpochInterval
forall a b. (a -> b) -> a -> b
$ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
        MinFeeRefScriptCostPerByte Rational
q -> ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
-> NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a.
ASetter' (PParamsUpdate EmulatorEra) (StrictMaybe a)
-> a -> Sem effs (PParamsUpdate EmulatorEra)
setL ASetter'
  (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
Conway.ppuMinFeeRefScriptCostPerByteL (NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra))
-> NonNegativeInterval -> Sem effs (PParamsUpdate EmulatorEra)
forall a b. (a -> b) -> a -> b
$ NonNegativeInterval
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> Maybe a -> a
fromMaybe NonNegativeInterval
forall a. Bounded a => a
minBound (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
C.Ledger.boundRational Rational
q

-- | Translates a given skeleton proposal into a governance action
toGovAction ::
  (Members '[MockChainRead, Error MockChainError, Error P.Ledger.ToCardanoError] effs) =>
  GovernanceAction a ->
  StrictMaybe Conway.ScriptHash ->
  Sem effs (Conway.GovAction Emulator.EmulatorEra)
toGovAction :: forall (effs :: EffectRow) (a :: UserKind).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
GovernanceAction a
-> StrictMaybe ScriptHash -> Sem effs (GovAction EmulatorEra)
toGovAction GovernanceAction a
NoConfidence StrictMaybe ScriptHash
_ = GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra))
-> GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose EmulatorEra)
-> GovAction EmulatorEra
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
Conway.NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose EmulatorEra)
forall a. StrictMaybe a
SNothing
toGovAction UpdateCommittee {} StrictMaybe ScriptHash
_ = MockChainError -> Sem effs (GovAction EmulatorEra)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs (GovAction EmulatorEra))
-> MockChainError -> Sem effs (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
MCEUnsupportedFeature String
"UpdateCommittee"
toGovAction NewConstitution {} StrictMaybe ScriptHash
_ = MockChainError -> Sem effs (GovAction EmulatorEra)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs (GovAction EmulatorEra))
-> MockChainError -> Sem effs (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
MCEUnsupportedFeature String
"TxGovActionNewConstitution"
toGovAction HardForkInitiation {} StrictMaybe ScriptHash
_ = MockChainError -> Sem effs (GovAction EmulatorEra)
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs (GovAction EmulatorEra))
-> MockChainError -> Sem effs (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
MCEUnsupportedFeature String
"TxGovActionHardForkInitiation"
toGovAction (ParameterChange [ParamChange]
changes) StrictMaybe ScriptHash
sHash = do
  PParamsUpdate EmulatorEra
ppu <- (PParamsUpdate EmulatorEra
 -> ParamChange -> Sem effs (PParamsUpdate EmulatorEra))
-> PParamsUpdate EmulatorEra
-> [ParamChange]
-> Sem effs (PParamsUpdate EmulatorEra)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((ParamChange
 -> PParamsUpdate EmulatorEra
 -> Sem effs (PParamsUpdate EmulatorEra))
-> PParamsUpdate EmulatorEra
-> ParamChange
-> Sem effs (PParamsUpdate EmulatorEra)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParamChange
-> PParamsUpdate EmulatorEra
-> Sem effs (PParamsUpdate EmulatorEra)
forall (effs :: EffectRow).
Member (Error MockChainError) effs =>
ParamChange
-> PParamsUpdate EmulatorEra
-> Sem effs (PParamsUpdate EmulatorEra)
toPParamsUpdate) (PParamsHKD StrictMaybe EmulatorEra -> PParamsUpdate EmulatorEra
forall era. PParamsHKD StrictMaybe era -> PParamsUpdate era
Conway.PParamsUpdate PParamsHKD StrictMaybe EmulatorEra
forall era. EraPParams era => PParamsHKD StrictMaybe era
Cardano.emptyPParamsStrictMaybe) [ParamChange]
changes
  GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra))
-> GovAction EmulatorEra -> Sem effs (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'PParamUpdatePurpose EmulatorEra)
-> PParamsUpdate EmulatorEra
-> StrictMaybe ScriptHash
-> GovAction EmulatorEra
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
Conway.ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose EmulatorEra)
forall a. StrictMaybe a
SNothing PParamsUpdate EmulatorEra
ppu StrictMaybe ScriptHash
sHash
toGovAction (TreasuryWithdrawals (Map Credential Lovelace -> [(Credential, Lovelace)]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(Credential, Lovelace)]
withdrawals)) StrictMaybe ScriptHash
sHash =
  (Map RewardAccount Coin
-> StrictMaybe ScriptHash -> GovAction EmulatorEra
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
`Conway.TreasuryWithdrawals` StrictMaybe ScriptHash
sHash) (Map RewardAccount Coin -> GovAction EmulatorEra)
-> ([(RewardAccount, Coin)] -> Map RewardAccount Coin)
-> [(RewardAccount, Coin)]
-> GovAction EmulatorEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(RewardAccount, Coin)] -> GovAction EmulatorEra)
-> Sem effs [(RewardAccount, Coin)]
-> Sem effs (GovAction EmulatorEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Credential, Lovelace) -> Sem effs (RewardAccount, Coin))
-> [(Credential, Lovelace)] -> Sem effs [(RewardAccount, Coin)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Credential
cred, Api.Lovelace Integer
lv) -> (,Integer -> Coin
Cardano.Coin Integer
lv) (RewardAccount -> (RewardAccount, Coin))
-> Sem effs RewardAccount -> Sem effs (RewardAccount, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs RewardAccount
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs RewardAccount
toRewardAccount Credential
cred) [(Credential, Lovelace)]
withdrawals

-- | Translates a list of skeleton proposals into a proposal procedures
toProposalProcedures ::
  (Members '[MockChainRead, Error MockChainError, Error P.Ledger.ToCardanoError] effs) =>
  [TxSkelProposal] ->
  Sem effs (Cardano.TxProposalProcedures Cardano.BuildTx Cardano.ConwayEra)
toProposalProcedures :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
[TxSkelProposal]
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
toProposalProcedures [TxSkelProposal]
props | [TxSkelProposal] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxSkelProposal]
props = TxProposalProcedures BuildTx ConwayEra
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxProposalProcedures BuildTx ConwayEra
forall build era. TxProposalProcedures build era
Cardano.TxProposalProceduresNone
toProposalProcedures [TxSkelProposal]
props =
  OMap
  (ProposalProcedure (ShelleyLedgerEra ConwayEra))
  (BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> TxProposalProcedures BuildTx ConwayEra
OMap
  (ProposalProcedure EmulatorEra)
  (BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> TxProposalProcedures BuildTx ConwayEra
forall era build.
EraPParams (ShelleyLedgerEra era) =>
OMap
  (ProposalProcedure (ShelleyLedgerEra era))
  (BuildTxWith build (Maybe (ScriptWitness WitCtxStake era)))
-> TxProposalProcedures build era
Cardano.TxProposalProcedures (OMap
   (ProposalProcedure EmulatorEra)
   (BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
 -> TxProposalProcedures BuildTx ConwayEra)
-> ([(ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
    -> OMap
         (ProposalProcedure EmulatorEra)
         (BuildTxWith
            BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))))
-> [(ProposalProcedure EmulatorEra,
     BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
-> TxProposalProcedures BuildTx ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ProposalProcedure EmulatorEra,
  BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
-> OMap
     (ProposalProcedure EmulatorEra)
     (BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
    ([(ProposalProcedure EmulatorEra,
   BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
 -> TxProposalProcedures BuildTx ConwayEra)
-> Sem
     effs
     [(ProposalProcedure EmulatorEra,
       BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
-> Sem effs (TxProposalProcedures BuildTx ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSkelProposal]
-> (TxSkelProposal
    -> Sem
         effs
         (ProposalProcedure EmulatorEra,
          BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))))
-> Sem
     effs
     [(ProposalProcedure EmulatorEra,
       BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
      [TxSkelProposal]
props
      ( \(TxSkelProposal (cred -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
returnCredential) GovernanceAction kind
govAction Maybe (User kind 'Redemption)
mConstitution (TxSkelAnchor -> Anchor
toCardanoAnchor -> Anchor
anchor)) -> do
          Lovelace
proposalDeposit <- Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
govActionDeposit
          RewardAccount
rewardAccount <- Credential -> Sem effs RewardAccount
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs RewardAccount
toRewardAccount Credential
returnCredential
          (Maybe (ScriptWitness WitCtxStake ConwayEra)
-> BuildTxWith
     BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith -> BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))
mConstitutionWitness, StrictMaybe ScriptHash
mConstitutionHash) <- case Maybe (User kind 'Redemption)
mConstitution of
            Just (UserRedeemedScript (script -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> VScript
script) TxSkelRedeemer
redeemer) -> do
              ScriptWitness WitCtxStake ConwayEra
scriptWitness <- VScript
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> Sem effs (ScriptWitness WitCtxStake ConwayEra)
forall (effs :: EffectRow) a b.
(Members
   '[MockChainRead, Error MockChainError, Error ToCardanoError] effs,
 ToVScript a) =>
a
-> TxSkelRedeemer
-> ScriptDatum b
-> Sem effs (ScriptWitness b ConwayEra)
toScriptWitness VScript
script TxSkelRedeemer
redeemer ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake
              Cardano.ScriptHash ScriptHash
scriptHash <- Either ToCardanoError ScriptHash -> Sem effs ScriptHash
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError ScriptHash -> Sem effs ScriptHash)
-> Either ToCardanoError ScriptHash -> Sem effs ScriptHash
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Either ToCardanoError ScriptHash
P.Ledger.toCardanoScriptHash (ScriptHash -> Either ToCardanoError ScriptHash)
-> ScriptHash -> Either ToCardanoError ScriptHash
forall a b. (a -> b) -> a -> b
$ VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash VScript
script
              (Maybe (ScriptWitness WitCtxStake ConwayEra),
 StrictMaybe ScriptHash)
-> Sem
     effs
     (Maybe (ScriptWitness WitCtxStake ConwayEra),
      StrictMaybe ScriptHash)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness WitCtxStake ConwayEra
-> Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. a -> Maybe a
Just ScriptWitness WitCtxStake ConwayEra
scriptWitness, ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
scriptHash)
            Maybe (User kind 'Redemption)
_ -> (Maybe (ScriptWitness WitCtxStake ConwayEra),
 StrictMaybe ScriptHash)
-> Sem
     effs
     (Maybe (ScriptWitness WitCtxStake ConwayEra),
      StrictMaybe ScriptHash)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. Maybe a
Nothing, StrictMaybe ScriptHash
forall a. StrictMaybe a
SNothing)
          GovAction EmulatorEra
cardanoGovAction <- GovernanceAction kind
-> StrictMaybe ScriptHash -> Sem effs (GovAction EmulatorEra)
forall (effs :: EffectRow) (a :: UserKind).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
GovernanceAction a
-> StrictMaybe ScriptHash -> Sem effs (GovAction EmulatorEra)
toGovAction GovernanceAction kind
govAction StrictMaybe ScriptHash
mConstitutionHash
          (ProposalProcedure EmulatorEra,
 BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> Sem
     effs
     (ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coin
-> RewardAccount
-> GovAction EmulatorEra
-> Anchor
-> ProposalProcedure EmulatorEra
forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
Conway.ProposalProcedure (Integer -> Coin
Cardano.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Lovelace -> Integer
forall a b. Coercible a b => a -> b
coerce Lovelace
proposalDeposit) RewardAccount
rewardAccount GovAction EmulatorEra
cardanoGovAction Anchor
anchor, BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))
mConstitutionWitness)
      )