-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Morley client initialization.
module Morley.Client.Init
  ( MorleyClientConfig(..)
  , mkLogAction

    -- * Lens
  , 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 necessary for morley client initialization.
data MorleyClientConfig = MorleyClientConfig
  { MorleyClientConfig -> Maybe BaseUrl
mccEndpointUrl :: Maybe BaseUrl
  -- ^ URL of tezos endpoint on which operations are performed
  , MorleyClientConfig -> FilePath
mccTezosClientPath :: FilePath
  -- ^ Path to @octez-client@ binary through which operations are
  -- performed
  , MorleyClientConfig -> Maybe FilePath
mccMbTezosClientDataDir :: Maybe FilePath
  -- ^ Path to @octez-client@ data directory.
  , MorleyClientConfig -> Word
mccVerbosity :: Word
  -- ^ Verbosity level. @0@ means that only important messages will be
  -- printed. The greater this value is, the more messages will be
  -- printed during execution. After some small unspecified limit
  -- increasing this value does not change anything.
  , MorleyClientConfig -> Maybe SecretKey
mccSecretKey :: Maybe Ed25519.SecretKey
  -- ^ Custom secret key to use for signing.
  } 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
$cshowsPrec :: Int -> MorleyClientConfig -> ShowS
showsPrec :: Int -> MorleyClientConfig -> ShowS
$cshow :: MorleyClientConfig -> FilePath
show :: MorleyClientConfig -> FilePath
$cshowList :: [MorleyClientConfig] -> ShowS
showList :: [MorleyClientConfig] -> ShowS
Show


makeLensesWith postfixLFields ''MorleyClientConfig

-- | Make appropriate 'ClientLogAction' based on verbosity specified by the user.
mkLogAction :: MonadIO m => Word -> ClientLogAction m
mkLogAction :: forall (m :: * -> *). MonadIO m => Word -> ClientLogAction m
mkLogAction Word
verbosity =
  Severity
-> (Message -> Severity)
-> LogAction m Message
-> LogAction m Message
forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
severity Message -> Severity
forall sev. Msg sev -> sev
msgSeverity (LogAction m Message -> LogAction m Message)
-> LogAction m Message -> LogAction m Message
forall a b. (a -> b) -> a -> b
$
    FieldMap m
-> LogAction m (RichMsg m Message) -> LogAction m Message
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 Message) -> LogAction m Message)
-> LogAction m (RichMsg m Message) -> LogAction m Message
forall a b. (a -> b) -> a -> b
$
      (RichMsg m Message
 -> (Maybe ThreadId -> Maybe Time -> Message -> Text) -> m Text)
-> (Maybe ThreadId -> Maybe Time -> Message -> Text)
-> RichMsg m Message
-> m Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip RichMsg m Message
-> (Maybe ThreadId -> Maybe Time -> Message -> Text) -> m Text
forall (m :: * -> *) msg.
MonadIO m =>
RichMsg m msg
-> (Maybe ThreadId -> Maybe Time -> msg -> Text) -> m Text
fmtRichMessageCustomDefault Maybe ThreadId -> Maybe Time -> Message -> Text
fmt (RichMsg m Message -> m Text)
-> LogAction m Text -> LogAction m (RichMsg m Message)
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
    -- NB: ignoring thread id because it's not informative here
    fmt :: Maybe ThreadId -> Maybe Time -> Message -> 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
msgSeverity :: forall sev. Msg sev -> sev
msgSeverity :: Severity
msgStack :: CallStack
msgText :: Text
msgStack :: forall sev. Msg sev -> CallStack
msgText :: forall sev. Msg sev -> Text
..} =
        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