@@ -3,6 +3,7 @@ module Cardano.CEM.Monads where
33import Prelude
44
55import Data.Set (Set )
6+ import GHC.Natural (Natural )
67
78import PlutusLedgerApi.V1.Address (Address )
89import PlutusLedgerApi.V2 (
@@ -14,10 +15,39 @@ import PlutusLedgerApi.V2 (
1415import Cardano.Api hiding (Address , In , Out , queryUtxo , txIns )
1516import Cardano.Api.Shelley (PoolId )
1617import Cardano.Ledger.Core (PParams )
17- import Cardano.Ledger.Shelley.API (ApplyTxError (.. ))
18+ import Cardano.Ledger.Shelley.API (ApplyTxError (.. ), Coin )
1819
20+ import Cardano.CEM
21+ import Cardano.CEM.OnChain
1922import Cardano.Extras
2023
24+ -- CEMAction and TxSpec
25+
26+ data CEMAction script
27+ = MkCEMAction (CEMParams script ) (Transition script )
28+
29+ deriving stock instance
30+ (CEMScript script ) => Show (CEMAction script )
31+
32+ -- FIXME: use generic Some
33+ data SomeCEMAction where
34+ MkSomeCEMAction ::
35+ forall script .
36+ (CEMScriptCompiled script ) =>
37+ CEMAction script ->
38+ SomeCEMAction
39+
40+ instance Show SomeCEMAction where
41+ -- FIXME: show script name
42+ show :: SomeCEMAction -> String
43+ show (MkSomeCEMAction action) = show action
44+
45+ data TxSpec = MkTxSpec
46+ { actions :: [SomeCEMAction ]
47+ , specSigner :: SigningKey PaymentKey
48+ }
49+ deriving stock (Show )
50+
2151-- MonadBlockchainParams
2252
2353-- | Params of blockchain required for transaction-building
@@ -73,6 +103,20 @@ data TxSubmittingError
73103 | UnhandledNodeSubmissionError (ApplyTxError LedgerEra )
74104 deriving stock (Show )
75105
106+ -- | Error occurred while trying to execute CEMScript transition
107+ data TransitionError
108+ = StateMachineError
109+ { errorMessage :: String
110+ }
111+ | MissingTransitionInput
112+ deriving stock (Show , Eq )
113+
114+ data TxResolutionError
115+ = TxSpecIsIncorrect
116+ | MkTransitionError SomeCEMAction TransitionError
117+ | UnhandledSubmittingError TxSubmittingError
118+ deriving stock (Show )
119+
76120-- | Ability to send transaction to chain
77121class (MonadQueryUtxo m ) => MonadSubmitTx m where
78122 submitResolvedTx :: ResolvedTx -> m (Either TxSubmittingError TxId )
0 commit comments