From a352f6269da6c8677237c2290982904b1fe818d1 Mon Sep 17 00:00:00 2001 From: euonymos Date: Mon, 16 Dec 2024 13:01:52 -0600 Subject: [PATCH] chore: CEM.Indexing module --- cem-script.cabal | 7 +- src/Cardano/CEM.hs | 2 +- src/Cardano/CEM/Address.hs | 126 +++++++++++++-------------- src/Cardano/CEM/Indexing.hs | 7 ++ src/Cardano/CEM/Indexing/Event.hs | 9 +- src/Cardano/CEM/Indexing/Oura.hs | 24 +++-- src/Cardano/CEM/Indexing/Tx.hs | 59 ++++++------- src/Cardano/CEM/Monads.hs | 2 +- src/Cardano/CEM/OffChain.hs | 6 +- test/CEM/Test/Auction.hs | 3 +- test/CEM/Test/Oura/Communication.hs | 15 ++-- test/CEM/Test/OuraFilters/Auction.hs | 45 +++++----- test/CEM/Test/OuraFilters/Mock.hs | 2 +- test/CEM/Test/OuraFilters/Simple.hs | 65 +++++++------- 14 files changed, 191 insertions(+), 181 deletions(-) create mode 100644 src/Cardano/CEM/Indexing.hs diff --git a/cem-script.cabal b/cem-script.cabal index a2f134d..ebcb8d0 100644 --- a/cem-script.cabal +++ b/cem-script.cabal @@ -149,9 +149,7 @@ library hs-source-dirs: src/ exposed-modules: Cardano.CEM - Cardano.CEM.Indexing.Event - Cardano.CEM.Indexing.Oura - Cardano.CEM.Indexing.Tx + Cardano.CEM.Indexing Cardano.CEM.Testing.StateMachine other-modules: @@ -160,6 +158,9 @@ library Cardano.CEM.Documentation Cardano.CEM.DSL Cardano.CEM.DSLSmart + Cardano.CEM.Indexing.Event + Cardano.CEM.Indexing.Oura + Cardano.CEM.Indexing.Tx Cardano.CEM.Monads Cardano.CEM.Monads.CLB Cardano.CEM.Monads.L1Commons diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs index 640aca7..79b560a 100644 --- a/src/Cardano/CEM.hs +++ b/src/Cardano/CEM.hs @@ -4,7 +4,7 @@ module Cardano.CEM ( -- TODO: review -import Cardano.CEM.Address as X (scriptCredential) +import Cardano.CEM.Address as X (cemScriptPlutusCredential) import Cardano.CEM.Compile as X import Cardano.CEM.DSL as X ( CEMScript (..), diff --git a/src/Cardano/CEM/Address.hs b/src/Cardano/CEM/Address.hs index 4d224fd..371ca8d 100644 --- a/src/Cardano/CEM/Address.hs +++ b/src/Cardano/CEM/Address.hs @@ -1,70 +1,62 @@ module Cardano.CEM.Address ( - AddressBech32 (MkAddressBech32, unAddressBech32), - cardanoAddressBech32, - scriptCredential, - scriptCardanoAddress, cemScriptAddress, + cemScriptPlutusCredential, + cemScriptPlutusAddress, plutusAddressToShelleyAddress, ) where -import Cardano.Api qualified -import Cardano.Api.Address qualified -import Cardano.Api.Ledger qualified +import Cardano.Api qualified as C +import Cardano.Api.Address qualified as C (Address (..)) +import Cardano.Api.Ledger qualified as C import Cardano.CEM.OnChain (CEMScriptCompiled (cemScriptCompiled)) -import Cardano.CEM.OnChain qualified as Compiled -import Cardano.Crypto.Hash qualified as Cardano.Hash -import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Credential qualified as Cred -import Cardano.Ledger.Hashes qualified -import Cardano.Ledger.Keys qualified as Ledger.Keys +import Cardano.Crypto.Hash qualified as Crypto +import Cardano.Ledger.BaseTypes qualified as L +import Cardano.Ledger.Credential qualified as L +import Cardano.Ledger.Hashes qualified as L +import Cardano.Ledger.Keys qualified as L import Data.Proxy (Proxy) -import Data.String (IsString) -import Data.Text qualified as T import Plutarch.LedgerApi (scriptHash) import Plutarch.Script (serialiseScript) import Plutus.Extras (scriptValidatorHash) -import PlutusLedgerApi.V1 qualified -import PlutusLedgerApi.V1.Address (Address, scriptHashAddress) +import PlutusLedgerApi.V1 qualified as P +import PlutusLedgerApi.V1.Address qualified as P (scriptHashAddress) import Prelude -newtype AddressBech32 = MkAddressBech32 {unAddressBech32 :: T.Text} - deriving newtype (Eq, Show, IsString) - -cardanoAddressBech32 :: Cardano.Api.Address Cardano.Api.ShelleyAddr -> AddressBech32 -cardanoAddressBech32 = MkAddressBech32 . Cardano.Api.serialiseToBech32 - -{-# INLINEABLE cemScriptAddress #-} cemScriptAddress :: - forall script. (CEMScriptCompiled script) => Proxy script -> Address -cemScriptAddress = - scriptHashAddress . scriptValidatorHash . serialiseScript . cemScriptCompiled - -scriptCardanoAddress :: forall script. - (Compiled.CEMScriptCompiled script) => - Cardano.Api.Ledger.Network -> + (CEMScriptCompiled script) => + C.Network -> Proxy script -> - Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr) -scriptCardanoAddress network = + Either String (C.Address C.ShelleyAddr) +cemScriptAddress network = plutusAddressToShelleyAddress network - . flip PlutusLedgerApi.V1.Address Nothing - . scriptCredential + . flip P.Address Nothing + . cemScriptPlutusCredential + +{-# INLINEABLE cemScriptPlutusAddress #-} +cemScriptPlutusAddress :: + forall script. (CEMScriptCompiled script) => Proxy script -> P.Address +cemScriptPlutusAddress = + P.scriptHashAddress + . scriptValidatorHash + . serialiseScript + . cemScriptCompiled -scriptCredential :: +cemScriptPlutusCredential :: forall script. - (Compiled.CEMScriptCompiled script) => + (CEMScriptCompiled script) => Proxy script -> - PlutusLedgerApi.V1.Credential -scriptCredential = - PlutusLedgerApi.V1.ScriptCredential + P.Credential +cemScriptPlutusCredential = + P.ScriptCredential . scriptHash - . Compiled.cemScriptCompiled + . cemScriptCompiled plutusAddressToShelleyAddress :: - Cardano.Api.Ledger.Network -> - PlutusLedgerApi.V1.Address -> - Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr) -plutusAddressToShelleyAddress network (PlutusLedgerApi.V1.Address payment stake) = do + L.Network -> + P.Address -> + Either String (C.Address C.ShelleyAddr) +plutusAddressToShelleyAddress network (P.Address payment stake) = do paymentCred <- maybe (Left "plutusAddressToShelleyAddress:can't decode payment credential") @@ -75,36 +67,36 @@ plutusAddressToShelleyAddress network (PlutusLedgerApi.V1.Address payment stake) (Left "plutusAddressToShelleyAddress:can't decode stake credential") Right stakeCredential - pure $ Cardano.Api.Address.ShelleyAddress network paymentCred stakeCred + pure $ C.ShelleyAddress network paymentCred stakeCred where credentialToCardano - ( PlutusLedgerApi.V1.PubKeyCredential - (PlutusLedgerApi.V1.PubKeyHash pkh) + ( P.PubKeyCredential + (P.PubKeyHash pkh) ) = - Cred.KeyHashObj - . Ledger.Keys.KeyHash - <$> Cardano.Hash.hashFromBytes - (PlutusLedgerApi.V1.fromBuiltin pkh) + L.KeyHashObj + . L.KeyHash + <$> Crypto.hashFromBytes + (P.fromBuiltin pkh) credentialToCardano - ( PlutusLedgerApi.V1.ScriptCredential - (PlutusLedgerApi.V1.ScriptHash hash) + ( P.ScriptCredential + (P.ScriptHash hash') ) = - Cred.ScriptHashObj - . Cardano.Ledger.Hashes.ScriptHash - <$> Cardano.Hash.hashFromBytes - (PlutusLedgerApi.V1.fromBuiltin hash) + L.ScriptHashObj + . L.ScriptHash + <$> Crypto.hashFromBytes + (P.fromBuiltin hash') paymentCredential = credentialToCardano payment stakeCredential = case stake of - Nothing -> Just Cardano.Api.Ledger.StakeRefNull + Nothing -> Just L.StakeRefNull Just ref -> case ref of - PlutusLedgerApi.V1.StakingHash cred -> - Cardano.Api.Ledger.StakeRefBase + P.StakingHash cred -> + L.StakeRefBase <$> credentialToCardano cred - PlutusLedgerApi.V1.StakingPtr slotNo txIx sertId -> + P.StakingPtr slotNo txIx sertId -> Just $ - Cardano.Api.Ledger.StakeRefPtr $ - Cred.Ptr - (Ledger.SlotNo $ fromInteger slotNo) - (Ledger.TxIx $ fromInteger txIx) - (Ledger.CertIx $ fromInteger sertId) + L.StakeRefPtr $ + L.Ptr + (L.SlotNo $ fromInteger slotNo) + (L.TxIx $ fromInteger txIx) + (L.CertIx $ fromInteger sertId) diff --git a/src/Cardano/CEM/Indexing.hs b/src/Cardano/CEM/Indexing.hs new file mode 100644 index 0000000..907130a --- /dev/null +++ b/src/Cardano/CEM/Indexing.hs @@ -0,0 +1,7 @@ +module Cardano.CEM.Indexing + ( module X + ) where + +import Cardano.CEM.Indexing.Event as X +import Cardano.CEM.Indexing.Oura as X +import Cardano.CEM.Indexing.Tx as X \ No newline at end of file diff --git a/src/Cardano/CEM/Indexing/Event.hs b/src/Cardano/CEM/Indexing/Event.hs index 6b59b22..4f8d90a 100644 --- a/src/Cardano/CEM/Indexing/Event.hs +++ b/src/Cardano/CEM/Indexing/Event.hs @@ -1,7 +1,10 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | Indexer events, i.e. indexer outputs. -module Cardano.CEM.Indexing.Event where +module Cardano.CEM.Indexing.Event ( + IndexerEvent (..), + extractEvent, +) where import Cardano.Api qualified as C import Cardano.Api.ScriptData qualified as C @@ -63,7 +66,7 @@ deriving stock instance (Eq (Spine (Transition script))) => (Eq (IndexerEvent script)) -{- | The core function, that extracts an Event out of a Oura transaction. +{- | The core function, that extracts an 'Event' out of a Oura transaction. It might be a pure function, IO here was used mostly to simplify debugging during its development. -} @@ -77,7 +80,7 @@ extractEvent :: IO (Maybe (IndexerEvent script)) extractEvent network tx = do -- Script payment credential based predicate - let ~(Right scriptAddr) = Address.scriptCardanoAddress network (Proxy @script) + let ~(Right scriptAddr) = Address.cemScriptAddress network (Proxy @script) let cPred = hasAddr scriptAddr -- Source state diff --git a/src/Cardano/CEM/Indexing/Oura.hs b/src/Cardano/CEM/Indexing/Oura.hs index 4494db3..3d220d5 100644 --- a/src/Cardano/CEM/Indexing/Oura.hs +++ b/src/Cardano/CEM/Indexing/Oura.hs @@ -1,6 +1,7 @@ {- | CEM provides the building blocks to build an indexer for your dApp. Current implementation is based on Oura. This module provides tools to -run Oura. +run Oura daemon, most important being function to buil a config for Oura +for a particular CEM Script. -} module Cardano.CEM.Indexing.Oura ( SourcePath (MkSourcePath, unSourcePath), @@ -10,9 +11,14 @@ module Cardano.CEM.Indexing.Oura ( selectByAddress, ouraMonitoringScript, configToText, + + -- * Addresses + AddressBech32 (MkAddressBech32, unAddressBech32), + cardanoAddressBech32, ) where -import Cardano.CEM.Address qualified as Address +import Cardano.Api qualified as C +import Cardano.CEM.Address (cemScriptAddress) import Cardano.CEM.OnChain (CEMScriptCompiled) import Cardano.Ledger.BaseTypes qualified as Ledger import Data.Data (Proxy) @@ -45,8 +51,8 @@ daemonConfig filters sourcePath sinkPath = ] -- | A oura *filter* that selects by address -selectByAddress :: Address.AddressBech32 -> Filter -selectByAddress (Address.MkAddressBech32 addressBech32) = +selectByAddress :: AddressBech32 -> Filter +selectByAddress (MkAddressBech32 addressBech32) = MkFilter $ Toml.ToValue.table [ "predicate" .= Toml.Text addressBech32 -- "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x" @@ -67,8 +73,8 @@ ouraMonitoringScript p network sourcePath sinkPath = (\filters -> daemonConfig filters sourcePath sinkPath) . pure . selectByAddress - . Address.cardanoAddressBech32 - <$> Address.scriptCardanoAddress network p + . cardanoAddressBech32 + <$> cemScriptAddress network p cursor :: Toml.Table cursor = @@ -108,3 +114,9 @@ source (MkSourcePath socketPath) = configToText :: Table -> T.Text configToText = T.pack . show . Toml.Pretty.prettyToml + +newtype AddressBech32 = MkAddressBech32 {unAddressBech32 :: T.Text} + deriving newtype (Eq, Show, IsString) + +cardanoAddressBech32 :: C.Address C.ShelleyAddr -> AddressBech32 +cardanoAddressBech32 = MkAddressBech32 . C.serialiseToBech32 diff --git a/src/Cardano/CEM/Indexing/Tx.hs b/src/Cardano/CEM/Indexing/Tx.hs index f5d3471..d65b50b 100644 --- a/src/Cardano/CEM/Indexing/Tx.hs +++ b/src/Cardano/CEM/Indexing/Tx.hs @@ -5,16 +5,16 @@ {-# HLINT ignore "Use fewer imports" #-} --- | Indexer inputs, Txs as they are represented by Oura. +{- | Cardano transactions as they are represented by Oura. +Source: https://docs.rs/utxorpc-spec/latest/utxorpc_spec/utxorpc/v1alpha/cardano/struct.Tx.html +-} module Cardano.CEM.Indexing.Tx where -import Cardano.Api (TxIn, UTxO) import Cardano.Api qualified as C import Cardano.Api.Address qualified as C (Address (..)) -import Cardano.Api.SerialiseRaw qualified as SerialiseRaw -import Cardano.CEM.Address qualified as Address +import Cardano.CEM.Address (plutusAddressToShelleyAddress) import Cardano.Extras (Era) -import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.BaseTypes qualified as L import Control.Lens.TH (makeLenses, makeLensesFor) import Control.Monad ((<=<)) import Data.Aeson (KeyValue ((.=))) @@ -32,7 +32,7 @@ import Data.Text qualified as T import Data.Vector qualified as Vec import GHC.Generics (Generic (Rep)) import GHC.Stack.Types (HasCallStack) -import PlutusLedgerApi.V1 qualified +import PlutusLedgerApi.V1 qualified as P import Safe import Prelude @@ -249,7 +249,6 @@ arbitraryTx = , _hash = MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" } --- Source: https://docs.rs/utxorpc-spec/latest/utxorpc_spec/utxorpc/v1alpha/cardano/struct.Tx.html data Tx = MkTx { _inputs :: [TxInput] , _outputs :: [TxOutput] @@ -273,14 +272,14 @@ makeLensesFor [("collateral", "txCollateral")] ''Tx -- PlutusData (JSON representation) and other serialisations -encodePlutusData :: PlutusLedgerApi.V1.Data -> PlutusData +encodePlutusData :: P.Data -> PlutusData encodePlutusData = MkPlutusData . datumToJson -datumToJson :: PlutusLedgerApi.V1.Data -> Aeson.Value +datumToJson :: P.Data -> Aeson.Value {-# NOINLINE datumToJson #-} datumToJson = \case - PlutusLedgerApi.V1.Constr n fields -> + P.Constr n fields -> Aeson.object [ "constr" .= Aeson.object @@ -291,7 +290,7 @@ datumToJson = (Vec.fromList $ datumToJson <$> fields) ] ] - PlutusLedgerApi.V1.Map kvs -> + P.Map kvs -> Aeson.object [ "map" .= Aeson.object @@ -306,7 +305,7 @@ datumToJson = ) ] ] - PlutusLedgerApi.V1.I n -> + P.I n -> Aeson.object [ "big_int" .= Aeson.object @@ -320,7 +319,7 @@ datumToJson = ) ] ] - PlutusLedgerApi.V1.B bs -> + P.B bs -> Aeson.object [ "bounded_bytes" .= Aeson.String @@ -328,7 +327,7 @@ datumToJson = B64.encodeBase64 bs ) ] - PlutusLedgerApi.V1.List xs -> + P.List xs -> Aeson.object [ "array" .= Aeson.object @@ -349,39 +348,39 @@ digits base n = totalDigits :: forall n m. (Integral n, RealFrac m, Floating m) => n -> n -> n totalDigits base = round @m . logBase (fromIntegral base) . fromIntegral -serialisePubKeyHash :: PlutusLedgerApi.V1.PubKeyHash -> Hash28 -serialisePubKeyHash = MkBlake2b244Hex . serialiseAsHex . PlutusLedgerApi.V1.getPubKeyHash +serialisePubKeyHash :: P.PubKeyHash -> Hash28 +serialisePubKeyHash = MkBlake2b244Hex . serialiseAsHex . P.getPubKeyHash -serialiseCurrencySymbol :: PlutusLedgerApi.V1.CurrencySymbol -> Hash28 -serialiseCurrencySymbol = MkBlake2b244Hex . serialiseAsHex . PlutusLedgerApi.V1.unCurrencySymbol +serialiseCurrencySymbol :: P.CurrencySymbol -> Hash28 +serialiseCurrencySymbol = MkBlake2b244Hex . serialiseAsHex . P.unCurrencySymbol -serialiseScriptHash :: PlutusLedgerApi.V1.ScriptHash -> Hash28 -serialiseScriptHash = MkBlake2b244Hex . serialiseAsHex . PlutusLedgerApi.V1.getScriptHash +serialiseScriptHash :: P.ScriptHash -> Hash28 +serialiseScriptHash = MkBlake2b244Hex . serialiseAsHex . P.getScriptHash -serialiseTxHash :: PlutusLedgerApi.V1.TxId -> Hash32 -serialiseTxHash = MkBlake2b255Hex . serialiseAsHex . PlutusLedgerApi.V1.getTxId +serialiseTxHash :: P.TxId -> Hash32 +serialiseTxHash = MkBlake2b255Hex . serialiseAsHex . P.getTxId -serialiseAsHex :: PlutusLedgerApi.V1.BuiltinByteString -> T.Text +serialiseAsHex :: P.BuiltinByteString -> T.Text serialiseAsHex = B16.extractBase16 . B16.encodeBase16 - . PlutusLedgerApi.V1.fromBuiltin + . P.fromBuiltin -plutusAddressToOuraAddress :: (HasCallStack) => PlutusLedgerApi.V1.Address -> Address +plutusAddressToOuraAddress :: (HasCallStack) => P.Address -> Address plutusAddressToOuraAddress = MkAddressAsBase64 . B64.extractBase64 . B64.encodeBase64 - . SerialiseRaw.serialiseToRawBytes + . C.serialiseToRawBytes . either error id - . Address.plutusAddressToShelleyAddress Ledger.Mainnet + . plutusAddressToShelleyAddress L.Mainnet -------------------------------------------------------------------------------- -- CEM (cardano-api) -> Tx -- For testing: build a tx in the Oura format from a Cardano tx. -- We populate only fields we use, use with cautious. -resolvedTxToOura :: C.TxBodyContent C.BuildTx Era -> UTxO Era -> Tx +resolvedTxToOura :: C.TxBodyContent C.BuildTx Era -> C.UTxO Era -> Tx resolvedTxToOura tbc utxo = arbitraryTx { _inputs = oInputs @@ -392,7 +391,7 @@ resolvedTxToOura tbc utxo = oOutputs = toOuraTxOutput <$> C.txOuts tbc -- | This is a partial function, use with cautious -toOuraInput :: UTxO Era -> TxIn -> Maybe TxInput +toOuraInput :: C.UTxO Era -> C.TxIn -> Maybe TxInput toOuraInput (C.UTxO utxo) txIn = case Map.lookup txIn utxo of Nothing -> Nothing @@ -443,4 +442,4 @@ toOuraAddrress (C.AddressInEra _ addr) = -- . Base64.encodeBase64 . B16.extractBase16 . B16.encodeBase16 - . SerialiseRaw.serialiseToRawBytes + . C.serialiseToRawBytes diff --git a/src/Cardano/CEM/Monads.hs b/src/Cardano/CEM/Monads.hs index c32e95c..1e2022b 100644 --- a/src/Cardano/CEM/Monads.hs +++ b/src/Cardano/CEM/Monads.hs @@ -27,7 +27,7 @@ data CEMAction script = MkCEMAction (Params script) (Transition script) deriving stock instance (CEMScript script) => Show (CEMAction script) --- TODO: can we rmove this by adding exitential type to CEMAction? +-- TODO: can we rmove this by adding existential type to CEMAction? data SomeCEMAction where MkSomeCEMAction :: forall script. diff --git a/src/Cardano/CEM/OffChain.hs b/src/Cardano/CEM/OffChain.hs index b8c38be..6986735 100644 --- a/src/Cardano/CEM/OffChain.hs +++ b/src/Cardano/CEM/OffChain.hs @@ -14,7 +14,7 @@ import Cardano.Api.Shelley ( toMaryValue, toPlutusData, ) -import Cardano.CEM.Address (cemScriptAddress) +import Cardano.CEM.Address (cemScriptPlutusAddress) import Cardano.CEM.Compile (transitionInStateSpine) import Cardano.CEM.DSL import Cardano.CEM.Monads ( @@ -105,7 +105,7 @@ queryScriptTxInOut params = do Nothing -> False -- May happen in case of changed Datum encoding return mScriptTxIn where - scriptAddress = cemScriptAddress (Proxy :: Proxy script) + scriptAddress = cemScriptPlutusAddress (Proxy :: Proxy script) queryScriptState :: forall m script. @@ -257,7 +257,7 @@ process (MkCEMAction params transition) ec = case ec of PerTransitionErrors [SpecExecutionError $ show message] where script = cemScriptCompiled (Proxy :: Proxy script) - scriptAddress = cemScriptAddress (Proxy :: Proxy script) + scriptAddress = cemScriptPlutusAddress (Proxy :: Proxy script) -- ----------------------------------------------------------------------------- -- Transaction resolving diff --git a/test/CEM/Test/Auction.hs b/test/CEM/Test/Auction.hs index 78fd872..4693779 100644 --- a/test/CEM/Test/Auction.hs +++ b/test/CEM/Test/Auction.hs @@ -14,8 +14,7 @@ import CEM.Test.Utils ( ) import Cardano.Api.NetworkId (toShelleyNetwork) import Cardano.CEM -import Cardano.CEM.Indexing.Event -import Cardano.CEM.Indexing.Tx (resolvedTxToOura) +import Cardano.CEM.Indexing import Cardano.Extras import Control.Monad.Trans (MonadIO (..)) import Data.Proxy (Proxy (..)) diff --git a/test/CEM/Test/Oura/Communication.hs b/test/CEM/Test/Oura/Communication.hs index b39b30f..7ba9722 100644 --- a/test/CEM/Test/Oura/Communication.hs +++ b/test/CEM/Test/Oura/Communication.hs @@ -19,8 +19,7 @@ module CEM.Test.Oura.Communication ( ) where import CEM.Test.Utils -import Cardano.CEM.Indexing.Oura (SinkPath, SourcePath (MkSourcePath), unSinkPath) -import Cardano.CEM.Indexing.Oura qualified as Indexing +import Cardano.CEM.Indexing import Control.Concurrent ( Chan, ThreadId, @@ -68,7 +67,7 @@ newtype WorkDir = MkWorkDir {unWorkDir :: T.Text} withOura :: WorkDir -> SpotGarbage IO Process.ProcessHandle -> - (Indexing.SourcePath -> Indexing.SinkPath -> Table) -> + (SourcePath -> SinkPath -> Table) -> (Oura IO -> IO r) -> IO r withOura spotHandle workdir makeConfig = @@ -77,24 +76,24 @@ withOura spotHandle workdir makeConfig = runOura :: WorkDir -> SpotGarbage IO Process.ProcessHandle -> - (Indexing.SourcePath -> Indexing.SinkPath -> Table) -> + (SourcePath -> SinkPath -> Table) -> Maybe Interval -> ContT r IO (Oura IO) runOura (MkWorkDir (T.unpack -> workdir)) spotHandle makeConfig outputCheckingInterval = do writerPath <- ContT $ withNewFile "writer.socket" workdir - sinkPath :: Indexing.SinkPath <- + sinkPath :: SinkPath <- fmap fromString $ ContT $ withNewFile "sink.socket" workdir - sourcePath :: Indexing.SourcePath <- + sourcePath :: SourcePath <- fmap fromString $ ContT $ withNewFile "source.socket" workdir - lift $ removeFile $ T.unpack $ Indexing.unSourcePath sourcePath + lift $ removeFile $ T.unpack $ unSourcePath sourcePath let - config = Indexing.configToText $ makeConfig sourcePath sinkPath + config = configToText $ makeConfig sourcePath sinkPath configPath <- ContT $ withNewFile "Indexing.toml" workdir lift $ T.IO.writeFile configPath config (ouraHandle, waitingForClose) <- launchOura configPath spotHandle diff --git a/test/CEM/Test/OuraFilters/Auction.hs b/test/CEM/Test/OuraFilters/Auction.hs index df19e36..9ade880 100644 --- a/test/CEM/Test/OuraFilters/Auction.hs +++ b/test/CEM/Test/OuraFilters/Auction.hs @@ -9,8 +9,7 @@ import CEM.Test.Oura.Communication qualified as Oura import CEM.Test.OuraFilters.Mock qualified as Mock import CEM.Test.Utils (SpotGarbage, withTimeout) import Cardano.CEM hiding (error) -- FIXME: -import Cardano.CEM.Indexing.Oura qualified as OuraConfig -import Cardano.CEM.Indexing.Tx qualified as Tx +import Cardano.CEM.Indexing import Cardano.Ledger.BaseTypes qualified as Ledger import Control.Lens ((%~), (.~)) import Control.Monad ((>=>)) @@ -31,29 +30,29 @@ spec = describe "Auction example" do focus $ it "Catches any Auction validator transition" \spotGarbage -> let - auctionPaymentCredential = scriptCredential $ Proxy @Auction.SimpleAuction + auctionPaymentCredential = cemScriptPlutusCredential $ Proxy @Auction.SimpleAuction -- we want oura to monitor just payment credential, ignoring stake credentials arbitraryStakeCredential = PlutusLedgerApi.V1.StakingPtr 5 3 2 rightTxHash = - Tx.MkBlake2b255Hex + MkBlake2b255Hex "2266778888888888888888888888888888888888888888888888444444444444" inputFromValidator = emptyInputFixture auctionPaymentCredential (Just arbitraryStakeCredential) tx = Mock.txToBS . Mock.mkTxEvent - . (Tx.inputs %~ (inputFromValidator :)) - . (Tx.hash .~ rightTxHash) - $ Tx.arbitraryTx + . (inputs %~ (inputFromValidator :)) + . (hash .~ rightTxHash) + $ arbitraryTx unmatchingTx = Mock.txToBS . Mock.mkTxEvent - $ Tx.arbitraryTx + $ arbitraryTx makeConfig source sink = either error id $ - OuraConfig.ouraMonitoringScript (Proxy @Auction.SimpleAuction) Ledger.Mainnet source sink + ouraMonitoringScript (Proxy @Auction.SimpleAuction) Ledger.Mainnet source sink in do Oura.withOura @@ -68,28 +67,28 @@ spec = oura.send tx msg <- oura.receive txHash <- either error pure $ extractTxHash msg - Tx.MkBlake2b255Hex txHash `shouldBe` rightTxHash + MkBlake2b255Hex txHash `shouldBe` rightTxHash oura.shutDown emptyInputFixture :: PlutusLedgerApi.V1.Credential -> Maybe PlutusLedgerApi.V1.StakingCredential -> - Tx.TxInput + TxInput emptyInputFixture paymentCred mstakeCred = - Tx.MkTxInput - { Tx._as_output = - Tx.MkTxOutput - { Tx._address = - Tx.plutusAddressToOuraAddress $ + MkTxInput + { _as_output = + MkTxOutput + { _address = + plutusAddressToOuraAddress $ PlutusLedgerApi.V1.Address paymentCred mstakeCred - , Tx._datum = Nothing - , Tx._coin = 2 - , Tx._script = Nothing - , Tx._assets = mempty + , _datum = Nothing + , _coin = 2 + , _script = Nothing + , _assets = mempty } - , Tx._tx_hash = Tx.MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" - , Tx._output_index = 0 - , Tx._redeemer = Nothing + , _tx_hash = MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" + , _output_index = 0 + , _redeemer = Nothing } extractTxHash :: BS.ByteString -> Either String T.Text diff --git a/test/CEM/Test/OuraFilters/Mock.hs b/test/CEM/Test/OuraFilters/Mock.hs index e2a9d8a..8e711d2 100644 --- a/test/CEM/Test/OuraFilters/Mock.hs +++ b/test/CEM/Test/OuraFilters/Mock.hs @@ -6,7 +6,7 @@ module CEM.Test.OuraFilters.Mock where -import Cardano.CEM.Indexing.Tx (Tx, WithoutUnderscore (..)) +import Cardano.CEM.Indexing import Control.Lens.TH (makeLenses) import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS diff --git a/test/CEM/Test/OuraFilters/Simple.hs b/test/CEM/Test/OuraFilters/Simple.hs index 202ea46..2ef965b 100644 --- a/test/CEM/Test/OuraFilters/Simple.hs +++ b/test/CEM/Test/OuraFilters/Simple.hs @@ -9,8 +9,7 @@ import CEM.Test.Oura.Communication qualified as Oura import CEM.Test.OuraFilters.Auction qualified as Auction import CEM.Test.OuraFilters.Mock qualified as Mock import CEM.Test.Utils -import Cardano.CEM.Indexing.Oura qualified as Config -import Cardano.CEM.Indexing.Tx qualified as Tx +import Cardano.CEM.Indexing import Control.Lens (ix, (.~)) import Control.Monad ((>=>)) import Data.Aeson ((.:)) @@ -26,46 +25,46 @@ import Prelude exampleMatchingTx :: Mock.TxEvent exampleMatchingTx = exampleTx - & Mock.parsed_tx . Tx.inputs . ix 0 . Tx.as_output . Tx.address .~ inputAddress + & Mock.parsed_tx . inputs . ix 0 . as_output . address .~ inputAddress where - inputAddress = Tx.MkAddressAsBase64 "AZSTMVzZLrXYxDBOZ7fhauNtYdNFAmlGV4EaLI4ze2LP/2QDoGo6y8NPjEYAPGn+eaNijO+pxHJR" + inputAddress = MkAddressAsBase64 "AZSTMVzZLrXYxDBOZ7fhauNtYdNFAmlGV4EaLI4ze2LP/2QDoGo6y8NPjEYAPGn+eaNijO+pxHJR" -exampleFilter :: Config.Filter -exampleFilter = Config.selectByAddress "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x" +exampleFilter :: Filter +exampleFilter = selectByAddress "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x" exampleTx :: Mock.TxEvent exampleTx = Mock.mkTxEvent $ - Tx.arbitraryTx - & Tx.inputs - .~ [ Tx.MkTxInput - { Tx._tx_hash = Tx.MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" - , Tx._output_index = 5 - , Tx._as_output = out - , Tx._redeemer = + arbitraryTx + & inputs + .~ [ MkTxInput + { _tx_hash = MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" + , _output_index = 5 + , _as_output = out + , _redeemer = Just $ - Tx.MkRedeemer - { _purpose = Tx.PURPOSE_UNSPECIFIED - , payload = Tx.encodePlutusData (V1.I 212) + MkRedeemer + { _purpose = PURPOSE_UNSPECIFIED + , payload = encodePlutusData (V1.I 212) } } ] - & Tx.outputs .~ [out] - & Tx.txCollateral . Tx.collateral_return . Tx.coin .~ 25464 - & Tx.txCollateral . Tx.total_collateral .~ 2555 - & Tx.fee .~ 967 - & Tx.validity .~ Tx.MkTxValidity {Tx._start = 324, Tx._ttl = 323} + & outputs .~ [out] + & txCollateral . collateral_return . coin .~ 25464 + & txCollateral . total_collateral .~ 2555 + & fee .~ 967 + & validity .~ MkTxValidity {_start = 324, _ttl = 323} where out = - Tx.MkTxOutput - { Tx._address = Tx.MkAddressAsBase64 "cM+tGRS1mdGL/9FNK71pYBnCiZy91qAzJc32gLw=" - , Tx._coin = 254564 - , Tx._assets = [] - , Tx._datum = + MkTxOutput + { _address = MkAddressAsBase64 "cM+tGRS1mdGL/9FNK71pYBnCiZy91qAzJc32gLw=" + , _coin = 254564 + , _assets = [] + , _datum = Just $ - Tx.MkDatum - { Tx._payload = - Tx.encodePlutusData $ + MkDatum + { _payload = + encodePlutusData $ V1.List [ V1.Map [ (V1.I 2, V1.I 33) @@ -74,10 +73,10 @@ exampleTx = , V1.I 34 , V1.B "aboba" ] - , Tx.hash = Tx.MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" - , Tx._original_cbor = "" + , hash = MkBlake2b255Hex "af6366838cfac9cc56856ffe1d595ad1dd32c9bafb1ca064a08b5c687293110f" + , _original_cbor = "" } - , Tx._script = Nothing + , _script = Nothing } simpleSpec :: Spec @@ -90,7 +89,7 @@ simpleSpec = killProcessesOnError do Oura.withOura (Oura.MkWorkDir "./tmp") spotGarbage - (Config.daemonConfig [exampleFilter]) + (daemonConfig [exampleFilter]) \oura -> do withTimeout 3.0 do oura.send tx