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.Conversion
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.Strict qualified as SMap
import Data.Maybe
import Data.Maybe.Strict
import Data.OSet.Strict qualified as OSet
import Data.Set qualified as Set
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 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 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.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate EmulatorEra) (StrictMaybe Natural)
Conway.ppuNOptL (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
        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 StandardCrypto)
sHash <- case Maybe (Versioned Script, TxSkelRedeemer)
txSkelProposalWitness of
    Maybe (Versioned Script, TxSkelRedeemer)
Nothing -> StrictMaybe (ScriptHash StandardCrypto)
-> m (StrictMaybe (ScriptHash StandardCrypto))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StrictMaybe (ScriptHash StandardCrypto)
forall a. StrictMaybe a
SNothing
    Just (Versioned Script
script, TxSkelRedeemer
_) -> do
      Cardano.ScriptHash ScriptHash StandardCrypto
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
toScriptHash Versioned Script
script))
      StrictMaybe (ScriptHash StandardCrypto)
-> m (StrictMaybe (ScriptHash StandardCrypto))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StrictMaybe (ScriptHash StandardCrypto)
 -> m (StrictMaybe (ScriptHash StandardCrypto)))
-> StrictMaybe (ScriptHash StandardCrypto)
-> m (StrictMaybe (ScriptHash StandardCrypto))
forall a b. (a -> b) -> a -> b
$ ScriptHash StandardCrypto
-> StrictMaybe (ScriptHash StandardCrypto)
forall a. a -> StrictMaybe a
SJust ScriptHash StandardCrypto
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 (EraCrypto EmulatorEra))
-> GovAction EmulatorEra
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> 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 (EraCrypto EmulatorEra))
StrictMaybe (ScriptHash StandardCrypto)
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 StandardCrypto) Coin
cardanoMap <- [(RewardAccount StandardCrypto, Coin)]
-> Map (RewardAccount StandardCrypto) Coin
forall k a. Ord k => [(k, a)] -> Map k a
SMap.fromList ([(RewardAccount StandardCrypto, Coin)]
 -> Map (RewardAccount StandardCrypto) Coin)
