Move CEMScript to oura config functionality in CEM.OuraConfig

cem-script.cabal

@@ -140,6 +140,7 @@ library
   hs-source-dirs:  src/
   exposed-modules:
     Cardano.CEM
+    Cardano.CEM.Address
     Cardano.CEM.Documentation
     Cardano.CEM.Examples.Auction
     Cardano.CEM.Examples.Compilation

src/Cardano/CEM/Address.hs

@@ -0,0 +1,91 @@
+module Cardano.CEM.Address (
+  cardanoAddressBech32,
+  scriptCardanoAddress,
+  plutusAddressToShelleyAddress,
+  AddressBech32 (MkAddressBech32, unAddressBech32),
+) where
+
+import Cardano.Api qualified
+import Cardano.Api.Address qualified
+import Cardano.Api.Ledger qualified
+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 Data.Data (Proxy (Proxy))
+import Data.String (IsString)
+import Data.Text qualified as T
+import Plutus.Extras qualified
+import PlutusLedgerApi.V1 qualified
+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
+
+scriptCardanoAddress ::
+  forall script.
+  (Compiled.CEMScriptCompiled script) =>
+  Proxy script ->
+  Cardano.Api.Ledger.Network ->
+  Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr)
+scriptCardanoAddress _ network =
+  plutusAddressToShelleyAddress network
+    . flip PlutusLedgerApi.V1.Address Nothing
+    . PlutusLedgerApi.V1.ScriptCredential
+    . Plutus.Extras.scriptValidatorHash
+    . Compiled.cemScriptCompiled
+    $ Proxy @script
+
+plutusAddressToShelleyAddress ::
+  Cardano.Api.Ledger.Network ->
+  PlutusLedgerApi.V1.Address ->
+  Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr)
+plutusAddressToShelleyAddress network (PlutusLedgerApi.V1.Address payment stake) = do
+  paymentCred <-
+    maybe
+      (Left "plutusAddressToShelleyAddress:can't decode payment credential")
+      Right
+      paymentCredential
+  stakeCred <-
+    maybe
+      (Left "plutusAddressToShelleyAddress:can't decode stake credential")
+      Right
+      stakeCredential
+  pure $ Cardano.Api.Address.ShelleyAddress network paymentCred stakeCred
+  where
+    credentialToCardano
+      ( PlutusLedgerApi.V1.PubKeyCredential
+          (PlutusLedgerApi.V1.PubKeyHash pkh)
+        ) =
+        Cred.KeyHashObj
+          . Ledger.Keys.KeyHash
+          <$> Cardano.Hash.hashFromBytes
+            (PlutusLedgerApi.V1.fromBuiltin pkh)
+    credentialToCardano
+      ( PlutusLedgerApi.V1.ScriptCredential
+          (PlutusLedgerApi.V1.ScriptHash scriptHash)
+        ) =
+        Cred.ScriptHashObj
+          . Cardano.Ledger.Hashes.ScriptHash
+          <$> Cardano.Hash.hashFromBytes
+            (PlutusLedgerApi.V1.fromBuiltin scriptHash)
+
+    paymentCredential = credentialToCardano payment
+    stakeCredential = case stake of
+      Nothing -> Just Cardano.Api.Ledger.StakeRefNull
+      Just ref -> case ref of
+        PlutusLedgerApi.V1.StakingHash cred ->
+          Cardano.Api.Ledger.StakeRefBase
+            <$> credentialToCardano cred
+        PlutusLedgerApi.V1.StakingPtr slotNo txIx sertId ->
+          Just $
+            Cardano.Api.Ledger.StakeRefPtr $
+              Cred.Ptr
+                (Ledger.SlotNo $ fromInteger slotNo)
+                (Ledger.TxIx $ fromInteger txIx)
+                (Ledger.CertIx $ fromInteger sertId)

src/Cardano/CEM/OuraConfig.hs

@@ -4,8 +4,13 @@ module Cardano.CEM.OuraConfig (
   Filter (MkFilter, unFilter),
   daemonConfig,
   selectByAddress,
+  ouraMonitoringScript,
 ) where
 
+import Cardano.CEM.Address qualified as Address
+import Cardano.CEM.OnChain (CEMScriptCompiled)
+import Cardano.Ledger.BaseTypes qualified as Ledger
+import Data.Data (Proxy)
 import Data.String (IsString)
 import Data.Text qualified as T
 import Toml qualified
