{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Messaging.Server.Control
  ( CPClientRole (..),
    ControlProtocol (..),
  ) where

import qualified Data.Attoparsec.ByteString.Char8 as A
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo, SenderId)

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

data ControlProtocol
  = CPAuth BasicAuth
  | CPSuspend
  | CPResume
  | CPClients
  | CPStats
  | CPStatsRTS
  | CPThreads
  | CPSockets
  | CPSocketThreads
  | CPServerInfo
  | CPDelete SenderId
  | CPStatus SenderId
  | CPBlock SenderId BlockingInfo
  | CPUnblock SenderId
  | CPSave
  | CPHelp
  | CPQuit
  | CPSkip

instance StrEncoding ControlProtocol where
  strEncode :: ControlProtocol -> ByteString
strEncode = \case
    CPAuth BasicAuth
bs -> ByteString
"auth " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BasicAuth -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode BasicAuth
bs
    ControlProtocol
CPSuspend -> ByteString
"suspend"
    ControlProtocol
CPResume -> ByteString
"resume"
    ControlProtocol
CPClients -> ByteString
"clients"
    ControlProtocol
CPStats -> ByteString
"stats"
    ControlProtocol
CPStatsRTS -> ByteString
"stats-rts"
    ControlProtocol
CPThreads -> ByteString
"threads"
    ControlProtocol
CPSockets -> ByteString
"sockets"
    ControlProtocol
CPSocketThreads -> ByteString
"socket-threads"
    ControlProtocol
CPServerInfo -> ByteString
"server-info"
    CPDelete SenderId
sId -> ByteString
"delete " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SenderId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SenderId
sId
    CPStatus SenderId
sId -> ByteString
"status " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SenderId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SenderId
sId
    CPBlock SenderId
sId BlockingInfo
info -> ByteString
"block " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SenderId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SenderId
sId ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BlockingInfo -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode BlockingInfo
info
    CPUnblock SenderId
sId -> ByteString
"unblock " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SenderId -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SenderId
sId
    ControlProtocol
CPSave -> ByteString
"save"
    ControlProtocol
CPHelp -> ByteString
"help"
    ControlProtocol
CPQuit -> ByteString
"quit"
    ControlProtocol
CPSkip -> ByteString
""
  strP :: Parser ControlProtocol
strP =
    (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString
-> (ByteString -> Parser ControlProtocol) -> Parser ControlProtocol
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
      ByteString
"auth" -> BasicAuth -> ControlProtocol
CPAuth (BasicAuth -> ControlProtocol)
-> Parser ByteString BasicAuth -> Parser ControlProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString BasicAuth
forall a. StrEncoding a => Parser a
_strP
      ByteString
"suspend" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPSuspend
      ByteString
"resume" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPResume
      ByteString
"clients" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPClients
      ByteString
"stats" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPStats
      ByteString
"stats-rts" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPStatsRTS
      ByteString
"threads" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPThreads
      ByteString
"sockets" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPSockets
      ByteString
"socket-threads" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPSocketThreads
      ByteString
"server-info" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPServerInfo
      ByteString
"delete" -> SenderId -> ControlProtocol
CPDelete (SenderId -> ControlProtocol)
-> Parser ByteString SenderId -> Parser ControlProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SenderId
forall a. StrEncoding a => Parser a
_strP
      ByteString
"status" -> SenderId -> ControlProtocol
CPStatus (SenderId -> ControlProtocol)
-> Parser ByteString SenderId -> Parser ControlProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SenderId
forall a. StrEncoding a => Parser a
_strP
      ByteString
"block" -> SenderId -> BlockingInfo -> ControlProtocol
CPBlock (SenderId -> BlockingInfo -> ControlProtocol)
-> Parser ByteString SenderId
-> Parser ByteString (BlockingInfo -> ControlProtocol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SenderId
forall a. StrEncoding a => Parser a
_strP Parser ByteString (BlockingInfo -> ControlProtocol)
-> Parser ByteString BlockingInfo -> Parser ControlProtocol
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
      ByteString
"unblock" -> SenderId -> ControlProtocol
CPUnblock (SenderId -> ControlProtocol)
-> Parser ByteString SenderId -> Parser ControlProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SenderId
forall a. StrEncoding a => Parser a
_strP
      ByteString
"save" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPSave
      ByteString
"help" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPHelp
      ByteString
"quit" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPQuit
      ByteString
"" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPSkip
      ByteString
_ -> String -> Parser ControlProtocol
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad ControlProtocol command"