module Cooked.MockChain.MockChainSt where
import Cardano.Api qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
import Cardano.Ledger.Shelley.API qualified as Shelley
import Cardano.Ledger.Shelley.LedgerState qualified as Shelley
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Arrow
import Cooked.Conversion.ToScriptHash
import Cooked.Conversion.ToVersionedScript
import Cooked.InitialDistribution
import Cooked.MockChain.GenerateTx (GenerateTxError (..), generateTxOut)
import Cooked.MockChain.UtxoState
import Cooked.Output
import Cooked.Skeleton
import Data.Bifunctor (bimap)
import Data.Default
import Data.Either.Combinators (mapLeft)
import Data.List (foldl')
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (mapMaybe)
import Ledger.Index qualified as Ledger
import Ledger.Orphans ()
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core (view)
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
data MockChainSt = MockChainSt
{ MockChainSt -> Params
mcstParams :: Emulator.Params,
MockChainSt -> UtxoIndex
mcstIndex :: Ledger.UtxoIndex,
MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: Map Api.DatumHash (TxSkelOutDatum, Integer),
MockChainSt -> Map ValidatorHash (Versioned Validator)
mcstValidators :: Map Script.ValidatorHash (Script.Versioned Script.Validator),
MockChainSt -> Slot
mcstCurrentSlot :: Ledger.Slot
}
deriving (Int -> MockChainSt -> ShowS
[MockChainSt] -> ShowS
MockChainSt -> String
(Int -> MockChainSt -> ShowS)
-> (MockChainSt -> String)
-> ([MockChainSt] -> ShowS)
-> Show MockChainSt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockChainSt -> ShowS
showsPrec :: Int -> MockChainSt -> ShowS
$cshow :: MockChainSt -> String
show :: MockChainSt -> String
$cshowList :: [MockChainSt] -> ShowS
showList :: [MockChainSt] -> ShowS
Show, MockChainSt -> MockChainSt -> Bool
(MockChainSt -> MockChainSt -> Bool)
-> (MockChainSt -> MockChainSt -> Bool) -> Eq MockChainSt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MockChainSt -> MockChainSt -> Bool
== :: MockChainSt -> MockChainSt -> Bool
$c/= :: MockChainSt -> MockChainSt -> Bool
/= :: MockChainSt -> MockChainSt -> Bool
Eq)
instance Default MockChainSt where
def :: MockChainSt
def = MockChainSt
mockChainSt0
getIndex :: Ledger.UtxoIndex -> Map Api.TxOutRef Api.TxOut
getIndex :: UtxoIndex -> Map TxOutRef TxOut
getIndex =
[(TxOutRef, TxOut)] -> Map TxOutRef TxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(TxOutRef, TxOut)] -> Map TxOutRef TxOut)
-> (UtxoIndex -> [(TxOutRef, TxOut)])
-> UtxoIndex
-> Map TxOutRef TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut CtxUTxO ConwayEra) -> (TxOutRef, TxOut))
-> [(TxIn, TxOut CtxUTxO ConwayEra)] -> [(TxOutRef, TxOut)]
forall a b. (a -> b) -> [a] -> [b]
map ((TxIn -> TxOutRef)
-> (TxOut CtxUTxO ConwayEra -> TxOut)
-> (TxIn, TxOut CtxUTxO ConwayEra)
-> (TxOutRef, TxOut)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TxIn -> TxOutRef
Ledger.fromCardanoTxIn (TxOut CtxTx ConwayEra -> TxOut
forall era. TxOut CtxTx era -> TxOut
Ledger.fromCardanoTxOutToPV2TxInfoTxOut (TxOut CtxTx ConwayEra -> TxOut)
-> (TxOut CtxUTxO ConwayEra -> TxOut CtxTx ConwayEra)
-> TxOut CtxUTxO ConwayEra
-> TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxUTxO ConwayEra -> TxOut CtxTx ConwayEra
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
toCtxTxTxOut))
([(TxIn, TxOut CtxUTxO ConwayEra)] -> [(TxOutRef, TxOut)])
-> (UtxoIndex -> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> UtxoIndex
-> [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut CtxUTxO ConwayEra)
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map TxIn (TxOut CtxUTxO ConwayEra)
-> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> (UtxoIndex -> Map TxIn (TxOut CtxUTxO ConwayEra))
-> UtxoIndex
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxIn (TxOut CtxUTxO ConwayEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
Cardano.unUTxO
where
toCtxTxTxOut :: Cardano.TxOut Cardano.CtxUTxO era -> Cardano.TxOut Cardano.CtxTx era
toCtxTxTxOut :: forall era. TxOut CtxUTxO era -> TxOut CtxTx era
toCtxTxTxOut (Cardano.TxOut AddressInEra era
addr TxOutValue era
val TxOutDatum CtxUTxO era
d ReferenceScript era
refS) =
let dat :: TxOutDatum CtxTx era
dat = case TxOutDatum CtxUTxO era
d of
TxOutDatum CtxUTxO era
Cardano.TxOutDatumNone -> TxOutDatum CtxTx era
forall ctx era. TxOutDatum ctx era
Cardano.TxOutDatumNone
Cardano.TxOutDatumHash AlonzoEraOnwards era
s Hash ScriptData
h -> AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum CtxTx era
forall era ctx.
AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum ctx era
Cardano.TxOutDatumHash AlonzoEraOnwards era
s Hash ScriptData
h
Cardano.TxOutDatumInline BabbageEraOnwards era
s HashableScriptData
sd -> BabbageEraOnwards era -> HashableScriptData -> TxOutDatum CtxTx era
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
Cardano.TxOutDatumInline BabbageEraOnwards era
s HashableScriptData
sd
in AddressInEra era
-> TxOutValue era
-> TxOutDatum CtxTx era
-> ReferenceScript era
-> TxOut CtxTx era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
Cardano.TxOut AddressInEra era
addr TxOutValue era
val TxOutDatum CtxTx era
dat ReferenceScript era
refS
mcstToUtxoState :: MockChainSt -> UtxoState
mcstToUtxoState :: MockChainSt -> UtxoState
mcstToUtxoState MockChainSt {UtxoIndex
mcstIndex :: MockChainSt -> UtxoIndex
mcstIndex :: UtxoIndex
mcstIndex, Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums} =
Map Address UtxoPayloadSet -> UtxoState
UtxoState
(Map Address UtxoPayloadSet -> UtxoState)
-> (UtxoIndex -> Map Address UtxoPayloadSet)
-> UtxoIndex
-> UtxoState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Address, UtxoPayloadSet)
-> Map Address UtxoPayloadSet -> Map Address UtxoPayloadSet)
-> Map Address UtxoPayloadSet
-> [(Address, UtxoPayloadSet)]
-> Map Address UtxoPayloadSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Address
address, UtxoPayloadSet
utxoValueSet) Map Address UtxoPayloadSet
acc -> (UtxoPayloadSet -> UtxoPayloadSet -> UtxoPayloadSet)
-> Address
-> UtxoPayloadSet
-> Map Address UtxoPayloadSet
-> Map Address UtxoPayloadSet
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith UtxoPayloadSet -> UtxoPayloadSet -> UtxoPayloadSet
forall a. Semigroup a => a -> a -> a
(<>) Address
address UtxoPayloadSet
utxoValueSet Map Address UtxoPayloadSet
acc) Map Address UtxoPayloadSet
forall k a. Map k a
Map.empty
([(Address, UtxoPayloadSet)] -> Map Address UtxoPayloadSet)
-> (UtxoIndex -> [(Address, UtxoPayloadSet)])
-> UtxoIndex
-> Map Address UtxoPayloadSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, TxOut CtxUTxO ConwayEra)
-> Maybe (Address, UtxoPayloadSet))
-> [(TxIn, TxOut CtxUTxO ConwayEra)] -> [(Address, UtxoPayloadSet)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
( (TxOutRef, TxOut) -> Maybe (Address, UtxoPayloadSet)
extractPayload
((TxOutRef, TxOut) -> Maybe (Address, UtxoPayloadSet))
-> ((TxIn, TxOut CtxUTxO ConwayEra) -> (TxOutRef, TxOut))
-> (TxIn, TxOut CtxUTxO ConwayEra)
-> Maybe (Address, UtxoPayloadSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> TxOutRef)
-> (TxOut CtxUTxO ConwayEra -> TxOut)
-> (TxIn, TxOut CtxUTxO ConwayEra)
-> (TxOutRef, TxOut)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
TxIn -> TxOutRef
Ledger.fromCardanoTxIn
TxOut CtxUTxO ConwayEra -> TxOut
forall era. TxOut CtxUTxO era -> TxOut
Ledger.fromCardanoTxOutToPV2TxInfoTxOut'
)
([(TxIn, TxOut CtxUTxO ConwayEra)] -> [(Address, UtxoPayloadSet)])
-> (UtxoIndex -> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> UtxoIndex
-> [(Address, UtxoPayloadSet)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut CtxUTxO ConwayEra)
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall k a. Map k a -> [(k, a)]
Map.toList
(Map TxIn (TxOut CtxUTxO ConwayEra)
-> [(TxIn, TxOut CtxUTxO ConwayEra)])
-> (UtxoIndex -> Map TxIn (TxOut CtxUTxO ConwayEra))
-> UtxoIndex
-> [(TxIn, TxOut CtxUTxO ConwayEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxIn (TxOut CtxUTxO ConwayEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
Cardano.unUTxO
(UtxoIndex -> UtxoState) -> UtxoIndex -> UtxoState
forall a b. (a -> b) -> a -> b
$ UtxoIndex
mcstIndex
where
extractPayload :: (Api.TxOutRef, Api.TxOut) -> Maybe (Api.Address, UtxoPayloadSet)
extractPayload :: (TxOutRef, TxOut) -> Maybe (Address, UtxoPayloadSet)
extractPayload (TxOutRef
txOutRef, out :: TxOut
out@Api.TxOut {Address
txOutAddress :: Address
txOutAddress :: TxOut -> Address
Api.txOutAddress, Value
txOutValue :: Value
txOutValue :: TxOut -> Value
Api.txOutValue, OutputDatum
txOutDatum :: OutputDatum
txOutDatum :: TxOut -> OutputDatum
Api.txOutDatum}) =
do
let mRefScript :: Maybe ScriptHash
mRefScript = TxOut -> Maybe ScriptHash
forall o.
(IsAbstractOutput o, ToScriptHash (ReferenceScriptType o)) =>
o -> Maybe ScriptHash
outputReferenceScriptHash TxOut
out
TxSkelOutDatum
txSkelOutDatum <-
case OutputDatum
txOutDatum of
OutputDatum
Api.NoOutputDatum -> TxSkelOutDatum -> Maybe TxSkelOutDatum
forall a. a -> Maybe a
Just TxSkelOutDatum
TxSkelOutNoDatum
Api.OutputDatum Datum
datum -> (TxSkelOutDatum, Integer) -> TxSkelOutDatum
forall a b. (a, b) -> a
fst ((TxSkelOutDatum, Integer) -> TxSkelOutDatum)
-> Maybe (TxSkelOutDatum, Integer) -> Maybe TxSkelOutDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Maybe (TxSkelOutDatum, Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Datum -> DatumHash
Script.datumHash Datum
datum) Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums
Api.OutputDatumHash DatumHash
hash -> (TxSkelOutDatum, Integer) -> TxSkelOutDatum
forall a b. (a, b) -> a
fst ((TxSkelOutDatum, Integer) -> TxSkelOutDatum)
-> Maybe (TxSkelOutDatum, Integer) -> Maybe TxSkelOutDatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Maybe (TxSkelOutDatum, Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DatumHash
hash Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums
(Address, UtxoPayloadSet) -> Maybe (Address, UtxoPayloadSet)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Address
txOutAddress,
[UtxoPayload] -> UtxoPayloadSet
UtxoPayloadSet [TxOutRef
-> Value -> TxSkelOutDatum -> Maybe ScriptHash -> UtxoPayload
UtxoPayload TxOutRef
txOutRef Value
txOutValue TxSkelOutDatum
txSkelOutDatum Maybe ScriptHash
mRefScript]
)
mcstToSkelContext :: MockChainSt -> SkelContext
mcstToSkelContext :: MockChainSt -> SkelContext
mcstToSkelContext MockChainSt {Map DatumHash (TxSkelOutDatum, Integer)
Map ValidatorHash (Versioned Validator)
UtxoIndex
Params
Slot
mcstParams :: MockChainSt -> Params
mcstIndex :: MockChainSt -> UtxoIndex
mcstDatums :: MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstValidators :: MockChainSt -> Map ValidatorHash (Versioned Validator)
mcstCurrentSlot :: MockChainSt -> Slot
mcstParams :: Params
mcstIndex :: UtxoIndex
mcstDatums :: Map DatumHash (TxSkelOutDatum, Integer)
mcstValidators :: Map ValidatorHash (Versioned Validator)
mcstCurrentSlot :: Slot
..} =
Map TxOutRef TxOut -> Map DatumHash TxSkelOutDatum -> SkelContext
SkelContext
(UtxoIndex -> Map TxOutRef TxOut
getIndex UtxoIndex
mcstIndex)
(((TxSkelOutDatum, Integer) -> TxSkelOutDatum)
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash TxSkelOutDatum
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TxSkelOutDatum, Integer) -> TxSkelOutDatum
forall a b. (a, b) -> a
fst Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums)
mcstToEmulatedLedgerState :: MockChainSt -> Emulator.EmulatedLedgerState
mcstToEmulatedLedgerState :: MockChainSt -> EmulatedLedgerState
mcstToEmulatedLedgerState MockChainSt {Map DatumHash (TxSkelOutDatum, Integer)
Map ValidatorHash (Versioned Validator)
UtxoIndex
Params
Slot
mcstParams :: MockChainSt -> Params
mcstIndex :: MockChainSt -> UtxoIndex
mcstDatums :: MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstValidators :: MockChainSt -> Map ValidatorHash (Versioned Validator)
mcstCurrentSlot :: MockChainSt -> Slot
mcstParams :: Params
mcstIndex :: UtxoIndex
mcstDatums :: Map DatumHash (TxSkelOutDatum, Integer)
mcstValidators :: Map ValidatorHash (Versioned Validator)
mcstCurrentSlot :: Slot
..} =
let els :: EmulatedLedgerState
els@(Emulator.EmulatedLedgerState MempoolEnv EmulatorEra
le LedgerState EmulatorEra
mps) = Params -> EmulatedLedgerState
Emulator.initialState Params
mcstParams
in EmulatedLedgerState
els
{ Emulator._ledgerEnv = le {Shelley.ledgerSlotNo = fromIntegral mcstCurrentSlot},
Emulator._memPoolState =
mps
{ Shelley.lsUTxOState =
Shelley.smartUTxOState
(Emulator.emulatorPParams mcstParams)
(Ledger.fromPlutusIndex mcstIndex)
(Emulator.Coin 0)
(Emulator.Coin 0)
def
(Emulator.Coin 0)
}
}
addDatums :: [(Api.DatumHash, TxSkelOutDatum)] -> MockChainSt -> MockChainSt
addDatums :: [(DatumHash, TxSkelOutDatum)] -> MockChainSt -> MockChainSt
addDatums [(DatumHash, TxSkelOutDatum)]
toAdd st :: MockChainSt
st@(MockChainSt {Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums}) =
MockChainSt
st
{ mcstDatums =
foldl
( \Map DatumHash (TxSkelOutDatum, Integer)
datumMap (DatumHash
dHash, TxSkelOutDatum
dat) ->
((TxSkelOutDatum, Integer)
-> (TxSkelOutDatum, Integer) -> (TxSkelOutDatum, Integer))
-> DatumHash
-> (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\(TxSkelOutDatum
d, Integer
n) (TxSkelOutDatum
_, Integer
n') -> (TxSkelOutDatum
d, Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n')) DatumHash
dHash (TxSkelOutDatum
dat, Integer
1) Map DatumHash (TxSkelOutDatum, Integer)
datumMap
)
mcstDatums
toAdd
}
removeDatums :: [Api.DatumHash] -> MockChainSt -> MockChainSt
removeDatums :: [DatumHash] -> MockChainSt -> MockChainSt
removeDatums [DatumHash]
toRemove st :: MockChainSt
st@(MockChainSt {Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: MockChainSt -> Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums :: Map DatumHash (TxSkelOutDatum, Integer)
mcstDatums}) =
MockChainSt
st
{ mcstDatums =
foldl
(flip (Map.update (\(TxSkelOutDatum
dat, Integer
n) -> (TxSkelOutDatum
dat,) (Integer -> (TxSkelOutDatum, Integer))
-> Maybe Integer -> Maybe (TxSkelOutDatum, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Integer
minusMaybe Integer
n)))
mcstDatums
toRemove
}
where
minusMaybe :: Integer -> Maybe Integer
minusMaybe :: Integer -> Maybe Integer
minusMaybe Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Maybe Integer
forall a. Maybe a
Nothing
minusMaybe Integer
n = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
addValidators :: Map Script.ValidatorHash (Script.Versioned Script.Validator) -> MockChainSt -> MockChainSt
addValidators :: Map ValidatorHash (Versioned Validator)
-> MockChainSt -> MockChainSt
addValidators Map ValidatorHash (Versioned Validator)
valMap st :: MockChainSt
st@(MockChainSt {Map ValidatorHash (Versioned Validator)
mcstValidators :: MockChainSt -> Map ValidatorHash (Versioned Validator)
mcstValidators :: Map ValidatorHash (Versioned Validator)
mcstValidators}) = MockChainSt
st {mcstValidators = Map.union valMap mcstValidators}
utxoState0 :: UtxoState
utxoState0 :: UtxoState
utxoState0 = MockChainSt -> UtxoState
mcstToUtxoState MockChainSt
mockChainSt0
mockChainSt0 :: MockChainSt
mockChainSt0 :: MockChainSt
mockChainSt0 = Params
-> UtxoIndex
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map ValidatorHash (Versioned Validator)
-> Slot
-> MockChainSt
MockChainSt Params
forall a. Default a => a
def UtxoIndex
utxoIndex0 Map DatumHash (TxSkelOutDatum, Integer)
forall k a. Map k a
Map.empty Map ValidatorHash (Versioned Validator)
forall k a. Map k a
Map.empty Slot
0
mockChainSt0From :: InitialDistribution -> MockChainSt
mockChainSt0From :: InitialDistribution -> MockChainSt
mockChainSt0From InitialDistribution
i0 = Params
-> UtxoIndex
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map ValidatorHash (Versioned Validator)
-> Slot
-> MockChainSt
MockChainSt Params
forall a. Default a => a
def (InitialDistribution -> UtxoIndex
utxoIndex0From InitialDistribution
i0) (InitialDistribution -> Map DatumHash (TxSkelOutDatum, Integer)
datumMap0From InitialDistribution
i0) (InitialDistribution -> Map ValidatorHash (Versioned Validator)
referenceScriptMap0From InitialDistribution
i0) Slot
0
referenceScriptMap0From :: InitialDistribution -> Map Script.ValidatorHash (Script.Versioned Script.Validator)
referenceScriptMap0From :: InitialDistribution -> Map ValidatorHash (Versioned Validator)
referenceScriptMap0From (InitialDistribution [TxSkelOut]
initDist) =
[(ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator))
-> [(ValidatorHash, Versioned Validator)]
-> Map ValidatorHash (Versioned Validator)
forall a b. (a -> b) -> a -> b
$ (TxSkelOut -> Maybe (ValidatorHash, Versioned Validator))
-> [TxSkelOut] -> [(ValidatorHash, Versioned Validator)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxSkelOut -> Maybe (ValidatorHash, Versioned Validator)
unitMaybeFrom [TxSkelOut]
initDist
where
unitMaybeFrom :: TxSkelOut -> Maybe (Script.ValidatorHash, Script.Versioned Script.Validator)
unitMaybeFrom :: TxSkelOut -> Maybe (ValidatorHash, Versioned Validator)
unitMaybeFrom (Pays o
output) = do
ReferenceScriptType o
refScript <- Optic' A_Lens NoIx o (Maybe (ReferenceScriptType o))
-> o -> Maybe (ReferenceScriptType o)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx o (Maybe (ReferenceScriptType o))
forall o.
IsAbstractOutput o =>
Lens' o (Maybe (ReferenceScriptType o))
outputReferenceScriptL o
output
let vScript :: Versioned Script
vScript@(Script.Versioned Script
script Language
version) = ReferenceScriptType o -> Versioned Script
forall a. ToVersionedScript a => a -> Versioned Script
toVersionedScript ReferenceScriptType o
refScript
Api.ScriptHash BuiltinByteString
scriptHash = Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
toScriptHash Versioned Script
vScript
(ValidatorHash, Versioned Validator)
-> Maybe (ValidatorHash, Versioned Validator)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuiltinByteString -> ValidatorHash
Script.ValidatorHash BuiltinByteString
scriptHash, Validator -> Language -> Versioned Validator
forall script. script -> Language -> Versioned script
Script.Versioned (Script -> Validator
Script.Validator Script
script) Language
version)
datumMap0From :: InitialDistribution -> Map Api.DatumHash (TxSkelOutDatum, Integer)
datumMap0From :: InitialDistribution -> Map DatumHash (TxSkelOutDatum, Integer)
datumMap0From (InitialDistribution [TxSkelOut]
initDist) =
(Map DatumHash (TxSkelOutDatum, Integer)
-> TxSkelOut -> Map DatumHash (TxSkelOutDatum, Integer))
-> Map DatumHash (TxSkelOutDatum, Integer)
-> [TxSkelOut]
-> Map DatumHash (TxSkelOutDatum, Integer)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map DatumHash (TxSkelOutDatum, Integer)
m -> ((TxSkelOutDatum, Integer)
-> (TxSkelOutDatum, Integer) -> (TxSkelOutDatum, Integer))
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\(TxSkelOutDatum
d, Integer
n1) (TxSkelOutDatum
_, Integer
n2) -> (TxSkelOutDatum
d, Integer
n1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n2)) Map DatumHash (TxSkelOutDatum, Integer)
m (Map DatumHash (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer))
-> (TxSkelOut -> Map DatumHash (TxSkelOutDatum, Integer))
-> TxSkelOut
-> Map DatumHash (TxSkelOutDatum, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelOut -> Map DatumHash (TxSkelOutDatum, Integer)
unitMapFrom) Map DatumHash (TxSkelOutDatum, Integer)
forall k a. Map k a
Map.empty [TxSkelOut]
initDist
where
unitMapFrom :: TxSkelOut -> Map Api.DatumHash (TxSkelOutDatum, Integer)
unitMapFrom :: TxSkelOut -> Map DatumHash (TxSkelOutDatum, Integer)
unitMapFrom TxSkelOut
txSkelOut =
let datum :: TxSkelOutDatum
datum = Optic' A_Lens NoIx TxSkelOut TxSkelOutDatum
-> TxSkelOut -> TxSkelOutDatum
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TxSkelOut TxSkelOutDatum
txSkelOutDatumL TxSkelOut
txSkelOut
in Map DatumHash (TxSkelOutDatum, Integer)
-> (Datum -> Map DatumHash (TxSkelOutDatum, Integer))
-> Maybe Datum
-> Map DatumHash (TxSkelOutDatum, Integer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map DatumHash (TxSkelOutDatum, Integer)
forall k a. Map k a
Map.empty ((DatumHash
-> (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer))
-> (TxSkelOutDatum, Integer)
-> DatumHash
-> Map DatumHash (TxSkelOutDatum, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip DatumHash
-> (TxSkelOutDatum, Integer)
-> Map DatumHash (TxSkelOutDatum, Integer)
forall k a. k -> a -> Map k a
Map.singleton (TxSkelOutDatum
datum, Integer
1) (DatumHash -> Map DatumHash (TxSkelOutDatum, Integer))
-> (Datum -> DatumHash)
-> Datum
-> Map DatumHash (TxSkelOutDatum, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> DatumHash
Script.datumHash) (Maybe Datum -> Map DatumHash (TxSkelOutDatum, Integer))
-> Maybe Datum -> Map DatumHash (TxSkelOutDatum, Integer)
forall a b. (a -> b) -> a -> b
$ TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum TxSkelOutDatum
datum
utxoIndex0From :: InitialDistribution -> Ledger.UtxoIndex
utxoIndex0From :: InitialDistribution -> UtxoIndex
utxoIndex0From (InitialDistribution [TxSkelOut]
initDist) = case Either GenerateTxError (TxBody ConwayEra)
mkBody of
Left GenerateTxError
err -> String -> UtxoIndex
forall a. HasCallStack => String -> a
error (String -> UtxoIndex) -> String -> UtxoIndex
forall a b. (a -> b) -> a -> b
$ GenerateTxError -> String
forall a. Show a => a -> String
show GenerateTxError
err
Right TxBody ConwayEra
body -> Blockchain -> UtxoIndex
Ledger.initialise [[CardanoTx -> OnChainTx
Emulator.unsafeMakeValid (CardanoTx -> OnChainTx) -> CardanoTx -> OnChainTx
forall a b. (a -> b) -> a -> b
$ Tx ConwayEra -> CardanoTx
Ledger.CardanoEmulatorEraTx (Tx ConwayEra -> CardanoTx) -> Tx ConwayEra -> CardanoTx
forall a b. (a -> b) -> a -> b
$ TxBody ConwayEra -> [KeyWitness ConwayEra] -> Tx ConwayEra
forall era. TxBody era -> [KeyWitness era] -> Tx era
Cardano.Tx TxBody ConwayEra
body []]]
where
mkBody :: Either GenerateTxError (Cardano.TxBody Cardano.ConwayEra)
mkBody :: Either GenerateTxError (TxBody ConwayEra)
mkBody = do
Value
value <- (ToCardanoError -> GenerateTxError)
-> Either ToCardanoError Value -> Either GenerateTxError Value
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (String -> ToCardanoError -> GenerateTxError
ToCardanoError String
"Value error") (Either ToCardanoError Value -> Either GenerateTxError Value)
-> Either ToCardanoError Value -> Either GenerateTxError Value
forall a b. (a -> b) -> a -> b
$ Value -> Either ToCardanoError Value
Ledger.toCardanoValue ((Value -> TxSkelOut -> Value) -> Value -> [TxSkelOut] -> Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Value
v -> (Value
v Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<>) (Value -> Value) -> (TxSkelOut -> Value) -> TxSkelOut -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx TxSkelOut Value -> TxSkelOut -> Value
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx TxSkelOut Value
txSkelOutValueL) Value
forall a. Monoid a => a
mempty [TxSkelOut]
initDist)
let mintValue :: TxMintValue BuildTx ConwayEra
mintValue = (Value
-> BuildTxWith
BuildTx (Map PolicyId (ScriptWitness WitCtxMint ConwayEra))
-> TxMintValue BuildTx ConwayEra)
-> BuildTxWith
BuildTx (Map PolicyId (ScriptWitness WitCtxMint ConwayEra))
-> Value
-> TxMintValue BuildTx ConwayEra
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MaryEraOnwards ConwayEra
-> Value
-> BuildTxWith
BuildTx (Map PolicyId (ScriptWitness WitCtxMint ConwayEra))
-> TxMintValue BuildTx ConwayEra
forall era build.
MaryEraOnwards era
-> Value
-> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era))
-> TxMintValue build era
Cardano.TxMintValue MaryEraOnwards ConwayEra
Cardano.MaryEraOnwardsConway) (Map PolicyId (ScriptWitness WitCtxMint ConwayEra)
-> BuildTxWith
BuildTx (Map PolicyId (ScriptWitness WitCtxMint ConwayEra))
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith Map PolicyId (ScriptWitness WitCtxMint ConwayEra)
forall a. Monoid a => a
mempty) (Value -> TxMintValue BuildTx ConwayEra)
-> (Value -> Value) -> Value -> TxMintValue BuildTx ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetId -> Bool) -> Value -> Value
Cardano.filterValue (AssetId -> AssetId -> Bool
forall a. Eq a => a -> a -> Bool
/= AssetId
Cardano.AdaAssetId) (Value -> TxMintValue BuildTx ConwayEra)
-> Value -> TxMintValue BuildTx ConwayEra
forall a b. (a -> b) -> a -> b
$ Value
value
theNetworkId :: NetworkId
theNetworkId = NetworkMagic -> NetworkId
Cardano.Testnet (NetworkMagic -> NetworkId) -> NetworkMagic -> NetworkId
forall a b. (a -> b) -> a -> b
$ Word32 -> NetworkMagic
Cardano.NetworkMagic Word32
42
genesisKeyHash :: Hash GenesisUTxOKey
genesisKeyHash = KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey
Cardano.GenesisUTxOKeyHash (KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey)
-> KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey
forall a b. (a -> b) -> a -> b
$ Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
"23d51e91ae5adc7ae801e9de4cd54175fb7464ec2680b25686bbb194"
inputs :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
inputs = [(NetworkId -> Hash GenesisUTxOKey -> TxIn
Cardano.genesisUTxOPseudoTxIn NetworkId
theNetworkId Hash GenesisUTxOKey
genesisKeyHash, Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era))
-> Witness WitCtxTxIn era
-> BuildTxWith BuildTx (Witness WitCtxTxIn era)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn era
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
Cardano.KeyWitness KeyWitnessInCtx WitCtxTxIn
Cardano.KeyWitnessForSpending)]
[TxOut CtxTx ConwayEra]
outputs <- (TxSkelOut -> Either GenerateTxError (TxOut CtxTx ConwayEra))
-> [TxSkelOut] -> Either GenerateTxError [TxOut CtxTx 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 (NetworkId
-> TxSkelOut -> Either GenerateTxError (TxOut CtxTx ConwayEra)
generateTxOut NetworkId
theNetworkId) [TxSkelOut]
initDist
(TxBodyError -> GenerateTxError)
-> Either TxBodyError (TxBody ConwayEra)
-> Either GenerateTxError (TxBody ConwayEra)
forall a c b. (a -> c) -> Either a b -> Either c b
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> TxBodyError -> GenerateTxError
TxBodyError String
"Body error") (Either TxBodyError (TxBody ConwayEra)
-> Either GenerateTxError (TxBody ConwayEra))
-> Either TxBodyError (TxBody ConwayEra)
-> Either GenerateTxError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$
ShelleyBasedEra ConwayEra
-> TxBodyContent BuildTx ConwayEra
-> Either TxBodyError (TxBody ConwayEra)
forall era.
ShelleyBasedEra era
-> TxBodyContent BuildTx era -> Either TxBodyError (TxBody era)
Cardano.createAndValidateTransactionBody ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway (TxBodyContent BuildTx ConwayEra
-> Either TxBodyError (TxBody ConwayEra))
-> TxBodyContent BuildTx ConwayEra
-> Either TxBodyError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$
TxBodyContent BuildTx ConwayEra
Ledger.emptyTxBodyContent {Cardano.txMintValue = mintValue, Cardano.txOuts = outputs, Cardano.txIns = inputs}
utxoIndex0 :: Ledger.UtxoIndex
utxoIndex0 :: UtxoIndex
utxoIndex0 = InitialDistribution -> UtxoIndex
utxoIndex0From InitialDistribution
forall a. Default a => a
def