{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Simplex.Messaging.Server.StoreLog
  ( StoreLog, -- constructors are not exported
    StoreLogRecord (..), -- used in tests
    openWriteStoreLog,
    openReadStoreLog,
    storeLogFilePath,
    closeStoreLog,
    writeStoreLogRecord,
    logCreateQueue,
    logCreateLink,
    logDeleteLink,
    logSecureQueue,
    logUpdateKeys,
    logAddNotifier,
    logSuspendQueue,
    logBlockQueue,
    logUnblockQueue,
    logDeleteQueue,
    logDeleteNotifier,
    logUpdateQueueTime,
    logNewService,
    logQueueService,
    readWriteStoreLog,
    readLogLines,
    foldLogLines,
  )
where

import Control.Applicative (optional, (<|>))
import qualified Control.Exception as E
import Control.Logger.Simple
import Control.Monad
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.List (sort, stripPrefix)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime, nominalDay)
import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
import GHC.IO (catchAny)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
import Simplex.Messaging.Server.QueueStore
import Simplex.Messaging.Server.StoreLog.Types
import Simplex.Messaging.SystemTime
import Simplex.Messaging.Util (ifM, tshow, unlessM, whenM)
import System.Directory (doesFileExist, listDirectory, removeFile, renameFile)
import System.IO
import System.FilePath (takeDirectory, takeFileName)

data StoreLogRecord
  = CreateQueue RecipientId QueueRec
  | CreateLink RecipientId LinkId QueueLinkData
  | DeleteLink RecipientId
  | SecureQueue QueueId SndPublicAuthKey
  | UpdateKeys RecipientId (NonEmpty RcvPublicAuthKey)
  | AddNotifier QueueId NtfCreds
  | SuspendQueue QueueId
  | BlockQueue QueueId BlockingInfo
  | UnblockQueue QueueId
  | DeleteQueue QueueId
  | DeleteNotifier QueueId
  | UpdateTime QueueId SystemDate
  | NewService ServiceRec
  | QueueService RecipientId ASubscriberParty (Maybe ServiceId)
  deriving (Int -> StoreLogRecord -> ShowS
[StoreLogRecord] -> ShowS
StoreLogRecord -> FilePath
(Int -> StoreLogRecord -> ShowS)
-> (StoreLogRecord -> FilePath)
-> ([StoreLogRecord] -> ShowS)
-> Show StoreLogRecord
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreLogRecord -> ShowS
showsPrec :: Int -> StoreLogRecord -> ShowS
$cshow :: StoreLogRecord -> FilePath
show :: StoreLogRecord -> FilePath
$cshowList :: [StoreLogRecord] -> ShowS
showList :: [StoreLogRecord] -> ShowS
Show)

data SLRTag
  = CreateQueue_
  | CreateLink_
  | DeleteLink_
  | SecureQueue_
  | UpdateKeys_
  | AddNotifier_
  | SuspendQueue_
  | BlockQueue_
  | UnblockQueue_
  | DeleteQueue_
  | DeleteNotifier_
  | UpdateTime_
  | NewService_
  | QueueService_

instance StrEncoding QueueRec where
  strEncode :: QueueRec -> ByteString
strEncode QueueRec {NonEmpty SndPublicAuthKey
recipientKeys :: NonEmpty SndPublicAuthKey
$sel:recipientKeys:QueueRec :: QueueRec -> NonEmpty SndPublicAuthKey
recipientKeys, RcvDhSecret
rcvDhSecret :: RcvDhSecret
$sel:rcvDhSecret:QueueRec :: QueueRec -> RcvDhSecret
rcvDhSecret, Maybe RecipientId
rcvServiceId :: Maybe RecipientId
$sel:rcvServiceId:QueueRec :: QueueRec -> Maybe RecipientId
rcvServiceId, RecipientId
senderId :: RecipientId
$sel:senderId:QueueRec :: QueueRec -> RecipientId
senderId, Maybe SndPublicAuthKey
senderKey :: Maybe SndPublicAuthKey
$sel:senderKey:QueueRec :: QueueRec -> Maybe SndPublicAuthKey
senderKey, Maybe QueueMode
queueMode :: Maybe QueueMode
$sel:queueMode:QueueRec :: QueueRec -> Maybe QueueMode
queueMode, Maybe (RecipientId, QueueLinkData)
queueData :: Maybe (RecipientId, QueueLinkData)
$sel:queueData:QueueRec :: QueueRec -> Maybe (RecipientId, QueueLinkData)
queueData, Maybe NtfCreds
notifier :: Maybe NtfCreds
$sel:notifier:QueueRec :: QueueRec -> Maybe NtfCreds
notifier, ServerEntityStatus
status :: ServerEntityStatus
$sel:status:QueueRec :: QueueRec -> ServerEntityStatus
status, Maybe SystemDate
updatedAt :: Maybe SystemDate
$sel:updatedAt:QueueRec :: QueueRec -> Maybe SystemDate
updatedAt} =
    [ByteString] -> ByteString
