Add option to collect logs inside ContractEnvironment. (#113)

* Add option to collect logs inside ContractEnvironment.

Adds additional interpretetion for PrintLog effect, that saves the log inside TVar in ContractEnviroment.
This is turned on/off by flag in PABConfig.

Author: zmrocze

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)
 ```

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

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

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

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)

src/BotPlutusInterface/Effects.hs

@@ -40,14 +40,15 @@ import BotPlutusInterface.Types (
   ContractState (ContractState),
   LogContext (BpiLog, ContractLog),
   LogLevel (..),
+  LogsList (LogsList),
   TxBudget,
   TxFile,
   addBudget,
  )
 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

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

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 _ = "<ContractStats>"
 
+-- | 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 _ = "<ContractLogs>"
+
 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
       }
 

test/Spec/BotPlutusInterface/Config.hs

@@ -113,5 +113,6 @@ pabConfigExample =
     , pcPort = 1021
     , pcEnableTxEndpoint = True
     , pcCollectStats = False
+    , pcCollectLogs = False
     , pcBudgetMultiplier = 1
     }

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