From ae302686587b5529de4ccbbe6d10f4afe18058df Mon Sep 17 00:00:00 2001 From: Renegatto Date: Mon, 16 Sep 2024 21:18:18 +0300 Subject: [PATCH] Move CEMScript to oura config functionality in CEM.OuraConfig --- cem-script.cabal | 1 + src/Cardano/CEM/Address.hs | 91 +++++++++++++++++++++++++++++++++++ src/Cardano/CEM/OuraConfig.hs | 25 +++++++++- test/OuraFilters/Auction.hs | 48 +++++++----------- test/OuraFilters/Mock.hs | 63 +----------------------- 5 files changed, 134 insertions(+), 94 deletions(-) create mode 100644 src/Cardano/CEM/Address.hs diff --git a/cem-script.cabal b/cem-script.cabal index ceead04..f2355d1 100644 --- a/cem-script.cabal +++ b/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 diff --git a/src/Cardano/CEM/Address.hs b/src/Cardano/CEM/Address.hs new file mode 100644 index 0000000..be8c6b5 --- /dev/null +++ b/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) diff --git a/src/Cardano/CEM/OuraConfig.hs b/src/Cardano/CEM/OuraConfig.hs index 90a9d0e..04a0f81 100644 --- a/src/Cardano/CEM/OuraConfig.hs +++ b/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,8 +38,8 @@ 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" @@ -42,6 +47,22 @@ selectByAddress addressBech32 = , "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 diff --git a/test/OuraFilters/Auction.hs b/test/OuraFilters/Auction.hs index 0327ecc..610bea9 100644 --- a/test/OuraFilters/Auction.hs +++ b/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 -> diff --git a/test/OuraFilters/Mock.hs b/test/OuraFilters/Mock.hs index cc9e41c..a05c8e6 100644 --- a/test/OuraFilters/Mock.hs +++ b/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,58 +361,6 @@ 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 @@ -427,4 +368,4 @@ plutusAddressToOuraAddress = . Base64.encodeBase64 . SerialiseRaw.serialiseToRawBytes . either error id - . plutusAddressToShelleyAddress + . Address.plutusAddressToShelleyAddress Ledger.Mainnet