B.concat
      [ ByteString -> NonEmpty SndPublicAuthKey -> ByteString
forall a. StrEncoding a => ByteString -> a -> ByteString
p ByteString
"rk=" NonEmpty SndPublicAuthKey
recipientKeys,
        ByteString -> RcvDhSecret -> ByteString
forall a. StrEncoding a => ByteString -> a -> ByteString
p ByteString
" rdh=" RcvDhSecret
rcvDhSecret,
        ByteString -> RecipientId -> ByteString
forall a. StrEncoding a => ByteString -> a -> ByteString
p ByteString
" sid=" RecipientId
senderId,
        ByteString -> Maybe SndPublicAuthKey -> ByteString
forall a. StrEncoding a => ByteString -> a -> ByteString
p ByteString
" sk=" Maybe SndPublicAuthKey
senderKey,
        ByteString
-> (QueueMode -> ByteString) -> Maybe QueueMode -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((ByteString
" queue_mode=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString)
-> (QueueMode -> ByteString) -> QueueMode -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueMode -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode) Maybe QueueMode
queueMode,
        ByteString -> Maybe RecipientId -> ByteString
forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt ByteString
" link_id=" ((RecipientId, QueueLinkData) -> RecipientId
forall a b. (a, b) -> a
fst ((RecipientId, QueueLinkData) -> RecipientId)
-> Maybe (RecipientId, QueueLinkData) -> Maybe RecipientId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (RecipientId, QueueLinkData)
queueData),
        ByteString -> Maybe QueueLinkData -> ByteString
forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt ByteString
" queue_data=" ((RecipientId, QueueLinkData) -> QueueLinkData
forall a b. (a, b) -> b
snd ((RecipientId, QueueLinkData) -> QueueLinkData)
-> Maybe (RecipientId, QueueLinkData) -> Maybe QueueLinkData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (RecipientId, QueueLinkData)
queueData),
        ByteString -> Maybe NtfCreds -> ByteString
forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt ByteString
" notifier=" Maybe NtfCreds
notifier,
        ByteString -> Maybe SystemDate -> ByteString
forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt ByteString
" updated_at=" Maybe SystemDate
updatedAt,
        ByteString
statusStr,
        ByteString -> Maybe RecipientId -> ByteString
forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt ByteString
" rsrv=" Maybe RecipientId
rcvServiceId
      ]
    where
      p :: StrEncoding a => ByteString -> a -> ByteString
      p :: forall a. StrEncoding a => ByteString -> a -> ByteString
p ByteString
param = (ByteString
param ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
      opt :: StrEncoding a => ByteString -> Maybe a -> ByteString
      opt :: forall a. StrEncoding a => ByteString -> Maybe a -> ByteString
opt = ByteString -> (a -> ByteString) -> Maybe a -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" ((a -> ByteString) -> Maybe a -> ByteString)
-> (ByteString -> a -> ByteString)
-> ByteString
-> Maybe a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a -> ByteString
forall a. StrEncoding a => ByteString -> a -> ByteString
p
      statusStr :: ByteString
statusStr = case ServerEntityStatus
status of
        ServerEntityStatus
EntityActive -> ByteString
""
        ServerEntityStatus
_ -> ByteString
" status=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ServerEntityStatus -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ServerEntityStatus
status

  strP :: Parser QueueRec
strP = do
    NonEmpty SndPublicAuthKey
recipientKeys <- Parser ByteString ByteString
"rk=" Parser ByteString ByteString
-> Parser ByteString (NonEmpty SndPublicAuthKey)
-> Parser ByteString (NonEmpty SndPublicAuthKey)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty SndPublicAuthKey)
forall a. StrEncoding a => Parser a
strP_
    RcvDhSecret
rcvDhSecret <- Parser ByteString ByteString
"rdh=" Parser ByteString ByteString
-> Parser ByteString RcvDhSecret -> Parser ByteString RcvDhSecret
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RcvDhSecret
forall a. StrEncoding a => Parser a
strP_
    RecipientId
senderId <- Parser ByteString ByteString
"sid=" Parser ByteString ByteString
-> Parser ByteString RecipientId -> Parser ByteString RecipientId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_
    Maybe SndPublicAuthKey
senderKey <- Parser ByteString ByteString
"sk=" Parser ByteString ByteString
-> Parser ByteString (Maybe SndPublicAuthKey)
-> Parser ByteString (Maybe SndPublicAuthKey)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Maybe SndPublicAuthKey)
forall a. StrEncoding a => Parser a
strP
    Maybe QueueMode
queueMode <-
      Bool -> Maybe QueueMode
toQueueMode (Bool -> Maybe QueueMode)
-> Parser ByteString Bool -> Parser ByteString (Maybe QueueMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" sndSecure=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
forall a. StrEncoding a => Parser a
strP)
        Parser ByteString (Maybe QueueMode)
-> Parser ByteString (Maybe QueueMode)
-> Parser ByteString (Maybe QueueMode)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just (QueueMode -> Maybe QueueMode)
-> Parser ByteString QueueMode
-> Parser ByteString (Maybe QueueMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" queue_mode=" Parser ByteString ByteString
-> Parser ByteString QueueMode -> Parser ByteString QueueMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString QueueMode
forall a. Encoding a => Parser a
smpP)
        Parser ByteString (Maybe QueueMode)
-> Parser ByteString (Maybe QueueMode)
-> Parser ByteString (Maybe QueueMode)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe QueueMode -> Parser ByteString (Maybe QueueMode)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe QueueMode
forall a. Maybe a
Nothing -- unknown queue mode, we cannot imply that it is contact address
    Maybe (RecipientId, QueueLinkData)
queueData <- Parser ByteString (RecipientId, QueueLinkData)
-> Parser ByteString (Maybe (RecipientId, QueueLinkData))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString (RecipientId, QueueLinkData)
 -> Parser ByteString (Maybe (RecipientId, QueueLinkData)))
