git.iko.soy/typeable/control-logger
on master help sign in
swap
2478ebf9 ahead, 0 behind
4 files changed+102−58
since splitsnapshots
unifiedsplit
control-logger.cabal+51−43 src/Control/Logger.hs+32−8 src/Control/Logger/Internal.hs+17−5 src/Control/Logger/Orphans.hs+2−2
control-logger.cabal+51−43
@@ -1,47 +1,55 @@
1−cabal-version: 2.4
2−name: control-logger
3−version: 0.1.0.0
4−synopsis: Logger used by all projects
5−license-file: LICENSE
6−build-type: Simple
1+cabal-version: 2.4
2+name: control-logger
3+version: 0.1.0.0
4+synopsis: Logger used by all projects
5+license-file: LICENSE
6+build-type: Simple
77
88library
9− hs-source-dirs: src
10− ghc-options: -Wall
9+ hs-source-dirs: src
10+ ghc-options: -Wall
11+
1112 if !impl(ghcjs)
12− exposed-modules: Control.Logger
13− Control.Logger.Katip
14− Control.Logger.Katip.Utils
15− Control.Logger.Orphans
16− exposed-modules: Control.Logger.Internal
17− build-depends: base
18− , aeson
19− , bytestring
20− , control-has
21− , control-has-katip
22− , deepseq
23− , exceptions
24− , fast-logger
25− , http-client
26− , lens
27− , monad-logger
28− , mtl
29− , shakespeare
30− , text
31− , time
32− , unordered-containers
13+ exposed-modules:
14+ Control.Logger
15+ Control.Logger.Katip
16+ Control.Logger.Katip.Utils
17+ Control.Logger.Orphans
18+
19+ exposed-modules: Control.Logger.Internal
20+ build-depends:
21+ , aeson
22+ , base >=4.11
23+ , bytestring
24+ , control-has
25+ , control-has-katip
26+ , deepseq
27+ , exceptions
28+ , fast-logger >=2.4.11
29+ , http-client
30+ , lens
31+ , monad-logger
32+ , mtl
33+ , shakespeare
34+ , text
35+ , time
36+ , unordered-containers
37+
3338 if !impl(ghcjs)
34− build-depends: katip >= 0.8.8.0
35− , optparse-applicative
36− default-language: Haskell2010
37− default-extensions: RankNTypes
38− DataKinds
39− FlexibleContexts
40− FlexibleInstances
41− LambdaCase
42− OverloadedStrings
43− ScopedTypeVariables
44− DeriveGeneric
45− ConstraintKinds
46− RecordWildCards
47− TypeSynonymInstances
39+ build-depends:
40+ , katip >=0.8.8.0
41+ , optparse-applicative
42+
43+ default-language: Haskell2010
44+ default-extensions:
45+ ConstraintKinds
46+ DataKinds
47+ DeriveGeneric
48+ FlexibleContexts
49+ FlexibleInstances
50+ LambdaCase
51+ OverloadedStrings
52+ RankNTypes
53+ RecordWildCards
54+ ScopedTypeVariables
55+ TypeSynonymInstances
src/Control/Logger.hs+32−8
@@ -3,6 +3,8 @@ module Control.Logger
33 ( Logger
44 , loggerContext
55 , scrubber
6+ , censor
7+ , censorWith
68 , logMsg
79 , logMsgWith
810 , logInfo
@@ -34,6 +36,7 @@ module Control.Logger
3436 , st
3537 , ToObject(..)
3638 , withScrubber
39+ , censoringWith
3740 , censoring
3841 ) where
3942
@@ -41,7 +44,9 @@ import Control.Has
4144import Control.Lens hiding (censoring)
4245import Control.Logger.Internal
4346import Control.Logger.Orphans ()
47+import Control.Monad
4448import Control.Monad.Catch
49+import Control.Monad.IO.Class
4550import qualified Data.List as List
4651import Data.Monoid
4752import Data.Text (Text)
@@ -51,10 +56,6 @@ import GHC.Stack
5156import Katip (ToObject (..))
5257import System.Log.FastLogger
5358import Text.Shakespeare.Text (st)
54−#if MIN_VERSION_mtl(2,3,0)
55−import Control.Monad
56−import Control.Monad.IO.Class
57−#endif
5859
5960logError
6061 :: (LoggingMonad r m)
@@ -108,7 +109,21 @@ logErrorWith
108109 -> m ()
109110logErrorWith logger msg = withFrozenCallStack (logMsgWith logger Error msg)
110111
111−-- | Adjust the scrubbing function.
112+safeReplace :: Text -> Text -> Text -> Text
113+safeReplace what with where_
114+ | Text.null what = where_
115+ | otherwise = Text.replace what with where_
116+
117+-- | Add a some text to scrubber
118+censorWith :: Text -> Text -> Logger -> Logger
119+censorWith replacement needle l =
120+ l & scrubber <>~ Endo (safeReplace needle replacement)
121+
122+-- | Censor with "***"
123+censor :: Text -> Logger -> Logger
124+censor = censorWith "***"
125+
126+-- | Run an action with adjusted scrubber
112127withScrubber
113128 :: forall r m a. (Has Logger r, MonadReader r m)
114129 => (Endo Text -> Endo Text)
@@ -120,14 +135,23 @@ withScrubber scrubF = local expandScrubber
120135 expandScrubber = over part (over scrubber scrubF)
121136
122137-- | Run an action while censoring additional text from logs
123−censoring
138+censoringWith
124139 :: (Has Logger r, MonadReader r m)
125140 => Text
141+ -> Text
126142 -> m a
127143 -> m a
128−censoring txt = withScrubber (<> censored)
144+censoringWith replacement txt = withScrubber (<> censored)
129145 where
130− censored = Endo (Text.replace txt "XXXX")
146+ censored = Endo (safeReplace txt replacement)
147+
148+-- | Run an action while censoring additional text from logs
149+censoring
150+ :: (Has Logger r, MonadReader r m)
151+ => Text
152+ -> m a
153+ -> m a
154+censoring = censoringWith "***"
131155
132156-- | Log exceptions occured in computation and just ignore them.
133157tryLogError
src/Control/Logger/Internal.hs+17−5
@@ -16,14 +16,12 @@ module Control.Logger.Internal
1616
1717import Control.Has
1818import Control.Lens
19+import Control.Monad.IO.Class
1920import Control.DeepSeq
20−import Data.Aeson (ToJSON, FromJSON, Object)
21+import Data.Aeson (ToJSON, FromJSON, Object, Value(..))
2122import Data.Text (Text)
2223import Data.Monoid
2324import GHC.Stack
24−#if MIN_VERSION_mtl(2,3,0)
25−import Control.Monad.IO.Class
26−#endif
2725
2826
2927data LogSeverity
@@ -79,4 +77,18 @@ logMsgWith logger s t =
7977 liftIO $ runLogger logger callStack s t
8078
8179runLogger :: Logger -> CallStack -> LogSeverity -> Text -> IO ()
82−runLogger (Logger ctx theScrubber logger) cs ls txt = logger ctx cs ls (appEndo theScrubber txt)
80+runLogger (Logger ctx theScrubber logger) cs ls txt
81+ = logger (scrubContext theScrubber ctx) cs ls (appEndo theScrubber txt)
82+
83+
84+scrubContext :: Endo Text -> Object -> Object
85+scrubContext theScrubber = fmap doScrub
86+ where
87+ doScrub :: Value -> Value
88+ doScrub = \case
89+ Object object -> Object (fmap doScrub object)
90+ Array array -> Array (fmap doScrub array)
91+ String string -> String (appEndo theScrubber string)
92+ n@Number{} -> n
93+ b@Bool{} -> b
94+ n@Null -> n
src/Control/Logger/Orphans.hs+2−2
@@ -10,7 +10,7 @@ import Control.EnvT
1010import Control.Has
1111import Control.Logger.Internal
1212import Control.Monad.Logger
13−import qualified Data.Text as T
13+import qualified Data.Text.Encoding as T
1414import GHC.Stack
1515
1616
@@ -21,7 +21,7 @@ instance (Has Logger r, MonadIO m)
2121 in withFrozenCallStack
2222 $ logMsg
2323 (mlLevelToLogSeverity level)
24− (T.pack . show . toLogStr $ msg)
24+ (T.decodeUtf8Lenient . fromLogStr . toLogStr $ msg)
2525
2626locToCallStack :: Loc -> CallStack
2727locToCallStack Loc {..} = fromCallSiteList