mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-07-21 17:43:10 +00:00
f3408d9bb6
* explicit exports * more empty exports * add exports * reorder * use correct ControlProtocol type for xftp router --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
42 lines
1.1 KiB
Haskell
42 lines
1.1 KiB
Haskell
{-# 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 = \case
|
|
CPAuth tok -> "auth " <> strEncode tok
|
|
CPStatsRTS -> "stats-rts"
|
|
CPDelete fId -> strEncode (Str "delete", fId)
|
|
CPBlock fId info -> strEncode (Str "block", fId, info)
|
|
CPHelp -> "help"
|
|
CPQuit -> "quit"
|
|
CPSkip -> ""
|
|
strP =
|
|
A.takeTill (== ' ') >>= \case
|
|
"auth" -> CPAuth <$> _strP
|
|
"stats-rts" -> pure CPStatsRTS
|
|
"delete" -> CPDelete <$> _strP
|
|
"block" -> CPBlock <$> _strP <*> _strP
|
|
"help" -> pure CPHelp
|
|
"quit" -> pure CPQuit
|
|
"" -> pure CPSkip
|
|
_ -> fail "bad ControlProtocol command"
|