-> Parser ByteString (RecipientId, QueueLinkData)
-> Parser ByteString (Maybe (RecipientId, QueueLinkData))
forall a b. (a -> b) -> a -> b
$ (,) (RecipientId -> QueueLinkData -> (RecipientId, QueueLinkData))
-> Parser ByteString RecipientId
-> Parser
     ByteString (QueueLinkData -> (RecipientId, QueueLinkData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" link_id=" Parser ByteString ByteString
-> Parser ByteString RecipientId -> Parser ByteString RecipientId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP) Parser ByteString (QueueLinkData -> (RecipientId, QueueLinkData))
-> Parser ByteString QueueLinkData
-> Parser ByteString (RecipientId, QueueLinkData)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" queue_data=" Parser ByteString ByteString
-> Parser ByteString QueueLinkData
-> Parser ByteString QueueLinkData
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString QueueLinkData
forall a. StrEncoding a => Parser a
strP)
    Maybe NtfCreds
notifier <- Parser ByteString NtfCreds -> Parser ByteString (Maybe NtfCreds)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString NtfCreds -> Parser ByteString (Maybe NtfCreds))
-> Parser ByteString NtfCreds -> Parser ByteString (Maybe NtfCreds)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" notifier=" Parser ByteString ByteString
-> Parser ByteString NtfCreds -> Parser ByteString NtfCreds
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString NtfCreds
forall a. StrEncoding a => Parser a
strP
    Maybe SystemDate
updatedAt <- Parser ByteString SystemDate
-> Parser ByteString (Maybe SystemDate)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString SystemDate
 -> Parser ByteString (Maybe SystemDate))
-> Parser ByteString SystemDate
-> Parser ByteString (Maybe SystemDate)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" updated_at=" Parser ByteString ByteString
-> Parser ByteString SystemDate -> Parser ByteString SystemDate
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SystemDate
forall a. StrEncoding a => Parser a
strP
    ServerEntityStatus
status <- (Parser ByteString ByteString
" status=" Parser ByteString ByteString
-> Parser ByteString ServerEntityStatus
-> Parser ByteString ServerEntityStatus
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ServerEntityStatus
forall a. StrEncoding a => Parser a
strP) Parser ByteString ServerEntityStatus
-> Parser ByteString ServerEntityStatus
-> Parser ByteString ServerEntityStatus
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ServerEntityStatus -> Parser ByteString ServerEntityStatus
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerEntityStatus
EntityActive
    Maybe RecipientId
rcvServiceId <- Parser ByteString RecipientId
-> Parser ByteString (Maybe RecipientId)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString RecipientId
 -> Parser ByteString (Maybe RecipientId))
-> Parser ByteString RecipientId
-> Parser ByteString (Maybe RecipientId)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" rsrv=" Parser ByteString ByteString
-> Parser ByteString RecipientId -> Parser ByteString RecipientId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
    QueueRec -> Parser QueueRec
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      QueueRec
        { NonEmpty SndPublicAuthKey
$sel:recipientKeys:QueueRec :: NonEmpty SndPublicAuthKey
recipientKeys :: NonEmpty SndPublicAuthKey
recipientKeys,
          RcvDhSecret
$sel:rcvDhSecret:QueueRec :: RcvDhSecret
rcvDhSecret :: RcvDhSecret
rcvDhSecret,
          RecipientId
$sel:senderId:QueueRec :: RecipientId
senderId :: RecipientId
senderId,
          Maybe SndPublicAuthKey
$sel:senderKey:QueueRec :: Maybe SndPublicAuthKey
senderKey :: Maybe SndPublicAuthKey
senderKey,
          Maybe QueueMode
$sel:queueMode:QueueRec :: Maybe QueueMode
queueMode :: Maybe QueueMode
queueMode,
          Maybe (RecipientId, QueueLinkData)
$sel:queueData:QueueRec :: Maybe (RecipientId, QueueLinkData)
queueData :: Maybe (RecipientId, QueueLinkData)
queueData,
          Maybe NtfCreds
$sel:notifier:QueueRec :: Maybe NtfCreds
notifier :: Maybe NtfCreds
notifier,
          ServerEntityStatus
$sel:status:QueueRec :: ServerEntityStatus
status :: ServerEntityStatus
status,
          Maybe SystemDate
$sel:updatedAt:QueueRec :: Maybe SystemDate
updatedAt :: Maybe SystemDate
updatedAt,
          Maybe RecipientId
$sel:rcvServiceId:QueueRec :: Maybe RecipientId
rcvServiceId :: Maybe RecipientId
rcvServiceId
        }
    where
      toQueueMode :: Bool -> Maybe QueueMode
toQueueMode Bool
sndSecure = QueueMode -> Maybe QueueMode
forall a. a -> Maybe a
Just (QueueMode -> Maybe QueueMode) -> QueueMode -> Maybe QueueMode
forall a b. (a -> b) -> a -> b
$ if Bool
sndSecure then QueueMode
QMMessaging else QueueMode
QMContact

instance StrEncoding SLRTag where
  strEncode :: SLRTag -> ByteString
strEncode = \case
    SLRTag
CreateQueue_ -> ByteString
"CREATE"
    SLRTag
CreateLink_ -> ByteString
"LINK"
    SLRTag
DeleteLink_ -> ByteString
"LDELETE"
    SLRTag
SecureQueue_ -> ByteString
"SECURE"
    SLRTag
UpdateKeys_ -> ByteString
"KEYS"
    SLRTag
AddNotifier_ -> ByteString
"NOTIFIER"
    SLRTag
SuspendQueue_ -> ByteString
"SUSPEND"
    SLRTag
BlockQueue_ -> ByteString
"BLOCK"
    SLRTag
UnblockQueue_ -> ByteString
"UNBLOCK"
    SLRTag
DeleteQueue_ -> ByteString
"DELETE"
    SLRTag
DeleteNotifier_ -> ByteString
"NDELETE"
    SLRTag
UpdateTime_ -> ByteString
"TIME"
    SLRTag