@@ -33,15 +38,31 @@ daemonConfig filters sourcePath sinkPath =
     ]
 
 -- | A oura *filter* that selects by address
-selectByAddress :: T.Text -> Filter
-selectByAddress addressBech32 =
+selectByAddress :: Address.AddressBech32 -> Filter
+selectByAddress (Address.MkAddressBech32 addressBech32) =
   MkFilter $
     Toml.ToValue.table
       [ "predicate" .= Toml.Text addressBech32 -- "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x"
       , "skip_uncertain" .= Toml.Bool False
       , "type" .= Toml.Text "Select"
       ]
 
+-- | Makes an oura config such that oura is going to monitor all spendings from the script's payment credential.
+ouraMonitoringScript ::
+  forall script.
+  (CEMScriptCompiled script) =>
+  Proxy script ->
+  Ledger.Network ->
+  SourcePath ->
+  SinkPath ->
+  Either String Toml.Table
+ouraMonitoringScript p network sourcePath sinkPath =
+  (\filters -> daemonConfig filters sourcePath sinkPath)
+    . pure
+    . selectByAddress
+    . Address.cardanoAddressBech32
+    <$> Address.scriptCardanoAddress p network
+
 cursor :: Toml.Table
 cursor =
   Toml.ToValue.table

test/OuraFilters/Auction.hs

@@ -6,6 +6,8 @@ module OuraFilters.Auction (spec) where
 import Cardano.CEM.Examples.Auction qualified as Auction
 import Cardano.CEM.Examples.Compilation ()
 import Cardano.CEM.OnChain qualified as Compiled
+import Cardano.CEM.OuraConfig qualified as OuraConfig
+import Cardano.Ledger.BaseTypes qualified as Ledger
 import Control.Lens ((%~), (.~))
 import Control.Monad ((>=>))
 import Data.Aeson ((.:))
@@ -15,19 +17,13 @@ import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as BS.IO
 import Data.Data (Proxy (Proxy))
 import Data.Text qualified as T
-import Data.Text.IO qualified as T.IO
 import Oura qualified
-
--- import Oura.Config qualified as Config
-
-import Cardano.CEM.OuraConfig qualified as OuraConfig
 import OuraFilters.Mock qualified as Mock
 import Plutus.Extras (scriptValidatorHash)
 import PlutusLedgerApi.V1 qualified
 import System.Process (ProcessHandle)
 import Test.Hspec (describe, focus, it, shouldBe)
 import Test.Hspec.Core.Spec (SpecM)
-import Toml qualified
 import Utils (SpotGarbage, withTimeout)
 import Prelude
 
@@ -36,14 +32,6 @@ spec =
   describe "Auction example" do
     focus $ it "Catches any Auction validator transition" \spotGarbage ->
       let
-        auctionAddress =
-          PlutusLedgerApi.V1.Address
-            auctionPaymentCredential
-            Nothing
-        auctionAddressBech32Text =
-          Mock.shelleyAddressBech32
-            . either error id
-            $ Mock.plutusAddressToShelleyAddress auctionAddress
         auctionPaymentCredential =
           PlutusLedgerApi.V1.ScriptCredential auctionValidatorHash
         auctionValidatorHash =
@@ -69,25 +57,23 @@ spec =
           Mock.txToBS
             . Mock.mkTxEvent
             $ Mock.arbitraryTx
-        makeConfig :: OuraConfig.SourcePath -> OuraConfig.SinkPath -> Toml.Table
-        makeConfig sourcePath sinkPath =
-          OuraConfig.daemonConfig
-            [OuraConfig.selectByAddress auctionAddressBech32Text]
-            sourcePath
-            sinkPath
+        makeConfig source sink =
+          either error id $
+            OuraConfig.ouraMonitoringScript (Proxy @Auction.SimpleAuction) Ledger.Mainnet source sink
        in
         do
