Merge pull request #76 from mlabs-haskell/uhbif19/update-deps

Update deps and improve `CEMScript` constraints

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: .

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,15 +121,13 @@ common common-offchain
     , cardano-ledger-shelley
     , containers
     , filepath
-    , ouroboros-consensus-cardano
     , ouroboros-network-protocols
     , pretty-show
     , retry
     , text
     , time
     , unix
 
--- https://github.com/IntersectMBO/cardano-api/issues/502
 common common-executable
   import:      common-offchain
   ghc-options: -threaded -rtsopts

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)
 

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

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)