Skip to content

Commit 3af819b

Browse files
IAmPara0xIAmPara0x
committed
improve logging
1 parent a84a95f commit 3af819b

File tree

6 files changed

+82
-38
lines changed

6 files changed

+82
-38
lines changed

‎src/BotPlutusInterface/Balance.hs‎

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,14 @@ import BotPlutusInterface.Effects (
2323
)
2424
import BotPlutusInterface.Files (DummyPrivKey, unDummyPrivateKey)
2525
import BotPlutusInterface.Files qualified as Files
26-
import BotPlutusInterface.Types (CollateralUtxo, LogLevel (Debug), PABConfig, collateralTxOutRef)
26+
import BotPlutusInterface.Types (
27+
CollateralUtxo (collateralTxOutRef),
28+
LogLevel (Debug),
29+
LogType (TxBalancingLog),
30+
PABConfig,
31+
collateralTxOutRef,
32+
)
33+
2734
import Cardano.Api (ExecutionUnitPrices (ExecutionUnitPrices))
2835
import Cardano.Api.Shelley (ProtocolParameters (protocolParamPrices))
2936
import Control.Monad (foldM, void, zipWithM)
@@ -121,7 +128,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
121128
requiredSigs :: [PubKeyHash]
122129
requiredSigs = map Ledger.unPaymentPubKeyHash $ Map.keys (unBalancedTxRequiredSignatories unbalancedTx)
123130

124-
lift $ printBpiLog @w Debug $ viaShow utxoIndex
131+
lift $ printBpiLog @w (Debug [TxBalancingLog]) $ viaShow utxoIndex
125132

126133
-- We need this folder on the CLI machine, which may not be the local machine
127134
lift $ createDirectoryIfMissingCLI @w False (Text.unpack "pcTxFileDir")
@@ -182,7 +189,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
182189

183190
let minUtxos = prevMinUtxos ++ nextMinUtxos
184191

185-
lift $ printBpiLog @w Debug $ "Min utxos:" <+> pretty minUtxos
192+
lift $ printBpiLog @w (Debug [TxBalancingLog]) $ "Min utxos:" <+> pretty minUtxos
186193

187194
-- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
188195
txWithoutFees <-
@@ -194,7 +201,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
194201

195202
let fees = nonBudgettedFees + getBudgetPrice (getExecutionUnitPrices pabConf) exBudget
196203

197-
lift $ printBpiLog @w Debug $ "Fees:" <+> pretty fees
204+
lift $ printBpiLog @w (Debug [TxBalancingLog]) $ "Fees:" <+> pretty fees
198205

