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

module Simplex.FileTransfer.Server.Control
  ( ControlProtocol (..),
  )
where

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

data ControlProtocol
  = CPAuth BasicAuth
  | CPStatsRTS
  | CPDelete XFTPFileId
  | CPBlock XFTPFileId BlockingInfo
  | CPHelp
  | CPQuit
  | CPSkip

instance StrEncoding ControlProtocol where
  strEncode :: ControlProtocol -> ByteString
strEncode = \case
    CPAuth BasicAuth
tok -> ByteString
"auth " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BasicAuth -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode BasicAuth
tok
    ControlProtocol
CPStatsRTS -> ByteString
"stats-rts"
    CPDelete XFTPFileId
fId -> (Str, XFTPFileId) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> Str
Str ByteString
"delete", XFTPFileId
fId)
    CPBlock XFTPFileId
fId BlockingInfo
info -> (Str, XFTPFileId, BlockingInfo) -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode (ByteString -> Str
Str ByteString
"block", XFTPFileId
fId, BlockingInfo
info)
    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
"stats-rts" -> ControlProtocol -> Parser ControlProtocol
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ControlProtocol
CPStatsRTS
      ByteString
"delete" -> XFTPFileId -> ControlProtocol
CPDelete (XFTPFileId -> ControlProtocol)
-> Parser ByteString XFTPFileId -> Parser ControlProtocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString XFTPFileId
forall a. StrEncoding a => Parser a
_strP
      ByteString
"block" -> XFTPFileId -> BlockingInfo -> ControlProtocol
CPBlock (XFTPFileId -> BlockingInfo -> ControlProtocol)
-> Parser ByteString XFTPFileId
-> Parser ByteString (BlockingInfo -> ControlProtocol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString XFTPFileId
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
"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"