Skip to content

Commit 9e8112a

Browse files
rv-auditorrv-auditor
committed
Merge remote-tracking branch 'origin/master' into release
2 parents 2ee1fa2 + ac6c535 commit 9e8112a

File tree

8 files changed

+91
-37
lines changed

8 files changed

+91
-37
lines changed

‎booster/library/Booster/CLOptions.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -244,14 +244,14 @@ levelToContext =
244244
[
245245
( "Simplify"
246246
,
247-
[ [ctxt| booster|kore>function*|simplification*,success|failure|abort|detail |]
247+
[ [ctxt| booster|kore>function*|simplification*|hook*,success|failure|abort|detail |]
248248
, [ctxt| booster|kore>function*|simplification*,match,failure|abort |]
249249
]
250250
)
251251
,
252252
( "SimplifySuccess"
253253
,
254-
[ [ctxt| booster|kore>function*|simplification*,success|detail |]
254+
[ [ctxt| booster|kore>function*|simplification*|hook*,success|detail |]
255255
]
256256
)
257257
,

‎booster/library/Booster/Log.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ module Booster.Log (
1919
jsonLogger,
2020
textLogger,
2121
withContext,
22+
withContexts,
2223
withKorePatternContext,
2324
withPatternContext,
2425
withRuleContext,
@@ -83,6 +84,10 @@ instance ToLogFormat Text where
8384
toTextualLog t = t
8485
toJSONLog t = String t
8586

87+
instance ToLogFormat String where
88+
toTextualLog = pack
89+
toJSONLog = String . pack
90+
8691
instance ToLogFormat Term where
8792
toTextualLog t = renderOneLineText $ pretty t
8893
toJSONLog t = toJSON $ addHeader $ externaliseTerm t
@@ -141,6 +146,10 @@ logPretty = logMessage . renderOneLineText . pretty
141146
withContext :: LoggerMIO m => SimpleContext -> m a -> m a
142147
withContext c = withContext_ (CLNullary c)
143148

149+
withContexts :: LoggerMIO m => [SimpleContext] -> m a -> m a
150+
withContexts [] m = m
151+
withContexts cs m = foldr withContext m cs
152+
144153
withContext_ :: LoggerMIO m => CLContext -> m a -> m a
145154
withContext_ c =
146155
withLogger

‎booster/test/rpc-integration/test-log-simplify-json/simplify-log.txt.golden‎

Lines changed: 30 additions & 0 deletions
Large diffs are not rendered by default.

‎booster/test/rpc-integration/test-log-simplify-json/test.sh‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ echo "client=$client"
88
echo "dir=$dir"
99
echo "arguments=$*"
1010

11-
diff="git diff --no-index"
11+
diff="git --no-pager diff --no-index"
1212
# remove "--regenerate" and tweak $diff if it is present
1313

1414
regenerate () {

‎booster/tools/booster/Proxy.hs‎

Lines changed: 18 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ import Kore.Log qualified
4949
import Kore.Syntax.Definition (SentenceAxiom)
5050
import Kore.Syntax.Json.Types qualified as KoreJson
5151
import SMT qualified
52-
import Stats (StatsVar, addStats, microsWithUnit, timed)
52+
import Stats (MethodTiming (..), StatsVar, addStats, microsWithUnit, timed)
5353

5454
data KoreServer = KoreServer
5555
{ serverState :: MVar.MVar Kore.ServerState
@@ -64,7 +64,7 @@ data KoreServer = KoreServer
6464
}
6565

6666
data ProxyConfig = ProxyConfig
67-
{ statsVar :: Maybe StatsVar
67+
{ statsVar :: StatsVar
6868
, forceFallback :: Maybe Depth
6969
, boosterState :: MVar.MVar Booster.ServerState
7070
, fallbackReasons :: [HaltReason]
@@ -83,7 +83,7 @@ respondEither ::
8383
Respond (API 'Req) m (API 'Res) ->
8484
Respond (API 'Req) m (API 'Res) ->
8585
Respond (API 'Req) m (API 'Res)
86-
respondEither cfg@ProxyConfig{statsVar, boosterState} booster kore req = case req of
86+
respondEither cfg@ProxyConfig{boosterState} booster kore req = case req of
8787
Execute execReq
8888
| isJust execReq.stepTimeout || isJust execReq.movingAverageStepTimeout ->
8989
loggedKore ExecuteM req
@@ -252,21 +252,10 @@ respondEither cfg@ProxyConfig{statsVar, boosterState} booster kore req = case re
252252
logStats method (time, time)
253253
pure result
254254

255-
logStats method (time, koreTime)
256-
| Just v <- statsVar = do
257-
addStats v method time koreTime
258-
Booster.Log.withContext CtxProxy $
259-
Booster.Log.logMessage' $
260-
Text.pack $
261-
unwords
262-
[ "Performed"
263-
, show method
264-
, "in"
265-
, microsWithUnit time
266-
, "(" <> microsWithUnit koreTime <> " kore time)"
267-
]
268-
| otherwise =
269-
pure ()
255+
logStats method (time, koreTime) = do
256+
let timing = MethodTiming{method, time, koreTime}
257+
addStats cfg.statsVar timing
258+
Booster.Log.withContexts [CtxProxy, CtxTiming] $ Booster.Log.logMessage timing
270259

271260
handleExecute ::
272261
LogSettings ->
@@ -397,11 +386,17 @@ respondEither cfg@ProxyConfig{statsVar, boosterState} booster kore req = case re
397386
, assumeStateDefined = Just True
398387
}
399388
)
400-
when (isJust statsVar) $ do
401-
Booster.Log.withContext CtxProxy $
402-
Booster.Log.logMessage $
403-
Text.pack $
404-
"Kore fall-back in " <> microsWithUnit kTime
389+
Booster.Log.withContexts [CtxProxy, CtxTiming, CtxKore] $
390+
Booster.Log.logMessage $
391+
WithJsonMessage
392+
( toJSON
393+
MethodTiming
394+
{ method = ExecuteM
395+
, time = kTime
396+
, koreTime = kTime
397+
}
398+
)
399+
("Kore fall-back in " <> microsWithUnit kTime)
405400
case kResult of
406401
Right (Execute koreResult) -> do
407402
let

‎booster/tools/booster/Server.hs‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE QuasiQuotes #-}
23
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
34

45
{- |
@@ -13,7 +14,6 @@ import Control.DeepSeq (force)
1314
import Control.Exception (AsyncException (UserInterrupt), evaluate, handleJust)
1415
import Control.Monad (forM_, unless, void)
1516
import Control.Monad.Catch (bracket)
16-
import Control.Monad.Extra (whenJust)
1717
import Control.Monad.IO.Class (MonadIO (liftIO))
1818
import Control.Monad.Logger (
1919
LogLevel (..),
@@ -58,7 +58,7 @@ import Booster.GlobalState
5858
import Booster.JsonRpc qualified as Booster
5959
import Booster.LLVM.Internal (mkAPI, withDLib)
6060
import Booster.Log hiding (withLogger)
61-
import Booster.Log.Context qualified
61+
import Booster.Log.Context qualified as Ctxt
6262
import Booster.Pattern.Base (Predicate (..))
6363
import Booster.Prettyprinter (renderOneLineText)
6464
import Booster.SMT.Base qualified as SMT (SExpr (..), SMTId (..))
@@ -149,6 +149,7 @@ main = do
149149
logContextsWithcustomLevelContexts =
150150
logContexts
151151
<> concatMap (\case LevelOther o -> fromMaybe [] $ levelToContext Map.!? o; _ -> []) customLevels
152+
<> [[Ctxt.ctxt| *>timing |] | printStats]
152153
contextLoggingEnabled = not (null logContextsWithcustomLevelContexts)
153154
koreSolverOptions = translateSMTOpts smtOptions
154155
timestampFlag = case timeStampsFormat of
@@ -177,7 +178,7 @@ main = do
177178
( \(Log.SomeEntry _ c) -> Text.encodeUtf8 <$> Log.oneLineContextDoc c
178179
)
179180
ctxt
180-
in any (flip Booster.Log.Context.mustMatch contextStrs) logContextsWithcustomLevelContexts
181+
in any (flip Ctxt.mustMatch contextStrs) logContextsWithcustomLevelContexts
181182
)
182183

183184
koreLogEntries =
@@ -194,7 +195,7 @@ main = do
194195
flip Booster.Log.filterLogger boosterContextLogger $ \(Booster.Log.LogMessage (Booster.Flag alwaysDisplay) ctxts _) ->
195196
alwaysDisplay
196197
|| let ctxt = map (Text.encodeUtf8 . Booster.Log.toTextualLog) ctxts
197-
in any (flip Booster.Log.Context.mustMatch ctxt) logContextsWithcustomLevelContexts
198+
in any (flip Ctxt.mustMatch ctxt) logContextsWithcustomLevelContexts
198199

199200
runBoosterLogger :: Booster.Log.LoggerT IO a -> IO a
200201
runBoosterLogger = flip runReaderT filteredBoosterContextLogger . Booster.Log.unLoggerT
@@ -303,7 +304,7 @@ main = do
303304
, mSMTOptions = if boosterSMT then smtOptions else Nothing
304305
, addedModules = mempty
305306
}
306-
statsVar <- if printStats then Just <$> Stats.newStats else pure Nothing
307+
statsVar <- Stats.newStats
307308

308309
writeGlobalEquationOptions equationOptions
309310

@@ -343,8 +344,9 @@ main = do
343344
interruptHandler _ =
344345
runBoosterLogger . Booster.Log.withContext CtxProxy $ do
345346
Booster.Log.logMessage' @_ @Text "Server shutting down"
346-
whenJust statsVar $ \var ->
347-
liftIO (Stats.finaliseStats var) >>= Booster.Log.logMessage'
347+
( liftIO (Stats.finaliseStats statsVar)
348+
>>= Booster.Log.withContext CtxTiming . Booster.Log.logMessage
349+
)
348350
liftIO exitSuccess
349351
handleJust isInterrupt interruptHandler $ runBoosterLogger server
350352
where

‎booster/tools/booster/Stats.hs‎

Lines changed: 21 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,15 @@ module Stats (
66
microsWithUnit,
77
RequestStats (..),
88
StatsVar,
9+
MethodTiming (..),
910
) where
1011

1112
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
1213
import Control.Monad.IO.Class (MonadIO (liftIO))
1314
import Data.Aeson
1415
import Data.Map (Map)
1516
import Data.Map qualified as Map
17+
import Data.Text (pack)
1618
import Deriving.Aeson
1719
import GHC.Generics ()
1820
import Prettyprinter
@@ -108,14 +110,29 @@ singleStats' x korePart =
108110

109111
type StatsVar = MVar (Map APIMethod (Stats' Double))
110112

113+
-- helper type mainly for json logging
114+
data MethodTiming a = MethodTiming {method :: APIMethod, time :: a, koreTime :: a}
115+
deriving stock (Eq, Show, Generic)
116+
deriving
117+
(ToJSON, FromJSON)
118+
via CustomJSON '[FieldLabelModifier '[CamelToKebab]] (MethodTiming a)
119+
120+
instance ToLogFormat (MethodTiming Double) where
121+
toTextualLog mt =
122+
pack $
123+
printf
124+
"Performed %s in %s (%s kore time)"
125+
(show mt.method)
126+
(microsWithUnit mt.time)
127+
(microsWithUnit mt.koreTime)
128+
toJSONLog = toJSON
129+
111130
addStats ::
112131
MonadIO m =>
113132
MVar (Map APIMethod (Stats' Double)) ->
114-
APIMethod ->
115-
Double ->
116-
Double ->
133+
MethodTiming Double ->
117134
m ()
118-
addStats statVar method time koreTime =
135+
addStats statVar MethodTiming{method, time, koreTime} =
119136
liftIO . modifyMVar_ statVar $
120137
pure . Map.insertWith (<>) method (singleStats' time koreTime)
121138

‎kore-rpc-types/src/Kore/JsonRpc/Types/ContextLog.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ data SimpleContext
4747
| CtxDetail
4848
| CtxSubstitution
4949
| CtxDepth
50+
| CtxTiming
5051
| -- standard log levels
5152
CtxError
5253
| CtxWarn

0 commit comments

Comments
 (0)