-- | PostgreSQL logging back-end.
module Log.Backend.PostgreSQL (pgLogger, withPgLogger) where

import Control.Applicative
import Control.Concurrent
import Control.Exception.Lifted
import Control.Monad.State.Lazy
import Data.Aeson ((.=), Value(..), object, encode)
import Data.List.Split
import Data.Monoid.Utils
import Data.String
import Data.Typeable
import Database.PostgreSQL.PQTypes
import Prelude
import qualified Data.ByteString.Base64 as B64
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V

import Log.Data
import Log.Logger
import Log.Internal.Logger

newtype InvalidEncodingRecoveryAttempt = Attempt Int
  deriving Int -> InvalidEncodingRecoveryAttempt
InvalidEncodingRecoveryAttempt -> Int
InvalidEncodingRecoveryAttempt -> [InvalidEncodingRecoveryAttempt]
InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
(InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt)
-> (InvalidEncodingRecoveryAttempt
    -> InvalidEncodingRecoveryAttempt)
-> (Int -> InvalidEncodingRecoveryAttempt)
-> (InvalidEncodingRecoveryAttempt -> Int)
-> (InvalidEncodingRecoveryAttempt
    -> [InvalidEncodingRecoveryAttempt])
-> (InvalidEncodingRecoveryAttempt
    -> InvalidEncodingRecoveryAttempt
    -> [InvalidEncodingRecoveryAttempt])
-> (InvalidEncodingRecoveryAttempt
    -> InvalidEncodingRecoveryAttempt
    -> [InvalidEncodingRecoveryAttempt])
-> (InvalidEncodingRecoveryAttempt
    -> InvalidEncodingRecoveryAttempt
    -> InvalidEncodingRecoveryAttempt
    -> [InvalidEncodingRecoveryAttempt])
-> Enum InvalidEncodingRecoveryAttempt
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
$cenumFromThenTo :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
enumFromTo :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
$cenumFromTo :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
enumFromThen :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
$cenumFromThen :: InvalidEncodingRecoveryAttempt
-> InvalidEncodingRecoveryAttempt
-> [InvalidEncodingRecoveryAttempt]
enumFrom :: InvalidEncodingRecoveryAttempt -> [InvalidEncodingRecoveryAttempt]
$cenumFrom :: InvalidEncodingRecoveryAttempt -> [InvalidEncodingRecoveryAttempt]
fromEnum :: InvalidEncodingRecoveryAttempt -> Int
$cfromEnum :: InvalidEncodingRecoveryAttempt -> Int
toEnum :: Int -> InvalidEncodingRecoveryAttempt
$ctoEnum :: Int -> InvalidEncodingRecoveryAttempt
pred :: InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
$cpred :: InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
succ :: InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
$csucc :: InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
Enum

-- | Create a 'pgLogger' for the duration of the given action, and
-- shut it down afterwards, making sure that all buffered messages are
-- actually written to the DB.
withPgLogger :: ConnectionSourceM IO -> (Logger -> IO r) -> IO r
withPgLogger :: ConnectionSourceM IO -> (Logger -> IO r) -> IO r
withPgLogger ConnectionSourceM IO
cs Logger -> IO r
act = do
  Logger
logger <- ConnectionSourceM IO -> IO Logger
pgLogger ConnectionSourceM IO
cs
  Logger -> (Logger -> IO r) -> IO r
forall r. Logger -> (Logger -> IO r) -> IO r
withLogger Logger
logger Logger -> IO r
act

