module Morley.Client.Init
( MorleyClientConfig(..)
, mkLogAction
, mccEndpointUrlL
, mccTezosClientPathL
, mccMbTezosClientDataDirL
, mccVerbosityL
, mccSecretKeyL
) where
import Colog
(Msg(..), Severity(..), cmapM, defaultFieldMap, filterBySeverity, fmtRichMessageCustomDefault,
logTextStderr, msgSeverity, showSeverity, showSourceLoc, showTime, upgradeMessageAction)
import Morley.Util.Lens
import Servant.Client (BaseUrl(..))
import Morley.Client.Logging (ClientLogAction, logFlush)
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519
data MorleyClientConfig = MorleyClientConfig
{ MorleyClientConfig -> Maybe BaseUrl
mccEndpointUrl :: Maybe BaseUrl
, MorleyClientConfig -> FilePath
mccTezosClientPath :: FilePath
, MorleyClientConfig -> Maybe FilePath
mccMbTezosClientDataDir :: Maybe FilePath
, MorleyClientConfig -> Word
mccVerbosity :: Word
, MorleyClientConfig -> Maybe SecretKey
mccSecretKey :: Maybe Ed25519.SecretKey
} deriving stock Int -> MorleyClientConfig -> ShowS
[MorleyClientConfig] -> ShowS
MorleyClientConfig -> FilePath
(Int -> MorleyClientConfig -> ShowS)
-> (MorleyClientConfig -> FilePath)
-> ([MorleyClientConfig] -> ShowS)
-> Show MorleyClientConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MorleyClientConfig] -> ShowS
$cshowList :: [MorleyClientConfig] -> ShowS
show :: MorleyClientConfig -> FilePath
$cshow :: MorleyClientConfig -> FilePath
showsPrec :: Int -> MorleyClientConfig -> ShowS
$cshowsPrec :: Int -> MorleyClientConfig -> ShowS
Show
makeLensesWith postfixLFields ''MorleyClientConfig
mkLogAction :: MonadIO m => Word -> ClientLogAction m
mkLogAction :: forall (m :: * -> *). MonadIO m => Word -> ClientLogAction m
mkLogAction Word
verbosity =
Severity
-> (Msg Severity -> Severity)
-> LogAction m (Msg Severity)
-> LogAction m (Msg Severity)
forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
severity Msg Severity -> Severity
forall sev. Msg sev -> sev
msgSeverity (LogAction m (Msg Severity) -> LogAction m (Msg Severity))
-> LogAction m (Msg Severity) -> LogAction m (Msg Severity)
forall a b. (a -> b) -> a -> b
$
FieldMap m
-> LogAction m (RichMsg m (Msg Severity))
-> LogAction m (Msg Severity)
forall (m :: * -> *) msg.
FieldMap m -> LogAction m (RichMsg m msg) -> LogAction m msg
upgradeMessageAction FieldMap m
forall (m :: * -> *). MonadIO m => FieldMap m
defaultFieldMap (LogAction m (RichMsg m (Msg Severity))
-> LogAction m (Msg Severity))
-> LogAction m (RichMsg m (Msg Severity))
-> LogAction m (Msg Severity)
forall a b. (a -> b) -> a -> b
$
(RichMsg m (Msg Severity)
-> (Maybe ThreadId -> Maybe Time -> Msg Severity -> Text)
-> m Text)
-> (Maybe ThreadId -> Maybe Time -> Msg Severity -> Text)
-> RichMsg m (Msg Severity)
-> m Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip RichMsg m (Msg Severity)
-> (Maybe ThreadId -> Maybe Time -> Msg Severity -> Text) -> m Text
forall (m :: * -> *) msg.
MonadIO m =>
RichMsg m msg
-> (Maybe ThreadId -> Maybe Time -> msg -> Text) -> m Text
fmtRichMessageCustomDefault Maybe ThreadId -> Maybe Time -> Msg Severity -> Text
fmt (RichMsg m (Msg Severity) -> m Text)
-> LogAction m Text -> LogAction m (RichMsg m (Msg Severity))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogAction m b -> LogAction m a
`cmapM` LogAction m Text
logTextStderrFlush
where
severity :: Severity
severity = case Word
verbosity of
Word
0 -> Severity
Warning
Word
1 -> Severity
Info
Word
_ -> Severity
Debug
logTextStderrFlush :: LogAction m Text
logTextStderrFlush = LogAction m Text
forall (m :: * -> *). MonadIO m => LogAction m Text
logTextStderr LogAction m Text -> LogAction m Text -> LogAction m Text
forall a. Semigroup a => a -> a -> a
<> Handle -> LogAction m Text
forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
stderr
fmt :: Maybe ThreadId -> Maybe Time -> Msg Severity -> Text
fmt Maybe ThreadId
_ (Text -> (Time -> Text) -> Maybe Time -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Time -> Text
showTime -> Text
time) Msg{CallStack
Text
Severity
msgStack :: forall sev. Msg sev -> CallStack
msgText :: forall sev. Msg sev -> Text
msgText :: Text
msgStack :: CallStack
msgSeverity :: Severity
msgSeverity :: forall sev. Msg sev -> sev
..} =
Severity -> Text
showSeverity Severity
msgSeverity
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
time
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Word
verbosity Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
2 then CallStack -> Text
showSourceLoc CallStack
msgStack else Text
forall a. Monoid a => a
mempty)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msgText