-> m [(RewardAccount StandardCrypto, Coin)]
-> m (Map (RewardAccount StandardCrypto) Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Credential, Lovelace) -> m (RewardAccount StandardCrypto, Coin))
-> [(Credential, Lovelace)]
-> m [(RewardAccount StandardCrypto, 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 StandardCrypto
 -> (RewardAccount StandardCrypto, Coin))
-> m (RewardAccount StandardCrypto)
-> m (RewardAccount StandardCrypto, Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> m (RewardAccount StandardCrypto)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m (RewardAccount StandardCrypto)
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 (EraCrypto EmulatorEra)) Coin
-> StrictMaybe (ScriptHash (EraCrypto EmulatorEra))
-> GovAction EmulatorEra
forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
Conway.TreasuryWithdrawals Map (RewardAccount (EraCrypto EmulatorEra)) Coin
Map (RewardAccount StandardCrypto) Coin
cardanoMap StrictMaybe (ScriptHash (EraCrypto EmulatorEra))
StrictMaybe (ScriptHash StandardCrypto)
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, Maybe (Cardano.ScriptWitness Cardano.WitCtxStake Cardano.ConwayEra))
toProposalProcedureAndWitness :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      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 StandardCrypto
cred <- Credential -> m (RewardAccount StandardCrypto)
forall (m :: * -> *).
MonadBlockChainBalancing m =>
Credential -> m (RewardAccount StandardCrypto)
toRewardAccount (Credential -> m (RewardAccount StandardCrypto))
-> Credential -> m (RewardAccount StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Address -> Credential
forall a. ToCredential a => a -> Credential
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 StandardCrypto))
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 StandardCrypto) -> Maybe (m (Anchor StandardCrypto))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (m (Anchor StandardCrypto) -> Maybe (m (Anchor StandardCrypto)))
-> m (Anchor StandardCrypto) -> Maybe (m (Anchor StandardCrypto))
forall a b. (a -> b) -> a -> b
$ Url -> SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto
forall c. Url -> SafeHash c AnchorData -> Anchor c
Cardano.Anchor Url
anchorUrl (SafeHash StandardCrypto AnchorData -> Anchor StandardCrypto)
-> (ByteString -> SafeHash StandardCrypto AnchorData)
-> ByteString
-> Anchor StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
Cardano.hashAnchorData (AnchorData -> SafeHash StandardCrypto AnchorData)
-> (ByteString -> AnchorData)
-> ByteString
-> SafeHash StandardCrypto AnchorData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AnchorData
Cardano.AnchorData (ByteString -> Anchor StandardCrypto)
-> m ByteString -> m (Anchor StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
anchorDataHash
  Anchor StandardCrypto
anchor <- m (Anchor StandardCrypto)
-> Maybe (m (Anchor StandardCrypto)) -> m (Anchor StandardCrypto)
forall a. a -> Maybe a -> a
fromMaybe (Anchor StandardCrypto -> m (Anchor StandardCrypto)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Anchor StandardCrypto
forall a. Default a => a
def) Maybe (m (Anchor StandardCrypto))
proposalAnchor
  let conwayProposalProcedure :: ProposalProcedure EmulatorEra
conwayProposalProcedure = Coin
-> RewardAccount (EraCrypto EmulatorEra)
-> GovAction EmulatorEra
-> Anchor (EraCrypto EmulatorEra)
-> ProposalProcedure EmulatorEra
forall era.
Coin
-> RewardAccount (EraCrypto era)
-> GovAction era
-> Anchor (EraCrypto era)
-> ProposalProcedure era
Conway.ProposalProcedure (Integer -> Coin
Emulator.Coin Integer
minDeposit) RewardAccount (EraCrypto EmulatorEra)
RewardAccount StandardCrypto
cred GovAction EmulatorEra
govAction Anchor (EraCrypto EmulatorEra)
Anchor StandardCrypto
anchor
  (ProposalProcedure EmulatorEra
conwayProposalProcedure,) (Maybe (ScriptWitness WitCtxStake ConwayEra)
 -> (ProposalProcedure EmulatorEra,
     Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> m (Maybe (ScriptWitness WitCtxStake ConwayEra))
-> m (ProposalProcedure EmulatorEra,
      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, ToVersionedScript 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
anchorResolution = do
  (Set (ProposalProcedure EmulatorEra)
-> OSet (ProposalProcedure EmulatorEra)
forall a. Set a -> OSet a
OSet.fromSet -> OSet (ProposalProcedure EmulatorEra)
ppSet, Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
-> BuildTxWith
     BuildTx
     (Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith -> BuildTxWith
  BuildTx
  (Map
     (ProposalProcedure EmulatorEra)
     (ScriptWitness WitCtxStake ConwayEra))
ppMap) <- [TxSkelProposal]
-> m (Set (ProposalProcedure EmulatorEra),
      Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
go [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
 -> m (TxProposalProcedures BuildTx ConwayEra))
-> TxProposalProcedures BuildTx ConwayEra
-> m (TxProposalProcedures BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$
    if OSet (ProposalProcedure EmulatorEra) -> Bool
forall a. OSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null OSet (ProposalProcedure EmulatorEra)
ppSet
      then TxProposalProcedures BuildTx ConwayEra
forall build era. TxProposalProcedures build era
Cardano.TxProposalProceduresNone
      else OSet (ProposalProcedure (ShelleyLedgerEra ConwayEra))
-> BuildTxWith
     BuildTx
     (Map
        (ProposalProcedure (ShelleyLedgerEra ConwayEra))
        (ScriptWitness WitCtxStake ConwayEra))
-> TxProposalProcedures BuildTx ConwayEra
forall era build.
EraPParams (ShelleyLedgerEra era) =>
OSet (ProposalProcedure (ShelleyLedgerEra era))
-> BuildTxWith
     build
     (Map
        (ProposalProcedure (ShelleyLedgerEra era))
        (ScriptWitness WitCtxStake era))
-> TxProposalProcedures build era
Cardano.TxProposalProcedures OSet (ProposalProcedure (ShelleyLedgerEra ConwayEra))
OSet (ProposalProcedure EmulatorEra)
ppSet BuildTxWith
  BuildTx
  (Map
     (ProposalProcedure (ShelleyLedgerEra ConwayEra))
     (ScriptWitness WitCtxStake ConwayEra))
BuildTxWith
  BuildTx
  (Map
     (ProposalProcedure EmulatorEra)
     (ScriptWitness WitCtxStake ConwayEra))
ppMap
  where
    go :: [TxSkelProposal]
-> m (Set (ProposalProcedure EmulatorEra),
      Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
go [] = (Set (ProposalProcedure EmulatorEra),
 Map
   (ProposalProcedure EmulatorEra)
   (ScriptWitness WitCtxStake ConwayEra))
-> m (Set (ProposalProcedure EmulatorEra),
      Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (ProposalProcedure EmulatorEra)
forall a. Set a
Set.empty, Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
forall k a. Map k a
Map.empty)
    go (TxSkelProposal
h : [TxSkelProposal]
t) = do
      (Set (ProposalProcedure EmulatorEra)
proposals, Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
mapWitnesses) <- [TxSkelProposal]
-> m (Set (ProposalProcedure EmulatorEra),
      Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
go [TxSkelProposal]
t
      (ProposalProcedure EmulatorEra
proposal, Maybe (ScriptWitness WitCtxStake ConwayEra)
maybeWitness) <- TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      Maybe (ScriptWitness WitCtxStake ConwayEra))
forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelProposal
-> AnchorResolution
-> m (ProposalProcedure EmulatorEra,
      Maybe (ScriptWitness WitCtxStake ConwayEra))
toProposalProcedureAndWitness TxSkelProposal
h AnchorResolution
anchorResolution
      let outputMap :: Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
outputMap = case Maybe (ScriptWitness WitCtxStake ConwayEra)
maybeWitness of
            Maybe (ScriptWitness WitCtxStake ConwayEra)
Nothing -> Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
mapWitnesses
            Just ScriptWitness WitCtxStake ConwayEra
newWitness -> ProposalProcedure EmulatorEra
-> ScriptWitness WitCtxStake ConwayEra
-> Map
     (ProposalProcedure EmulatorEra)
     (ScriptWitness WitCtxStake ConwayEra)
-> Map
     (ProposalProcedure EmulatorEra)
     (ScriptWitness WitCtxStake ConwayEra)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ProposalProcedure EmulatorEra
proposal ScriptWitness WitCtxStake ConwayEra
newWitness Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
mapWitnesses
      (Set (ProposalProcedure EmulatorEra),
 Map
   (ProposalProcedure EmulatorEra)
   (ScriptWitness WitCtxStake ConwayEra))
-> m (Set (ProposalProcedure EmulatorEra),
      Map
        (ProposalProcedure EmulatorEra)
        (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProposalProcedure EmulatorEra
-> Set (ProposalProcedure EmulatorEra)
-> Set (ProposalProcedure EmulatorEra)
forall a. Ord a => a -> Set a -> Set a
Set.insert ProposalProcedure EmulatorEra
proposal Set (ProposalProcedure EmulatorEra)
proposals, Map
  (ProposalProcedure EmulatorEra)
  (ScriptWitness WitCtxStake ConwayEra)
outputMap)