diff --git a/src/Cardano/CEM/OuraConfig.hs b/src/Cardano/CEM/OuraConfig.hs index 9b13be7..079b1c3 100644 --- a/src/Cardano/CEM/OuraConfig.hs +++ b/src/Cardano/CEM/OuraConfig.hs @@ -21,8 +21,8 @@ newtype SinkPath = MkSinkPath {unSinkPath :: T.Text} newtype Filter = MkFilter {unFilter :: Toml.Table} deriving newtype (Eq, Show) -daemonConfig :: SourcePath -> SinkPath -> [Filter] -> Toml.Table -daemonConfig sourcePath sinkPath filters = +daemonConfig :: [Filter] -> SourcePath -> SinkPath -> Toml.Table +daemonConfig filters sourcePath sinkPath = Toml.ToValue.table [ "filters" .= Toml.List (Toml.Table . unFilter <$> filters) , "cursor" .= cursor diff --git a/test/Oura.hs b/test/Oura.hs index 9cdcd04..25e534c 100644 --- a/test/Oura.hs +++ b/test/Oura.hs @@ -22,11 +22,11 @@ import Toml.Pretty qualified import Utils (withNewFile) import Utils qualified +import Cardano.CEM.OuraConfig qualified as Config import Control.Concurrent.Async (Async) import Control.Concurrent.Async qualified as Async import Data.ByteString qualified as BS import Oura.Communication qualified as Communication -import Oura.Config qualified as Config import System.Directory (removeFile) import Toml (Table) diff --git a/test/Oura/Communication.hs b/test/Oura/Communication.hs index af3d384..f71110e 100644 --- a/test/Oura/Communication.hs +++ b/test/Oura/Communication.hs @@ -31,8 +31,8 @@ import Data.Traversable (for) import Network.Socket qualified as Socket import Network.Socket.ByteString qualified as Socket.BS +import Cardano.CEM.OuraConfig (SinkPath, SourcePath (MkSourcePath), unSinkPath) import Data.ByteString.Char8 qualified as BS.Char8 -import Oura.Config (SinkPath, SourcePath (MkSourcePath), unSinkPath) data OuraDaemonConnection = MkOuraDaemonConnection { ownSocket :: Socket.Socket diff --git a/test/Oura/Config.hs b/test/Oura/Config.hs index 3087ca8..513d493 100644 --- a/test/Oura/Config.hs +++ b/test/Oura/Config.hs @@ -1,9 +1,6 @@ {-# LANGUAGE BlockArguments #-} module Oura.Config ( - daemonConfig, - SourcePath (MkSourcePath, unSourcePath), - SinkPath (MkSinkPath, unSinkPath), filtersL, predicateL, tableL, @@ -16,6 +13,7 @@ module Oura.Config ( import Prelude +import Cardano.CEM.OuraConfig qualified as Config import Control.Lens ( At (at), Each (each), @@ -31,83 +29,18 @@ import Control.Lens ( _Just, ) import Data.Map (Map) -import Data.String (IsString) import Data.Text qualified as T import Toml qualified -import Toml.Schema.ToValue ((.=)) -import Toml.Schema.ToValue qualified as Toml.ToValue -- * Config -newtype SourcePath = MkSourcePath {unSourcePath :: T.Text} - deriving newtype (IsString) +filterL :: Iso' Config.Filter Toml.Table +filterL = iso Config.unFilter Config.MkFilter -newtype SinkPath = MkSinkPath {unSinkPath :: T.Text} - deriving newtype (IsString) - -daemonConfig :: SourcePath -> SinkPath -> Toml.Table -daemonConfig sourcePath sinkPath = - Toml.ToValue.table - [ "filters" .= Toml.List filters - , "cursor" .= cursor - , "intersect" .= intersect - , "sink" .= sink sinkPath - , "source" .= source sourcePath - ] - -filters :: [Toml.Value] -filters = - [ Toml.Table $ - Toml.ToValue.table - [ "predicate" .= Toml.Text "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x" - , "skip_uncertain" .= Toml.Bool False - , "type" .= Toml.Text "Select" - ] - ] - -cursor :: Toml.Table -cursor = - Toml.ToValue.table - [ "path" .= Toml.Text "./oura-daemon-cursor" - , "type" .= Toml.Text "File" - ] -intersect :: Toml.Table -intersect = - Toml.ToValue.table - [ "type" .= Toml.Text "Point" - , "value" - .= Toml.List - [ Toml.Integer 37225013 - , Toml.Text "65b3d40e6114e05b662ddde737da63bbab05b86d476148614e82cde98462a6f5" - ] - ] -sink :: SinkPath -> Toml.Table -sink (MkSinkPath sinkPath) = - Toml.ToValue.table - [ "compress_files" .= Toml.Bool True - , "max_bytes_per_file" .= Toml.Integer 1_000_000 - , "max_total_files" .= Toml.Integer 10 - , "output_format" .= Toml.Text "JSONL" - , "output_path" .= Toml.Text sinkPath - , "type" .= Toml.Text "FileRotate" - ] -source :: SourcePath -> Toml.Table -source (MkSourcePath socketPath) = - Toml.ToValue.table - [ "socket_path" .= Toml.Text socketPath - , "type" .= Toml.Text "TxOverSocket" - ] - -newtype Filter = MkFilter {unFilter :: Toml.Table} - deriving newtype (Eq, Show) - -filterL :: Iso' Filter Toml.Table -filterL = iso unFilter MkFilter - -predicateL :: Traversal' Filter T.Text +predicateL :: Traversal' Config.Filter T.Text predicateL = filterL . atKey "predicate" . _Just . _Text -filtersL :: Traversal' Toml.Table [Filter] +filtersL :: Traversal' Toml.Table [Config.Filter] filtersL = atKey "filters" . _Just diff --git a/test/OuraFilters.hs b/test/OuraFilters.hs index e0b99fd..b199c4c 100644 --- a/test/OuraFilters.hs +++ b/test/OuraFilters.hs @@ -1,8 +1,10 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} module OuraFilters (ouraFiltersSpec) where +import Cardano.CEM.OuraConfig qualified as Config import Control.Lens (ix, (.~)) import Control.Monad ((>=>)) import Data.Aeson ((.:)) @@ -13,7 +15,6 @@ import Data.Function ((&)) import Data.Text qualified as T import Oura (Oura (receive, send, shutDown)) import Oura qualified -import Oura.Config qualified as Config import OuraFilters.Auction qualified import OuraFilters.Mock qualified as Mock import PlutusLedgerApi.V1 qualified as V1 @@ -28,6 +29,9 @@ exampleMatchingTx = where inputAddress = Mock.MkAddressAsBase64 "AZSTMVzZLrXYxDBOZ7fhauNtYdNFAmlGV4EaLI4ze2LP/2QDoGo6y8NPjEYAPGn+eaNijO+pxHJR" +exampleFilter :: Config.Filter +exampleFilter = Config.selectByAddress "addr1qx2fxv2umyhttkxyxp8x0dlpdt3k6cwng5pxj3jhsydzer3n0d3vllmyqwsx5wktcd8cc3sq835lu7drv2xwl2wywfgse35a3x" + exampleTx :: Mock.TxEvent exampleTx = Mock.mkTxEvent $ @@ -77,16 +81,20 @@ ouraFiltersSpec = Utils.killProcessesOnError do tx = Mock.txToBS exampleTx matchingTx = Mock.txToBS exampleMatchingTx in - Oura.withOura (Oura.MkWorkDir "./tmp") spotGarbage Config.daemonConfig \oura -> do - Utils.withTimeout 3.0 do - oura.send tx - oura.send matchingTx - Right outTxHash <- - extractOutputTxHash <$> oura.receive - Right inputTxHash <- - pure $ extractInputTxHash matchingTx - outTxHash `shouldBe` inputTxHash - oura.shutDown + Oura.withOura + (Oura.MkWorkDir "./tmp") + spotGarbage + (Config.daemonConfig [exampleFilter]) + \oura -> do + Utils.withTimeout 3.0 do + oura.send tx + oura.send matchingTx + Right outTxHash <- + extractOutputTxHash <$> oura.receive + Right inputTxHash <- + pure $ extractInputTxHash matchingTx + outTxHash `shouldBe` inputTxHash + oura.shutDown OuraFilters.Auction.spec extractInputTxHash :: BS.ByteString -> Either String T.Text diff --git a/test/OuraFilters/Auction.hs b/test/OuraFilters/Auction.hs index 99c883d..63f9972 100644 --- a/test/OuraFilters/Auction.hs +++ b/test/OuraFilters/Auction.hs @@ -6,7 +6,7 @@ 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 Control.Lens (Ixed (ix), (%~), (.~)) +import Control.Lens ((%~), (.~)) import Control.Monad ((>=>)) import Data.Aeson ((.:)) import Data.Aeson qualified as Aeson @@ -14,11 +14,13 @@ import Data.Aeson.Types qualified as Aeson.Types import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BS.IO import Data.Data (Proxy (Proxy)) -import Data.Function ((&)) import Data.Text qualified as T import Data.Text.IO qualified as T.IO import Oura qualified -import Oura.Config qualified as Config + +-- 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 @@ -67,13 +69,12 @@ spec = Mock.txToBS . Mock.mkTxEvent $ Mock.arbitraryTx - makeConfig :: Config.SourcePath -> Config.SinkPath -> Toml.Table + makeConfig :: OuraConfig.SourcePath -> OuraConfig.SinkPath -> Toml.Table makeConfig sourcePath sinkPath = - Config.daemonConfig sourcePath sinkPath - & Config.filtersL - . ix 0 - . Config.predicateL - .~ auctionAddressBech32Text + OuraConfig.daemonConfig + [OuraConfig.selectByAddress auctionAddressBech32Text] + sourcePath + sinkPath in do putStrLn "Hash:"