NewService_ -> ByteString
"NEW_SERVICE"
    SLRTag
QueueService_ -> ByteString
"QUEUE_SERVICE"

  strP :: Parser SLRTag
strP =
    [Parser SLRTag] -> Parser SLRTag
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
      [ Parser ByteString ByteString
"CREATE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
CreateQueue_,
        Parser ByteString ByteString
"LINK" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
CreateLink_,
        Parser ByteString ByteString
"LDELETE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
DeleteLink_,
        Parser ByteString ByteString
"SECURE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
SecureQueue_,
        Parser ByteString ByteString
"KEYS" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
UpdateKeys_,
        Parser ByteString ByteString
"NOTIFIER" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
AddNotifier_,
        Parser ByteString ByteString
"SUSPEND" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
SuspendQueue_,
        Parser ByteString ByteString
"BLOCK" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
BlockQueue_,
        Parser ByteString ByteString
"UNBLOCK" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
UnblockQueue_,
        Parser ByteString ByteString
"DELETE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
DeleteQueue_,
        Parser ByteString ByteString
"NDELETE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
DeleteNotifier_,
        Parser ByteString ByteString
"TIME" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
UpdateTime_,
        Parser ByteString ByteString
"NEW_SERVICE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
NewService_,
        Parser ByteString ByteString
"QUEUE_SERVICE" Parser ByteString ByteString -> SLRTag -> Parser SLRTag
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SLRTag
QueueService_
      ]

instance StrEncoding StoreLogRecord where
  strEncode :: StoreLogRecord -> ByteString
strEncode = \case
    CreateQueue RecipientId
rId QueueRec
q -> [ByteString] -> ByteString
B.unwords [SLRTag -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SLRTag
CreateQueue_, ByteString
"rid=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> RecipientId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RecipientId
rId, QueueRec -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode QueueRec
q]
    CreateLink RecipientId
rId RecipientId
lnkId QueueLinkData
d -> (SLRTag, RecipientId, RecipientId, QueueLinkData) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
CreateLink_, RecipientId
rId, RecipientId
lnkId, QueueLinkData
d)
    DeleteLink RecipientId
rId -> (SLRTag, RecipientId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
DeleteLink_, RecipientId
rId)
    SecureQueue RecipientId
rId SndPublicAuthKey
sKey -> (SLRTag, RecipientId, SndPublicAuthKey) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
SecureQueue_, RecipientId
rId, SndPublicAuthKey
sKey)
    UpdateKeys RecipientId
rId NonEmpty SndPublicAuthKey
rKeys -> (SLRTag, RecipientId, NonEmpty SndPublicAuthKey) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
UpdateKeys_, RecipientId
rId, NonEmpty SndPublicAuthKey
rKeys)
    AddNotifier RecipientId
rId NtfCreds
ntfCreds -> (SLRTag, RecipientId, NtfCreds) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
AddNotifier_, RecipientId
rId, NtfCreds
ntfCreds)
    SuspendQueue RecipientId
rId -> (SLRTag, RecipientId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
SuspendQueue_, RecipientId
rId)
    BlockQueue RecipientId
rId BlockingInfo
info -> (SLRTag, RecipientId, BlockingInfo) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
BlockQueue_, RecipientId
rId, BlockingInfo
info)
    UnblockQueue RecipientId
rId -> (SLRTag, RecipientId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
UnblockQueue_, RecipientId
rId)
    DeleteQueue RecipientId
rId -> (SLRTag, RecipientId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
DeleteQueue_, RecipientId
rId)
    DeleteNotifier RecipientId
rId -> (SLRTag, RecipientId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
DeleteNotifier_, RecipientId
rId)
    UpdateTime RecipientId
rId SystemDate
t ->  (SLRTag, RecipientId, SystemDate) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
UpdateTime_, RecipientId
rId, SystemDate
t)
    NewService ServiceRec
sr -> (SLRTag, ServiceRec) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
NewService_, ServiceRec
sr)
    QueueService RecipientId
rId ASubscriberParty
party Maybe RecipientId
serviceId -> (SLRTag, RecipientId, ASubscriberParty, Maybe RecipientId)
-> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (SLRTag
QueueService_, RecipientId
rId, ASubscriberParty
party, Maybe RecipientId
serviceId)

  strP :: Parser StoreLogRecord
strP =
    Parser SLRTag
