Skip to content

Commit

Permalink
Merge pull request mlabs-haskell#76 from mlabs-haskell/uhbif19/update…
Browse files Browse the repository at this point in the history
…-deps

Update deps and improve `CEMScript` constraints
  • Loading branch information
uhbif19 authored May 31, 2024
2 parents 8a39968 + 13a5308 commit b13d558
Show file tree
Hide file tree
Showing 5 changed files with 37 additions and 66 deletions.
25 changes: 7 additions & 18 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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: .
Expand Down
9 changes: 5 additions & 4 deletions cem-script.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
27 changes: 14 additions & 13 deletions src/Cardano/CEM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand Down
23 changes: 6 additions & 17 deletions src/Cardano/CEM/OffChain.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -129,7 +120,6 @@ queryScriptTxInOut ::
forall m script.
( MonadQueryUtxo m
, CEMScriptCompiled script
, Eq (CEMParams script)
) =>
CEMParams script ->
m (Maybe (TxIn, TxOut CtxUTxO Era))
Expand All @@ -151,7 +141,6 @@ queryScriptState ::
forall m script.
( MonadQueryUtxo m
, CEMScriptCompiled script
, Eq (CEMParams script)
) =>
CEMParams script ->
m (Maybe (State script))
Expand Down Expand Up @@ -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
Expand Down
19 changes: 5 additions & 14 deletions src/Cardano/CEM/Testing/StateMachine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand Down

0 comments on commit b13d558

Please sign in to comment.