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

import Cardano.Api qualified as Cardano
import Cardano.Ledger.BaseTypes qualified as Cardano
import Cardano.Ledger.Conway.Core qualified as Conway
import Cardano.Ledger.Conway.Governance qualified as Conway
import Cardano.Ledger.Core qualified as Cardano (emptyPParamsStrictMaybe)
import Cardano.Ledger.Plutus.ExUnits qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Lens qualified as Lens
import Control.Monad.Catch
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Witness
import Cooked.Skeleton
import Data.Default
import Data.Map qualified as Map
import Data.Map.Ordered.Strict qualified as OMap
import Data.Map.Strict qualified as SMap
import Data.Maybe
import Data.Maybe.Strict
import Data.Text qualified as Text
import GHC.IO.Unsafe
import Ledger.Tx.CardanoAPI qualified as Ledger
import Lens.Micro qualified as MicroLens
import Network.HTTP.Simple qualified as Network
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api

-- | Transorms a `TxParameterChange` into an actual change over a Cardano
-- parameter update
toPParamsUpdate :: TxParameterChange -> Conway.PParamsUpdate Emulator.EmulatorEra -> Conway.PParamsUpdate Emulator.EmulatorEra
toPParamsUpdate :: TxParameterChange
-> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
toPParamsUpdate TxParameterChange
pChange =
  -- From rational to bounded rational
  let toBR :: (Cardano.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
Cardano.boundRational
      -- Helper to set one of the param update with a lens
      setL :: ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter s t a (StrictMaybe a)
l = ASetter s t a (StrictMaybe a) -> StrictMaybe a -> s -> t
forall s t a b. ASetter s t a b -> b -> s -> t
MicroLens.set ASetter s t a (StrictMaybe a)
l (StrictMaybe a -> s -> t) -> (a -> StrictMaybe a) -> a -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust
   in case TxParameterChange
pChange of
        -- will exist later on: MinFeeRefScriptCostPerByte n -> setL Conway.ppuMinFeeRefScriptCostPerByteL $ fromIntegral n
        FeePerByte Integer
n -> ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinFeeAL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinFeeBL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
-> Word32 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
Conway.ppuMaxBBSizeL (Word32 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Word32 -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
-> Word32 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word32)
  (StrictMaybe Word32)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word32)
Conway.ppuMaxTxSizeL (Word32 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Word32 -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word16)
  (StrictMaybe Word16)
-> Word16 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word16)
  (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
Conway.ppuMaxBHSizeL (Word16 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Word16 -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuKeyDepositL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuPoolDepositL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuEMaxL (EpochInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
Cardano.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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word16)
  (StrictMaybe Word16)
-> Word16 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Word16)
  (StrictMaybe Word16)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Word16)
Conway.ppuNOptL (Word16 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Word16 -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe NonNegativeInterval)
  (StrictMaybe NonNegativeInterval)
-> NonNegativeInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe NonNegativeInterval)
  (StrictMaybe NonNegativeInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe NonNegativeInterval)
Conway.ppuA0L (NonNegativeInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> NonNegativeInterval
-> PParamsUpdate EmulatorEra
-> 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
Cardano.boundRational Rational
q
        MonetaryExpansion Rational
q -> ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe UnitInterval)
  (StrictMaybe UnitInterval)
-> UnitInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe UnitInterval)
  (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
Conway.ppuRhoL (UnitInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> UnitInterval
-> PParamsUpdate EmulatorEra
-> 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
Cardano.boundRational Rational
q
        TreasuryCut Rational
q -> ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe UnitInterval)
  (StrictMaybe UnitInterval)
-> UnitInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe UnitInterval)
  (StrictMaybe UnitInterval)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe UnitInterval)
Conway.ppuTauL (UnitInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> UnitInterval
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuMinPoolCostL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe CoinPerByte)
  (StrictMaybe CoinPerByte)
-> CoinPerByte
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe CoinPerByte)
  (StrictMaybe CoinPerByte)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe CoinPerByte)
