servers: blocking records for content moderation (#1430)

* servers: blocking records for content moderation

* update

* encode BLOCKED as AUTH in old versions

* update

* unblock queue command

* test, status command
This commit is contained in:
Evgeny
2025-01-12 19:34:00 +00:00
committed by GitHub
parent 9d9ec8cd0b
commit 3d4e0b06c0
20 changed files with 415 additions and 94 deletions
+20 -2
View File
@@ -1,11 +1,15 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Messaging.Server.QueueStore where
import Control.Applicative ((<|>))
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Time.Clock.System (SystemTime (..), getSystemTime)
import Simplex.Messaging.Encoding.String
@@ -19,7 +23,7 @@ data QueueRec = QueueRec
senderKey :: !(Maybe SndPublicAuthKey),
sndSecure :: !SenderCanSecure,
notifier :: !(Maybe NtfCreds),
status :: !ServerQueueStatus,
status :: !ServerEntityStatus,
updatedAt :: !(Maybe RoundedSystemTime)
}
deriving (Show)
@@ -37,7 +41,21 @@ instance StrEncoding NtfCreds where
(notifierId, notifierKey, rcvNtfDhSecret) <- strP
pure NtfCreds {notifierId, notifierKey, rcvNtfDhSecret}
data ServerQueueStatus = QueueActive | QueueOff deriving (Eq, Show)
data ServerEntityStatus
= EntityActive
| EntityBlocked BlockingInfo
| EntityOff
deriving (Eq, Show)
instance StrEncoding ServerEntityStatus where
strEncode = \case
EntityActive -> "active"
EntityBlocked info -> "blocked," <> strEncode info
EntityOff -> "off"
strP =
"active" $> EntityActive
<|> "blocked," *> (EntityBlocked <$> strP)
<|> "off" $> EntityOff
newtype RoundedSystemTime = RoundedSystemTime Int64
deriving (Eq, Ord, Show)