{-# DEPRECATED pgLogger "Use 'withPgLogger' instead!" #-}

-- | Start an asynchronous logger thread that inserts log messages
-- into a PostgreSQL database.
--
-- Please use 'withPglogger' instead, which is more exception-safe
-- (see the note attached to 'mkBulkLogger').
pgLogger :: ConnectionSourceM IO -> IO Logger
pgLogger :: ConnectionSourceM IO -> IO Logger
pgLogger ConnectionSourceM IO
cs = Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger
mkBulkLogger Text
forall s. IsString s => s
loggerName
              (([LogMessage] -> IO ()) -> [[LogMessage]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
serialize (InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ())
-> InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> InvalidEncodingRecoveryAttempt
Attempt Int
1) ([[LogMessage]] -> IO ())
-> ([LogMessage] -> [[LogMessage]]) -> [LogMessage] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [LogMessage] -> [[LogMessage]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
1000)
              (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    loggerName :: IsString s => s
    loggerName :: s
loggerName = s
"PostgreSQL"

    sqlInsertLog :: SQL
    sqlInsertLog :: SQL
sqlInsertLog = SQL
"INSERT INTO logs "
      SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL
"(time, level, component, domain, message, data) VALUES"

    serialize :: InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
    serialize :: InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
serialize !InvalidEncodingRecoveryAttempt
attempt [LogMessage]
msgs = ConnectionSourceM IO -> TransactionSettings -> DBT IO () -> IO ()
forall (m :: * -> *) a.
(MonadBase IO m, MonadMask m) =>
ConnectionSourceM m -> TransactionSettings -> DBT m a -> m a
runDBT ConnectionSourceM IO
cs TransactionSettings
ts
      (SQL -> DBT IO ()
forall (m :: * -> *). MonadDB m => SQL -> m ()
runSQL_ (SQL -> DBT IO ()) -> SQL -> DBT IO ()
forall a b. (a -> b) -> a -> b
$ SQL
sqlInsertLog
       SQL -> SQL -> SQL
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SQL -> [SQL] -> SQL
forall m. Monoid m => m -> [m] -> m
mintercalate SQL
", " ((LogMessage -> SQL) -> [LogMessage] -> [SQL]
forall a b. (a -> b) -> [a] -> [b]
map LogMessage -> SQL
sqlifyMessage [LogMessage]
msgs))
      IO () -> [Handler IO ()] -> IO ()
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> [Handler m a] -> m a
`catches` [
        -- Propagate base async exceptions thrown by the runtime system.
        (AsyncException -> IO ()) -> Handler IO ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((AsyncException -> IO ()) -> Handler IO ())
-> (AsyncException -> IO ()) -> Handler IO ()
forall a b. (a -> b) -> a -> b
$ \(AsyncException
e::AsyncException) -> AsyncException -> IO ()
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO AsyncException
e
      , (SomeException -> IO ()) -> Handler IO ()
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO ()) -> Handler IO ())
-> (SomeException -> IO ()) -> Handler IO ()
forall a b. (a -> b) -> a -> b
$ \(SomeException
e::SomeException) -> case SomeException -> Maybe DBException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
        Just dbe :: DBException
dbe@DBException{}
          | Just DetailedQueryError
qe <- DBException -> Maybe DetailedQueryError
getEncodingQueryError DBException
dbe -> case InvalidEncodingRecoveryAttempt
attempt of
            Attempt Int
1 -> do
              -- If a client uses UTF-8 encoding (TODO: in fact it should
              -- always be the case as Text is encoded as UTF-8 for sql
              -- serialization), then this error occurs only when any of the
              -- strings we want to serialize contains NULL bytes. In such
              -- case we scan the logs and replace each NULL with "\0".
              String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
forall s. IsString s => s
loggerName
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": couldn't serialize logs due to character encoding error \""
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ DetailedQueryError -> String
qeMessagePrimary DetailedQueryError
qe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\", removing NULL bytes and retrying"
              InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
serialize (InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
forall a. Enum a => a -> a
succ InvalidEncodingRecoveryAttempt
attempt) ([LogMessage] -> IO ()) -> [LogMessage] -> IO ()
forall a b. (a -> b) -> a -> b
$ (LogMessage -> LogMessage) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> [a] -> [b]
map (\LogMessage
msg ->
                -- If any text inside the message had NULL bytes,
                -- add acknowledgment of that fact to its data.
                case State Bool LogMessage -> Bool -> (LogMessage, Bool)
forall s a. State s a -> s -> (a, s)
runState ((Text -> StateT Bool Identity Text)
-> LogMessage -> State Bool LogMessage
forall (m :: * -> *).
(Applicative m, Monad m) =>
(Text -> m Text) -> LogMessage -> m LogMessage
mapTexts Text -> StateT Bool Identity Text
removeNULLs LogMessage
msg) Bool
False of
                  (LogMessage
newMsg, Bool
True) -> LogMessage
newMsg {
                    lmData :: Value
lmData = LogMessage -> Value
lmData LogMessage
newMsg
                             Value -> (Text, Value) -> Value
`addPair` (Text
"_log", Value
"NULL bytes were escaped")
                  }
                  (LogMessage
_, Bool
False) -> LogMessage
msg) [LogMessage]
msgs
            Attempt Int
2 -> do
              -- This should never happen, but let us be paranoid for
              -- a minute. If the error is still happening after removal
              -- of NULL bytes, go through each message and encode all
              -- texts as base64, effectively transforming them into ASCII.
              String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
forall s. IsString s => s
loggerName
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": couldn't serialize logs due to character encoding error \""
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ DetailedQueryError -> String
qeMessagePrimary DetailedQueryError
qe
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" after NULL bytes were removed, encoding all texts"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in the problematic batch as base64 to make them ASCII"
              InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
serialize (InvalidEncodingRecoveryAttempt -> InvalidEncodingRecoveryAttempt
forall a. Enum a => a -> a
succ InvalidEncodingRecoveryAttempt
attempt) ([LogMessage] -> IO ()) -> [LogMessage] -> IO ()
forall a b. (a -> b) -> a -> b
$ (LogMessage -> LogMessage) -> [LogMessage] -> [LogMessage]
forall a b. (a -> b) -> [a] -> [b]
map (\LogMessage
msg ->
                let newMsg :: LogMessage
newMsg = Identity LogMessage -> LogMessage
forall a. Identity a -> a
runIdentity (Identity LogMessage -> LogMessage)
-> Identity LogMessage -> LogMessage
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> LogMessage -> Identity LogMessage
forall (m :: * -> *).
(Applicative m, Monad m) =>
(Text -> m Text) -> LogMessage -> m LogMessage
mapTexts Text -> Identity Text
convertBase64 LogMessage
msg
                 in LogMessage
newMsg {
                  lmData :: Value
lmData = LogMessage -> Value
lmData LogMessage
newMsg
                    Value -> (Text, Value) -> Value
`addPair` (Text
"_log", Value
"Texts encoded as base64")
                }) [LogMessage]
msgs
            Attempt Int
_ -> do
              -- This can't happen, all texts are ASCII now.
              String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
forall s. IsString s => s
loggerName
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": impossible happened "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(>2 attempt failed because of character encoding error \""
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ DetailedQueryError -> String
qeMessagePrimary DetailedQueryError
qe
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" even though all texts are ASCII), skipping the batch"
        Maybe DBException
_ -> do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
forall s. IsString s => s
loggerName
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": couldn't serialize logs:"
            String -> String -> String
forall m. (IsString m, Monoid m) => m -> m -> m
<+> SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", retrying in 10 seconds"
          Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000
          -- Do not increment the attempt here, it's used to
          -- track invalid encoding recovery attempts only.
          InvalidEncodingRecoveryAttempt -> [LogMessage] -> IO ()
serialize InvalidEncodingRecoveryAttempt
attempt [LogMessage]
msgs
      ]

    addPair :: Value -> (T.Text, Value) -> Value
    addPair :: Value -> (Text, Value) -> Value
addPair Value
data_ (Text
name, Value
value) = case Value
data_ of
      Object Object
obj -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
name Value
value Object
obj
      Value
_          -> [(Text, Value)] -> Value
object
                    [ Text
"_data" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
data_
                    , Text
"_log"  Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value
                    ]

    getEncodingQueryError :: DBException -> Maybe DetailedQueryError
    getEncodingQueryError :: DBException -> Maybe DetailedQueryError
getEncodingQueryError DBException{e
sql
dbeQueryContext :: ()
dbeError :: ()
dbeError :: e
dbeQueryContext :: sql
..}
      | Just (DetailedQueryError
qe::DetailedQueryError) <- e -> Maybe DetailedQueryError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
dbeError
      ,    DetailedQueryError -> ErrorCode
qeErrorCode DetailedQueryError
qe ErrorCode -> ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorCode
CharacterNotInRepertoire
        Bool -> Bool -> Bool
|| DetailedQueryError -> ErrorCode
qeErrorCode DetailedQueryError
qe ErrorCode -> ErrorCode -> Bool
forall a. Eq a => a -> a -> Bool
== ErrorCode
UntranslatableCharacter = DetailedQueryError -> Maybe DetailedQueryError
forall a. a -> Maybe a
Just DetailedQueryError
qe
      | Bool
otherwise = Maybe DetailedQueryError
forall a. Maybe a
Nothing

    convertBase64 :: T.Text -> Identity T.Text
    convertBase64 :: Text -> Identity Text
convertBase64 = Text -> Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Identity Text) -> (Text -> Text) -> Text -> Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeLatin1 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

    removeNULLs :: T.Text -> State Bool T.Text
    removeNULLs :: Text -> StateT Bool Identity Text
removeNULLs Text
s = do
      let newS :: Text
newS = Text -> Text -> Text -> Text
T.replace Text
"\0" Text
"\\0" Text
s
      Bool -> StateT Bool Identity () -> StateT Bool Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
T.length Text
newS Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Int
T.length Text
s) (StateT Bool Identity () -> StateT Bool Identity ())
-> StateT Bool Identity () -> StateT Bool Identity ()
forall a b. (a -> b) -> a -> b
$ Bool -> StateT Bool Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Bool
True
      Text -> StateT Bool Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
