chore: CEM.Indexing module

mlabs-haskell · Dec 16, 2024 · a352f62 · a352f62
1 parent 8f80353
commit a352f62
Show file tree

Hide file tree

Showing 14 changed files with 191 additions and 181 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
diff --git 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
@@ -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