chore: reorganize modules

cem-script.cabal

@@ -145,7 +145,9 @@ library
     Cardano.CEM.Examples.Auction
     Cardano.CEM.Examples.Compilation
     Cardano.CEM.Examples.Voting
-    Cardano.CEM.Indexing
+    Cardano.CEM.Indexing.Event
+    Cardano.CEM.Indexing.Oura
+    Cardano.CEM.Indexing.Tx
     Cardano.CEM.Monads
     Cardano.CEM.Monads.CLB
     Cardano.CEM.Monads.L1
@@ -156,15 +158,20 @@ library
 
   other-modules:   Cardano.CEM.Monads.L1Commons
   build-depends:
+    , base16
+    , base64
     , cem-script:cardano-extras
     , cem-script:data-spine
     , clb
     , dependent-map
+    , lens
     , ouroboros-consensus
     , QuickCheck
     , quickcheck-dynamic
+    , safe
     , singletons-th
     , toml-parser
+    , vector
 
 test-suite cem-sdk-test
   import:
@@ -206,12 +213,10 @@ test-suite cem-sdk-test
     Auction
     Dynamic
     OffChain
-    Oura
     Oura.Communication
-    Oura.Config
-    OuraFilters
     OuraFilters.Auction
     OuraFilters.Mock
+    OuraFilters.Simple
     TestNFT
     Utils
     Voting

src/Cardano/CEM/Indexing/Event.hs

