Skip to content

Commit beadd21

Browse files
committed
Move some datatypes from .Offchain up to .Monads
1 parent a1b7d61 commit beadd21

File tree

2 files changed

+46
-41
lines changed

2 files changed

+46
-41
lines changed

src/Cardano/CEM/Monads.hs

Lines changed: 45 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module Cardano.CEM.Monads where
33
import Prelude
44

55
import Data.Set (Set)
6+
import GHC.Natural (Natural)
67

78
import PlutusLedgerApi.V1.Address (Address)
89
import PlutusLedgerApi.V2 (
@@ -14,10 +15,39 @@ import PlutusLedgerApi.V2 (
1415
import Cardano.Api hiding (Address, In, Out, queryUtxo, txIns)
1516
import Cardano.Api.Shelley (PoolId)
1617
import 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
1922
import 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
77121
class (MonadQueryUtxo m) => MonadSubmitTx m where
78122
submitResolvedTx :: ResolvedTx -> m (Either TxSubmittingError TxId)

src/Cardano/CEM/OffChain.hs

Lines changed: 1 addition & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -59,45 +59,6 @@ awaitTx txId = do
5959
then return ()
6060
else go $ n - 1
6161

62-
data CEMAction script
63-
= MkCEMAction (CEMParams script) (Transition script)
64-
65-
deriving stock instance
66-
(CEMScript script) => Show (CEMAction script)
67-
68-
-- FIXME: use generic Some
69-
data SomeCEMAction where
70-
MkSomeCEMAction ::
71-
forall script.
72-
(CEMScriptCompiled script) =>
73-
CEMAction script ->
74-
SomeCEMAction
75-
76-
instance Show SomeCEMAction where
77-
-- FIXME: show script name
78-
show :: SomeCEMAction -> String
79-
show (MkSomeCEMAction action) = show action
80-
81-
data TxSpec = MkTxSpec
82-
{ actions :: [SomeCEMAction]
83-
, specSigner :: SigningKey PaymentKey
84-
}
85-
deriving stock (Show)
86-
87-
-- | Error occurred while trying to execute CEMScript transition
88-
data TransitionError
89-
= StateMachineError
90-
{ errorMessage :: String
91-
}
92-
| MissingTransitionInput
93-
deriving stock (Show, Eq)
94-
95-
data TxResolutionError
96-
= TxSpecIsIncorrect
97-
| MkTransitionError SomeCEMAction TransitionError
98-
| UnhandledSubmittingError TxSubmittingError
99-
deriving stock (Show)
100-
10162
failLeft :: (MonadFail m, Show s) => Either s a -> m a
10263
failLeft (Left errorMsg) = fail $ show errorMsg
10364
failLeft (Right value) = return value
@@ -252,7 +213,7 @@ resolveTx spec = runExceptT $ do
252213
-- Merge specs
253214
let
254215
mergedSpec' = head actionsSpecs
255-
mergedSpec = mergedSpec' {signer = specSigner spec}
216+
mergedSpec = (mergedSpec' :: ResolvedTx) {signer = specSigner spec}
256217

257218
return mergedSpec
258219

0 commit comments

Comments
 (0)