diff --git a/README.md b/README.md index 34d151f6..0de74025 100644 --- a/README.md +++ b/README.md @@ -126,6 +126,9 @@ Top-level configuration file fields: collectStats: `true` or `false` Save some stats during contract run (only transactions execution budgets supported atm) (default: false) + collectLogs: `true` or `false` + Save logs from contract execution: pab request logs and contract + logs (default: false) budgetMultiplier: rational multiplier in form `1` or `1 % 2` (default: 1) ``` diff --git a/examples/plutus-game/pabConfig.value b/examples/plutus-game/pabConfig.value index bf9da779..833c4a70 100644 --- a/examples/plutus-game/pabConfig.value +++ b/examples/plutus-game/pabConfig.value @@ -29,3 +29,6 @@ enableTxEndpoint: true -- Save some stats during contract run (only transactions execution budgets supported atm) collectStats: false + +-- Save logs from contract execution: pab request logs and contract logs +collectLogs: false diff --git a/examples/plutus-nft/pabConfig.value b/examples/plutus-nft/pabConfig.value index bf9da779..833c4a70 100644 --- a/examples/plutus-nft/pabConfig.value +++ b/examples/plutus-nft/pabConfig.value @@ -29,3 +29,6 @@ enableTxEndpoint: true -- Save some stats during contract run (only transactions execution budgets supported atm) collectStats: false + +-- Save logs from contract execution: pab request logs and contract logs +collectLogs: false diff --git a/examples/plutus-transfer/pabConfig.value b/examples/plutus-transfer/pabConfig.value index 581609df..9c465699 100644 --- a/examples/plutus-transfer/pabConfig.value +++ b/examples/plutus-transfer/pabConfig.value @@ -29,3 +29,6 @@ enableTxEndpoint: true -- Save some stats during contract run (only transactions execution budgets supported atm) collectStats: false + +-- Save logs from contract execution: pab request logs and contract logs +collectLogs: false diff --git a/src/BotPlutusInterface/Config.hs b/src/BotPlutusInterface/Config.hs index dc3043df..57d56ba6 100644 --- a/src/BotPlutusInterface/Config.hs +++ b/src/BotPlutusInterface/Config.hs @@ -96,6 +96,7 @@ instance ToValue PABConfig where pcPort pcEnableTxEndpoint pcCollectStats + pcCollectLogs pcBudgetMultiplier ) = Sections @@ -118,6 +119,7 @@ instance ToValue PABConfig where , Section () "port" $ toValue pcPort , Section () "enableTxEndpoint" $ toValue pcEnableTxEndpoint , Section () "collectStats" $ toValue pcCollectStats + , Section () "collectLogs" $ toValue pcCollectLogs , Section () "budgetMultiplier" $ toValue pcBudgetMultiplier ] {- ORMOLU_ENABLE -} @@ -209,6 +211,13 @@ pabConfigSpec = sectionsSpec "PABConfig" $ do trueOrFalseSpec "Save some stats during contract run (only transactions execution budgets supported atm)" + pcCollectLogs <- + sectionWithDefault' + (pcCollectLogs def) + "collectLogs" + trueOrFalseSpec + "Save logs from contract execution: pab request logs and contract logs" + pcBudgetMultiplier <- sectionWithDefault' (pcBudgetMultiplier def) diff --git a/src/BotPlutusInterface/Effects.hs b/src/BotPlutusInterface/Effects.hs index 8dd4b366..81b7e24c 100644 --- a/src/BotPlutusInterface/Effects.hs +++ b/src/BotPlutusInterface/Effects.hs @@ -40,6 +40,7 @@ import BotPlutusInterface.Types ( ContractState (ContractState), LogContext (BpiLog, ContractLog), LogLevel (..), + LogsList (LogsList), TxBudget, TxFile, addBudget, @@ -47,7 +48,7 @@ import BotPlutusInterface.Types ( import Cardano.Api (AsType, FileError (FileIOError), HasTextEnvelope, TextEnvelopeDescr, TextEnvelopeError) import Cardano.Api qualified import Control.Concurrent qualified as Concurrent -import Control.Concurrent.STM (atomically, modifyTVar, modifyTVar') +import Control.Concurrent.STM (TVar, atomically, modifyTVar, modifyTVar') import Control.Lens ((^.)) import Control.Monad (void, when) import Control.Monad.Freer (Eff, LastMember, Member, interpretM, reinterpret, send, subsume, type (~>)) @@ -138,7 +139,12 @@ handlePABEffect contractEnv = case contractEnv.cePABConfig.pcCliLocation of Local -> Directory.createDirectoryIfMissing createParents filePath Remote ipAddr -> createDirectoryIfMissingRemote ipAddr createParents filePath - PrintLog logCtx logLevel txt -> printLog' contractEnv.cePABConfig.pcLogLevel logCtx logLevel txt + PrintLog logCtx logLevel txt -> + let logMsg = prettyLog logCtx logLevel txt + in do + printLog' contractEnv.cePABConfig.pcLogLevel logCtx logLevel logMsg + when contractEnv.cePABConfig.pcCollectLogs $ + collectLog contractEnv.ceContractLogs logCtx logLevel logMsg UpdateInstanceState s -> do atomically $ modifyTVar contractEnv.ceContractState $ @@ -181,7 +187,15 @@ printLog' logLevelSetting msgCtx msgLogLvl msg = where target = Render.renderString . layoutPretty defaultLayoutOptions $ - pretty msgCtx <+> pretty msgLogLvl <+> msg + prettyLog msgCtx msgLogLvl msg + +prettyLog :: LogContext -> LogLevel -> PP.Doc () -> PP.Doc () +prettyLog msgCtx msgLogLvl msg = pretty msgCtx <+> pretty msgLogLvl <+> msg + +collectLog :: TVar LogsList -> LogContext -> LogLevel -> PP.Doc () -> IO () +collectLog logs logCtx logLvl msg = atomically $ modifyTVar' logs appendLog + where + appendLog (LogsList ls) = LogsList $ (logCtx, logLvl, msg) : ls -- | Reinterpret contract logs to be handled by PABEffect later down the line. handleContractLog :: forall w a effs. Member (PABEffect w) effs => Pretty a => Eff (LogMsg a ': effs) ~> Eff effs diff --git a/src/BotPlutusInterface/Server.hs b/src/BotPlutusInterface/Server.hs index 21152f44..ec24adc3 100644 --- a/src/BotPlutusInterface/Server.hs +++ b/src/BotPlutusInterface/Server.hs @@ -273,6 +273,7 @@ handleContract pabConf state@(AppState st) contract = liftIO $ do contractInstanceID <- liftIO $ ContractInstanceId <$> UUID.nextRandom contractState <- newTVarIO (ContractState Active mempty) contractStats <- newTVarIO mempty + contractLogs <- newTVarIO mempty atomically $ modifyTVar st (Map.insert contractInstanceID (SomeContractState contractState)) @@ -282,6 +283,7 @@ handleContract pabConf state@(AppState st) contract = liftIO $ do , ceContractState = contractState , ceContractInstanceId = contractInstanceID , ceContractStats = contractStats + , ceContractLogs = contractLogs } void $ forkIO $ do diff --git a/src/BotPlutusInterface/Types.hs b/src/BotPlutusInterface/Types.hs index b10d70fb..29c56202 100644 --- a/src/BotPlutusInterface/Types.hs +++ b/src/BotPlutusInterface/Types.hs @@ -22,6 +22,7 @@ module BotPlutusInterface.Types ( SpendBudgets, MintBudgets, ContractStats (..), + LogsList (..), addBudget, ) where @@ -54,6 +55,7 @@ import Plutus.PAB.Effects.Contract.Builtin ( endpointsToSchemas, ) import Prettyprinter (Pretty (pretty)) +import Prettyprinter qualified as PP import Servant.Client (BaseUrl (BaseUrl), Scheme (Http)) import Wallet.Types (ContractInstanceId (..)) import Prelude @@ -82,7 +84,10 @@ data PABConfig = PABConfig , pcTipPollingInterval :: !Natural , pcPort :: !Port , pcEnableTxEndpoint :: !Bool - , pcCollectStats :: !Bool + , -- | Collect contract execution stats inside ContractEnvironment + pcCollectStats :: !Bool + , -- | Collect logs inside ContractEnvironment, doesn't depend on log level + pcCollectLogs :: !Bool , pcBudgetMultiplier :: !Rational } deriving stock (Show, Eq) @@ -144,11 +149,22 @@ newtype ContractStats = ContractStats instance Show (TVar ContractStats) where show _ = "" +-- | List of string logs. +newtype LogsList = LogsList + { getLogsList :: [(LogContext, LogLevel, PP.Doc ())] + } + deriving stock (Show) + deriving newtype (Semigroup, Monoid) + +instance Show (TVar LogsList) where + show _ = "" + data ContractEnvironment w = ContractEnvironment { cePABConfig :: PABConfig , ceContractInstanceId :: ContractInstanceId , ceContractState :: TVar (ContractState w) , ceContractStats :: TVar ContractStats + , ceContractLogs :: TVar LogsList } deriving stock (Show) @@ -222,6 +238,7 @@ instance Default PABConfig where , pcPort = 9080 , pcEnableTxEndpoint = False , pcCollectStats = False + , pcCollectLogs = False , pcBudgetMultiplier = 1 } diff --git a/test/Spec/BotPlutusInterface/Config.hs b/test/Spec/BotPlutusInterface/Config.hs index 95d8bf21..50e48d0b 100644 --- a/test/Spec/BotPlutusInterface/Config.hs +++ b/test/Spec/BotPlutusInterface/Config.hs @@ -113,5 +113,6 @@ pabConfigExample = , pcPort = 1021 , pcEnableTxEndpoint = True , pcCollectStats = False + , pcCollectLogs = False , pcBudgetMultiplier = 1 } diff --git a/test/Spec/MockContract.hs b/test/Spec/MockContract.hs index bbf75a7a..7d197e9c 100644 --- a/test/Spec/MockContract.hs +++ b/test/Spec/MockContract.hs @@ -255,6 +255,7 @@ instance Monoid w => Default (ContractEnvironment w) where , ceContractInstanceId = ContractInstanceId UUID.nil , ceContractState = unsafePerformIO $ newTVarIO def , ceContractStats = unsafePerformIO $ newTVarIO mempty + , ceContractLogs = unsafePerformIO $ newTVarIO mempty } instance Monoid w => Default (ContractState w) where