Conway.ppuCoinsPerUTxOByteL (CoinPerByte
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> CoinPerByte
-> PParamsUpdate EmulatorEra
-> 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 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall a. a -> a
id -- TODO unsupported for now
        Prices Rational
q Rational
r -> ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Prices)
  (StrictMaybe Prices)
-> Prices -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Prices)
  (StrictMaybe Prices)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Prices)
Conway.ppuPricesL (Prices -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Prices -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe ExUnits)
  (StrictMaybe ExUnits)
-> ExUnits
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe ExUnits)
  (StrictMaybe ExUnits)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
Conway.ppuMaxTxExUnitsL (ExUnits -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> ExUnits
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe ExUnits)
  (StrictMaybe ExUnits)
-> ExUnits
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe ExUnits)
  (StrictMaybe ExUnits)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe ExUnits)
Conway.ppuMaxBlockExUnitsL (ExUnits -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> ExUnits
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
-> Natural
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuMaxValSizeL (Natural -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Natural
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
-> Natural
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuCollateralPercentageL (Natural -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Natural
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
-> Natural
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuMaxCollateralInputsL (Natural -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Natural
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe PoolVotingThresholds)
  (StrictMaybe PoolVotingThresholds)
-> PoolVotingThresholds
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe PoolVotingThresholds)
  (StrictMaybe PoolVotingThresholds)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
Lens'
  (PParamsUpdate EmulatorEra) (StrictMaybe PoolVotingThresholds)
Conway.ppuPoolVotingThresholdsL (PoolVotingThresholds
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> PoolVotingThresholds
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe DRepVotingThresholds)
  (StrictMaybe DRepVotingThresholds)
-> DRepVotingThresholds
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe DRepVotingThresholds)
  (StrictMaybe DRepVotingThresholds)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
Lens'
  (PParamsUpdate EmulatorEra) (StrictMaybe DRepVotingThresholds)
Conway.ppuDRepVotingThresholdsL (DRepVotingThresholds
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> DRepVotingThresholds
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
-> Natural
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Natural)
  (StrictMaybe Natural)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuCommitteeMinSizeL (Natural -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Natural
-> PParamsUpdate EmulatorEra
-> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuCommitteeMaxTermLengthL (EpochInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
Cardano.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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuGovActionLifetimeL (EpochInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
Cardano.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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuGovActionDepositL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
-> Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe Coin)
  (StrictMaybe Coin)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Coin)
Conway.ppuDRepDepositL (Coin -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> Coin -> PParamsUpdate EmulatorEra -> 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)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall {s} {t} {a} {a}.
ASetter s t a (StrictMaybe a) -> a -> s -> t
setL ASetter
  (PParamsUpdate EmulatorEra)
  (PParamsUpdate EmulatorEra)
  (StrictMaybe EpochInterval)
  (StrictMaybe EpochInterval)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe EpochInterval)
Conway.ppuDRepActivityL (EpochInterval
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> EpochInterval
-> PParamsUpdate EmulatorEra
-> PParamsUpdate EmulatorEra
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
Cardano.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

-- | Translates a given skeleton proposal into a governance action
toGovAction :: (MonadBlockChainBalancing m) => TxSkelProposal -> m (Conway.GovAction Emulator.EmulatorEra)
toGovAction :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal -> m (GovAction EmulatorEra)
toGovAction TxSkelProposal {Maybe String
Maybe (Versioned Script, TxSkelRedeemer)
Address
TxGovAction
txSkelProposalAddress :: Address
txSkelProposalAction :: TxGovAction
txSkelProposalWitness :: Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalAnchor :: Maybe String
txSkelProposalAddress :: TxSkelProposal -> Address
txSkelProposalAction :: TxSkelProposal -> TxGovAction
txSkelProposalWitness :: TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalAnchor :: TxSkelProposal -> Maybe String
..} = do
  StrictMaybe ScriptHash
sHash <- case Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness of
    Maybe (Versioned Script, TxSkelRedeemer)
Nothing -> StrictMaybe ScriptHash -> m (StrictMaybe ScriptHash)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StrictMaybe ScriptHash
forall a. StrictMaybe a
SNothing
    Just (Versioned Script
script, TxSkelRedeemer
_) -> do
      Cardano.ScriptHash ScriptHash
sHash <-
        String -> Either ToCardanoError ScriptHash -> m ScriptHash
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
          String
"Unable to convert script hash"
          (ScriptHash -> Either ToCardanoError ScriptHash
Ledger.toCardanoScriptHash (Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash Versioned Script
script))
      StrictMaybe ScriptHash -> m (StrictMaybe ScriptHash)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StrictMaybe ScriptHash -> m (StrictMaybe ScriptHash))
-> StrictMaybe ScriptHash -> m (StrictMaybe ScriptHash)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
sHash
  case TxGovAction
txSkelProposalAction of
    TxGovActionParameterChange [TxParameterChange]
changes ->
      GovAction EmulatorEra -> m (GovAction EmulatorEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovAction EmulatorEra -> m (GovAction EmulatorEra))
-> GovAction EmulatorEra -> m (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 -- TODO, should not be Nothing later on
          ((PParamsUpdate EmulatorEra
 -> TxParameterChange -> PParamsUpdate EmulatorEra)
-> PParamsUpdate EmulatorEra
-> [TxParameterChange]
-> PParamsUpdate EmulatorEra
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((TxParameterChange
 -> PParamsUpdate EmulatorEra -> PParamsUpdate EmulatorEra)
-> PParamsUpdate EmulatorEra
-> TxParameterChange
-> PParamsUpdate EmulatorEra
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxParameterChange
-> PParamsUpdate EmulatorEra -> 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) [TxParameterChange]
changes)
          StrictMaybe ScriptHash
sHash
    TxGovActionHardForkInitiation ProtocolVersion
_ -> String -> m (GovAction EmulatorEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"TxGovActionHardForkInitiation unsupported"
    TxGovActionTreasuryWithdrawals Map Credential Lovelace
mapCredentialLovelace -> do
      Map RewardAccount Coin
cardanoMap <- [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
SMap.fromList ([(RewardAccount, Coin)] -> Map RewardAccount Coin)
-> m [(RewardAccount, Coin)] -> m (Map RewardAccount Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Credential, Lovelace) -> m (RewardAccount, Coin))
-> [(Credential, Lovelace)] -> m [(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
Emulator.Coin Integer
lv) (RewardAccount -> (RewardAccount, Coin))
-> m RewardAccount -> m (RewardAccount, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> m RewardAccount
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m RewardAccount
toRewardAccount Credential
cred) (Map Credential Lovelace -> [(Credential, Lovelace)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Credential Lovelace
mapCredentialLovelace)
      GovAction EmulatorEra -> m (GovAction EmulatorEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovAction EmulatorEra -> m (GovAction EmulatorEra))
-> GovAction EmulatorEra -> m (GovAction EmulatorEra)
forall a b. (a -> b) -> a -> b
$ Map RewardAccount Coin
-> StrictMaybe ScriptHash -> GovAction EmulatorEra
forall era.
Map RewardAccount Coin -> StrictMaybe ScriptHash -> GovAction era
Conway.TreasuryWithdrawals Map RewardAccount Coin
cardanoMap StrictMaybe ScriptHash
sHash
    TxGovAction
TxGovActionNoConfidence -> GovAction EmulatorEra -> m (GovAction EmulatorEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GovAction EmulatorEra -> m (GovAction EmulatorEra))
-> GovAction EmulatorEra -> m (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 -- TODO, should not be Nothing later on
    TxGovActionUpdateCommittee {} -> String -> m (GovAction EmulatorEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"TxGovActionUpdateCommittee unsupported"
    TxGovActionNewConstitution Constitution
_ -> String -> m (GovAction EmulatorEra)
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString String
"TxGovActionNewConstitution unsupported"

-- | Translates a skeleton proposal into a proposal procedure alongside a
-- possible witness
toProposalProcedureAndWitness ::
  (MonadBlockChainBalancing m) =>
  TxSkelProposal ->
  AnchorResolution ->
  m (Conway.ProposalProcedure Emulator.EmulatorEra, Cardano.BuildTxWith Cardano.BuildTx (Maybe (Cardano.ScriptWitness Cardano.WitCtxStake Cardano.ConwayEra)))
toProposalProcedureAndWitness :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
toProposalProcedureAndWitness txSkelProposal :: TxSkelProposal
txSkelProposal@TxSkelProposal {Maybe String
Maybe (Versioned Script, TxSkelRedeemer)
Address
TxGovAction
txSkelProposalAddress :: TxSkelProposal -> Address
txSkelProposalAction :: TxSkelProposal -> TxGovAction
txSkelProposalWitness :: TxSkelProposal -> Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalAnchor :: TxSkelProposal -> Maybe String
txSkelProposalAddress :: Address
txSkelProposalAction :: TxGovAction
txSkelProposalWitness :: Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalAnchor :: Maybe String
..} AnchorResolution
anchorResolution = do
  Integer
minDeposit <- Coin -> Integer
Emulator.unCoin (Coin -> Integer) -> (Params -> Coin) -> Params -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Coin (PParams EmulatorEra) Coin
-> PParams EmulatorEra -> Coin
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
Lens.view Getting Coin (PParams EmulatorEra) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams EmulatorEra) Coin
Conway.ppGovActionDepositL (PParams EmulatorEra -> Coin)
-> (Params -> PParams EmulatorEra) -> Params -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> PParams EmulatorEra
Emulator.pEmulatorPParams (Params -> Integer) -> m Params -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  RewardAccount
cred <- Credential -> m RewardAccount
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m RewardAccount
toRewardAccount (Credential -> m RewardAccount) -> Credential -> m RewardAccount
forall a b. (a -> b) -> a -> b
$ Address -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential Address
txSkelProposalAddress
  GovAction EmulatorEra
govAction <- TxSkelProposal -> m (GovAction EmulatorEra)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal -> m (GovAction EmulatorEra)
toGovAction TxSkelProposal
txSkelProposal
  let proposalAnchor :: Maybe (m Anchor)
proposalAnchor = do
        String
anchor <- Maybe String
txSkelProposalAnchor
        Url
anchorUrl <- Int -> Text -> Maybe Url
forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
Cardano.textToUrl (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
anchor) (String -> Text
Text.pack String
anchor)
        let anchorDataHash :: m ByteString
anchorDataHash =
              case AnchorResolution
anchorResolution of
                AnchorResolution
AnchorResolutionHttp ->
                  -- WARNING: very unsafe and unreproducible
                  IO (m ByteString) -> m ByteString
forall a. IO a -> a
unsafePerformIO
                    ( (HttpException -> IO (m ByteString))
-> IO (m ByteString) -> IO (m ByteString)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle
                        (m ByteString -> IO (m ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (m ByteString -> IO (m ByteString))
-> (HttpException -> m ByteString)
-> HttpException
-> IO (m ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> m a
throwOnString (String -> m ByteString)
-> (HttpException -> String) -> HttpException -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
"Error when parsing anchor " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
anchor String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with error: ") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (HttpException -> String) -> HttpException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Show a => a -> String
show @Network.HttpException))
                        ((String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
Network.parseRequest String
anchor IO Request
-> (Request -> IO (Response ByteString))
-> IO (Response ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
Network.httpBS) IO (Response ByteString)
-> (Response ByteString -> m ByteString) -> IO (m ByteString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall a. Response a -> a
Network.getResponseBody)
                    )
                AnchorResolutionLocal Map String ByteString
urls ->
                  String -> Maybe ByteString -> m ByteString
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Maybe a -> m a
throwOnMaybe String
"Error when attempting to retrieve anchor url in the local anchor resolution map" (String -> Map String ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
anchor Map String ByteString
urls)
        m Anchor -> Maybe (m Anchor)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m Anchor -> Maybe (m Anchor)) -> m Anchor -> Maybe (m Anchor)
forall a b. (a -> b) -> a -> b
$ Url -> SafeHash AnchorData -> Anchor
Cardano.Anchor Url
anchorUrl (SafeHash AnchorData -> Anchor)
-> (ByteString -> SafeHash AnchorData) -> ByteString -> Anchor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
Conway.hashAnnotated (AnchorData -> SafeHash AnchorData)
-> (ByteString -> AnchorData) -> ByteString -> SafeHash AnchorData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AnchorData
Cardano.AnchorData (ByteString -> Anchor) -> m ByteString -> m Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
anchorDataHash
  Anchor
anchor <- m Anchor -> Maybe (m Anchor) -> m Anchor
forall a. a -> Maybe a -> a
fromMaybe (Anchor -> m Anchor
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Anchor
forall a. Default a => a
def) Maybe (m Anchor)
proposalAnchor
  let conwayProposalProcedure :: ProposalProcedure EmulatorEra
conwayProposalProcedure = Coin
-> RewardAccount
-> GovAction EmulatorEra
-> Anchor
-> ProposalProcedure EmulatorEra
forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
Conway.ProposalProcedure (Integer -> Coin
Emulator.Coin Integer
minDeposit) RewardAccount
cred GovAction EmulatorEra
govAction Anchor
anchor
  (ProposalProcedure EmulatorEra
conwayProposalProcedure,) (BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))
 -> (ProposalProcedure EmulatorEra,
     BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))))
-> (Maybe (ScriptWitness WitCtxStake ConwayEra)
    -> BuildTxWith
         BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> Maybe (ScriptWitness WitCtxStake ConwayEra)
-> (ProposalProcedure EmulatorEra,
    BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ScriptWitness WitCtxStake ConwayEra)
-> BuildTxWith
     BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Maybe (ScriptWitness WitCtxStake ConwayEra)
 -> (ProposalProcedure EmulatorEra,
     BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))))
-> m (Maybe (ScriptWitness WitCtxStake ConwayEra))
-> m (ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness of
    Maybe (Versioned Script, TxSkelRedeemer)
Nothing -> Maybe (ScriptWitness WitCtxStake ConwayEra)
-> m (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. Maybe a
Nothing
    Just (Versioned Script
script, TxSkelRedeemer
redeemer) -> ScriptWitness WitCtxStake ConwayEra
-> Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. a -> Maybe a
Just (ScriptWitness WitCtxStake ConwayEra
 -> Maybe (ScriptWitness WitCtxStake ConwayEra))
-> m (ScriptWitness WitCtxStake ConwayEra)
-> m (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Versioned Script
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> m (ScriptWitness WitCtxStake ConwayEra)
forall (m :: * -> *) a b.
(MonadBlockChainBalancing m, ToVersioned Script a) =>
a
-> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra)
toScriptWitness Versioned Script
script TxSkelRedeemer
redeemer ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake

-- | Translates a list of skeleton proposals into a proposal procedures
toProposalProcedures ::
  (MonadBlockChainBalancing m) =>
  [TxSkelProposal] ->
  AnchorResolution ->
  m (Cardano.TxProposalProcedures Cardano.BuildTx Cardano.ConwayEra)
toProposalProcedures :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
[TxSkelProposal]
-> AnchorResolution -> m (TxProposalProcedures BuildTx ConwayEra)
toProposalProcedures [TxSkelProposal]
props AnchorResolution
_ | [TxSkelProposal] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxSkelProposal]
props = TxProposalProcedures BuildTx ConwayEra
-> m (TxProposalProcedures BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxProposalProcedures BuildTx ConwayEra
forall build era. TxProposalProcedures build era
Cardano.TxProposalProceduresNone
toProposalProcedures [TxSkelProposal]
props AnchorResolution
anchorResolution =
  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)
-> m [(ProposalProcedure EmulatorEra,
       BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
-> m (TxProposalProcedures BuildTx ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxSkelProposal
 -> m (ProposalProcedure EmulatorEra,
       BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra))))
-> [TxSkelProposal]
-> m [(ProposalProcedure EmulatorEra,
       BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))]
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 (TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      BuildTxWith BuildTx (Maybe (ScriptWitness WitCtxStake ConwayEra)))
`toProposalProcedureAndWitness` AnchorResolution
anchorResolution) [TxSkelProposal]
props