-          putStrLn "Hash:"
-          T.IO.putStrLn auctionAddressBech32Text
-          Oura.withOura (Oura.MkWorkDir "./tmp") spotGarbage makeConfig \oura -> do
-            withTimeout 6.0 do
-              oura.send unmatchingTx
-              oura.send tx
-              msg <- oura.receive
-              BS.IO.putStrLn $ "message: " <> msg
-              txHash <- either error pure $ extractTxHash msg
-              Mock.MkBlake2b255Hex txHash `shouldBe` rightTxHash
-              oura.shutDown
+          Oura.withOura
+            (Oura.MkWorkDir "./tmp")
+            spotGarbage
+            makeConfig
+            \oura -> do
+              withTimeout 6.0 do
+                oura.send unmatchingTx
+                oura.send tx
+                msg <- oura.receive
+                txHash <- either error pure $ extractTxHash msg
+                Mock.MkBlake2b255Hex txHash `shouldBe` rightTxHash
+                oura.shutDown
 
 emptyInputFixture ::
   PlutusLedgerApi.V1.Credential ->

test/OuraFilters/Mock.hs

@@ -6,16 +6,9 @@
 
 module OuraFilters.Mock where
 
-import Cardano.Api qualified
-import Cardano.Api.Address qualified as Address
-import Cardano.Api.Ledger qualified
-import Cardano.Api.Ledger qualified as Cred
 import Cardano.Api.SerialiseRaw qualified as SerialiseRaw
-import Cardano.Crypto.Hash qualified as Cardano.Hash
+import Cardano.CEM.Address qualified as Address
 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 Control.Lens.TH (makeLenses, makeLensesFor)
 import Control.Monad ((<=<))
 import Data.Aeson (KeyValue ((.=)))
@@ -368,63 +361,11 @@ serialiseAsHex =
     . Base16.encodeBase16
     . PlutusLedgerApi.V1.fromBuiltin
 
-plutusAddressToShelleyAddress ::
-  PlutusLedgerApi.V1.Address ->
-  Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr)
-plutusAddressToShelleyAddress (PlutusLedgerApi.V1.Address payment stake) = do
-  paymentCred <-
-    maybe
-      (Left "plutusAddressToShelleyAddress:can't decode payment credential")
-      Right
-      paymentCredential
-  stakeCred <-
-    maybe
-      (Left "plutusAddressToShelleyAddress:can't decode stake credential")
-      Right
-      stakeCredential
-  pure $ Address.ShelleyAddress Ledger.Mainnet paymentCred stakeCred
-  where
-    credentialToCardano
-      ( PlutusLedgerApi.V1.PubKeyCredential
-          (PlutusLedgerApi.V1.PubKeyHash pkh)
-        ) =
-        Cred.KeyHashObj
-          . Ledger.Keys.KeyHash
-          <$> Cardano.Hash.hashFromBytes
-            (PlutusLedgerApi.V1.fromBuiltin pkh)
-    credentialToCardano
-      ( PlutusLedgerApi.V1.ScriptCredential
-          (PlutusLedgerApi.V1.ScriptHash scriptHash)
-        ) =
-        Cred.ScriptHashObj
-          . Cardano.Ledger.Hashes.ScriptHash
-          <$> Cardano.Hash.hashFromBytes
-            (PlutusLedgerApi.V1.fromBuiltin scriptHash)
-
-    paymentCredential = credentialToCardano payment
-    stakeCredential = case stake of
-      Nothing -> Just Cardano.Api.Ledger.StakeRefNull
-      Just ref -> case ref of
-        PlutusLedgerApi.V1.StakingHash cred ->
-          Cardano.Api.Ledger.StakeRefBase
-            <$> credentialToCardano cred
-        PlutusLedgerApi.V1.StakingPtr slotNo txIx sertId ->
-          Just $
-            Cardano.Api.Ledger.StakeRefPtr $
-              Cred.Ptr
-                (Ledger.SlotNo $ fromInteger slotNo)
-                (Ledger.TxIx $ fromInteger txIx)
-                (Ledger.CertIx $ fromInteger sertId)
-
-shelleyAddressBech32 ::
-  Cardano.Api.Address Cardano.Api.ShelleyAddr -> T.Text
-shelleyAddressBech32 = Cardano.Api.serialiseToBech32
-
 plutusAddressToOuraAddress :: (HasCallStack) => PlutusLedgerApi.V1.Address -> Address
 plutusAddressToOuraAddress =
   MkAddressAsBase64
     . Base64.extractBase64
     . Base64.encodeBase64
     . SerialiseRaw.serialiseToRawBytes
     . either error id
-    . plutusAddressToShelleyAddress
+    . Address.plutusAddressToShelleyAddress Ledger.Mainnet