Files
simplexmq/src/Simplex/Messaging/Server/Control.hs
Alexander Bondarenko efe7ce27e7 control: add delete command (#933)
* control: add delete command

* logDeleteQueue only when found

* use default StrEncoding for CPDelete arg

* move stats update from main transaction

* use size

* stabilize AUTH timing tests

* more iterations

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
2023-12-26 20:20:12 +00:00

56 lines
1.4 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Messaging.Server.Control where
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString (ByteString)
import Simplex.Messaging.Encoding.String
data ControlProtocol
= CPSuspend
| CPResume
| CPClients
| CPStats
| CPStatsRTS
| CPThreads
| CPSockets
| CPSocketThreads
| CPDelete ByteString
| CPSave
| CPHelp
| CPQuit
| CPSkip
instance StrEncoding ControlProtocol where
strEncode = \case
CPSuspend -> "suspend"
CPResume -> "resume"
CPClients -> "clients"
CPStats -> "stats"
CPStatsRTS -> "stats-rts"
CPThreads -> "threads"
CPSockets -> "sockets"
CPSocketThreads -> "socket-threads"
CPDelete bs -> "delete " <> strEncode bs
CPSave -> "save"
CPHelp -> "help"
CPQuit -> "quit"
CPSkip -> ""
strP =
A.takeTill (== ' ') >>= \case
"suspend" -> pure CPSuspend
"resume" -> pure CPResume
"clients" -> pure CPClients
"stats" -> pure CPStats
"stats-rts" -> pure CPStatsRTS
"threads" -> pure CPThreads
"sockets" -> pure CPSockets
"socket-threads" -> pure CPSocketThreads
"delete" -> CPDelete <$> (A.space *> strP)
"save" -> pure CPSave
"help" -> pure CPHelp
"quit" -> pure CPQuit
"" -> pure CPSkip
_ -> fail "bad ControlProtocol command"