newS

    mapTexts :: forall m. (Applicative m, Monad m)
             => (T.Text -> m T.Text) -> LogMessage -> m LogMessage
    mapTexts :: (Text -> m Text) -> LogMessage -> m LogMessage
mapTexts Text -> m Text
doText LogMessage
lm = do
      Text
component <- Text -> m Text
doText      (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ LogMessage -> Text
lmComponent LogMessage
lm
      [Text]
domain    <- (Text -> m Text) -> [Text] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> m Text
doText ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ LogMessage -> [Text]
lmDomain LogMessage
lm
      Text
message   <- Text -> m Text
doText      (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ LogMessage -> Text
lmMessage LogMessage
lm
      Value
data_     <- Value -> m Value
doValue     (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ LogMessage -> Value
lmData LogMessage
lm
      LogMessage -> m LogMessage
forall (m :: * -> *) a. Monad m => a -> m a
return LogMessage
lm {
        lmComponent :: Text
lmComponent = Text
component
      , lmDomain :: [Text]
lmDomain    = [Text]
domain
      , lmMessage :: Text
lmMessage   = Text
message
      , lmData :: Value
lmData      = Value
data_
      }
      where
        doValue :: Value -> m Value
        doValue :: Value -> m Value
doValue (Object Object
obj) =
          Object -> Value
Object (Object -> Value) -> m Object -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Value) -> Object -> m Object)
-> Object -> [(Text, Value)] -> m Object
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Foldable.foldrM
          (\(Text
name, Value
value) Object
acc ->
             Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (Text -> Value -> Object -> Object)
-> m Text -> m (Value -> Object -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Text
doText Text
name m (Value -> Object -> Object) -> m Value -> m (Object -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> m Value
doValue Value
value m (Object -> Object) -> m Object -> m Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> m Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
acc)
          Object
forall k v. HashMap k v
H.empty (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
obj)
        doValue (Array Array
arr)  = Array -> Value
Array (Array -> Value) -> m Array -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> m Value) -> Array -> m Array
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Value -> m Value
doValue Array
arr
        doValue (String Text
s)   = Text -> Value
String (Text -> Value) -> m Text -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Text
doText Text
s
        doValue Value
v            = Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v

    sqlifyMessage :: LogMessage -> SQL
    sqlifyMessage :: LogMessage -> SQL
sqlifyMessage LogMessage{[Text]
Text
UTCTime
Value
LogLevel
lmTime :: LogMessage -> UTCTime
lmLevel :: LogMessage -> LogLevel
lmData :: Value
lmMessage :: Text
lmLevel :: LogLevel
lmTime :: UTCTime
lmDomain :: [Text]
lmComponent :: Text
lmMessage :: LogMessage -> Text
lmDomain :: LogMessage -> [Text]
lmComponent :: LogMessage -> Text
lmData :: LogMessage -> Value
..} = [SQL] -> SQL
forall a. Monoid a => [a] -> a
mconcat [
        SQL
"("
      , SQL
"," SQL -> UTCTime -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> UTCTime
lmTime
      , SQL
"," SQL -> Text -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> LogLevel -> Text
showLogLevel LogLevel
lmLevel
      , SQL
"," SQL -> Text -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> Text
lmComponent
      , SQL
"," SQL -> Array1 Text -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> [Text] -> Array1 Text
forall a. [a] -> Array1 a
Array1 [Text]
lmDomain
      , SQL
"," SQL -> Text -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> Text
lmMessage
      , SQL
"," SQL -> JSONB ByteString -> SQL
forall t. (Show t, ToSQL t) => SQL -> t -> SQL
<?> ByteString -> JSONB ByteString
forall jsonb. jsonb -> JSONB jsonb
JSONB (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
lmData)
      , SQL
")"
      ]

    ts :: TransactionSettings
    ts :: TransactionSettings
ts = TransactionSettings
defaultTransactionSettings {
      tsAutoTransaction :: Bool
tsAutoTransaction = Bool
False
    }