{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

module Test.WebDriver.Commands.Logs.BiDi (
  withRecordLogsViaBiDi
  , withRecordLogsViaBiDi'
  ) where

import Control.Concurrent.STM (retry)
import Control.Monad (forever)
import Control.Monad.Fix (fix)
import Control.Monad.IO.Unlift
import Control.Monad.Logger (MonadLogger, logDebugN, logErrorN, logInfoN, logWarnN)
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types (parseEither)
import qualified Data.List as L
import Data.String.Interpolate
import Data.Text (Text)
import qualified Network.URI as URI
import qualified Network.WebSockets as WS
import Test.WebDriver.Capabilities.Aeson
import Test.WebDriver.Commands.Logs.Common
import Test.WebDriver.Types
import Text.Read (readMaybe)
import UnliftIO.Async (withAsync)
import UnliftIO.Exception
import UnliftIO.STM (atomically, newTVarIO, readTVar, writeTVar)
import UnliftIO.Timeout (timeout)


data BiDiLogEvent = BiDiLogEvent {
  BiDiLogEvent -> Text
biDiType :: Text
  , BiDiLogEvent -> Text
biDiMethod :: Text
  , BiDiLogEvent -> Value
biDiParams :: Value
  } deriving Int -> BiDiLogEvent -> ShowS
[BiDiLogEvent] -> ShowS
BiDiLogEvent -> String
(Int -> BiDiLogEvent -> ShowS)
-> (BiDiLogEvent -> String)
-> ([BiDiLogEvent] -> ShowS)
-> Show BiDiLogEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BiDiLogEvent -> ShowS
showsPrec :: Int -> BiDiLogEvent -> ShowS
$cshow :: BiDiLogEvent -> String
show :: BiDiLogEvent -> String
$cshowList :: [BiDiLogEvent] -> ShowS
showList :: [BiDiLogEvent] -> ShowS
Show
deriveFromJSON toCamel2 ''BiDiLogEvent

data BiDiResponse = BiDiResponse {
  BiDiResponse -> Text
biDiResponseType :: Text
  , BiDiResponse -> Int
biDiResponseId :: Int
  , BiDiResponse -> Maybe Value
biDiResponseResult :: Maybe Value
  , BiDiResponse -> Maybe Value
biDiResponseError :: Maybe Value
  } deriving Int -> BiDiResponse -> ShowS
[BiDiResponse] -> ShowS
BiDiResponse -> String
(Int -> BiDiResponse -> ShowS)
-> (BiDiResponse -> String)
-> ([BiDiResponse] -> ShowS)
-> Show BiDiResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BiDiResponse -> ShowS
showsPrec :: Int -> BiDiResponse -> ShowS
$cshow :: BiDiResponse -> String
show :: BiDiResponse -> String
$cshowList :: [BiDiResponse] -> ShowS
showList :: [BiDiResponse] -> ShowS
Show
deriveFromJSON toCamel3 ''BiDiResponse

-- | Wrapper around 'withRecordLogsViaBiDi'' which uses the WebSocket URL from
-- the current 'Session'. You must make sure to pass '_capabilitiesWebSocketUrl'
-- = @Just True@ to enable this. This will not work with Selenium 3.
withRecordLogsViaBiDi :: (WebDriver m, MonadLogger m) => (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi :: forall (m :: * -> *) a.
(WebDriver m, MonadLogger m) =>
(LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi LogEntry -> m ()
cb m a
action = do
  Session {String
Maybe String
SessionId
Driver
sessionDriver :: Driver
sessionId :: SessionId
sessionName :: String
sessionWebSocketUrl :: Maybe String
sessionWebSocketUrl :: Session -> Maybe String
sessionName :: Session -> String
sessionId :: Session -> SessionId
sessionDriver :: Session -> Driver
..} <- m Session
forall (m :: * -> *). SessionState m => m Session
getSession
  String
webSocketUrl <- case Maybe String
sessionWebSocketUrl of
    Maybe String
Nothing -> IOError -> m String
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m String) -> IOError -> m String
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError [i|Session wasn't configured with a BiDi WebSocket URL when trying to record logs. Make sure to enable _capabilitiesWebSocketUrl.|]
    Just String
x -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
x

  URI
uri <- case String -> Maybe URI
URI.parseURI String
webSocketUrl of
    Just URI
x -> URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
x
    Maybe URI
Nothing -> IOError -> m URI
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m URI) -> IOError -> m URI
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError [i|Couldn't parse WebSocket URL: #{webSocketUrl}|]

  URI -> (LogEntry -> m ()) -> m a -> m a
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
URI -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi' URI
uri LogEntry -> m ()
cb m a
action

-- | Connect to WebSocket URL and subscribe to log events using the W3C BiDi protocol; see
-- <https://w3c.github.io/webdriver-bidi/>.
withRecordLogsViaBiDi' :: (MonadUnliftIO m, MonadLogger m) => URI.URI -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi' :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
URI -> (LogEntry -> m ()) -> m a -> m a
withRecordLogsViaBiDi' uri :: URI
uri@(URI.URI { uriAuthority :: URI -> Maybe URIAuth
uriAuthority=(Just (URI.URIAuth {uriPort :: URIAuth -> String
uriPort=(String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> ShowS -> String -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
L.drop Int
1 -> Just (Int
port :: Int)), String
uriUserInfo :: String
uriRegName :: String
uriRegName :: URIAuth -> String
uriUserInfo :: URIAuth -> String
..})), String
uriScheme :: String
uriPath :: String
uriQuery :: String
uriFragment :: String
uriFragment :: URI -> String
uriQuery :: URI -> String
uriPath :: URI -> String
uriScheme :: URI -> String
.. }) LogEntry -> m ()
cb m a
action = do
  TVar (Maybe (Either SomeException ()))
subscriptionStatus <- Maybe (Either SomeException ())
-> m (TVar (Maybe (Either SomeException ())))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe (Either SomeException ())
forall a. Maybe a
Nothing

  m () -> (Async () -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (TVar (Maybe (Either SomeException ())) -> m ()
backgroundAction TVar (Maybe (Either SomeException ()))
subscriptionStatus) ((Async () -> m a) -> m a) -> (Async () -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Async ()
_ -> do
    -- Wait for subscription to be confirmed or errored before proceeding
    Either SomeException ()
result <- STM (Either SomeException ()) -> m (Either SomeException ())
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Either SomeException ()) -> m (Either SomeException ()))
-> STM (Either SomeException ()) -> m (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Either SomeException ())
status <- TVar (Maybe (Either SomeException ()))
-> STM (Maybe (Either SomeException ()))
forall a. TVar a -> STM a
readTVar TVar (Maybe (Either SomeException ()))
subscriptionStatus
      case Maybe (Either SomeException ())
status of
        Maybe (Either SomeException ())
Nothing -> STM (Either SomeException ())
forall a. STM a
retry
        Just (Left SomeException
err) -> Either SomeException () -> STM (Either SomeException ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> Either SomeException ()
forall a b. a -> Either a b
Left SomeException
err)
        Just (Right ()) -> Either SomeException () -> STM (Either SomeException ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either SomeException ()
forall a b. b -> Either a b
Right ())

    case Either SomeException ()
result of
      Left SomeException
err -> SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SomeException
err
      Right () -> m a
action

  where
    backgroundAction :: TVar (Maybe (Either SomeException ())) -> m ()
backgroundAction TVar (Maybe (Either SomeException ()))
subscriptionStatus = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> do
      Either SomeException ()
result <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ do
        m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Connecting to #{uriRegName}:#{port}#{uriPath}|]

        IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> ClientApp () -> IO ()
forall a. String -> Int -> String -> ClientApp a -> IO a
WS.runClient String
uriRegName Int
port String
uriPath (ClientApp () -> IO ()) -> ClientApp () -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
          m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN Text
"BiDi: Connected successfully"

          -- Send subscription request for console logs
          m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN Text
"BiDi: Sending subscription request"
          Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [
            Key
"id" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
1 :: Int)
            , Key
"method" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"session.subscribe" :: Text)
            , Key
"params" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [
                Key
"events" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([Text
"log.entryAdded"] :: [Text])
              ]
            ]
          m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN Text
"BiDi: Sent subscription request, waiting for response..."

          Maybe ()
subscriptionResult <- Int -> IO () -> IO (Maybe ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
15_000_000 (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
loop -> do
            ByteString
msg <- Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn
            m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Waiting for subscription response: #{msg}|]
            case ByteString -> Maybe BiDiResponse
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
msg of
              Just response :: BiDiResponse
response@(BiDiResponse Text
responseType Int
responseId Maybe Value
_ Maybe Value
_)
                | Text
responseType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"success" Bool -> Bool -> Bool
&& Int
responseId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
                    m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN Text
"BiDi: Subscription successful!"
                    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (Either SomeException ()))
-> Maybe (Either SomeException ()) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Either SomeException ()))
subscriptionStatus (Either SomeException () -> Maybe (Either SomeException ())
forall a. a -> Maybe a
Just (() -> Either SomeException ()
forall a b. b -> Either a b
Right ()))
                | Text