@@ -0,0 +1,147 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- | Indexer events, i.e. indexer outputs.
+module Cardano.CEM.Indexing.Event where
+
+import Cardano.Api qualified as C
+import Cardano.Api.ScriptData qualified as C
+import Cardano.Api.SerialiseRaw qualified as SerialiseRaw
+import Cardano.CEM (CEMScript, CEMScriptDatum, State, Transition, transitionStage)
+import Cardano.CEM.Address qualified as Address
+import Cardano.CEM.Indexing.Tx
+import Cardano.CEM.OnChain (CEMScriptCompiled, CEMScriptIsData)
+import Cardano.Ledger.BaseTypes qualified as Ledger
+import Control.Lens (view, (^.))
+import Data.Bifunctor (first)
+import Data.ByteString.Base16 qualified as B16
+import Data.Data (Proxy (Proxy))
+import Data.Either.Extra (eitherToMaybe)
+import Data.Function ((&))
+import Data.List (find)
+import Data.Map.Strict qualified as Map
+import Data.Maybe (fromJust)
+import Data.Spine (Spine, getSpine)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Tuple (swap)
+import PlutusLedgerApi.V1 (FromData)
+import PlutusLedgerApi.V1 qualified
+import Prelude
+
+-- ---
+
+{- | Indexer events.
+  We extract events from transactions, where we can encounter three situations:
+
+  (1) For the very first transition there is only target datum and no redeemer.
+  In that case we can only restore the name of the transition,
+  i.e. 'Spine Transition'
+
+  (2) For intermidiate transitions we have both datums that identify them and
+  additionally redeemer, that contains the whole transition. In that case
+  we can restore the whole transition.
+
+  (3) For the final transition the situation is like (2) except the target
+  datum is missing, which doesn't matter.
+
+
+  TODO: How we can improve this in the future:
+  * API is probably bad, as we always have some transition like Init state -
+  which you can decode, as you have State. If one changes data
+  `CEMAction script = MkCEMAction (Params script) (Transition script)` to
+  `... = Init (Params script) (State script)
+       | Transition (Params script) (Transition script)`
+  one could reuse this datatype in all situations.
+-}
+data IndexerEvent script
+  = Initial (Spine (Transition script))
+  | -- | TODO: Migrate from (Spine (Transition script)) to (Transition script)
+    -- once we have this done: https://github.com/utxorpc/spec/issues/132
+    Following (Spine (Transition script)) -- (Transition script)
+
+deriving stock instance
+  (Show (Spine (Transition script))) =>
+  (Show (IndexerEvent script))
+deriving stock instance
+  (Eq (Spine (Transition script))) =>
+  (Eq (IndexerEvent script))
+
+{- | 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.
+-}
+extractEvent ::
+  forall script.
+  ( CEMScript script
+  , CEMScriptIsData script
+  , CEMScriptCompiled script
+  ) =>
+  Ledger.Network ->
+  Tx ->
+  IO (Maybe (IndexerEvent script))
+extractEvent network tx = do
+  -- Script payemnt credential based predicate
+  let ~(Right scriptAddr) = Address.scriptCardanoAddress (Proxy @script) network
+  let cPred = hasAddr scriptAddr
+
+  -- Source state
+  let mOwnInput :: Maybe TxInput = find (cPred . view as_output) (tx ^. inputs)
+  let mSourceState :: Maybe (State script) = (extractState . view as_output) =<< mOwnInput
+  let mSourceSpine :: Maybe (Spine (State script)) = getSpine <$> mSourceState
+
+  -- Target state
+  let mOwnOutput :: Maybe TxOutput = find cPred $ tx ^. outputs
+  let mTargetState :: Maybe (State script) = extractState =<< mOwnOutput
+  let mTargetSpine :: Maybe (Spine (State script)) = getSpine <$> mTargetState
+
+  -- Look up the transition
+  let transitions =
+        first
+          (\(_, b, c) -> (b, c))
+          . swap
+          <$> Map.toList (transitionStage $ Proxy @script)
+  let transSpine = lookup (mSourceSpine, mTargetSpine) transitions
+
+  -- Return
+  case mOwnInput of
+    Nothing -> pure $ Initial <$> transSpine
+    Just _ownInput -> do
+      -- TODO: fix once Oura has rawCbor for redeemer
+      -- rdm <- ownInput ^. redeemer
+      -- pure $ Following $ undefined (rdm ^. redeemerPayload)
+      pure $ Following <$> transSpine
+
+extractState ::
+  forall script.
+  (FromData (CEMScriptDatum script)) =>
+  TxOutput ->
+  Maybe (State script)
+extractState MkTxOutput {_datum = mDtm} =
+  case mDtm of
+    Nothing -> Nothing
+    Just dtm -> do
+      let MkDatum _ _ cbor = dtm
+      let datumAsData :: PlutusLedgerApi.V1.Data =
+            cbor
+              & C.toPlutusData
+                . C.getScriptData
+                . fromJust
+                . eitherToMaybe
+                . C.deserialiseFromCBOR C.AsHashableScriptData
+                . B16.decodeBase16Lenient -- use base64
+                . encodeUtf8
+      let ~(Just (_, _, state)) = PlutusLedgerApi.V1.fromData @(CEMScriptDatum script) datumAsData
+      pure state
+
+hasAddr :: C.Address C.ShelleyAddr -> TxOutput -> Bool
+hasAddr addr' output =
+  let addr = output ^. address
+   in fromOuraAddress addr == addr'
+
+fromOuraAddress :: Address -> C.Address C.ShelleyAddr
+fromOuraAddress (MkAddressAsBase64 addr) =
+  addr
+    & fromJust
+      . eitherToMaybe
+      . SerialiseRaw.deserialiseFromRawBytes (C.AsAddress C.AsShelleyAddr)
+      . B16.decodeBase16Lenient -- use base64
+      . encodeUtf8

src/Cardano/CEM/Indexing.hs → src/Cardano/CEM/Indexing/Oura.hs

@@ -1,4 +1,8 @@
-module Cardano.CEM.Indexing (
+{- | 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.
+-}
+module Cardano.CEM.Indexing.Oura (
   SourcePath (MkSourcePath, unSourcePath),
   SinkPath (MkSinkPath, unSinkPath),
   Filter (MkFilter, unFilter),