Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)
```
Expand Down
3 changes: 3 additions & 0 deletions examples/plutus-game/pabConfig.value
Original file line number Diff line number Diff line change
Expand Up @@ -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
3 changes: 3 additions & 0 deletions examples/plutus-nft/pabConfig.value
Original file line number Diff line number Diff line change
Expand Up @@ -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
3 changes: 3 additions & 0 deletions examples/plutus-transfer/pabConfig.value
Original file line number Diff line number Diff line change
Expand Up @@ -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
9 changes: 9 additions & 0 deletions src/BotPlutusInterface/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,7 @@ instance ToValue PABConfig where
pcPort
pcEnableTxEndpoint
pcCollectStats
pcCollectLogs
pcBudgetMultiplier
) =
Sections
Expand All @@ -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 -}
Expand Down Expand Up @@ -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)
Expand Down
20 changes: 17 additions & 3 deletions src/BotPlutusInterface/Effects.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (~>))
Expand Down Expand Up @@ -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 $
Expand Down Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/BotPlutusInterface/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))

Expand All @@ -282,6 +283,7 @@ handleContract pabConf state@(AppState st) contract = liftIO $ do
, ceContractState = contractState
, ceContractInstanceId = contractInstanceID
, ceContractStats = contractStats
, ceContractLogs = contractLogs
}
void $
forkIO $ do
Expand Down
19 changes: 18 additions & 1 deletion src/BotPlutusInterface/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ module BotPlutusInterface.Types (
SpendBudgets,
MintBudgets,
ContractStats (..),
LogsList (..),
addBudget,
) where

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -222,6 +238,7 @@ instance Default PABConfig where
, pcPort = 9080
, pcEnableTxEndpoint = False
, pcCollectStats = False
, pcCollectLogs = False
, pcBudgetMultiplier = 1
}

Expand Down
1 change: 1 addition & 0 deletions test/Spec/BotPlutusInterface/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -113,5 +113,6 @@ pabConfigExample =
, pcPort = 1021
, pcEnableTxEndpoint = True
, pcCollectStats = False
, pcCollectLogs = False
, pcBudgetMultiplier = 1
}
1 change: 1 addition & 0 deletions test/Spec/MockContract.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down