responseType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"error" Bool -> Bool -> Bool
&& Int
responseId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
                    let errMsg :: String
errMsg = String
"BiDi subscription failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BiDiResponse -> String
forall a. Show a => a -> String
show BiDiResponse
response
                    m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logErrorN [i|BiDi: #{errMsg}|]
                    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (Either SomeException ()))
-> Maybe (Either SomeException ()) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Either SomeException ()))
subscriptionStatus (Either SomeException () -> Maybe (Either SomeException ())
forall a. a -> Maybe a
Just (SomeException -> Either SomeException ()
forall a b. a -> Either a b
Left (IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> IOError
userError String
errMsg))))
                | Bool
otherwise -> do
                    m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Ignoring response with type #{responseType}, ID #{responseId}|]
                    IO ()
loop
              Maybe BiDiResponse
Nothing -> do
                m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Not a BiDiResponse, continuing to wait for subscription response (#{msg})|]
                IO ()
loop

          case Maybe ()
subscriptionResult of
            Maybe ()
Nothing -> do
              m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logErrorN Text
"BiDi: Subscription response timed out"
              STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (Either SomeException ()))
-> Maybe (Either SomeException ()) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Either SomeException ()))
subscriptionStatus (Either SomeException () -> Maybe (Either SomeException ())
forall a. a -> Maybe a
Just (SomeException -> Either SomeException ()
forall a b. a -> Either a b
Left (IOError -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> IOError
userError String
"BiDi subscription response timed out"))))
            Just () -> do
              m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN Text
