{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Simplex.Messaging.Server.QueueStore.QueueInfo
  ( QueueInfo (..),
    QSub (..),
    QSubThread (..),
    MsgInfo (..),
    MsgType (..),
    QueueMode (..),
  ) where

import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
import Simplex.Messaging.Util (eitherToMaybe, (<$?>))

data QueueInfo = QueueInfo
  { QueueInfo -> Bool
qiSnd :: Bool,
    QueueInfo -> Bool
qiNtf :: Bool,
    QueueInfo -> Maybe QSub
qiSub :: Maybe QSub,
    QueueInfo -> Int
qiSize :: Int,
    QueueInfo -> Maybe MsgInfo
qiMsg :: Maybe MsgInfo
  }
  deriving (QueueInfo -> QueueInfo -> Bool
(QueueInfo -> QueueInfo -> Bool)
-> (QueueInfo -> QueueInfo -> Bool) -> Eq QueueInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueueInfo -> QueueInfo -> Bool
== :: QueueInfo -> QueueInfo -> Bool
$c/= :: QueueInfo -> QueueInfo -> Bool
/= :: QueueInfo -> QueueInfo -> Bool
Eq, Int -> QueueInfo -> ShowS
[QueueInfo] -> ShowS
QueueInfo -> String
(Int -> QueueInfo -> ShowS)
-> (QueueInfo -> String)
-> ([QueueInfo] -> ShowS)
-> Show QueueInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueInfo -> ShowS
showsPrec :: Int -> QueueInfo -> ShowS
$cshow :: QueueInfo -> String
show :: QueueInfo -> String
$cshowList :: [QueueInfo] -> ShowS
showList :: [QueueInfo] -> ShowS
Show)

data QSub = QSub
  { QSub -> QSubThread
qSubThread :: QSubThread,
    QSub -> Maybe Text
qDelivered :: Maybe Text
  }
  deriving (QSub -> QSub -> Bool
(QSub -> QSub -> Bool) -> (QSub -> QSub -> Bool) -> Eq QSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QSub -> QSub -> Bool
== :: QSub -> QSub -> Bool
$c/= :: QSub -> QSub -> Bool
/= :: QSub -> QSub -> Bool
Eq, Int -> QSub -> ShowS
[QSub] -> ShowS
QSub -> String
(Int -> QSub -> ShowS)
-> (QSub -> String) -> ([QSub] -> ShowS) -> Show QSub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QSub -> ShowS
showsPrec :: Int -> QSub -> ShowS
$cshow :: QSub -> String
show :: QSub -> String
$cshowList :: [QSub] -> ShowS
showList :: [QSub] -> ShowS
Show)

data QSubThread = QNoSub | QSubPending | QSubThread | QProhibitSub
  deriving (QSubThread -> QSubThread -> Bool
(QSubThread -> QSubThread -> Bool)
-> (QSubThread -> QSubThread -> Bool) -> Eq QSubThread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QSubThread -> QSubThread -> Bool
== :: QSubThread -> QSubThread -> Bool
$c/= :: QSubThread -> QSubThread -> Bool
/= :: QSubThread -> QSubThread -> Bool
Eq, Int -> QSubThread -> ShowS
[QSubThread] -> ShowS
QSubThread -> String
(Int -> QSubThread -> ShowS)
-> (QSubThread -> String)
-> ([QSubThread] -> ShowS)
-> Show QSubThread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QSubThread -> ShowS
showsPrec :: Int -> QSubThread -> ShowS
$cshow :: QSubThread -> String
show :: QSubThread -> String
$cshowList :: [QSubThread] -> ShowS
showList :: [QSubThread] -> ShowS
Show)

data MsgInfo = MsgInfo
  { MsgInfo -> Text
msgId :: Text,
    MsgInfo -> UTCTime
msgTs :: UTCTime,
    MsgInfo -> MsgType
msgType :: MsgType
  }
  deriving (MsgInfo -> MsgInfo -> Bool
(MsgInfo -> MsgInfo -> Bool)
-> (MsgInfo -> MsgInfo -> Bool) -> Eq MsgInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgInfo -> MsgInfo -> Bool
== :: MsgInfo -> MsgInfo -> Bool
$c/= :: MsgInfo -> MsgInfo -> Bool
/= :: MsgInfo -> MsgInfo -> Bool
Eq, Int -> MsgInfo -> ShowS
[MsgInfo] -> ShowS
MsgInfo -> String
(Int -> MsgInfo -> ShowS)
-> (MsgInfo -> String) -> ([MsgInfo] -> ShowS) -> Show MsgInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgInfo -> ShowS
showsPrec :: Int -> MsgInfo -> ShowS
$cshow :: MsgInfo -> String
show :: MsgInfo -> String
$cshowList :: [MsgInfo] -> ShowS
showList :: [MsgInfo] -> ShowS
Show)

data MsgType = MTMessage | MTQuota
  deriving (MsgType -> MsgType -> Bool
(MsgType -> MsgType -> Bool)
-> (MsgType -> MsgType -> Bool) -> Eq MsgType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgType -> MsgType -> Bool
== :: MsgType -> MsgType -> Bool
$c/= :: MsgType -> MsgType -> Bool
/= :: MsgType -> MsgType -> Bool
Eq, Int -> MsgType -> ShowS
[MsgType] -> ShowS
MsgType -> String
(Int -> MsgType -> ShowS)
-> (MsgType -> String) -> ([MsgType] -> ShowS) -> Show MsgType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgType -> ShowS
showsPrec :: Int -> MsgType -> ShowS
$cshow :: MsgType -> String
show :: MsgType -> String
$cshowList :: [MsgType] -> ShowS
showList :: [MsgType] -> ShowS
Show)

data QueueMode = QMMessaging | QMContact deriving (QueueMode -> QueueMode -> Bool
(QueueMode -> QueueMode -> Bool)
-> (QueueMode -> QueueMode -> Bool) -> Eq QueueMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueueMode -> QueueMode -> Bool
== :: QueueMode -> QueueMode -> Bool
$c/= :: QueueMode -> QueueMode -> Bool
/= :: QueueMode -> QueueMode -> Bool
Eq, Int -> QueueMode -> ShowS
[QueueMode] -> ShowS
QueueMode -> String
(Int -> QueueMode -> ShowS)
-> (QueueMode -> String)
-> ([QueueMode] -> ShowS)
-> Show QueueMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueMode -> ShowS
showsPrec :: Int -> QueueMode -> ShowS
$cshow :: QueueMode -> String
show :: QueueMode -> String
$cshowList :: [QueueMode] -> ShowS
showList :: [QueueMode] -> ShowS
Show)

instance Encoding QueueMode where
  smpEncode :: QueueMode -> ByteString
smpEncode = \case
    QueueMode
QMMessaging -> ByteString
"M"
    QueueMode
QMContact -> ByteString
"C"
  smpP :: Parser QueueMode
smpP =
    Parser Char
A.anyChar Parser Char -> (Char -> Parser QueueMode) -> Parser QueueMode
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
      Char
'M' -> QueueMode -> Parser QueueMode
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueMode
QMMessaging
      Char
'C' -> QueueMode -> Parser QueueMode
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueueMode
QMContact
      Char
_ -> String -> Parser QueueMode
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad QueueMode"

instance FromField QueueMode where fromField :: FieldParser QueueMode
fromField = (Text -> Maybe QueueMode) -> FieldParser QueueMode
forall a. Typeable a => (Text -> Maybe a) -> Field -> Ok a
fromTextField_ ((Text -> Maybe QueueMode) -> FieldParser QueueMode)
-> (Text -> Maybe QueueMode) -> FieldParser QueueMode
forall a b. (a -> b) -> a -> b
$ Either String QueueMode -> Maybe QueueMode
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String QueueMode -> Maybe QueueMode)
-> (Text -> Either String QueueMode) -> Text -> Maybe QueueMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String QueueMode
forall a. Encoding a => ByteString -> Either String a
smpDecode (ByteString -> Either String QueueMode)
-> (Text -> ByteString) -> Text -> Either String QueueMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance ToField QueueMode where toField :: QueueMode -> SQLData
toField = Text -> SQLData
forall a. ToField a => a -> SQLData
toField (Text -> SQLData) -> (QueueMode -> Text) -> QueueMode -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (QueueMode -> ByteString) -> QueueMode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueMode -> ByteString
forall a. Encoding a => a -> ByteString
smpEncode

$(JQ.deriveJSON (enumJSON $ dropPrefix "Q") ''QSubThread)

$(JQ.deriveJSON defaultJSON ''QSub)

$(JQ.deriveJSON (enumJSON $ dropPrefix "MT") ''MsgType)

$(JQ.deriveJSON defaultJSON ''MsgInfo)

$(JQ.deriveJSON defaultJSON ''QueueInfo)

instance Encoding QueueInfo where
  smpEncode :: QueueInfo -> ByteString
smpEncode = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (QueueInfo -> ByteString) -> QueueInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueueInfo -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode
  smpP :: Parser QueueInfo
smpP = ByteString -> Either String QueueInfo
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict (ByteString -> Either String QueueInfo)
-> Parser ByteString ByteString -> Parser QueueInfo
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString