{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- | This module interfaces with two protobuf libraries: protobuf and
-- proto-lens.
--
-- The protobuf library was used to manually map types from
-- github.com/wireapp/generic-message-proto/proto/otr.proto. These types are in
-- 'Wire.API.Message.Proto'.
--
-- The proto-lens library was introduced afterwards to automatically map types
-- from the above proto definition. The types are in 'Proto.Otr' of
-- wire-message-proto-lens package.
module Wire.API.Message
  ( -- * Message
    MessageMetadata (..),
    defMessageMetadata,
    NewOtrMessage (..),
    QualifiedNewOtrMessage (..),
    qualifiedNewOtrMetadata,
    protoToNewOtrMessage,

    -- * Protobuf messages
    mkQualifiedOtrPayload,

    -- * Priority
    Priority (..),

    -- * Recipients
    OtrRecipients (..),
    QualifiedOtrRecipients (..),
    protoFromOtrRecipients,
    UserClientMap (..),

    -- * Mismatch
    ClientMismatch (..),
    ClientMismatchStrategy (..),
    MessageSendingStatus (..),
    UserClients (..),
    ReportMissing (..),
    IgnoreMissing (..),
  )
where

import Control.Lens (view, (.~), (?~))
import Data.Aeson qualified as A
import Data.ByteString.Lazy qualified as LBS
import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList))
import Data.Domain (Domain, domainText, mkDomain)
import Data.Id
import Data.Json.Util
import Data.Map.Strict qualified as Map
import Data.OpenApi qualified as S
import Data.ProtoLens qualified as ProtoLens
import Data.ProtoLens.Field qualified as ProtoLens
import Data.ProtocolBuffers qualified as Protobuf
import Data.Qualified (Qualified (..))
import Data.Schema
import Data.Serialize (runGet)
import Data.Set qualified as Set
import Data.Text.Read qualified as Reader
import Data.UUID qualified as UUID
import Imports
import Proto.Otr qualified
import Proto.Otr_Fields qualified as Proto.Otr
import Servant (FromHttpApiData (..))
import Wire.API.Message.Proto qualified as Proto
import Wire.API.ServantProto (FromProto (..), ToProto (..))
import Wire.API.User.Client
import Wire.Arbitrary (Arbitrary (..), GenericUniform (..))

--------------------------------------------------------------------------------
-- Message

data MessageMetadata = MessageMetadata
  { mmNativePush :: Bool,
    mmTransient :: Bool,
    mmNativePriority :: Maybe Priority,
    mmData :: Maybe Text
  }
  deriving stock (Eq, Generic, Ord, Show)
  deriving (Arbitrary) via (GenericUniform MessageMetadata)
  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema MessageMetadata)

messageMetadataObjectSchema :: ObjectSchema SwaggerDoc MessageMetadata
messageMetadataObjectSchema =
  MessageMetadata
    <$> mmNativePush .= fmap (fromMaybe True) (optField "native_push" schema)
    <*> mmTransient .= fmap (fromMaybe False) (optField "transient" schema)
    <*> mmNativePriority .= maybe_ (optField "native_priority" schema)
    <*> mmData .= maybe_ (optField "data" schema)

instance ToSchema MessageMetadata where
  schema = object messageMetadataObjectSchema

defMessageMetadata :: MessageMetadata
defMessageMetadata =
  MessageMetadata
    { mmNativePush = True,
      mmTransient = False,
      mmNativePriority = Nothing,
      mmData = Nothing
    }

data NewOtrMessage = NewOtrMessage
  { newOtrSender :: ClientId,
    newOtrRecipients :: OtrRecipients,
    newOtrNativePush :: Bool,
    newOtrTransient :: Bool,
    newOtrNativePriority :: Maybe Priority,
    newOtrData :: Maybe Text,
    newOtrReportMissing :: Maybe [UserId]
    -- FUTUREWORK: if (and only if) clients can promise this uid list will always exactly
    -- be the list of uids we could also extract from the messages' recipients field, we
    -- should do the latter, for two reasons: (1) no need for an artificial limit on the
    -- body field length, because it'd be just a boolean; (2) less network consumption.
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform NewOtrMessage)
  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema NewOtrMessage)

newOtrMessageMetadata :: NewOtrMessage -> MessageMetadata
newOtrMessageMetadata msg =
  MessageMetadata
    (newOtrNativePush msg)
    (newOtrTransient msg)
    (newOtrNativePriority msg)
    (newOtrData msg)

instance ToSchema NewOtrMessage where
  schema =
    object $
      mk
        <$> newOtrSender .= field "sender" schema
        <*> newOtrRecipients .= field "recipients" schema
        <*> newOtrMessageMetadata .= messageMetadataObjectSchema
        <*> newOtrReportMissing .= maybe_ (optField "report_missing" (array schema))
    where
      mk :: ClientId -> OtrRecipients -> MessageMetadata -> Maybe [UserId] -> NewOtrMessage
      mk cid rcpts mm =
        NewOtrMessage
          cid
          rcpts
          (mmNativePush mm)
          (mmTransient mm)
          (mmNativePriority mm)
          (mmData mm)

instance FromProto NewOtrMessage where
  fromProto bs = protoToNewOtrMessage <$> runGet Protobuf.decodeMessage bs

protoToNewOtrMessage :: Proto.NewOtrMessage -> NewOtrMessage
protoToNewOtrMessage msg =
  NewOtrMessage
    { newOtrSender = Proto.toClientId (view Proto.newOtrMessageSender msg),
      newOtrRecipients = protoToOtrRecipients (view Proto.newOtrMessageRecipients msg),
      newOtrNativePush = view Proto.newOtrMessageNativePush msg,
      newOtrTransient = view Proto.newOtrMessageTransient msg,
      newOtrData = toBase64Text <$> view Proto.newOtrMessageData msg,
      newOtrNativePriority = protoToPriority <$> view Proto.newOtrMessageNativePriority msg,
      newOtrReportMissing = protoToReportMissing $ view Proto.newOtrMessageReportMissing msg
    }

protoToReportMissing :: [Proto.UserId] -> Maybe [UserId]
protoToReportMissing [] = Nothing
protoToReportMissing us = Just $ view Proto.userId <$> us

data QualifiedNewOtrMessage = QualifiedNewOtrMessage
  { qualifiedNewOtrSender :: ClientId,
    qualifiedNewOtrRecipients :: QualifiedOtrRecipients,
    qualifiedNewOtrNativePush :: Bool,
    qualifiedNewOtrTransient :: Bool,
    qualifiedNewOtrNativePriority :: Maybe Priority,
    qualifiedNewOtrData :: ByteString,
    qualifiedNewOtrClientMismatchStrategy :: ClientMismatchStrategy
  }
  deriving stock (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform QualifiedNewOtrMessage)

qualifiedNewOtrMetadata :: QualifiedNewOtrMessage -> MessageMetadata
qualifiedNewOtrMetadata msg =
  MessageMetadata
    { mmNativePush = qualifiedNewOtrNativePush msg,
      mmTransient = qualifiedNewOtrTransient msg,
      mmNativePriority = qualifiedNewOtrNativePriority msg,
      mmData = Just . toBase64Text $ qualifiedNewOtrData msg
    }

instance S.ToSchema QualifiedNewOtrMessage where
  declareNamedSchema _ =
    pure $
      S.NamedSchema (Just "QualifiedNewOtrMessage") $
        mempty
          & S.description
            ?~ "This object can only be parsed from Protobuf.\n\
               \The specification for the protobuf types is here: \n\
               \https://github.com/wireapp/generic-message-proto/blob/master/proto/otr.proto."

instance FromProto QualifiedNewOtrMessage where
  fromProto bs = protolensToQualifiedNewOtrMessage =<< ProtoLens.decodeMessage bs

instance ToProto QualifiedNewOtrMessage where
  toProto = ProtoLens.encodeMessage . qualifiedNewOtrMessageToProto

protolensToQualifiedNewOtrMessage :: Proto.Otr.QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
protolensToQualifiedNewOtrMessage protoMsg = do
  recipients <- protolensOtrRecipientsToOtrRecipients $ view Proto.Otr.recipients protoMsg
  strat <- protolensToClientMismatchStrategy $ view Proto.Otr.maybe'clientMismatchStrategy protoMsg
  pure $
    QualifiedNewOtrMessage
      { qualifiedNewOtrSender = protolensToClientId $ view Proto.Otr.sender protoMsg,
        qualifiedNewOtrRecipients = recipients,
        qualifiedNewOtrNativePush = view Proto.Otr.nativePush protoMsg,
        qualifiedNewOtrTransient = view Proto.Otr.transient protoMsg,
        qualifiedNewOtrNativePriority = protolensToPriority <$> view Proto.Otr.maybe'nativePriority protoMsg,
        qualifiedNewOtrData = view Proto.Otr.blob protoMsg,
        qualifiedNewOtrClientMismatchStrategy = strat
      }

protolensToClientId :: Proto.Otr.ClientId -> ClientId
protolensToClientId = ClientId . view Proto.Otr.client

qualifiedNewOtrMessageToProto :: QualifiedNewOtrMessage -> Proto.Otr.QualifiedNewOtrMessage
qualifiedNewOtrMessageToProto msg =
  ProtoLens.defMessage
    & Proto.Otr.sender .~ clientIdToProtolens (qualifiedNewOtrSender msg)
    & Proto.Otr.recipients .~ qualifiedOtrRecipientsToProtolens (qualifiedNewOtrRecipients msg)
    & Proto.Otr.blob .~ qualifiedNewOtrData msg
    & Proto.Otr.nativePush .~ qualifiedNewOtrNativePush msg
    & Proto.Otr.maybe'nativePriority .~ fmap priorityToProtolens (qualifiedNewOtrNativePriority msg)
    & Proto.Otr.transient .~ qualifiedNewOtrTransient msg
    & Proto.Otr.maybe'clientMismatchStrategy ?~ clientMismatchStrategyToProtolens (qualifiedNewOtrClientMismatchStrategy msg)

mkQualifiedOtrPayload :: ClientId -> [(Qualified UserId, ClientId, ByteString)] -> ByteString -> ClientMismatchStrategy -> Proto.Otr.QualifiedNewOtrMessage
mkQualifiedOtrPayload sender entries dat strat =
  qualifiedNewOtrMessageToProto
    QualifiedNewOtrMessage
      { qualifiedNewOtrSender = sender,
        qualifiedNewOtrRecipients = mkRecipients entries,
        qualifiedNewOtrNativePush = True,
        qualifiedNewOtrNativePriority = Nothing,
        qualifiedNewOtrTransient = False,
        qualifiedNewOtrClientMismatchStrategy = strat,
        qualifiedNewOtrData = dat
      }
  where
    mkRecipients =
      QualifiedOtrRecipients
        . QualifiedUserClientMap
        . foldr
          ( \(Qualified u d, c, t) ->
              Map.insertWith
                (Map.unionWith (<>))
                d
                (Map.singleton u (Map.singleton c t))
          )
          mempty

clientIdToProtolens :: ClientId -> Proto.Otr.ClientId
clientIdToProtolens cid =
  ProtoLens.defMessage
    & Proto.Otr.client .~ (either error fst . Reader.hexadecimal $ clientToText cid)

--------------------------------------------------------------------------------
-- Priority

-- | Native push notification priority flag.  'LowPriority' is never used, but might be in the
-- future.
--
-- @neongreen writes: [...] nobody seems to ever set `native_priority` in the client code. Exhibits
-- A1 and A2:
--
-- * <https://github.com/search?q=org%3Awireapp+native_priority&type=Code>
-- * <https://sourcegraph.com/search?q=native_priority+repo:^github\.com/wireapp/+#1>
--
-- see also: 'Wire.API.Message.Proto.Priority'.
data Priority = LowPriority | HighPriority
  deriving stock (Eq, Show, Ord, Enum, Generic)
  deriving (Arbitrary) via (GenericUniform Priority)
  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema Priority

instance ToSchema Priority where
  schema =
    enum @Text $
      mconcat
        [ element "low" LowPriority,
          element "high" HighPriority
        ]

protoToPriority :: Proto.Priority -> Priority
protoToPriority Proto.LowPriority = LowPriority
protoToPriority Proto.HighPriority = HighPriority

protolensToPriority :: Proto.Otr.Priority -> Priority
protolensToPriority = \case
  Proto.Otr.LOW_PRIORITY -> LowPriority
  Proto.Otr.HIGH_PRIORITY -> HighPriority

priorityToProtolens :: Priority -> Proto.Otr.Priority
priorityToProtolens LowPriority = Proto.Otr.LOW_PRIORITY
priorityToProtolens HighPriority = Proto.Otr.HIGH_PRIORITY

--------------------------------------------------------------------------------
-- Recipients

-- FUTUREWORK: Add ToSchema when 'NewOtrMessage' has ToSchema
newtype OtrRecipients = OtrRecipients
  { otrRecipientsMap :: UserClientMap Text
  }
  deriving stock (Eq, Show)
  deriving newtype (ToSchema, A.ToJSON, A.FromJSON, Semigroup, Monoid, Arbitrary)

protoToOtrRecipients :: [Proto.UserEntry] -> OtrRecipients
protoToOtrRecipients =
  OtrRecipients
    . UserClientMap
    . foldl' userEntries mempty
  where
    userEntries :: Map UserId (Map ClientId Text) -> Proto.UserEntry -> Map UserId (Map ClientId Text)
    userEntries acc x =
      let u = view Proto.userEntryId x
          c = view Proto.userEntryClients x
          m = foldl' clientEntries mempty c
       in Map.insert (view Proto.userId u) m acc
    clientEntries acc x =
      let c = Proto.toClientId $ view Proto.clientEntryId x
          t = toBase64Text $ view Proto.clientEntryMessage x
       in Map.insert c t acc

protoFromOtrRecipients :: OtrRecipients -> [Proto.UserEntry]
protoFromOtrRecipients rcps =
  let m = userClientMap (otrRecipientsMap rcps)
   in map mkProtoRecipient (Map.toList m)
  where
    mkProtoRecipient (usr, clts) =
      let xs = map mkClientEntry (Map.toList clts)
       in Proto.userEntry (Proto.fromUserId usr) xs
    mkClientEntry (clt, t) = Proto.clientEntry (Proto.fromClientId clt) (fromBase64TextLenient t)

newtype QualifiedOtrRecipients = QualifiedOtrRecipients
  { qualifiedOtrRecipientsMap :: QualifiedUserClientMap ByteString
  }
  deriving stock (Eq, Show)
  deriving newtype (Arbitrary)
  deriving (Semigroup, Monoid) via (QualifiedUserClientMap (First ByteString))

protolensOtrRecipientsToOtrRecipients :: [Proto.Otr.QualifiedUserEntry] -> Either String QualifiedOtrRecipients
protolensOtrRecipientsToOtrRecipients entries =
  QualifiedOtrRecipients . QualifiedUserClientMap <$> protolensToQualifiedUCMap entries
  where
    protolensToQualifiedUCMap :: [Proto.Otr.QualifiedUserEntry] -> Either String (Map Domain (Map UserId (Map ClientId ByteString)))
    protolensToQualifiedUCMap qualifiedEntries = parseMap (mkDomain . view Proto.Otr.domain) (protolensToUCMap . view Proto.Otr.entries) qualifiedEntries

    protolensToUCMap :: [Proto.Otr.UserEntry] -> Either String (Map UserId (Map ClientId ByteString))
    protolensToUCMap es = parseMap parseUserId parseClientMap es

    parseUserId :: Proto.Otr.UserEntry -> Either String UserId
    parseUserId =
      maybe (Left "Invalid UUID") (pure . Id)
        . UUID.fromByteString
        . LBS.fromStrict
        . view Proto.Otr.uuid
        . view Proto.Otr.user

    parseClientMap :: Proto.Otr.UserEntry -> Either String (Map ClientId ByteString)
    parseClientMap entry = parseMap parseClientId parseText $ view Proto.Otr.clients entry

    parseClientId :: Proto.Otr.ClientEntry -> Either String ClientId
    parseClientId = pure . protolensToClientId . view Proto.Otr.client

    parseText :: Proto.Otr.ClientEntry -> Either String ByteString
    parseText = pure . view Proto.Otr.text

qualifiedOtrRecipientsToProtolens :: QualifiedOtrRecipients -> [Proto.Otr.QualifiedUserEntry]
qualifiedOtrRecipientsToProtolens (QualifiedOtrRecipients (QualifiedUserClientMap recipients)) =
  map (uncurry quEntry) . Map.assocs $ recipients
  where
    quEntry :: Domain -> Map UserId (Map ClientId ByteString) -> Proto.Otr.QualifiedUserEntry
    quEntry domain m =
      ProtoLens.defMessage
        & Proto.Otr.domain .~ domainText domain
        & Proto.Otr.entries .~ map (uncurry uEntry) (Map.assocs m)

    uEntry :: UserId -> Map ClientId ByteString -> Proto.Otr.UserEntry
    uEntry uid m =
      ProtoLens.defMessage
        & Proto.Otr.user . Proto.Otr.uuid .~ LBS.toStrict (UUID.toByteString (toUUID uid))
        & Proto.Otr.clients .~ map (uncurry cEntry) (Map.assocs m)

    cEntry :: ClientId -> ByteString -> Proto.Otr.ClientEntry
    cEntry cid msg =
      ProtoLens.defMessage
        & Proto.Otr.client .~ clientIdToProtolens cid
        & Proto.Otr.text .~ msg

parseMap :: (Applicative f, Ord k) => (a -> f k) -> (a -> f v) -> [a] -> f (Map k v)
parseMap keyParser valueParser xs = Map.fromList <$> traverse (\x -> (,) <$> keyParser x <*> valueParser x) xs

--------------------------------------------------------------------------------
-- Filter

data ClientMismatchStrategy
  = MismatchReportAll
  | MismatchIgnoreAll
  | MismatchReportOnly (Set (Qualified UserId))
  | MismatchIgnoreOnly (Set (Qualified UserId))
  deriving (Eq, Show, Generic)
  deriving (Arbitrary) via (GenericUniform ClientMismatchStrategy)

protolensToClientMismatchStrategy :: Maybe Proto.Otr.QualifiedNewOtrMessage'ClientMismatchStrategy -> Either String ClientMismatchStrategy
protolensToClientMismatchStrategy = \case
  Nothing -> Left "ClientMismatchStrategy not specified!"
  Just (Proto.Otr.QualifiedNewOtrMessage'IgnoreAll _) -> Right MismatchIgnoreAll
  Just (Proto.Otr.QualifiedNewOtrMessage'ReportAll _) -> Right MismatchReportAll
  Just (Proto.Otr.QualifiedNewOtrMessage'IgnoreOnly ignoreOnly) -> MismatchIgnoreOnly <$> protolensToSetQualifiedUserIds ignoreOnly
  Just (Proto.Otr.QualifiedNewOtrMessage'ReportOnly reportOnly) -> MismatchReportOnly <$> protolensToSetQualifiedUserIds reportOnly

clientMismatchStrategyToProtolens ::
  ClientMismatchStrategy ->
  Proto.Otr.QualifiedNewOtrMessage'ClientMismatchStrategy
clientMismatchStrategyToProtolens = \case
  MismatchIgnoreAll ->
    Proto.Otr.QualifiedNewOtrMessage'IgnoreAll ProtoLens.defMessage
  MismatchReportAll ->
    Proto.Otr.QualifiedNewOtrMessage'ReportAll ProtoLens.defMessage
  MismatchIgnoreOnly users ->
    Proto.Otr.QualifiedNewOtrMessage'IgnoreOnly
      ( ProtoLens.defMessage
          & Proto.Otr.userIds .~ map qualifiedUserIdToProtolens (toList users)
      )
  MismatchReportOnly users ->
    Proto.Otr.QualifiedNewOtrMessage'ReportOnly
      ( ProtoLens.defMessage
          & Proto.Otr.userIds .~ map qualifiedUserIdToProtolens (toList users)
      )

protolensToSetQualifiedUserIds :: (ProtoLens.HasField s "userIds" [Proto.Otr.QualifiedUserId]) => s -> Either String (Set (Qualified UserId))
protolensToSetQualifiedUserIds = fmap Set.fromList . mapM protolensToQualifiedUserId . view Proto.Otr.userIds

protolensToQualifiedUserId :: Proto.Otr.QualifiedUserId -> Either String (Qualified UserId)
protolensToQualifiedUserId protoQuid =
  Qualified
    <$> parseIdFromText (view Proto.Otr.id protoQuid)
    <*> mkDomain (view Proto.Otr.domain protoQuid)

qualifiedUserIdToProtolens :: Qualified UserId -> Proto.Otr.QualifiedUserId
qualifiedUserIdToProtolens (Qualified uid domain) =
  ProtoLens.defMessage
    & Proto.Otr.id .~ idToText uid
    & Proto.Otr.domain .~ domainText domain

data ClientMismatch = ClientMismatch
  { cmismatchTime :: UTCTimeMillis,
    -- | Clients that the message /should/ have been encrypted for, but wasn't.
    missingClients :: UserClients,
    -- | Clients that the message /should not/ have been encrypted for, but was.
    redundantClients :: UserClients,
    deletedClients :: UserClients
  }
  deriving stock (Eq, Show, Generic)
  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ClientMismatch

instance Arbitrary ClientMismatch where
  arbitrary =
    ClientMismatch
      <$> arbitrary
      <*> arbitrary
      <*> arbitrary
      <*> arbitrary

instance ToSchema ClientMismatch where
  schema =
    object $
      ClientMismatch
        <$> cmismatchTime .= field "time" schema
        <*> missingClients .= field "missing" schema
        <*> redundantClients .= field "redundant" schema
        <*> deletedClients .= field "deleted" schema

data MessageSendingStatus = MessageSendingStatus
  { mssTime :: UTCTimeMillis,
    mssMissingClients :: QualifiedUserClients,
    mssRedundantClients :: QualifiedUserClients,
    mssDeletedClients :: QualifiedUserClients,
    mssFailedToSend :: QualifiedUserClients,
    mssFailedToConfirmClients :: QualifiedUserClients
  }
  deriving stock (Eq, Show, Generic)
  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema MessageSendingStatus

instance ToSchema MessageSendingStatus where
  schema =
    objectWithDocModifier
      (description ?~ combinedDesc)
      $ MessageSendingStatus
        <$> mssTime .= field "time" schema
        <*> mssMissingClients .= field "missing" schema
        <*> mssRedundantClients .= field "redundant" schema
        <*> mssDeletedClients .= field "deleted" schema
        <*> mssFailedToSend .= field "failed_to_send" schema
        <*> mssFailedToConfirmClients .= field "failed_to_confirm_clients" schema
    where
      combinedDesc =
        "The Proteus message sending status. It has these fields:\n\
        \- `time`: "
          <> timeDesc
          <> "\n\
             \- `missing`: "
          <> missingDesc
          <> "\n\
             \- `redundant`: "
          <> redundantDesc
          <> "\n\
             \- `deleted`: "
          <> deletedDesc
          <> "\n\
             \- `failed_to_send`: "
          <> failedToSendDesc
      timeDesc = "Time of sending message."
      missingDesc = "Clients that the message /should/ have been encrypted for, but wasn't."
      redundantDesc = "Clients that the message /should not/ have been encrypted for, but was."
      deletedDesc = "Clients that were deleted."
      failedToSendDesc =
        "When message sending fails for some clients but succeeds for others, \
        \e.g., because a remote backend is unreachable, \
        \this field will contain the list of clients for which the message sending \
        \failed. This list should be empty when message sending is not even tried, \
        \like when some clients are missing."

-- QueryParams

data IgnoreMissing
  = IgnoreMissingAll
  | IgnoreMissingList (Set UserId)
  deriving (Show, Eq)

instance S.ToParamSchema IgnoreMissing where
  toParamSchema _ = mempty & S.type_ ?~ S.OpenApiString

instance FromHttpApiData IgnoreMissing where
  parseQueryParam = \case
    "true" -> Right IgnoreMissingAll
    "false" -> Right $ IgnoreMissingList mempty
    list -> IgnoreMissingList . Set.fromList . fromCommaSeparatedList <$> parseQueryParam list

data ReportMissing
  = ReportMissingAll
  | ReportMissingList (Set UserId)

instance S.ToParamSchema ReportMissing where
  toParamSchema _ = mempty & S.type_ ?~ S.OpenApiString

instance FromHttpApiData ReportMissing where
  parseQueryParam = \case
    "true" -> Right ReportMissingAll
    "false" -> Right $ ReportMissingList mempty
    list -> ReportMissingList . Set.fromList . fromCommaSeparatedList <$> parseQueryParam list