"BiDi: Starting log event listener"
              IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                ByteString
msg <- Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn
                m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Received log event: #{msg}|]
                case ByteString -> Maybe BiDiLogEvent
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
msg of
                  Just (BiDiLogEvent Text
"event" Text
"log.entryAdded" Value
params) ->
                    case Value -> Maybe LogEntry
parseBiDiLogEntry Value
params of
                      Just LogEntry
logEntry -> m () -> IO ()
forall a. m a -> IO a
runInIO (LogEntry -> m ()
cb LogEntry
logEntry)
                      Maybe LogEntry
Nothing -> m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logWarnN Text
"BiDi: Failed to parse log entry"
                  Maybe BiDiLogEvent
_ -> m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logDebugN [i|BiDi: Ignoring non-log event message: #{msg}|]

      case Either SomeException ()
result of
        Left SomeException
ex -> do
          m () -> IO ()
forall a. m a -> IO a
runInIO (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logErrorN [i|BiDi: got exception (URI #{uri}): #{ex}|]
          STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (Either SomeException ()))
-> Maybe (Either SomeException ()) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Either SomeException ()))
subscriptionStatus (Either SomeException () -> Maybe (Either SomeException ())
forall a. a -> Maybe a
Just (SomeException -> Either SomeException ()
forall a b. a -> Either a b
Left SomeException
ex))
        Right () -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
withRecordLogsViaBiDi' URI
uri LogEntry -> m ()
_cb m a
_action =
  IOError -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m a) -> IOError -> m a
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError [i|WebSocket URL didn't contain an authority: #{uri}|]

-- | Convert BiDi log parameters to LogEntry
parseBiDiLogEntry :: Value -> Maybe LogEntry
parseBiDiLogEntry :: Value -> Maybe LogEntry
parseBiDiLogEntry = \case
  Object Object
o -> case (Object -> Parser LogEntry) -> Object -> Either String LogEntry
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Object -> Parser LogEntry
parseLogEntry Object
o of
    Right LogEntry
entry -> LogEntry -> Maybe LogEntry
forall a. a -> Maybe a
Just LogEntry
entry
    Left String
_ -> Maybe LogEntry
forall a. Maybe a
Nothing
  Value
_ -> Maybe LogEntry
forall a. Maybe a
Nothing
  where
    parseLogEntry :: Object -> Parser LogEntry
parseLogEntry Object
o = do
      Double
timestamp <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
      Text
levelText <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"
      Text
message <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      LogLevel
level <- case Text -> Maybe LogLevel
parseLogLevel Text
levelText of
        Just LogLevel
l -> LogLevel -> Parser LogLevel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LogLevel
l
        Maybe LogLevel
Nothing -> String -> Parser LogLevel
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid log level"
      LogEntry -> Parser LogEntry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogEntry -> Parser LogEntry) -> LogEntry -> Parser LogEntry
forall a b. (a -> b) -> a -> b
$ Integer -> LogLevel -> Text -> LogEntry
LogEntry (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
timestamp :: Double)) LogLevel
level Text
message

    parseLogLevel :: Text -> Maybe LogLevel
    parseLogLevel :: Text -> Maybe LogLevel
parseLogLevel = \case
      Text
"debug" -> LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogDebug
      Text
"info" -> LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogInfo
      Text
"warn" -> LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogWarning
      Text
"error" -> LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LogSevere
      Text
_ -> Maybe LogLevel
forall a. Maybe a
Nothing