199206
-- Rebalance the initial tx with the above fees
200207
balancedTx <- hoistEither $ balanceTxStep balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` fees

‎src/BotPlutusInterface/Config.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import BotPlutusInterface.Effects (
1717
import BotPlutusInterface.Types (
1818
CLILocation (..),
1919
LogLevel (..),
20+
LogType (AnyLog),
2021
PABConfig (..),
2122
TxStatusPolling (TxStatusPolling, spBlocksTimeOut, spInterval),
2223
)
@@ -75,11 +76,11 @@ instance ToValue LogLevel where
7576

7677
logLevelSpec :: ValueSpec LogLevel
7778
logLevelSpec =
78-
Error <$ atomSpec "error"
79-
<!> Warn <$ atomSpec "warn"
80-
<!> Notice <$ atomSpec "notice"
81-
<!> Info <$ atomSpec "info"
82-
<!> Debug <$ atomSpec "debug"
79+
Error [AnyLog] <$ atomSpec "error"
80+
<!> Warn [AnyLog] <$ atomSpec "warn"
81+
<!> Notice [AnyLog] <$ atomSpec "notice"
82+
<!> Info [AnyLog] <$ atomSpec "info"
83+
<!> Debug [AnyLog] <$ atomSpec "debug"
8384

8485
instance ToValue TxStatusPolling where
8586
toValue (TxStatusPolling interval timeout) =

‎src/BotPlutusInterface/Contract.hs‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ import BotPlutusInterface.Types (
3535
CollateralUtxo (CollateralUtxo),
3636
ContractEnvironment (..),
3737
LogLevel (Debug, Notice, Warn),
38+
LogType (CollateralLog, PABLog),
3839
Tip (block, slot),
3940
TxFile (Signed),
4041
collateralValue,
@@ -174,7 +175,7 @@ handlePABReq ::
174175
PABReq ->
175176
Eff effs PABResp
176177
handlePABReq contractEnv req = do
177-
printBpiLog @w Debug $ pretty req
178+
printBpiLog @w (Debug [PABLog]) $ pretty req
178179
resp <- case req of
179180
----------------------
180181
-- Handled requests --
@@ -208,7 +209,7 @@ handlePABReq contractEnv req = do
208209
-- YieldUnbalancedTxReq UnbalancedTx
209210
unsupported -> error ("Unsupported PAB effect: " ++ show unsupported)
210211

211-
printBpiLog @w Debug $ pretty resp
212+
printBpiLog @w (Debug [PABLog]) $ pretty resp
212213
pure resp
213214

214215
{- | Await till transaction status change to something from `Unknown`.
@@ -227,7 +228,7 @@ awaitTxStatusChange ::
227228
Eff effs TxStatus
228229
awaitTxStatusChange contractEnv txId = do
229230
checkStartedBlock <- currentBlock contractEnv
230-
printBpiLog @w Debug $ pretty $ "Awaiting status change for " ++ show txId
231+
printBpiLog @w (Debug [PABLog]) $ pretty $ "Awaiting status change for " ++ show txId
231232

232233
let txStatusPolling = contractEnv.cePABConfig.pcTxStatusPolling
233234
pollInterval = fromIntegral $ txStatusPolling.spInterval
@@ -276,7 +277,7 @@ awaitTxStatusChange contractEnv txId = do
276277
pure . Just $ fromTx blk tx
277278
Nothing -> pure Nothing
278279

279-
logDebug = printBpiLog @w Debug . pretty
280+
logDebug = printBpiLog @w (Debug [PABLog]) . pretty
280281

281282
-- | This will FULLY balance a transaction
282283
balanceTx ::
@@ -344,7 +345,7 @@ writeBalancedTx contractEnv (Right tx) = do
344345
if signable
345346
then newEitherT $ CardanoCLI.signTx @w pabConf tx requiredSigners
346347
else
347-
lift . printBpiLog @w Warn . PP.vsep $
348+
lift . printBpiLog @w (Warn [PABLog]) . PP.vsep $
348349
[ "Not all required signatures have signing key files. Please sign and submit the tx manually:"
349350
, "Tx file:" <+> pretty (Files.txFilePath pabConf "raw" (Tx.txId tx))
350351
, "Signatories (pkh):" <+> pretty (Text.unwords (map pkhToText requiredSigners))
@@ -482,12 +483,12 @@ handleCollateral cEnv = do
482483
case result of
483484
Right collteralUtxo ->
484485
setInMemCollateral @w collteralUtxo
485-
>> Right <$> printBpiLog @w Debug "successfully set the collateral utxo in env."
486+
>> Right <$> printBpiLog @w (Debug [CollateralLog]) "successfully set the collateral utxo in env."
486487
Left err -> pure $ Left $ "Failed to make collateral: " <> err
487488
where
488489
--
489490
helperLog :: PP.Doc () -> ExceptT CollateralUtxo (Eff effs) ()
490-
helperLog msg = newEitherT $ Right <$> printBpiLog @w Debug msg
491+
helperLog msg = newEitherT $ Right <$> printBpiLog @w (Debug [CollateralLog]) msg
491492

492493
{- | Create collateral UTxO by submitting Tx.
493494
Then try to find created UTxO at own PKH address.
@@ -498,7 +499,7 @@ makeCollateral ::
498499
ContractEnvironment w ->
499500
Eff effs (Either Text CollateralUtxo)
500501
makeCollateral cEnv = runEitherT $ do
501-
lift $ printBpiLog @w Notice "Making collateral"
502+
lift $ printBpiLog @w (Notice [CollateralLog]) "Making collateral"
502503

503504
let pabConf = cEnv.cePABConfig
504505
unbalancedTx <-
@@ -517,7 +518,7 @@ makeCollateral cEnv = runEitherT $ do
517518
WriteBalancedTxFailed e -> throwE . T.pack $ "Failed to create collateral output: " <> show e
518519
WriteBalancedTxSuccess cTx -> do
519520
status <- lift $ awaitTxStatusChange cEnv (getCardanoTxId cTx)
520-
lift $ printBpiLog @w Notice $ "Collateral Tx Status: " <> pretty status
521+
lift $ printBpiLog @w (Notice [CollateralLog]) $ "Collateral Tx Status: " <> pretty status
521522
newEitherT $ findCollateralAtOwnPKH cEnv
522523

523524
-- | Finds a collateral present at user's address

‎src/BotPlutusInterface/Effects.hs‎

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ import BotPlutusInterface.Types (
4444
ContractState (ContractState),
4545
LogContext (BpiLog, ContractLog),
4646
LogLevel (..),
47+
LogType (..),
4748
LogsList (LogsList),
4849
TxBudget,
4950
TxFile,
@@ -64,6 +65,7 @@ import Data.Aeson qualified as JSON
6465
import Data.Bifunctor (second)
6566
import Data.ByteString qualified as ByteString
6667
import Data.Kind (Type)
68+
import Data.List (intersect)
6769
import Data.Maybe (catMaybes)
6870
import Data.String (IsString, fromString)
6971
import Data.Text (Text)
@@ -191,12 +193,18 @@ handlePABEffect contractEnv =
191193

192194
printLog' :: LogLevel -> LogContext -> LogLevel -> PP.Doc () -> IO ()
193195
printLog' logLevelSetting msgCtx msgLogLvl msg =
194-
when (logLevelSetting >= msgLogLvl) $ putStrLn target
196+
when
197+
( logLevelSetting {ltLogTypes = mempty} >= msgLogLvl {ltLogTypes = mempty}
198+
&& not (null intersectLogTypes)
199+
)
200+
$ putStrLn target
195201
where
196202
target =
197203
Render.renderString . layoutPretty defaultLayoutOptions $
198204
prettyLog msgCtx msgLogLvl msg
199205

206+
intersectLogTypes = ltLogTypes logLevelSetting `intersect` (ltLogTypes msgLogLvl <> [AnyLog])
207+
200208
prettyLog :: LogContext -> LogLevel -> PP.Doc () -> PP.Doc ()
201209
prettyLog msgCtx msgLogLvl msg = pretty msgCtx <+> pretty msgLogLvl <+> msg
202210

@@ -217,14 +225,14 @@ handleContractLogInternal = reinterpret $ \case
217225
msgPretty = pretty msgContent
218226
in printLog @w ContractLog msgLogLevel msgPretty
219227
where
220-
toNativeLogLevel Freer.Debug = Debug
221-
toNativeLogLevel Freer.Info = Info
222-
toNativeLogLevel Freer.Notice = Notice
223-
toNativeLogLevel Freer.Warning = Warn
224-
toNativeLogLevel Freer.Error = Error
225-
toNativeLogLevel Freer.Critical = Error
226-
toNativeLogLevel Freer.Alert = Error
227-
toNativeLogLevel Freer.Emergency = Error
228+
toNativeLogLevel Freer.Debug = Debug [AnyLog]
229+
toNativeLogLevel Freer.Info = Info [AnyLog]
230+
toNativeLogLevel Freer.Notice = Notice [AnyLog]
231+
toNativeLogLevel Freer.Warning = Warn [AnyLog]
232+
toNativeLogLevel Freer.Error = Error [AnyLog]
233+
toNativeLogLevel Freer.Critical = Error [AnyLog]
234+
toNativeLogLevel Freer.Alert = Error [AnyLog]
235+
toNativeLogLevel Freer.Emergency = Error [AnyLog]
228236

229237
callLocalCommand :: forall (a :: Type). ShellArgs a -> IO (Either Text a)
230238
callLocalCommand ShellArgs {cmdName, cmdArgs, cmdOutParser} =

‎src/BotPlutusInterface/Types.hs‎

Lines changed: 30 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,9 @@ module BotPlutusInterface.Types (
66
PABConfig (..),
77
CLILocation (..),
88
AppState (AppState),
9-
LogLevel (..),
109
LogContext (..),
10+
LogLevel (..),
11+
LogType (..),
1112
ContractEnvironment (..),
1213
Tip (Tip, epoch, hash, slot, block, era, syncProgress),
1314
ContractState (..),
@@ -245,16 +246,36 @@ data ContractState w = ContractState
245246
data CLILocation = Local | Remote Text
246247
deriving stock (Show, Eq)
247248

248-
data LogLevel = Error | Warn | Notice | Info | Debug
249-
deriving stock (Bounded, Enum, Eq, Ord, Show)
249+
data LogType
250+
= CoinSelectionLog
251+
| TxBalancingLog
252+
| CollateralLog
253+
| PABLog
254+
| AnyLog
255+
deriving stock (Eq, Ord, Show)
256+
257+
instance Pretty LogType where
258+
pretty CoinSelectionLog = "CoinSelection"
259+
pretty TxBalancingLog = "TxBalancing"
260+
pretty CollateralLog = "Collateral"
261+
pretty PABLog = "PABLog"
262+
pretty AnyLog = "Any"
263+
264+
data LogLevel
265+
= Error {ltLogTypes :: [LogType]}
266+
| Warn {ltLogTypes :: [LogType]}
267+
| Notice {ltLogTypes :: [LogType]}
268+
| Info {ltLogTypes :: [LogType]}
269+
| Debug {ltLogTypes :: [LogType]}
270+
deriving stock (Eq, Ord, Show)
250271

251272
instance Pretty LogLevel where
252273
pretty = \case
253-
Debug -> "[DEBUG]"
254-
Info -> "[INFO]"
255-
Notice -> "[NOTICE]"
256-
Warn -> "[WARNING]"
257-
Error -> "[ERROR]"
274+
Debug a -> "[DEBUG " <> pretty a <> "]"
275+
Info a -> "[INFO " <> pretty a <> "]"
276+
Notice a -> "[NOTICE " <> pretty a <> "]"
277+
Warn a -> "[WARNING " <> pretty a <> "]"
278+
Error a -> "[ERROR " <> pretty a <> "]"
258279

259280
data LogContext = BpiLog | ContractLog
260281
deriving stock (Bounded, Enum, Eq, Ord, Show)
@@ -278,7 +299,7 @@ instance Default PABConfig where
278299
, pcMetadataDir = "/metadata"
279300
, pcDryRun = True
280301
, pcProtocolParamsFile = "./protocol.json"
281-
, pcLogLevel = Info
302+
, pcLogLevel = Info [AnyLog]
282303
, pcOwnPubKeyHash = ""
283304
, pcOwnStakePubKeyHash = Nothing
284305
, pcPort = 9080

‎test/Spec/BotPlutusInterface/Config.hs‎

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,13 @@
33
module Spec.BotPlutusInterface.Config (tests) where
44

55
import BotPlutusInterface.Config (loadPABConfig, savePABConfig)
6-
import BotPlutusInterface.Types (CLILocation (..), LogLevel (..), PABConfig (..), TxStatusPolling (TxStatusPolling))
6+
import BotPlutusInterface.Types (
7+
CLILocation (..),
8+
LogLevel (..),
9+
LogType (AnyLog),
10+
PABConfig (..),
11+
TxStatusPolling (TxStatusPolling),
12+
)
713
import Cardano.Api (
814
AnyPlutusScriptVersion (..),
915
CostModel (..),
@@ -107,7 +113,7 @@ pabConfigExample =
107113
, pcMetadataDir = "path"
108114
, pcDryRun = False
109115
, pcProtocolParamsFile = "./protocol.json3"
110-
, pcLogLevel = Debug
116+
, pcLogLevel = Debug [AnyLog]
111117
, pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
112118
, pcOwnStakePubKeyHash = Just $ StakePubKeyHash "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97547"
113119
, pcPort = 1021

0 commit comments

Comments
 (0)