forall a. StrEncoding a => Parser a
strP_ Parser SLRTag
-> (SLRTag -> Parser StoreLogRecord) -> Parser StoreLogRecord
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SLRTag
CreateQueue_ -> RecipientId -> QueueRec -> StoreLogRecord
CreateQueue (RecipientId -> QueueRec -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (QueueRec -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"rid=" Parser ByteString ByteString
-> Parser ByteString RecipientId -> Parser ByteString RecipientId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_) Parser ByteString (QueueRec -> StoreLogRecord)
-> Parser QueueRec -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser QueueRec
forall a. StrEncoding a => Parser a
strP
      SLRTag
CreateLink_ -> RecipientId -> RecipientId -> QueueLinkData -> StoreLogRecord
CreateLink (RecipientId -> RecipientId -> QueueLinkData -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser
     ByteString (RecipientId -> QueueLinkData -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (RecipientId -> QueueLinkData -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (QueueLinkData -> StoreLogRecord)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (QueueLinkData -> StoreLogRecord)
-> Parser ByteString QueueLinkData -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString QueueLinkData
forall a. StrEncoding a => Parser a
strP
      SLRTag
DeleteLink_ -> RecipientId -> StoreLogRecord
DeleteLink (RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
      SLRTag
SecureQueue_ -> RecipientId -> SndPublicAuthKey -> StoreLogRecord
SecureQueue (RecipientId -> SndPublicAuthKey -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (SndPublicAuthKey -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (SndPublicAuthKey -> StoreLogRecord)
-> Parser ByteString SndPublicAuthKey -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString SndPublicAuthKey
forall a. StrEncoding a => Parser a
strP
      SLRTag
UpdateKeys_ -> RecipientId -> NonEmpty SndPublicAuthKey -> StoreLogRecord
UpdateKeys (RecipientId -> NonEmpty SndPublicAuthKey -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (NonEmpty SndPublicAuthKey -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (NonEmpty SndPublicAuthKey -> StoreLogRecord)
-> Parser ByteString (NonEmpty SndPublicAuthKey)
-> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty SndPublicAuthKey)
forall a. StrEncoding a => Parser a
strP
      SLRTag
AddNotifier_ -> RecipientId -> NtfCreds -> StoreLogRecord
AddNotifier (RecipientId -> NtfCreds -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (NtfCreds -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (NtfCreds -> StoreLogRecord)
-> Parser ByteString NtfCreds -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString NtfCreds
forall a. StrEncoding a => Parser a
strP
      SLRTag
SuspendQueue_ -> RecipientId -> StoreLogRecord
SuspendQueue (RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
      SLRTag
BlockQueue_ -> RecipientId -> BlockingInfo -> StoreLogRecord
BlockQueue (RecipientId -> BlockingInfo -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (BlockingInfo -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (BlockingInfo -> StoreLogRecord)
-> Parser ByteString BlockingInfo -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString BlockingInfo
forall a. StrEncoding a => Parser a
strP
      SLRTag
UnblockQueue_ -> RecipientId -> StoreLogRecord
UnblockQueue (RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
      SLRTag
DeleteQueue_ -> RecipientId -> StoreLogRecord
DeleteQueue (RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
      SLRTag
DeleteNotifier_ -> RecipientId -> StoreLogRecord
DeleteNotifier (RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP
      SLRTag
UpdateTime_ -> RecipientId -> SystemDate -> StoreLogRecord
UpdateTime (RecipientId -> SystemDate -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser ByteString (SystemDate -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (SystemDate -> StoreLogRecord)
-> Parser ByteString SystemDate -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString SystemDate
forall a. StrEncoding a => Parser a
strP
      SLRTag
NewService_ -> ServiceRec -> StoreLogRecord
NewService (ServiceRec -> StoreLogRecord)
-> Parser ByteString ServiceRec -> Parser StoreLogRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ServiceRec
forall a. StrEncoding a => Parser a
strP
      SLRTag
QueueService_ -> RecipientId
-> ASubscriberParty -> Maybe RecipientId -> StoreLogRecord
QueueService (RecipientId
 -> ASubscriberParty -> Maybe RecipientId -> StoreLogRecord)
-> Parser ByteString RecipientId
-> Parser
     ByteString
     (ASubscriberParty -> Maybe RecipientId -> StoreLogRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RecipientId
forall a. StrEncoding a => Parser a
strP_ Parser
  ByteString
  (ASubscriberParty -> Maybe RecipientId -> StoreLogRecord)
-> Parser ByteString ASubscriberParty
-> Parser ByteString (Maybe RecipientId -> StoreLogRecord)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ASubscriberParty
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (Maybe RecipientId -> StoreLogRecord)
-> Parser ByteString (Maybe RecipientId) -> Parser StoreLogRecord
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe RecipientId)
forall a. StrEncoding a => Parser a
strP

openWriteStoreLog :: Bool -> FilePath -> IO (StoreLog 'WriteMode)
openWriteStoreLog :: Bool -> FilePath -> IO (StoreLog 'WriteMode)
openWriteStoreLog Bool
append FilePath
f = do
  Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
f (IOMode -> IO Handle) -> IOMode -> IO Handle
forall a b. (a -> b) -> a -> b
$ if Bool
append then IOMode
AppendMode else IOMode
WriteMode
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
  StoreLog 'WriteMode -> IO (StoreLog 'WriteMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StoreLog 'WriteMode -> IO (StoreLog 'WriteMode))
-> StoreLog 'WriteMode -> IO (StoreLog 'WriteMode)
forall a b. (a -> b) -> a -> b
$ FilePath -> Handle -> StoreLog 'WriteMode
WriteStoreLog FilePath
f Handle
h

openReadStoreLog :: FilePath -> IO (StoreLog 'ReadMode)
openReadStoreLog :: FilePath -> IO (StoreLog 'ReadMode)
openReadStoreLog FilePath
f = do
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> IO Bool
doesFileExist FilePath
f) (FilePath -> FilePath -> IO ()
writeFile FilePath
f FilePath
"")
  FilePath -> Handle -> StoreLog 'ReadMode
ReadStoreLog FilePath
f (Handle -> StoreLog 'ReadMode)
-> IO Handle -> IO (StoreLog 'ReadMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IOMode -> IO Handle
openFile FilePath
f IOMode
ReadMode

storeLogFilePath :: StoreLog a -> FilePath
storeLogFilePath :: forall (a :: IOMode). StoreLog a -> FilePath
storeLogFilePath = \case
  WriteStoreLog FilePath
f Handle
_ -> FilePath
f
  ReadStoreLog FilePath
f Handle
_ -> FilePath
f

closeStoreLog :: StoreLog a -> IO ()
closeStoreLog :: forall (a :: IOMode). StoreLog a -> IO ()
closeStoreLog = \case
  WriteStoreLog FilePath
_ Handle
h -> Handle -> IO ()
close_ Handle
h
  ReadStoreLog FilePath
_ Handle
h -> Handle -> IO ()
close_ Handle
h
  where
    close_ :: Handle -> IO ()
close_ Handle
h = Handle -> IO ()
hClose Handle
h IO () -> (forall e. Exception e => e -> IO ()) -> IO ()
forall a. IO a -> (forall e. Exception e => e -> IO a) -> IO a
`catchAny` \e
e -> Text -> IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logError (Text
"STORE: closeStoreLog, error closing, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> e -> Text
forall a. Show a => a -> Text
tshow e
e)

writeStoreLogRecord :: StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord :: forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord (WriteStoreLog FilePath
_ Handle
h) r
r = IO () -> IO ()
forall a. IO a -> IO a
E.uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ r -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode r
r ByteString -> Char -> ByteString
`B.snoc` Char
'\n' -- hPutStrLn makes write non-atomic for length > 1024
  Handle -> IO ()
hFlush Handle
h

logCreateQueue :: StoreLog 'WriteMode -> RecipientId -> QueueRec -> IO ()
logCreateQueue :: StoreLog 'WriteMode -> RecipientId -> QueueRec -> IO ()
logCreateQueue StoreLog 'WriteMode
s RecipientId
rId QueueRec
q = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> QueueRec -> StoreLogRecord
CreateQueue RecipientId
rId QueueRec
q

logCreateLink :: StoreLog 'WriteMode -> RecipientId -> LinkId -> QueueLinkData -> IO ()
logCreateLink :: StoreLog 'WriteMode
-> RecipientId -> RecipientId -> QueueLinkData -> IO ()
logCreateLink StoreLog 'WriteMode
s RecipientId
rId RecipientId
lnkId QueueLinkData
d = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> RecipientId -> QueueLinkData -> StoreLogRecord
CreateLink RecipientId
rId RecipientId
lnkId QueueLinkData
d

logDeleteLink :: StoreLog 'WriteMode -> RecipientId -> IO ()
logDeleteLink :: StoreLog 'WriteMode -> RecipientId -> IO ()
logDeleteLink StoreLog 'WriteMode
s = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (RecipientId -> StoreLogRecord) -> RecipientId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId -> StoreLogRecord
DeleteLink

logSecureQueue :: StoreLog 'WriteMode -> QueueId -> SndPublicAuthKey -> IO ()
logSecureQueue :: StoreLog 'WriteMode -> RecipientId -> SndPublicAuthKey -> IO ()
logSecureQueue StoreLog 'WriteMode
s RecipientId
qId SndPublicAuthKey
sKey = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> SndPublicAuthKey -> StoreLogRecord
SecureQueue RecipientId
qId SndPublicAuthKey
sKey

logUpdateKeys :: StoreLog 'WriteMode -> QueueId -> NonEmpty RcvPublicAuthKey -> IO ()
logUpdateKeys :: StoreLog 'WriteMode
-> RecipientId -> NonEmpty SndPublicAuthKey -> IO ()
logUpdateKeys StoreLog 'WriteMode
s RecipientId
rId NonEmpty SndPublicAuthKey
rKeys = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> NonEmpty SndPublicAuthKey -> StoreLogRecord
UpdateKeys RecipientId
rId NonEmpty SndPublicAuthKey
rKeys

logAddNotifier :: StoreLog 'WriteMode -> QueueId -> NtfCreds -> IO ()
logAddNotifier :: StoreLog 'WriteMode -> RecipientId -> NtfCreds -> IO ()
logAddNotifier StoreLog 'WriteMode
s RecipientId
qId NtfCreds
ntfCreds = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> NtfCreds -> StoreLogRecord
AddNotifier RecipientId
qId NtfCreds
ntfCreds

logSuspendQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
logSuspendQueue :: StoreLog 'WriteMode -> RecipientId -> IO ()
logSuspendQueue StoreLog 'WriteMode
s = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (RecipientId -> StoreLogRecord) -> RecipientId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId -> StoreLogRecord
SuspendQueue

logBlockQueue :: StoreLog 'WriteMode -> QueueId -> BlockingInfo -> IO ()
logBlockQueue :: StoreLog 'WriteMode -> RecipientId -> BlockingInfo -> IO ()
logBlockQueue StoreLog 'WriteMode
s RecipientId
qId BlockingInfo
info = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> BlockingInfo -> StoreLogRecord
BlockQueue RecipientId
qId BlockingInfo
info

logUnblockQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
logUnblockQueue :: StoreLog 'WriteMode -> RecipientId -> IO ()
logUnblockQueue StoreLog 'WriteMode
s = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (RecipientId -> StoreLogRecord) -> RecipientId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId -> StoreLogRecord
UnblockQueue

logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
logDeleteQueue :: StoreLog 'WriteMode -> RecipientId -> IO ()
logDeleteQueue StoreLog 'WriteMode
s = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (RecipientId -> StoreLogRecord) -> RecipientId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId -> StoreLogRecord
DeleteQueue

logDeleteNotifier :: StoreLog 'WriteMode -> QueueId -> IO ()
logDeleteNotifier :: StoreLog 'WriteMode -> RecipientId -> IO ()
logDeleteNotifier StoreLog 'WriteMode
s = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (RecipientId -> StoreLogRecord) -> RecipientId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId -> StoreLogRecord
DeleteNotifier

logUpdateQueueTime :: StoreLog 'WriteMode -> QueueId -> SystemDate -> IO ()
logUpdateQueueTime :: StoreLog 'WriteMode -> RecipientId -> SystemDate -> IO ()
logUpdateQueueTime StoreLog 'WriteMode
s RecipientId
qId SystemDate
t = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ()) -> StoreLogRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ RecipientId -> SystemDate -> StoreLogRecord
UpdateTime RecipientId
qId SystemDate
t

logNewService :: StoreLog 'WriteMode -> ServiceRec -> IO ()
logNewService :: StoreLog 'WriteMode -> ServiceRec -> IO ()
logNewService StoreLog 'WriteMode
s  = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (ServiceRec -> StoreLogRecord) -> ServiceRec -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceRec -> StoreLogRecord
NewService

logQueueService :: (PartyI p, ServiceParty p) => StoreLog 'WriteMode -> RecipientId -> SParty p -> Maybe ServiceId -> IO ()
logQueueService :: forall (p :: Party).
(PartyI p, ServiceParty p) =>
StoreLog 'WriteMode
-> RecipientId -> SParty p -> Maybe RecipientId -> IO ()
logQueueService StoreLog 'WriteMode
s RecipientId
rId SParty p
party = StoreLog 'WriteMode -> StoreLogRecord -> IO ()
forall r. StrEncoding r => StoreLog 'WriteMode -> r -> IO ()
writeStoreLogRecord StoreLog 'WriteMode
s (StoreLogRecord -> IO ())
-> (Maybe RecipientId -> StoreLogRecord)
-> Maybe RecipientId
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientId
-> ASubscriberParty -> Maybe RecipientId -> StoreLogRecord
QueueService RecipientId
rId (SParty p -> ASubscriberParty
forall (p :: Party).
(PartyI p, ServiceParty p) =>
SParty p -> ASubscriberParty
ASP SParty p
party)

readWriteStoreLog :: (FilePath -> s -> IO ()) -> (StoreLog 'WriteMode -> s -> IO ()) -> FilePath -> s -> IO (StoreLog 'WriteMode)
readWriteStoreLog :: forall s.
(FilePath -> s -> IO ())
-> (StoreLog 'WriteMode -> s -> IO ())
-> FilePath
-> s
-> IO (StoreLog 'WriteMode)
readWriteStoreLog FilePath -> s -> IO ()
readStore StoreLog 'WriteMode -> s -> IO ()
writeStore FilePath
f s
st =
  IO Bool
-> IO (StoreLog 'WriteMode)
-> IO (StoreLog 'WriteMode)
-> IO (StoreLog 'WriteMode)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
    (FilePath -> IO Bool
doesFileExist FilePath
tempBackup)
    (IO ()
useTempBackup IO () -> IO (StoreLog 'WriteMode) -> IO (StoreLog 'WriteMode)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (StoreLog 'WriteMode)
readWriteLog)
    (IO Bool
-> IO (StoreLog 'WriteMode)
-> IO (StoreLog 'WriteMode)
-> IO (StoreLog 'WriteMode)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
f) IO (StoreLog 'WriteMode)
readWriteLog (Text -> IO (StoreLog 'WriteMode)
writeLog Text
"creating store log..."))
  where
    f' :: Text
f' = FilePath -> Text
T.pack FilePath
f
    tempBackup :: FilePath
tempBackup = FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".start"
    useTempBackup :: IO ()
useTempBackup = do
      -- preserve current file, use temp backup
      Text -> IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logWarn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Server terminated abnormally on last start, restoring state from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
tempBackup
      IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesFileExist FilePath
f) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> FilePath -> IO ()
renameFile FilePath
f (FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".bak")
        Text -> IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logNote (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"preserved incomplete state " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
f' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".bak")
      FilePath -> FilePath -> IO ()
renameFile FilePath
tempBackup FilePath
f
    readWriteLog :: IO (StoreLog 'WriteMode)
readWriteLog = do
      -- log backup is made in two steps to mitigate the crash during the compacting.
      -- Temporary backup file .start will be used when it is present.
      FilePath -> s -> IO ()
readStore FilePath
f s
st
      FilePath -> FilePath -> IO ()
renameFile FilePath
f FilePath
tempBackup -- 1) make temp backup
      StoreLog 'WriteMode
s <- Text -> IO (StoreLog 'WriteMode)
writeLog Text
"compacting store log (do not terminate)..." -- 2) save state
      IO ()
renameBackup -- 3) timed backup
      FilePath -> IO ()
removeStoreLogBackups FilePath
f
      StoreLog 'WriteMode -> IO (StoreLog 'WriteMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoreLog 'WriteMode
s
    writeLog :: Text -> IO (StoreLog 'WriteMode)
writeLog Text
msg = do
      StoreLog 'WriteMode
s <- Bool -> FilePath -> IO (StoreLog 'WriteMode)
openWriteStoreLog Bool
False FilePath
f
      Text -> IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logNote Text
msg
      StoreLog 'WriteMode -> s -> IO ()
writeStore StoreLog 'WriteMode
s s
st
      StoreLog 'WriteMode -> IO (StoreLog 'WriteMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoreLog 'WriteMode
s
    renameBackup :: IO ()
renameBackup = do
      UTCTime
ts <- IO UTCTime
getCurrentTime
      let timedBackup :: FilePath
timedBackup = FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTCTime -> FilePath
forall t. ISO8601 t => t -> FilePath
iso8601Show UTCTime
ts
      FilePath -> FilePath -> IO ()
renameFile FilePath
tempBackup FilePath
timedBackup
      Text -> IO ()
forall (m :: * -> *).
(?callStack::CallStack, MonadIO m) =>
Text -> m ()
logNote (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"original state preserved as " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
timedBackup

removeStoreLogBackups :: FilePath -> IO ()
removeStoreLogBackups :: FilePath -> IO ()
removeStoreLogBackups FilePath
f = do
  UTCTime
ts <- IO UTCTime
getCurrentTime
  [UTCTime]
times <- [UTCTime] -> [UTCTime]
forall a. Ord a => [a] -> [a]
sort ([UTCTime] -> [UTCTime])
-> ([FilePath] -> [UTCTime]) -> [FilePath] -> [UTCTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Maybe UTCTime) -> [FilePath] -> [UTCTime]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe UTCTime
backupPathTime ([FilePath] -> [UTCTime]) -> IO [FilePath] -> IO [UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory (ShowS
takeDirectory FilePath
f)
  let new :: UTCTime
new = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (- NominalDiffTime
nominalDay) UTCTime
ts
      old :: UTCTime
old = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (- NominalDiffTime
oldBackupTTL) UTCTime
ts
      times1 :: [UTCTime]
times1 = (UTCTime -> Bool) -> [UTCTime] -> [UTCTime]
forall a. (a -> Bool) -> [a] -> [a]
filter (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
new) [UTCTime]
times -- exclude backups newer than 24 hours
      times2 :: [UTCTime]
times2 = Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take ([UTCTime] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UTCTime]
times1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minOldBackups) [UTCTime]
times1 -- keep 3 backups older than 24 hours
      toDelete :: [UTCTime]
toDelete = (UTCTime -> Bool) -> [UTCTime] -> [UTCTime]
forall a. (a -> Bool) -> [a] -> [a]
filter (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
old) [UTCTime]
times2 -- remove all backups older than 21 day
  (UTCTime -> IO ()) -> [UTCTime] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
removeFile (FilePath -> IO ()) -> (UTCTime -> FilePath) -> UTCTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> FilePath
backupPath) [UTCTime]
toDelete
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([UTCTime] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UTCTime]
toDelete Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Removed " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show ([UTCTime] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UTCTime]
toDelete) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" backups:"
    (UTCTime -> IO ()) -> [UTCTime] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (UTCTime -> FilePath) -> UTCTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> FilePath
backupPath) [UTCTime]
toDelete
  where
    backupPathTime :: FilePath -> Maybe UTCTime
    backupPathTime :: FilePath -> Maybe UTCTime
backupPathTime = FilePath -> Maybe UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => FilePath -> m t
iso8601ParseM (FilePath -> Maybe UTCTime)
-> (FilePath -> Maybe FilePath) -> FilePath -> Maybe UTCTime
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
backupPathPfx
    backupPath :: UTCTime -> FilePath
    backupPath :: UTCTime -> FilePath
backupPath UTCTime
ts = FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> UTCTime -> FilePath
forall t. ISO8601 t => t -> FilePath
iso8601Show UTCTime
ts
    backupPathPfx :: FilePath
backupPathPfx = ShowS
takeFileName FilePath
f FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
    minOldBackups :: Int
minOldBackups = Int
3
    oldBackupTTL :: NominalDiffTime
oldBackupTTL = NominalDiffTime
21 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay

readLogLines :: Bool -> FilePath -> (Bool -> B.ByteString -> IO ()) -> IO ()
readLogLines :: Bool -> FilePath -> (Bool -> ByteString -> IO ()) -> IO ()
readLogLines Bool
tty FilePath
f Bool -> ByteString -> IO ()
action = Bool
-> FilePath -> (() -> Bool -> ByteString -> IO ()) -> () -> IO ()
forall a.
Bool -> FilePath -> (a -> Bool -> ByteString -> IO a) -> a -> IO a
foldLogLines Bool
tty FilePath
f ((Bool -> ByteString -> IO ()) -> () -> Bool -> ByteString -> IO ()
forall a b. a -> b -> a
const Bool -> ByteString -> IO ()
action) ()

foldLogLines :: Bool -> FilePath -> (a -> Bool -> B.ByteString -> IO a) -> a -> IO a
foldLogLines :: forall a.
Bool -> FilePath -> (a -> Bool -> ByteString -> IO a) -> a -> IO a
foldLogLines Bool
tty FilePath
f a -> Bool -> ByteString -> IO a
action a
initValue = do
  (Int
count :: Int, a
acc) <- FilePath -> IOMode -> (Handle -> IO (Int, a)) -> IO (Int, a)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
f IOMode
ReadMode ((Handle -> IO (Int, a)) -> IO (Int, a))
-> (Handle -> IO (Int, a)) -> IO (Int, a)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> IO Bool -> IO (Int, a) -> IO (Int, a) -> IO (Int, a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Handle -> IO Bool
hIsEOF Handle
h) ((Int, a) -> IO (Int, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, a
initValue)) (Handle -> Int -> a -> IO (Int, a)
loop Handle
h Int
0 a
initValue)
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> FilePath
forall a. Show a => a -> FilePath
progress Int
count
  a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
acc
  where
    loop :: Handle -> Int -> a -> IO (Int, a)
loop Handle
h !Int
i !a
acc = do
      ByteString
s <- Handle -> IO ByteString
B.hGetLine Handle
h
      Bool
eof <- Handle -> IO Bool
hIsEOF Handle
h
      a
acc' <- a -> Bool -> ByteString -> IO a
action a
acc Bool
eof ByteString
s
      let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
tty Bool -> Bool -> Bool
&& Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100000 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr (Int -> FilePath
forall a. Show a => a -> FilePath
progress Int
i' FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"\r") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
      if Bool
eof then (Int, a) -> IO (Int, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i', a
acc') else Handle -> Int -> a -> IO (Int, a)
loop Handle
h Int
i' a
acc'
    progress :: a -> FilePath
progress a
i = FilePath
"Processed: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
forall a. Show a => a -> FilePath
show a
i FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" log lines"