diff --git a/cabal.project b/cabal.project index 6cf81e4..a6d4812 100644 --- a/cabal.project +++ b/cabal.project @@ -11,31 +11,20 @@ repository cardano-haskell-packages d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee index-state: - , hackage.haskell.org 2024-05-06T13:38:48Z - , cardano-haskell-packages 2024-05-06T13:38:48Z + , hackage.haskell.org 2024-05-29T10:15:00Z + , cardano-haskell-packages 2024-05-24T09:29:56Z tests: true -allow-newer: - cardano-ledger-shelley-ma:base, - ouroboros-consensus-cardano:base, - --- This is needed since prettyprinting stuff was moved to --- cardano-ledger-test library which is no longer a subject --- to be published on CHaP. --- See discussion in https://github.com/IntersectMBO/cardano-ledger/pull/3973 -source-repository-package - type: git - location: https://github.com/IntersectMBO/cardano-ledger - tag: 6e2d37cc0f47bd02e89b4ce9f78b59c35c958e96 - --sha256: 6+Os/mQDzBOU+TkTD+n/T1MFcI+Mn0/tcBMJhLRfqyA= - subdir: - libs/cardano-ledger-test +constraints: + -- Newer version fails to build + -- https://github.com/input-output-hk/io-sim/issues/164 + io-classes-mtl == 0.1.1.0 source-repository-package type: git location: https://github.com/mlabs-haskell/clb - tag: b0717b7a4e84796dbbd3db25f95230fdbf8b4651 + tag: 925f80a9755d2292edf4589afb50dc1146b36ac2 --sha256: 6+Os/mQDzBOU+TkTD+n/T1MFcI+Mn0/tcBMJhLRfqyA= packages: . diff --git a/cem-script.cabal b/cem-script.cabal index 74a5668..d7ab13f 100644 --- a/cem-script.cabal +++ b/cem-script.cabal @@ -86,7 +86,7 @@ common common-onchain build-depends: , plutus-core , plutus-ledger-api - , plutus-tx + , plutus-tx >=1.24 , plutus-tx-plugin , template-haskell >=2.20 , th-abstraction >=0.6.0.0 @@ -106,10 +106,13 @@ common common-onchain common common-offchain import: common-lang + + -- Cardano-api:internal required due to: + -- https://github.com/IntersectMBO/cardano-api/issues/502 build-depends: , aeson , bytestring - , cardano-api ==8.38.0.0 + , cardano-api , cardano-api:internal , cardano-crypto-class , cardano-ledger-alonzo @@ -118,7 +121,6 @@ common common-offchain , cardano-ledger-shelley , containers , filepath - , ouroboros-consensus-cardano , ouroboros-network-protocols , pretty-show , retry @@ -126,7 +128,6 @@ common common-offchain , time , unix --- https://github.com/IntersectMBO/cardano-api/issues/502 common common-executable import: common-offchain ghc-options: -threaded -rtsopts diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs index eeaa045..adcc858 100644 --- a/src/Cardano/CEM.hs +++ b/src/Cardano/CEM.hs @@ -75,11 +75,21 @@ data TxFanConstraint script = MkTxFanC -- Main API +-- FIXME: move IsData here (now it breaks Plutus compilation) +type DefaultConstraints datatype = + ( Prelude.Eq datatype + , Prelude.Show datatype + ) + class ( HasSpine (Transition script) , HasSpine (State script) , Stages (Stage script) - , Show (Stage script) + , DefaultConstraints (Stage script) + , DefaultConstraints (Transition script) + , DefaultConstraints (State script) + , DefaultConstraints (Params script) + , DefaultConstraints (StageParams (Stage script)) ) => CEMScript script where @@ -142,19 +152,10 @@ data CEMParams script = MkCEMParams , stagesParams :: StageParams (Stage script) } -deriving stock instance - ( Show (Params script) - , (Show (StageParams (Stage script))) - ) => - (Show (CEMParams script)) - -deriving stock instance - ( Prelude.Eq (Params script) - , (Prelude.Eq (StageParams (Stage script))) - ) => - (Prelude.Eq (CEMParams script)) +deriving stock instance (CEMScript script) => (Show (CEMParams script)) +deriving stock instance (CEMScript script) => (Prelude.Eq (CEMParams script)) --- TODO: doc +-- FIXME: documentation type CEMScriptDatum script = (StageParams (Stage script), Params script, State script) diff --git a/src/Cardano/CEM/OffChain.hs b/src/Cardano/CEM/OffChain.hs index 4d07f30..1580362 100644 --- a/src/Cardano/CEM/OffChain.hs +++ b/src/Cardano/CEM/OffChain.hs @@ -53,7 +53,7 @@ awaitTx txId = do go 5 where go :: Integer -> m () - go 0 = liftIO $ fail "Tx was not awaited." -- TODO + go 0 = liftIO $ fail "Tx was not awaited." -- FIXME go n = do exists <- checkTxIdExists txId liftIO $ threadDelay 1_000_000 @@ -64,28 +64,19 @@ awaitTx txId = do data CEMAction script = MkCEMAction (CEMParams script) (Transition script) --- TODO deriving stock instance - ( Show (CEMParams script) - , Show (State script) - , Show (Transition script) - ) => - Show (CEMAction script) + (CEMScript script) => Show (CEMAction script) +-- FIXME: use generic Some data SomeCEMAction where MkSomeCEMAction :: forall script. - ( CEMScriptCompiled script - , Show (CEMAction script) - , Show (State script) - , Show (Transition script) - , Eq (CEMParams script) - ) => + (CEMScriptCompiled script) => CEMAction script -> SomeCEMAction instance Show SomeCEMAction where - -- TODO: show script name + -- FIXME: show script name show :: SomeCEMAction -> String show (MkSomeCEMAction action) = show action @@ -129,7 +120,6 @@ queryScriptTxInOut :: forall m script. ( MonadQueryUtxo m , CEMScriptCompiled script - , Eq (CEMParams script) ) => CEMParams script -> m (Maybe (TxIn, TxOut CtxUTxO Era)) @@ -151,7 +141,6 @@ queryScriptState :: forall m script. ( MonadQueryUtxo m , CEMScriptCompiled script - , Eq (CEMParams script) ) => CEMParams script -> m (Maybe (State script)) @@ -249,7 +238,7 @@ resolveAction address = addressSpecToAddress scriptAddress addressSpec -- TODO: protocol params -- calculateMinimumUTxO era txout bpp - minUtxoValue = convertTxOut $ lovelaceToValue $ Lovelace 3_000_000 + minUtxoValue = convertTxOut $ lovelaceToValue 3_000_000 -- TODO convertTxOut x = TxOutValueShelleyBased shelleyBasedEra $ toMaryValue x diff --git a/src/Cardano/CEM/Testing/StateMachine.hs b/src/Cardano/CEM/Testing/StateMachine.hs index fd9dbdd..4731ad0 100644 --- a/src/Cardano/CEM/Testing/StateMachine.hs +++ b/src/Cardano/CEM/Testing/StateMachine.hs @@ -52,8 +52,8 @@ data ScriptStateParams a = MkScriptStateParams params :: ScriptStateParams script -> Params script params = scriptParams . cemParams -deriving stock instance (Eq (CEMParams a)) => Eq (ScriptStateParams a) -deriving stock instance (Show (CEMParams a)) => Show (ScriptStateParams a) +deriving stock instance (CEMScript a) => Eq (ScriptStateParams a) +deriving stock instance (CEMScript a) => Show (ScriptStateParams a) data ScriptState a = Void @@ -66,10 +66,8 @@ data ScriptState a } deriving stock (Generic) -deriving stock instance - (Eq (State a), Eq (CEMParams a)) => Eq (ScriptState a) -deriving stock instance - (Show (State a), Show (CEMParams a)) => Show (ScriptState a) +deriving stock instance (CEMScript a) => Eq (ScriptState a) +deriving stock instance (CEMScript a) => Show (ScriptState a) instance HasVariables (ScriptState a) where getAllVariables _ = Set.empty @@ -78,14 +76,7 @@ instance {-# OVERLAPS #-} HasVariables (Action (ScriptState script) a) where getAllVariables _ = Set.empty class - ( CEMScriptCompiled script - , Show (Transition script) - , Show (State script) - , Show (CEMParams script) - , Eq (State script) - , Eq (CEMParams script) - , Eq (Transition script) - ) => + (CEMScriptCompiled script) => CEMScriptArbitrary script where arbitraryCEMParams :: [SigningKey PaymentKey] -> Gen (CEMParams script)