{-# 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
  { MessageMetadata -> Bool
mmNativePush :: Bool,
    MessageMetadata -> Bool
mmTransient :: Bool,
    MessageMetadata -> Maybe Priority
mmNativePriority :: Maybe Priority,
    MessageMetadata -> Maybe Text
mmData :: Maybe Text
  }
  deriving stock (MessageMetadata -> MessageMetadata -> Bool
(MessageMetadata -> MessageMetadata -> Bool)
-> (MessageMetadata -> MessageMetadata -> Bool)
-> Eq MessageMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageMetadata -> MessageMetadata -> Bool
== :: MessageMetadata -> MessageMetadata -> Bool
$c/= :: MessageMetadata -> MessageMetadata -> Bool
/= :: MessageMetadata -> MessageMetadata -> Bool
Eq, (forall x. MessageMetadata -> Rep MessageMetadata x)
-> (forall x. Rep MessageMetadata x -> MessageMetadata)
-> Generic MessageMetadata
forall x. Rep MessageMetadata x -> MessageMetadata
forall x. MessageMetadata -> Rep MessageMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageMetadata -> Rep MessageMetadata x
from :: forall x. MessageMetadata -> Rep MessageMetadata x
$cto :: forall x. Rep MessageMetadata x -> MessageMetadata
to :: forall x. Rep MessageMetadata x -> MessageMetadata
Generic, Eq MessageMetadata
Eq MessageMetadata =>
(MessageMetadata -> MessageMetadata -> Ordering)
-> (MessageMetadata -> MessageMetadata -> Bool)
-> (MessageMetadata -> MessageMetadata -> Bool)
-> (MessageMetadata -> MessageMetadata -> Bool)
-> (MessageMetadata -> MessageMetadata -> Bool)
-> (MessageMetadata -> MessageMetadata -> MessageMetadata)
-> (MessageMetadata -> MessageMetadata -> MessageMetadata)
-> Ord MessageMetadata
MessageMetadata -> MessageMetadata -> Bool
MessageMetadata -> MessageMetadata -> Ordering
MessageMetadata -> MessageMetadata -> MessageMetadata
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MessageMetadata -> MessageMetadata -> Ordering
compare :: MessageMetadata -> MessageMetadata -> Ordering
$c< :: MessageMetadata -> MessageMetadata -> Bool
< :: MessageMetadata -> MessageMetadata -> Bool
$c<= :: MessageMetadata -> MessageMetadata -> Bool
<= :: MessageMetadata -> MessageMetadata -> Bool
$c> :: MessageMetadata -> MessageMetadata -> Bool
> :: MessageMetadata -> MessageMetadata -> Bool
$c>= :: MessageMetadata -> MessageMetadata -> Bool
>= :: MessageMetadata -> MessageMetadata -> Bool
$cmax :: MessageMetadata -> MessageMetadata -> MessageMetadata
max :: MessageMetadata -> MessageMetadata -> MessageMetadata
$cmin :: MessageMetadata -> MessageMetadata -> MessageMetadata
min :: MessageMetadata -> MessageMetadata -> MessageMetadata
Ord, Int -> MessageMetadata -> ShowS
[MessageMetadata] -> ShowS
MessageMetadata -> String
(Int -> MessageMetadata -> ShowS)
-> (MessageMetadata -> String)
-> ([MessageMetadata] -> ShowS)
-> Show MessageMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageMetadata -> ShowS
showsPrec :: Int -> MessageMetadata -> ShowS
$cshow :: MessageMetadata -> String
show :: MessageMetadata -> String
$cshowList :: [MessageMetadata] -> ShowS
showList :: [MessageMetadata] -> ShowS
Show)
  deriving (Gen MessageMetadata
Gen MessageMetadata
-> (MessageMetadata -> [MessageMetadata])
-> Arbitrary MessageMetadata
MessageMetadata -> [MessageMetadata]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen MessageMetadata
arbitrary :: Gen MessageMetadata
$cshrink :: MessageMetadata -> [MessageMetadata]
shrink :: MessageMetadata -> [MessageMetadata]
Arbitrary) via (GenericUniform MessageMetadata)
  deriving ([MessageMetadata] -> Value
[MessageMetadata] -> Encoding
MessageMetadata -> Value
MessageMetadata -> Encoding
(MessageMetadata -> Value)
-> (MessageMetadata -> Encoding)
-> ([MessageMetadata] -> Value)
-> ([MessageMetadata] -> Encoding)
-> ToJSON MessageMetadata
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MessageMetadata -> Value
toJSON :: MessageMetadata -> Value
$ctoEncoding :: MessageMetadata -> Encoding
toEncoding :: MessageMetadata -> Encoding
$ctoJSONList :: [MessageMetadata] -> Value
toJSONList :: [MessageMetadata] -> Value
$ctoEncodingList :: [MessageMetadata] -> Encoding
toEncodingList :: [MessageMetadata] -> Encoding
A.ToJSON, Value -> Parser [MessageMetadata]
Value -> Parser MessageMetadata
(Value -> Parser MessageMetadata)
-> (Value -> Parser [MessageMetadata]) -> FromJSON MessageMetadata
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MessageMetadata
parseJSON :: Value -> Parser MessageMetadata
$cparseJSONList :: Value -> Parser [MessageMetadata]
parseJSONList :: Value -> Parser [MessageMetadata]
A.FromJSON, Typeable MessageMetadata
Typeable MessageMetadata =>
(Proxy MessageMetadata -> Declare (Definitions Schema) NamedSchema)
-> ToSchema MessageMetadata
Proxy MessageMetadata -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy MessageMetadata -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy MessageMetadata -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema MessageMetadata)

messageMetadataObjectSchema :: ObjectSchema SwaggerDoc MessageMetadata
messageMetadataObjectSchema :: ObjectSchema SwaggerDoc MessageMetadata
messageMetadataObjectSchema =
  Bool -> Bool -> Maybe Priority -> Maybe Text -> MessageMetadata
MessageMetadata
    (Bool -> Bool -> Maybe Priority -> Maybe Text -> MessageMetadata)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageMetadata
     (Bool -> Maybe Priority -> Maybe Text -> MessageMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageMetadata -> Bool
mmNativePush (MessageMetadata -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True) (Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"native_push" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageMetadata
  (Bool -> Maybe Priority -> Maybe Text -> MessageMetadata)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageMetadata
     (Maybe Priority -> Maybe Text -> MessageMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata a
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageMetadata -> Bool
mmTransient (MessageMetadata -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] Bool a
-> SchemaP SwaggerDoc Object [Pair] Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) (Text
-> SchemaP NamedSwaggerDoc Value Value Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"transient" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageMetadata
  (Maybe Priority -> Maybe Text -> MessageMetadata)
-> SchemaP
     SwaggerDoc Object [Pair] MessageMetadata (Maybe Priority)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageMetadata
     (Maybe Text -> MessageMetadata)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata a
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageMetadata -> Maybe Priority
mmNativePriority (MessageMetadata -> Maybe Priority)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Priority) (Maybe Priority)
-> SchemaP
     SwaggerDoc Object [Pair] MessageMetadata (Maybe Priority)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Priority (Maybe Priority)
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe Priority) (Maybe Priority)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Priority Priority
-> SchemaP SwaggerDoc Object [Pair] Priority (Maybe Priority)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"native_priority" SchemaP NamedSwaggerDoc Value Value Priority Priority
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)
    SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageMetadata
  (Maybe Text -> MessageMetadata)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata (Maybe Text)
-> ObjectSchema SwaggerDoc MessageMetadata
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageMetadata (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata a
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageMetadata -> Maybe Text
mmData (MessageMetadata -> Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] MessageMetadata (Maybe Text)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
-> SchemaP SwaggerDoc Object [Pair] (Maybe Text) (Maybe Text)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text (Maybe Text)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"data" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

instance ToSchema MessageMetadata where
  schema :: ValueSchema NamedSwaggerDoc MessageMetadata
schema = Text
-> ObjectSchema SwaggerDoc MessageMetadata
-> ValueSchema NamedSwaggerDoc MessageMetadata
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"MessageMetadata" ObjectSchema SwaggerDoc MessageMetadata
messageMetadataObjectSchema

defMessageMetadata :: MessageMetadata
defMessageMetadata :: MessageMetadata
defMessageMetadata =
  MessageMetadata
    { $sel:mmNativePush:MessageMetadata :: Bool
mmNativePush = Bool
True,
      $sel:mmTransient:MessageMetadata :: Bool
mmTransient = Bool
False,
      $sel:mmNativePriority:MessageMetadata :: Maybe Priority
mmNativePriority = Maybe Priority
forall a. Maybe a
Nothing,
      $sel:mmData:MessageMetadata :: Maybe Text
mmData = Maybe Text
forall a. Maybe a
Nothing
    }

data NewOtrMessage = NewOtrMessage
  { NewOtrMessage -> ClientId
newOtrSender :: ClientId,
    NewOtrMessage -> OtrRecipients
newOtrRecipients :: OtrRecipients,
    NewOtrMessage -> Bool
newOtrNativePush :: Bool,
    NewOtrMessage -> Bool
newOtrTransient :: Bool,
    NewOtrMessage -> Maybe Priority
newOtrNativePriority :: Maybe Priority,
    NewOtrMessage -> Maybe Text
newOtrData :: Maybe Text,
    NewOtrMessage -> Maybe [UserId]
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 (NewOtrMessage -> NewOtrMessage -> Bool
(NewOtrMessage -> NewOtrMessage -> Bool)
-> (NewOtrMessage -> NewOtrMessage -> Bool) -> Eq NewOtrMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewOtrMessage -> NewOtrMessage -> Bool
== :: NewOtrMessage -> NewOtrMessage -> Bool
$c/= :: NewOtrMessage -> NewOtrMessage -> Bool
/= :: NewOtrMessage -> NewOtrMessage -> Bool
Eq, Int -> NewOtrMessage -> ShowS
[NewOtrMessage] -> ShowS
NewOtrMessage -> String
(Int -> NewOtrMessage -> ShowS)
-> (NewOtrMessage -> String)
-> ([NewOtrMessage] -> ShowS)
-> Show NewOtrMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewOtrMessage -> ShowS
showsPrec :: Int -> NewOtrMessage -> ShowS
$cshow :: NewOtrMessage -> String
show :: NewOtrMessage -> String
$cshowList :: [NewOtrMessage] -> ShowS
showList :: [NewOtrMessage] -> ShowS
Show, (forall x. NewOtrMessage -> Rep NewOtrMessage x)
-> (forall x. Rep NewOtrMessage x -> NewOtrMessage)
-> Generic NewOtrMessage
forall x. Rep NewOtrMessage x -> NewOtrMessage
forall x. NewOtrMessage -> Rep NewOtrMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewOtrMessage -> Rep NewOtrMessage x
from :: forall x. NewOtrMessage -> Rep NewOtrMessage x
$cto :: forall x. Rep NewOtrMessage x -> NewOtrMessage
to :: forall x. Rep NewOtrMessage x -> NewOtrMessage
Generic)
  deriving (Gen NewOtrMessage
Gen NewOtrMessage
-> (NewOtrMessage -> [NewOtrMessage]) -> Arbitrary NewOtrMessage
NewOtrMessage -> [NewOtrMessage]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen NewOtrMessage
arbitrary :: Gen NewOtrMessage
$cshrink :: NewOtrMessage -> [NewOtrMessage]
shrink :: NewOtrMessage -> [NewOtrMessage]
Arbitrary) via (GenericUniform NewOtrMessage)
  deriving ([NewOtrMessage] -> Value
[NewOtrMessage] -> Encoding
NewOtrMessage -> Value
NewOtrMessage -> Encoding
(NewOtrMessage -> Value)
-> (NewOtrMessage -> Encoding)
-> ([NewOtrMessage] -> Value)
-> ([NewOtrMessage] -> Encoding)
-> ToJSON NewOtrMessage
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NewOtrMessage -> Value
toJSON :: NewOtrMessage -> Value
$ctoEncoding :: NewOtrMessage -> Encoding
toEncoding :: NewOtrMessage -> Encoding
$ctoJSONList :: [NewOtrMessage] -> Value
toJSONList :: [NewOtrMessage] -> Value
$ctoEncodingList :: [NewOtrMessage] -> Encoding
toEncodingList :: [NewOtrMessage] -> Encoding
A.ToJSON, Value -> Parser [NewOtrMessage]
Value -> Parser NewOtrMessage
(Value -> Parser NewOtrMessage)
-> (Value -> Parser [NewOtrMessage]) -> FromJSON NewOtrMessage
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser NewOtrMessage
parseJSON :: Value -> Parser NewOtrMessage
$cparseJSONList :: Value -> Parser [NewOtrMessage]
parseJSONList :: Value -> Parser [NewOtrMessage]
A.FromJSON, Typeable NewOtrMessage
Typeable NewOtrMessage =>
(Proxy NewOtrMessage -> Declare (Definitions Schema) NamedSchema)
-> ToSchema NewOtrMessage
Proxy NewOtrMessage -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy NewOtrMessage -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy NewOtrMessage -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via (Schema NewOtrMessage)

newOtrMessageMetadata :: NewOtrMessage -> MessageMetadata
newOtrMessageMetadata :: NewOtrMessage -> MessageMetadata
newOtrMessageMetadata NewOtrMessage
msg =
  Bool -> Bool -> Maybe Priority -> Maybe Text -> MessageMetadata
MessageMetadata
    (NewOtrMessage -> Bool
newOtrNativePush NewOtrMessage
msg)
    (NewOtrMessage -> Bool
newOtrTransient NewOtrMessage
msg)
    (NewOtrMessage -> Maybe Priority
newOtrNativePriority NewOtrMessage
msg)
    (NewOtrMessage -> Maybe Text
newOtrData NewOtrMessage
msg)

instance ToSchema NewOtrMessage where
  schema :: ValueSchema NamedSwaggerDoc NewOtrMessage
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage NewOtrMessage
-> ValueSchema NamedSwaggerDoc NewOtrMessage
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"new-otr-message" (SchemaP SwaggerDoc Object [Pair] NewOtrMessage NewOtrMessage
 -> ValueSchema NamedSwaggerDoc NewOtrMessage)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage NewOtrMessage
-> ValueSchema NamedSwaggerDoc NewOtrMessage
forall a b. (a -> b) -> a -> b
$
      ClientId
-> OtrRecipients
-> MessageMetadata
-> Maybe [UserId]
-> NewOtrMessage
mk
        (ClientId
 -> OtrRecipients
 -> MessageMetadata
 -> Maybe [UserId]
 -> NewOtrMessage)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage ClientId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewOtrMessage
     (OtrRecipients
      -> MessageMetadata -> Maybe [UserId] -> NewOtrMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewOtrMessage -> ClientId
newOtrSender (NewOtrMessage -> ClientId)
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage ClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"sender" SchemaP NamedSwaggerDoc Value Value ClientId ClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewOtrMessage
  (OtrRecipients
   -> MessageMetadata -> Maybe [UserId] -> NewOtrMessage)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage OtrRecipients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewOtrMessage
     (MessageMetadata -> Maybe [UserId] -> NewOtrMessage)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewOtrMessage (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage a
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewOtrMessage -> OtrRecipients
newOtrRecipients (NewOtrMessage -> OtrRecipients)
-> SchemaP SwaggerDoc Object [Pair] OtrRecipients OtrRecipients
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage OtrRecipients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
-> SchemaP SwaggerDoc Object [Pair] OtrRecipients OtrRecipients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"recipients" SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewOtrMessage
  (MessageMetadata -> Maybe [UserId] -> NewOtrMessage)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage MessageMetadata
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     NewOtrMessage
     (Maybe [UserId] -> NewOtrMessage)
forall a b.
SchemaP SwaggerDoc Object [Pair] NewOtrMessage (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage a
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewOtrMessage -> MessageMetadata
newOtrMessageMetadata (NewOtrMessage -> MessageMetadata)
-> ObjectSchema SwaggerDoc MessageMetadata
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage MessageMetadata
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ObjectSchema SwaggerDoc MessageMetadata
messageMetadataObjectSchema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  NewOtrMessage
  (Maybe [UserId] -> NewOtrMessage)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage (Maybe [UserId])
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage NewOtrMessage
forall a b.
SchemaP SwaggerDoc Object [Pair] NewOtrMessage (a -> b)
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage a
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NewOtrMessage -> Maybe [UserId]
newOtrReportMissing (NewOtrMessage -> Maybe [UserId])
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe [UserId]) (Maybe [UserId])
-> SchemaP SwaggerDoc Object [Pair] NewOtrMessage (Maybe [UserId])
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP SwaggerDoc Object [Pair] [UserId] (Maybe [UserId])
-> SchemaP
     SwaggerDoc Object [Pair] (Maybe [UserId]) (Maybe [UserId])
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
-> SchemaP SwaggerDoc Object [Pair] [UserId] (Maybe [UserId])
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"report_missing" (ValueSchema NamedSwaggerDoc UserId
-> SchemaP SwaggerDoc Value Value [UserId] [UserId]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema))
    where
      mk :: ClientId -> OtrRecipients -> MessageMetadata -> Maybe [UserId] -> NewOtrMessage
      mk :: ClientId
-> OtrRecipients
-> MessageMetadata
-> Maybe [UserId]
-> NewOtrMessage
mk ClientId
cid OtrRecipients
rcpts MessageMetadata
mm =
        ClientId
-> OtrRecipients
-> Bool
-> Bool
-> Maybe Priority
-> Maybe Text
-> Maybe [UserId]
-> NewOtrMessage
NewOtrMessage
          ClientId
cid
          OtrRecipients
rcpts
          (MessageMetadata -> Bool
mmNativePush MessageMetadata
mm)
          (MessageMetadata -> Bool
mmTransient MessageMetadata
mm)
          (MessageMetadata -> Maybe Priority
mmNativePriority MessageMetadata
mm)
          (MessageMetadata -> Maybe Text
mmData MessageMetadata
mm)

instance FromProto NewOtrMessage where
  fromProto :: ByteString -> Either String NewOtrMessage
fromProto ByteString
bs = NewOtrMessage -> NewOtrMessage
protoToNewOtrMessage (NewOtrMessage -> NewOtrMessage)
-> Either String NewOtrMessage -> Either String NewOtrMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get NewOtrMessage -> ByteString -> Either String NewOtrMessage
forall a. Get a -> ByteString -> Either String a
runGet Get NewOtrMessage
forall a. Decode a => Get a
Protobuf.decodeMessage ByteString
bs

protoToNewOtrMessage :: Proto.NewOtrMessage -> NewOtrMessage
protoToNewOtrMessage :: NewOtrMessage -> NewOtrMessage
protoToNewOtrMessage NewOtrMessage
msg =
  NewOtrMessage
    { $sel:newOtrSender:NewOtrMessage :: ClientId
newOtrSender = ClientId -> ClientId
Proto.toClientId (Getting ClientId NewOtrMessage ClientId
-> NewOtrMessage -> ClientId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ClientId NewOtrMessage ClientId
forall (f :: * -> *).
Functor f =>
(ClientId -> f ClientId) -> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageSender NewOtrMessage
msg),
      $sel:newOtrRecipients:NewOtrMessage :: OtrRecipients
newOtrRecipients = [UserEntry] -> OtrRecipients
protoToOtrRecipients (Getting [UserEntry] NewOtrMessage [UserEntry]
-> NewOtrMessage -> [UserEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UserEntry] NewOtrMessage [UserEntry]
forall (f :: * -> *).
Functor f =>
([UserEntry] -> f [UserEntry]) -> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageRecipients NewOtrMessage
msg),
      $sel:newOtrNativePush:NewOtrMessage :: Bool
newOtrNativePush = Getting Bool NewOtrMessage Bool -> NewOtrMessage -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool NewOtrMessage Bool
forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageNativePush NewOtrMessage
msg,
      $sel:newOtrTransient:NewOtrMessage :: Bool
newOtrTransient = Getting Bool NewOtrMessage Bool -> NewOtrMessage -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool NewOtrMessage Bool
forall (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageTransient NewOtrMessage
msg,
      $sel:newOtrData:NewOtrMessage :: Maybe Text
newOtrData = ByteString -> Text
toBase64Text (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe ByteString) NewOtrMessage (Maybe ByteString)
-> NewOtrMessage -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) NewOtrMessage (Maybe ByteString)
forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageData NewOtrMessage
msg,
      $sel:newOtrNativePriority:NewOtrMessage :: Maybe Priority
newOtrNativePriority = Priority -> Priority
protoToPriority (Priority -> Priority) -> Maybe Priority -> Maybe Priority
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Priority) NewOtrMessage (Maybe Priority)
-> NewOtrMessage -> Maybe Priority
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Priority) NewOtrMessage (Maybe Priority)
forall (f :: * -> *).
Functor f =>
(Maybe Priority -> f (Maybe Priority))
-> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageNativePriority NewOtrMessage
msg,
      $sel:newOtrReportMissing:NewOtrMessage :: Maybe [UserId]
newOtrReportMissing = [UserId] -> Maybe [UserId]
protoToReportMissing ([UserId] -> Maybe [UserId]) -> [UserId] -> Maybe [UserId]
forall a b. (a -> b) -> a -> b
$ Getting [UserId] NewOtrMessage [UserId]
-> NewOtrMessage -> [UserId]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UserId] NewOtrMessage [UserId]
forall (f :: * -> *).
Functor f =>
([UserId] -> f [UserId]) -> NewOtrMessage -> f NewOtrMessage
Proto.newOtrMessageReportMissing NewOtrMessage
msg
    }

protoToReportMissing :: [Proto.UserId] -> Maybe [UserId]
protoToReportMissing :: [UserId] -> Maybe [UserId]
protoToReportMissing [] = Maybe [UserId]
forall a. Maybe a
Nothing
protoToReportMissing [UserId]
us = [UserId] -> Maybe [UserId]
forall a. a -> Maybe a
Just ([UserId] -> Maybe [UserId]) -> [UserId] -> Maybe [UserId]
forall a b. (a -> b) -> a -> b
$ Getting UserId UserId UserId -> UserId -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId UserId UserId
forall (f :: * -> *).
Functor f =>
(UserId -> f UserId) -> UserId -> f UserId
Proto.userId (UserId -> UserId) -> [UserId] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
us

data QualifiedNewOtrMessage = QualifiedNewOtrMessage
  { QualifiedNewOtrMessage -> ClientId
qualifiedNewOtrSender :: ClientId,
    QualifiedNewOtrMessage -> QualifiedOtrRecipients
qualifiedNewOtrRecipients :: QualifiedOtrRecipients,
    QualifiedNewOtrMessage -> Bool
qualifiedNewOtrNativePush :: Bool,
    QualifiedNewOtrMessage -> Bool
qualifiedNewOtrTransient :: Bool,
    QualifiedNewOtrMessage -> Maybe Priority
qualifiedNewOtrNativePriority :: Maybe Priority,
    QualifiedNewOtrMessage -> ByteString
qualifiedNewOtrData :: ByteString,
    QualifiedNewOtrMessage -> ClientMismatchStrategy
qualifiedNewOtrClientMismatchStrategy :: ClientMismatchStrategy
  }
  deriving stock (QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool
(QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool)
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool)
-> Eq QualifiedNewOtrMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool
== :: QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool
$c/= :: QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool
/= :: QualifiedNewOtrMessage -> QualifiedNewOtrMessage -> Bool
Eq, Int -> QualifiedNewOtrMessage -> ShowS
[QualifiedNewOtrMessage] -> ShowS
QualifiedNewOtrMessage -> String
(Int -> QualifiedNewOtrMessage -> ShowS)
-> (QualifiedNewOtrMessage -> String)
-> ([QualifiedNewOtrMessage] -> ShowS)
-> Show QualifiedNewOtrMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedNewOtrMessage -> ShowS
showsPrec :: Int -> QualifiedNewOtrMessage -> ShowS
$cshow :: QualifiedNewOtrMessage -> String
show :: QualifiedNewOtrMessage -> String
$cshowList :: [QualifiedNewOtrMessage] -> ShowS
showList :: [QualifiedNewOtrMessage] -> ShowS
Show, (forall x. QualifiedNewOtrMessage -> Rep QualifiedNewOtrMessage x)
-> (forall x.
    Rep QualifiedNewOtrMessage x -> QualifiedNewOtrMessage)
-> Generic QualifiedNewOtrMessage
forall x. Rep QualifiedNewOtrMessage x -> QualifiedNewOtrMessage
forall x. QualifiedNewOtrMessage -> Rep QualifiedNewOtrMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. QualifiedNewOtrMessage -> Rep QualifiedNewOtrMessage x
from :: forall x. QualifiedNewOtrMessage -> Rep QualifiedNewOtrMessage x
$cto :: forall x. Rep QualifiedNewOtrMessage x -> QualifiedNewOtrMessage
to :: forall x. Rep QualifiedNewOtrMessage x -> QualifiedNewOtrMessage
Generic)
  deriving (Gen QualifiedNewOtrMessage
Gen QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> [QualifiedNewOtrMessage])
-> Arbitrary QualifiedNewOtrMessage
QualifiedNewOtrMessage -> [QualifiedNewOtrMessage]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen QualifiedNewOtrMessage
arbitrary :: Gen QualifiedNewOtrMessage
$cshrink :: QualifiedNewOtrMessage -> [QualifiedNewOtrMessage]
shrink :: QualifiedNewOtrMessage -> [QualifiedNewOtrMessage]
Arbitrary) via (GenericUniform QualifiedNewOtrMessage)

qualifiedNewOtrMetadata :: QualifiedNewOtrMessage -> MessageMetadata
qualifiedNewOtrMetadata :: QualifiedNewOtrMessage -> MessageMetadata
qualifiedNewOtrMetadata QualifiedNewOtrMessage
msg =
  MessageMetadata
    { $sel:mmNativePush:MessageMetadata :: Bool
mmNativePush = QualifiedNewOtrMessage -> Bool
qualifiedNewOtrNativePush QualifiedNewOtrMessage
msg,
      $sel:mmTransient:MessageMetadata :: Bool
mmTransient = QualifiedNewOtrMessage -> Bool
qualifiedNewOtrTransient QualifiedNewOtrMessage
msg,
      $sel:mmNativePriority:MessageMetadata :: Maybe Priority
mmNativePriority = QualifiedNewOtrMessage -> Maybe Priority
qualifiedNewOtrNativePriority QualifiedNewOtrMessage
msg,
      $sel:mmData:MessageMetadata :: Maybe Text
mmData = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
toBase64Text (ByteString -> Maybe Text) -> ByteString -> Maybe Text
forall a b. (a -> b) -> a -> b
$ QualifiedNewOtrMessage -> ByteString
qualifiedNewOtrData QualifiedNewOtrMessage
msg
    }

instance S.ToSchema QualifiedNewOtrMessage where
  declareNamedSchema :: Proxy QualifiedNewOtrMessage
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy QualifiedNewOtrMessage
_ =
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"QualifiedNewOtrMessage") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description
            ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"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 :: ByteString -> Either String QualifiedNewOtrMessage
fromProto ByteString
bs = QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
protolensToQualifiedNewOtrMessage (QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage)
-> Either String QualifiedNewOtrMessage
-> Either String QualifiedNewOtrMessage
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String QualifiedNewOtrMessage
forall msg. Message msg => ByteString -> Either String msg
ProtoLens.decodeMessage ByteString
bs

instance ToProto QualifiedNewOtrMessage where
  toProto :: QualifiedNewOtrMessage -> ByteString
toProto = QualifiedNewOtrMessage -> ByteString
forall msg. Message msg => msg -> ByteString
ProtoLens.encodeMessage (QualifiedNewOtrMessage -> ByteString)
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedNewOtrMessage -> QualifiedNewOtrMessage
qualifiedNewOtrMessageToProto

protolensToQualifiedNewOtrMessage :: Proto.Otr.QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
protolensToQualifiedNewOtrMessage :: QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
protolensToQualifiedNewOtrMessage QualifiedNewOtrMessage
protoMsg = do
  QualifiedOtrRecipients
recipients <- [QualifiedUserEntry] -> Either String QualifiedOtrRecipients
protolensOtrRecipientsToOtrRecipients ([QualifiedUserEntry] -> Either String QualifiedOtrRecipients)
-> [QualifiedUserEntry] -> Either String QualifiedOtrRecipients
forall a b. (a -> b) -> a -> b
$ Getting
  [QualifiedUserEntry] QualifiedNewOtrMessage [QualifiedUserEntry]
-> QualifiedNewOtrMessage -> [QualifiedUserEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [QualifiedUserEntry] QualifiedNewOtrMessage [QualifiedUserEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "recipients" a) =>
LensLike' f s a
Proto.Otr.recipients QualifiedNewOtrMessage
protoMsg
  ClientMismatchStrategy
strat <- Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
-> Either String ClientMismatchStrategy
protolensToClientMismatchStrategy (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
 -> Either String ClientMismatchStrategy)
-> Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
-> Either String ClientMismatchStrategy
forall a b. (a -> b) -> a -> b
$ Getting
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
  QualifiedNewOtrMessage
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
-> QualifiedNewOtrMessage
-> Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
  QualifiedNewOtrMessage
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'clientMismatchStrategy" a) =>
LensLike' f s a
Proto.Otr.maybe'clientMismatchStrategy QualifiedNewOtrMessage
protoMsg
  QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage -> Either String QualifiedNewOtrMessage
forall a b. (a -> b) -> a -> b
$
    QualifiedNewOtrMessage
      { $sel:qualifiedNewOtrSender:QualifiedNewOtrMessage :: ClientId
qualifiedNewOtrSender = ClientId -> ClientId
protolensToClientId (ClientId -> ClientId) -> ClientId -> ClientId
forall a b. (a -> b) -> a -> b
$ Getting ClientId QualifiedNewOtrMessage ClientId
-> QualifiedNewOtrMessage -> ClientId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ClientId QualifiedNewOtrMessage ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "sender" a) =>
LensLike' f s a
Proto.Otr.sender QualifiedNewOtrMessage
protoMsg,
        $sel:qualifiedNewOtrRecipients:QualifiedNewOtrMessage :: QualifiedOtrRecipients
qualifiedNewOtrRecipients = QualifiedOtrRecipients
recipients,
        $sel:qualifiedNewOtrNativePush:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrNativePush = Getting Bool QualifiedNewOtrMessage Bool
-> QualifiedNewOtrMessage -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool QualifiedNewOtrMessage Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "nativePush" a) =>
LensLike' f s a
Proto.Otr.nativePush QualifiedNewOtrMessage
protoMsg,
        $sel:qualifiedNewOtrTransient:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrTransient = Getting Bool QualifiedNewOtrMessage Bool
-> QualifiedNewOtrMessage -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool QualifiedNewOtrMessage Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "transient" a) =>
LensLike' f s a
Proto.Otr.transient QualifiedNewOtrMessage
protoMsg,
        $sel:qualifiedNewOtrNativePriority:QualifiedNewOtrMessage :: Maybe Priority
qualifiedNewOtrNativePriority = Priority -> Priority
protolensToPriority (Priority -> Priority) -> Maybe Priority -> Maybe Priority
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Priority) QualifiedNewOtrMessage (Maybe Priority)
-> QualifiedNewOtrMessage -> Maybe Priority
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Priority) QualifiedNewOtrMessage (Maybe Priority)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nativePriority" a) =>
LensLike' f s a
Proto.Otr.maybe'nativePriority QualifiedNewOtrMessage
protoMsg,
        $sel:qualifiedNewOtrData:QualifiedNewOtrMessage :: ByteString
qualifiedNewOtrData = Getting ByteString QualifiedNewOtrMessage ByteString
-> QualifiedNewOtrMessage -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString QualifiedNewOtrMessage ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "blob" a) =>
LensLike' f s a
Proto.Otr.blob QualifiedNewOtrMessage
protoMsg,
        $sel:qualifiedNewOtrClientMismatchStrategy:QualifiedNewOtrMessage :: ClientMismatchStrategy
qualifiedNewOtrClientMismatchStrategy = ClientMismatchStrategy
strat
      }

protolensToClientId :: Proto.Otr.ClientId -> ClientId
protolensToClientId :: ClientId -> ClientId
protolensToClientId = Word64 -> ClientId
ClientId (Word64 -> ClientId)
-> (ClientId -> Word64) -> ClientId -> ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word64 ClientId Word64 -> ClientId -> Word64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Word64 ClientId Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.Otr.client

qualifiedNewOtrMessageToProto :: QualifiedNewOtrMessage -> Proto.Otr.QualifiedNewOtrMessage
qualifiedNewOtrMessageToProto :: QualifiedNewOtrMessage -> QualifiedNewOtrMessage
qualifiedNewOtrMessageToProto QualifiedNewOtrMessage
msg =
  QualifiedNewOtrMessage
forall msg. Message msg => msg
ProtoLens.defMessage
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "sender" a) =>
LensLike' f s a
Proto.Otr.sender LensLike' Identity QualifiedNewOtrMessage ClientId
-> ClientId -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientId -> ClientId
clientIdToProtolens (QualifiedNewOtrMessage -> ClientId
qualifiedNewOtrSender QualifiedNewOtrMessage
msg)
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage [QualifiedUserEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "recipients" a) =>
LensLike' f s a
Proto.Otr.recipients LensLike' Identity QualifiedNewOtrMessage [QualifiedUserEntry]
-> [QualifiedUserEntry]
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ QualifiedOtrRecipients -> [QualifiedUserEntry]
qualifiedOtrRecipientsToProtolens (QualifiedNewOtrMessage -> QualifiedOtrRecipients
qualifiedNewOtrRecipients QualifiedNewOtrMessage
msg)
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "blob" a) =>
LensLike' f s a
Proto.Otr.blob LensLike' Identity QualifiedNewOtrMessage ByteString
-> ByteString -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ QualifiedNewOtrMessage -> ByteString
qualifiedNewOtrData QualifiedNewOtrMessage
msg
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "nativePush" a) =>
LensLike' f s a
Proto.Otr.nativePush LensLike' Identity QualifiedNewOtrMessage Bool
-> Bool -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ QualifiedNewOtrMessage -> Bool
qualifiedNewOtrNativePush QualifiedNewOtrMessage
msg
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage (Maybe Priority)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nativePriority" a) =>
LensLike' f s a
Proto.Otr.maybe'nativePriority LensLike' Identity QualifiedNewOtrMessage (Maybe Priority)
-> Maybe Priority
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Priority -> Priority) -> Maybe Priority -> Maybe Priority
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Priority -> Priority
priorityToProtolens (QualifiedNewOtrMessage -> Maybe Priority
qualifiedNewOtrNativePriority QualifiedNewOtrMessage
msg)
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedNewOtrMessage Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "transient" a) =>
LensLike' f s a
Proto.Otr.transient LensLike' Identity QualifiedNewOtrMessage Bool
-> Bool -> QualifiedNewOtrMessage -> QualifiedNewOtrMessage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ QualifiedNewOtrMessage -> Bool
qualifiedNewOtrTransient QualifiedNewOtrMessage
msg
    QualifiedNewOtrMessage
-> (QualifiedNewOtrMessage -> QualifiedNewOtrMessage)
-> QualifiedNewOtrMessage
forall a b. a -> (a -> b) -> b
& LensLike'
  Identity
  QualifiedNewOtrMessage
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'clientMismatchStrategy" a) =>
LensLike' f s a
Proto.Otr.maybe'clientMismatchStrategy LensLike'
  Identity
  QualifiedNewOtrMessage
  (Maybe QualifiedNewOtrMessage'ClientMismatchStrategy)
-> QualifiedNewOtrMessage'ClientMismatchStrategy
-> QualifiedNewOtrMessage
-> QualifiedNewOtrMessage
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ClientMismatchStrategy
-> QualifiedNewOtrMessage'ClientMismatchStrategy
clientMismatchStrategyToProtolens (QualifiedNewOtrMessage -> ClientMismatchStrategy
qualifiedNewOtrClientMismatchStrategy QualifiedNewOtrMessage
msg)

mkQualifiedOtrPayload :: ClientId -> [(Qualified UserId, ClientId, ByteString)] -> ByteString -> ClientMismatchStrategy -> Proto.Otr.QualifiedNewOtrMessage
mkQualifiedOtrPayload :: ClientId
-> [(Qualified UserId, ClientId, ByteString)]
-> ByteString
-> ClientMismatchStrategy
-> QualifiedNewOtrMessage
mkQualifiedOtrPayload ClientId
sender [(Qualified UserId, ClientId, ByteString)]
entries ByteString
dat ClientMismatchStrategy
strat =
  QualifiedNewOtrMessage -> QualifiedNewOtrMessage
qualifiedNewOtrMessageToProto
    QualifiedNewOtrMessage
      { $sel:qualifiedNewOtrSender:QualifiedNewOtrMessage :: ClientId
qualifiedNewOtrSender = ClientId
sender,
        $sel:qualifiedNewOtrRecipients:QualifiedNewOtrMessage :: QualifiedOtrRecipients
qualifiedNewOtrRecipients = [(Qualified UserId, ClientId, ByteString)]
-> QualifiedOtrRecipients
mkRecipients [(Qualified UserId, ClientId, ByteString)]
entries,
        $sel:qualifiedNewOtrNativePush:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrNativePush = Bool
True,
        $sel:qualifiedNewOtrNativePriority:QualifiedNewOtrMessage :: Maybe Priority
qualifiedNewOtrNativePriority = Maybe Priority
forall a. Maybe a
Nothing,
        $sel:qualifiedNewOtrTransient:QualifiedNewOtrMessage :: Bool
qualifiedNewOtrTransient = Bool
False,
        $sel:qualifiedNewOtrClientMismatchStrategy:QualifiedNewOtrMessage :: ClientMismatchStrategy
qualifiedNewOtrClientMismatchStrategy = ClientMismatchStrategy
strat,
        $sel:qualifiedNewOtrData:QualifiedNewOtrMessage :: ByteString
qualifiedNewOtrData = ByteString
dat
      }
  where
    mkRecipients :: [(Qualified UserId, ClientId, ByteString)]
-> QualifiedOtrRecipients
mkRecipients =
      QualifiedUserClientMap ByteString -> QualifiedOtrRecipients
QualifiedOtrRecipients
        (QualifiedUserClientMap ByteString -> QualifiedOtrRecipients)
-> ([(Qualified UserId, ClientId, ByteString)]
    -> QualifiedUserClientMap ByteString)
-> [(Qualified UserId, ClientId, ByteString)]
-> QualifiedOtrRecipients
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Domain (Map UserId (Map ClientId ByteString))
-> QualifiedUserClientMap ByteString
forall a.
Map Domain (Map UserId (Map ClientId a))
-> QualifiedUserClientMap a
QualifiedUserClientMap
        (Map Domain (Map UserId (Map ClientId ByteString))
 -> QualifiedUserClientMap ByteString)
-> ([(Qualified UserId, ClientId, ByteString)]
    -> Map Domain (Map UserId (Map ClientId ByteString)))
-> [(Qualified UserId, ClientId, ByteString)]
-> QualifiedUserClientMap ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Qualified UserId, ClientId, ByteString)
 -> Map Domain (Map UserId (Map ClientId ByteString))
 -> Map Domain (Map UserId (Map ClientId ByteString)))
-> Map Domain (Map UserId (Map ClientId ByteString))
-> [(Qualified UserId, ClientId, ByteString)]
-> Map Domain (Map UserId (Map ClientId ByteString))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          ( \(Qualified UserId
u Domain
d, ClientId
c, ByteString
t) ->
              (Map UserId (Map ClientId ByteString)
 -> Map UserId (Map ClientId ByteString)
 -> Map UserId (Map ClientId ByteString))
-> Domain
-> Map UserId (Map ClientId ByteString)
-> Map Domain (Map UserId (Map ClientId ByteString))
-> Map Domain (Map UserId (Map ClientId ByteString))
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
                ((Map ClientId ByteString
 -> Map ClientId ByteString -> Map ClientId ByteString)
-> Map UserId (Map ClientId ByteString)
-> Map UserId (Map ClientId ByteString)
-> Map UserId (Map ClientId ByteString)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Map ClientId ByteString
-> Map ClientId ByteString -> Map ClientId ByteString
forall a. Semigroup a => a -> a -> a
(<>))
                Domain
d
                (UserId
-> Map ClientId ByteString -> Map UserId (Map ClientId ByteString)
forall k a. k -> a -> Map k a
Map.singleton UserId
u (ClientId -> ByteString -> Map ClientId ByteString
forall k a. k -> a -> Map k a
Map.singleton ClientId
c ByteString
t))
          )
          Map Domain (Map UserId (Map ClientId ByteString))
forall a. Monoid a => a
mempty

clientIdToProtolens :: ClientId -> Proto.Otr.ClientId
clientIdToProtolens :: ClientId -> ClientId
clientIdToProtolens ClientId
cid =
  ClientId
forall msg. Message msg => msg
ProtoLens.defMessage
    ClientId -> (ClientId -> ClientId) -> ClientId
forall a b. a -> (a -> b) -> b
& LensLike' Identity ClientId Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.Otr.client LensLike' Identity ClientId Word64
-> Word64 -> ClientId -> ClientId
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((String -> Word64)
-> ((Word64, Text) -> Word64)
-> Either String (Word64, Text)
-> Word64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Word64
forall a. HasCallStack => String -> a
error (Word64, Text) -> Word64
forall a b. (a, b) -> a
fst (Either String (Word64, Text) -> Word64)
-> (Text -> Either String (Word64, Text)) -> Text -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Word64, Text)
forall a. Integral a => Reader a
Reader.hexadecimal (Text -> Word64) -> Text -> Word64
forall a b. (a -> b) -> a -> b
$ ClientId -> Text
clientToText ClientId
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 (Priority -> Priority -> Bool
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
/= :: Priority -> Priority -> Bool
Eq, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Priority -> ShowS
showsPrec :: Int -> Priority -> ShowS
$cshow :: Priority -> String
show :: Priority -> String
$cshowList :: [Priority] -> ShowS
showList :: [Priority] -> ShowS
Show, Eq Priority
Eq Priority =>
(Priority -> Priority -> Ordering)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Priority)
-> (Priority -> Priority -> Priority)
-> Ord Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Priority -> Priority -> Ordering
compare :: Priority -> Priority -> Ordering
$c< :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
>= :: Priority -> Priority -> Bool
$cmax :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
min :: Priority -> Priority -> Priority
Ord, Int -> Priority
Priority -> Int
Priority -> [Priority]
Priority -> Priority
Priority -> Priority -> [Priority]
Priority -> Priority -> Priority -> [Priority]
(Priority -> Priority)
-> (Priority -> Priority)
-> (Int -> Priority)
-> (Priority -> Int)
-> (Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> [Priority])
-> (Priority -> Priority -> Priority -> [Priority])
-> Enum Priority
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Priority -> Priority
succ :: Priority -> Priority
$cpred :: Priority -> Priority
pred :: Priority -> Priority
$ctoEnum :: Int -> Priority
toEnum :: Int -> Priority
$cfromEnum :: Priority -> Int
fromEnum :: Priority -> Int
$cenumFrom :: Priority -> [Priority]
enumFrom :: Priority -> [Priority]
$cenumFromThen :: Priority -> Priority -> [Priority]
enumFromThen :: Priority -> Priority -> [Priority]
$cenumFromTo :: Priority -> Priority -> [Priority]
enumFromTo :: Priority -> Priority -> [Priority]
$cenumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
enumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
Enum, (forall x. Priority -> Rep Priority x)
-> (forall x. Rep Priority x -> Priority) -> Generic Priority
forall x. Rep Priority x -> Priority
forall x. Priority -> Rep Priority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Priority -> Rep Priority x
from :: forall x. Priority -> Rep Priority x
$cto :: forall x. Rep Priority x -> Priority
to :: forall x. Rep Priority x -> Priority
Generic)
  deriving (Gen Priority
Gen Priority -> (Priority -> [Priority]) -> Arbitrary Priority
Priority -> [Priority]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Priority
arbitrary :: Gen Priority
$cshrink :: Priority -> [Priority]
shrink :: Priority -> [Priority]
Arbitrary) via (GenericUniform Priority)
  deriving ([Priority] -> Value
[Priority] -> Encoding
Priority -> Value
Priority -> Encoding
(Priority -> Value)
-> (Priority -> Encoding)
-> ([Priority] -> Value)
-> ([Priority] -> Encoding)
-> ToJSON Priority
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Priority -> Value
toJSON :: Priority -> Value
$ctoEncoding :: Priority -> Encoding
toEncoding :: Priority -> Encoding
$ctoJSONList :: [Priority] -> Value
toJSONList :: [Priority] -> Value
$ctoEncodingList :: [Priority] -> Encoding
toEncodingList :: [Priority] -> Encoding
A.ToJSON, Value -> Parser [Priority]
Value -> Parser Priority
(Value -> Parser Priority)
-> (Value -> Parser [Priority]) -> FromJSON Priority
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Priority
parseJSON :: Value -> Parser Priority
$cparseJSONList :: Value -> Parser [Priority]
parseJSONList :: Value -> Parser [Priority]
A.FromJSON, Typeable Priority
Typeable Priority =>
(Proxy Priority -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Priority
Proxy Priority -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Priority -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Priority -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Priority

instance ToSchema Priority where
  schema :: SchemaP NamedSwaggerDoc Value Value Priority Priority
schema =
    forall v doc a b.
(With v, HasEnum v doc) =>
Text
-> SchemaP [Value] v (Alt Maybe v) a b
-> SchemaP doc Value Value a b
enum @Text Text
"Priority" (SchemaP [Value] Text (Alt Maybe Text) Priority Priority
 -> SchemaP NamedSwaggerDoc Value Value Priority Priority)
-> SchemaP [Value] Text (Alt Maybe Text) Priority Priority
-> SchemaP NamedSwaggerDoc Value Value Priority Priority
forall a b. (a -> b) -> a -> b
$
      [SchemaP [Value] Text (Alt Maybe Text) Priority Priority]
-> SchemaP [Value] Text (Alt Maybe Text) Priority Priority
forall a. Monoid a => [a] -> a
mconcat
        [ Text
-> Priority
-> SchemaP [Value] Text (Alt Maybe Text) Priority Priority
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"low" Priority
LowPriority,
          Text
-> Priority
-> SchemaP [Value] Text (Alt Maybe Text) Priority Priority
forall a b.
(ToJSON a, Eq a, Eq b) =>
a -> b -> SchemaP [Value] a (Alt Maybe a) b b
element Text
"high" Priority
HighPriority
        ]

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

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

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

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

-- FUTUREWORK: Add ToSchema when 'NewOtrMessage' has ToSchema
newtype OtrRecipients = OtrRecipients
  { OtrRecipients -> UserClientMap Text
otrRecipientsMap :: UserClientMap Text
  }
  deriving stock (OtrRecipients -> OtrRecipients -> Bool
(OtrRecipients -> OtrRecipients -> Bool)
-> (OtrRecipients -> OtrRecipients -> Bool) -> Eq OtrRecipients
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OtrRecipients -> OtrRecipients -> Bool
== :: OtrRecipients -> OtrRecipients -> Bool
$c/= :: OtrRecipients -> OtrRecipients -> Bool
/= :: OtrRecipients -> OtrRecipients -> Bool
Eq, Int -> OtrRecipients -> ShowS
[OtrRecipients] -> ShowS
OtrRecipients -> String
(Int -> OtrRecipients -> ShowS)
-> (OtrRecipients -> String)
-> ([OtrRecipients] -> ShowS)
-> Show OtrRecipients
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OtrRecipients -> ShowS
showsPrec :: Int -> OtrRecipients -> ShowS
$cshow :: OtrRecipients -> String
show :: OtrRecipients -> String
$cshowList :: [OtrRecipients] -> ShowS
showList :: [OtrRecipients] -> ShowS
Show)
  deriving newtype (SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
-> ToSchema OtrRecipients
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
schema :: SchemaP NamedSwaggerDoc Value Value OtrRecipients OtrRecipients
ToSchema, [OtrRecipients] -> Value
[OtrRecipients] -> Encoding
OtrRecipients -> Value
OtrRecipients -> Encoding
(OtrRecipients -> Value)
-> (OtrRecipients -> Encoding)
-> ([OtrRecipients] -> Value)
-> ([OtrRecipients] -> Encoding)
-> ToJSON OtrRecipients
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: OtrRecipients -> Value
toJSON :: OtrRecipients -> Value
$ctoEncoding :: OtrRecipients -> Encoding
toEncoding :: OtrRecipients -> Encoding
$ctoJSONList :: [OtrRecipients] -> Value
toJSONList :: [OtrRecipients] -> Value
$ctoEncodingList :: [OtrRecipients] -> Encoding
toEncodingList :: [OtrRecipients] -> Encoding
A.ToJSON, Value -> Parser [OtrRecipients]
Value -> Parser OtrRecipients
(Value -> Parser OtrRecipients)
-> (Value -> Parser [OtrRecipients]) -> FromJSON OtrRecipients
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser OtrRecipients
parseJSON :: Value -> Parser OtrRecipients
$cparseJSONList :: Value -> Parser [OtrRecipients]
parseJSONList :: Value -> Parser [OtrRecipients]
A.FromJSON, NonEmpty OtrRecipients -> OtrRecipients
OtrRecipients -> OtrRecipients -> OtrRecipients
(OtrRecipients -> OtrRecipients -> OtrRecipients)
-> (NonEmpty OtrRecipients -> OtrRecipients)
-> (forall b. Integral b => b -> OtrRecipients -> OtrRecipients)
-> Semigroup OtrRecipients
forall b. Integral b => b -> OtrRecipients -> OtrRecipients
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: OtrRecipients -> OtrRecipients -> OtrRecipients
<> :: OtrRecipients -> OtrRecipients -> OtrRecipients
$csconcat :: NonEmpty OtrRecipients -> OtrRecipients
sconcat :: NonEmpty OtrRecipients -> OtrRecipients
$cstimes :: forall b. Integral b => b -> OtrRecipients -> OtrRecipients
stimes :: forall b. Integral b => b -> OtrRecipients -> OtrRecipients
Semigroup, Semigroup OtrRecipients
OtrRecipients
Semigroup OtrRecipients =>
OtrRecipients
-> (OtrRecipients -> OtrRecipients -> OtrRecipients)
-> ([OtrRecipients] -> OtrRecipients)
-> Monoid OtrRecipients
[OtrRecipients] -> OtrRecipients
OtrRecipients -> OtrRecipients -> OtrRecipients
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: OtrRecipients
mempty :: OtrRecipients
$cmappend :: OtrRecipients -> OtrRecipients -> OtrRecipients
mappend :: OtrRecipients -> OtrRecipients -> OtrRecipients
$cmconcat :: [OtrRecipients] -> OtrRecipients
mconcat :: [OtrRecipients] -> OtrRecipients
Monoid, Gen OtrRecipients
Gen OtrRecipients
-> (OtrRecipients -> [OtrRecipients]) -> Arbitrary OtrRecipients
OtrRecipients -> [OtrRecipients]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen OtrRecipients
arbitrary :: Gen OtrRecipients
$cshrink :: OtrRecipients -> [OtrRecipients]
shrink :: OtrRecipients -> [OtrRecipients]
Arbitrary)

protoToOtrRecipients :: [Proto.UserEntry] -> OtrRecipients
protoToOtrRecipients :: [UserEntry] -> OtrRecipients
protoToOtrRecipients =
  UserClientMap Text -> OtrRecipients
OtrRecipients
    (UserClientMap Text -> OtrRecipients)
-> ([UserEntry] -> UserClientMap Text)
-> [UserEntry]
-> OtrRecipients
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UserId (Map ClientId Text) -> UserClientMap Text
forall a. Map UserId (Map ClientId a) -> UserClientMap a
UserClientMap
    (Map UserId (Map ClientId Text) -> UserClientMap Text)
-> ([UserEntry] -> Map UserId (Map ClientId Text))
-> [UserEntry]
-> UserClientMap Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map UserId (Map ClientId Text)
 -> UserEntry -> Map UserId (Map ClientId Text))
-> Map UserId (Map ClientId Text)
-> [UserEntry]
-> Map UserId (Map ClientId Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map UserId (Map ClientId Text)
-> UserEntry -> Map UserId (Map ClientId Text)
userEntries Map UserId (Map ClientId Text)
forall a. Monoid a => a
mempty
  where
    userEntries :: Map UserId (Map ClientId Text) -> Proto.UserEntry -> Map UserId (Map ClientId Text)
    userEntries :: Map UserId (Map ClientId Text)
-> UserEntry -> Map UserId (Map ClientId Text)
userEntries Map UserId (Map ClientId Text)
acc UserEntry
x =
      let u :: UserId
u = Getting UserId UserEntry UserId -> UserEntry -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId UserEntry UserId
forall (f :: * -> *).
Functor f =>
(UserId -> f UserId) -> UserEntry -> f UserEntry
Proto.userEntryId UserEntry
x
          c :: [ClientEntry]
c = Getting [ClientEntry] UserEntry [ClientEntry]
-> UserEntry -> [ClientEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ClientEntry] UserEntry [ClientEntry]
forall (f :: * -> *).
Functor f =>
([ClientEntry] -> f [ClientEntry]) -> UserEntry -> f UserEntry
Proto.userEntryClients UserEntry
x
          m :: Map ClientId Text
m = (Map ClientId Text -> ClientEntry -> Map ClientId Text)
-> Map ClientId Text -> [ClientEntry] -> Map ClientId Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map ClientId Text -> ClientEntry -> Map ClientId Text
clientEntries Map ClientId Text
forall a. Monoid a => a
mempty [ClientEntry]
c
       in UserId
-> Map ClientId Text
-> Map UserId (Map ClientId Text)
-> Map UserId (Map ClientId Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Getting UserId UserId UserId -> UserId -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId UserId UserId
forall (f :: * -> *).
Functor f =>
(UserId -> f UserId) -> UserId -> f UserId
Proto.userId UserId
u) Map ClientId Text
m Map UserId (Map ClientId Text)
acc
    clientEntries :: Map ClientId Text -> ClientEntry -> Map ClientId Text
clientEntries Map ClientId Text
acc ClientEntry
x =
      let c :: ClientId
c = ClientId -> ClientId
Proto.toClientId (ClientId -> ClientId) -> ClientId -> ClientId
forall a b. (a -> b) -> a -> b
$ Getting ClientId ClientEntry ClientId -> ClientEntry -> ClientId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ClientId ClientEntry ClientId
forall (f :: * -> *).
Functor f =>
(ClientId -> f ClientId) -> ClientEntry -> f ClientEntry
Proto.clientEntryId ClientEntry
x
          t :: Text
t = ByteString -> Text
toBase64Text (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Getting ByteString ClientEntry ByteString
-> ClientEntry -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ClientEntry ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> ClientEntry -> f ClientEntry
Proto.clientEntryMessage ClientEntry
x
       in ClientId -> Text -> Map ClientId Text -> Map ClientId Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ClientId
c Text
t Map ClientId Text
acc

protoFromOtrRecipients :: OtrRecipients -> [Proto.UserEntry]
protoFromOtrRecipients :: OtrRecipients -> [UserEntry]
protoFromOtrRecipients OtrRecipients
rcps =
  let m :: Map UserId (Map ClientId Text)
m = UserClientMap Text -> Map UserId (Map ClientId Text)
forall a. UserClientMap a -> Map UserId (Map ClientId a)
userClientMap (OtrRecipients -> UserClientMap Text
otrRecipientsMap OtrRecipients
rcps)
   in ((UserId, Map ClientId Text) -> UserEntry)
-> [(UserId, Map ClientId Text)] -> [UserEntry]
forall a b. (a -> b) -> [a] -> [b]
map (UserId, Map ClientId Text) -> UserEntry
mkProtoRecipient (Map UserId (Map ClientId Text) -> [(UserId, Map ClientId Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map UserId (Map ClientId Text)
m)
  where
    mkProtoRecipient :: (UserId, Map ClientId Text) -> UserEntry
mkProtoRecipient (UserId
usr, Map ClientId Text
clts) =
      let xs :: [ClientEntry]
xs = ((ClientId, Text) -> ClientEntry)
-> [(ClientId, Text)] -> [ClientEntry]
forall a b. (a -> b) -> [a] -> [b]
map (ClientId, Text) -> ClientEntry
mkClientEntry (Map ClientId Text -> [(ClientId, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ClientId Text
clts)
       in UserId -> [ClientEntry] -> UserEntry
Proto.userEntry (UserId -> UserId
Proto.fromUserId UserId
usr) [ClientEntry]
xs
    mkClientEntry :: (ClientId, Text) -> ClientEntry
mkClientEntry (ClientId
clt, Text
t) = ClientId -> ByteString -> ClientEntry
Proto.clientEntry (ClientId -> ClientId
Proto.fromClientId ClientId
clt) (Text -> ByteString
fromBase64TextLenient Text
t)

newtype QualifiedOtrRecipients = QualifiedOtrRecipients
  { QualifiedOtrRecipients -> QualifiedUserClientMap ByteString
qualifiedOtrRecipientsMap :: QualifiedUserClientMap ByteString
  }
  deriving stock (QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool
(QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool)
-> (QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool)
-> Eq QualifiedOtrRecipients
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool
== :: QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool
$c/= :: QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool
/= :: QualifiedOtrRecipients -> QualifiedOtrRecipients -> Bool
Eq, Int -> QualifiedOtrRecipients -> ShowS
[QualifiedOtrRecipients] -> ShowS
QualifiedOtrRecipients -> String
(Int -> QualifiedOtrRecipients -> ShowS)
-> (QualifiedOtrRecipients -> String)
-> ([QualifiedOtrRecipients] -> ShowS)
-> Show QualifiedOtrRecipients
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QualifiedOtrRecipients -> ShowS
showsPrec :: Int -> QualifiedOtrRecipients -> ShowS
$cshow :: QualifiedOtrRecipients -> String
show :: QualifiedOtrRecipients -> String
$cshowList :: [QualifiedOtrRecipients] -> ShowS
showList :: [QualifiedOtrRecipients] -> ShowS
Show)
  deriving newtype (Gen QualifiedOtrRecipients
Gen QualifiedOtrRecipients
-> (QualifiedOtrRecipients -> [QualifiedOtrRecipients])
-> Arbitrary QualifiedOtrRecipients
QualifiedOtrRecipients -> [QualifiedOtrRecipients]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen QualifiedOtrRecipients
arbitrary :: Gen QualifiedOtrRecipients
$cshrink :: QualifiedOtrRecipients -> [QualifiedOtrRecipients]
shrink :: QualifiedOtrRecipients -> [QualifiedOtrRecipients]
Arbitrary)
  deriving (NonEmpty QualifiedOtrRecipients -> QualifiedOtrRecipients
QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
(QualifiedOtrRecipients
 -> QualifiedOtrRecipients -> QualifiedOtrRecipients)
-> (NonEmpty QualifiedOtrRecipients -> QualifiedOtrRecipients)
-> (forall b.
    Integral b =>
    b -> QualifiedOtrRecipients -> QualifiedOtrRecipients)
-> Semigroup QualifiedOtrRecipients
forall b.
Integral b =>
b -> QualifiedOtrRecipients -> QualifiedOtrRecipients
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
<> :: QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
$csconcat :: NonEmpty QualifiedOtrRecipients -> QualifiedOtrRecipients
sconcat :: NonEmpty QualifiedOtrRecipients -> QualifiedOtrRecipients
$cstimes :: forall b.
Integral b =>
b -> QualifiedOtrRecipients -> QualifiedOtrRecipients
stimes :: forall b.
Integral b =>
b -> QualifiedOtrRecipients -> QualifiedOtrRecipients
Semigroup, Semigroup QualifiedOtrRecipients
QualifiedOtrRecipients
Semigroup QualifiedOtrRecipients =>
QualifiedOtrRecipients
-> (QualifiedOtrRecipients
    -> QualifiedOtrRecipients -> QualifiedOtrRecipients)
-> ([QualifiedOtrRecipients] -> QualifiedOtrRecipients)
-> Monoid QualifiedOtrRecipients
[QualifiedOtrRecipients] -> QualifiedOtrRecipients
QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: QualifiedOtrRecipients
mempty :: QualifiedOtrRecipients
$cmappend :: QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
mappend :: QualifiedOtrRecipients
-> QualifiedOtrRecipients -> QualifiedOtrRecipients
$cmconcat :: [QualifiedOtrRecipients] -> QualifiedOtrRecipients
mconcat :: [QualifiedOtrRecipients] -> QualifiedOtrRecipients
Monoid) via (QualifiedUserClientMap (First ByteString))

protolensOtrRecipientsToOtrRecipients :: [Proto.Otr.QualifiedUserEntry] -> Either String QualifiedOtrRecipients
protolensOtrRecipientsToOtrRecipients :: [QualifiedUserEntry] -> Either String QualifiedOtrRecipients
protolensOtrRecipientsToOtrRecipients [QualifiedUserEntry]
entries =
  QualifiedUserClientMap ByteString -> QualifiedOtrRecipients
QualifiedOtrRecipients (QualifiedUserClientMap ByteString -> QualifiedOtrRecipients)
-> (Map Domain (Map UserId (Map ClientId ByteString))
    -> QualifiedUserClientMap ByteString)
-> Map Domain (Map UserId (Map ClientId ByteString))
-> QualifiedOtrRecipients
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Domain (Map UserId (Map ClientId ByteString))
-> QualifiedUserClientMap ByteString
forall a.
Map Domain (Map UserId (Map ClientId a))
-> QualifiedUserClientMap a
QualifiedUserClientMap (Map Domain (Map UserId (Map ClientId ByteString))
 -> QualifiedOtrRecipients)
-> Either
     String (Map Domain (Map UserId (Map ClientId ByteString)))
-> Either String QualifiedOtrRecipients
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualifiedUserEntry]
-> Either
     String (Map Domain (Map UserId (Map ClientId ByteString)))
protolensToQualifiedUCMap [QualifiedUserEntry]
entries
  where
    protolensToQualifiedUCMap :: [Proto.Otr.QualifiedUserEntry] -> Either String (Map Domain (Map UserId (Map ClientId ByteString)))
    protolensToQualifiedUCMap :: [QualifiedUserEntry]
-> Either
     String (Map Domain (Map UserId (Map ClientId ByteString)))
protolensToQualifiedUCMap [QualifiedUserEntry]
qualifiedEntries = (QualifiedUserEntry -> Either String Domain)
-> (QualifiedUserEntry
    -> Either String (Map UserId (Map ClientId ByteString)))
-> [QualifiedUserEntry]
-> Either
     String (Map Domain (Map UserId (Map ClientId ByteString)))
forall (f :: * -> *) k a v.
(Applicative f, Ord k) =>
(a -> f k) -> (a -> f v) -> [a] -> f (Map k v)
parseMap (Text -> Either String Domain
mkDomain (Text -> Either String Domain)
-> (QualifiedUserEntry -> Text)
-> QualifiedUserEntry
-> Either String Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text QualifiedUserEntry Text -> QualifiedUserEntry -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text QualifiedUserEntry Text
forall (f :: * -> *) s a.
(Functor f, HasField s "domain" a) =>
LensLike' f s a
Proto.Otr.domain) ([UserEntry] -> Either String (Map UserId (Map ClientId ByteString))
protolensToUCMap ([UserEntry]
 -> Either String (Map UserId (Map ClientId ByteString)))
-> (QualifiedUserEntry -> [UserEntry])
-> QualifiedUserEntry
-> Either String (Map UserId (Map ClientId ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [UserEntry] QualifiedUserEntry [UserEntry]
-> QualifiedUserEntry -> [UserEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [UserEntry] QualifiedUserEntry [UserEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "entries" a) =>
LensLike' f s a
Proto.Otr.entries) [QualifiedUserEntry]
qualifiedEntries

    protolensToUCMap :: [Proto.Otr.UserEntry] -> Either String (Map UserId (Map ClientId ByteString))
    protolensToUCMap :: [UserEntry] -> Either String (Map UserId (Map ClientId ByteString))
protolensToUCMap [UserEntry]
es = (UserEntry -> Either String UserId)
-> (UserEntry -> Either String (Map ClientId ByteString))
-> [UserEntry]
-> Either String (Map UserId (Map ClientId ByteString))
forall (f :: * -> *) k a v.
(Applicative f, Ord k) =>
(a -> f k) -> (a -> f v) -> [a] -> f (Map k v)
parseMap UserEntry -> Either String UserId
parseUserId UserEntry -> Either String (Map ClientId ByteString)
parseClientMap [UserEntry]
es

    parseUserId :: Proto.Otr.UserEntry -> Either String UserId
    parseUserId :: UserEntry -> Either String UserId
parseUserId =
      Either String UserId
-> (UUID -> Either String UserId)
-> Maybe UUID
-> Either String UserId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String UserId
forall a b. a -> Either a b
Left String
"Invalid UUID") (UserId -> Either String UserId
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> Either String UserId)
-> (UUID -> UserId) -> UUID -> Either String UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> UserId
forall {k} (a :: k). UUID -> Id a
Id)
        (Maybe UUID -> Either String UserId)
-> (UserEntry -> Maybe UUID) -> UserEntry -> Either String UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UUID
UUID.fromByteString
        (ByteString -> Maybe UUID)
-> (UserEntry -> ByteString) -> UserEntry -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict
        (ByteString -> ByteString)
-> (UserEntry -> ByteString) -> UserEntry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString UserId ByteString -> UserId -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString UserId ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "uuid" a) =>
LensLike' f s a
Proto.Otr.uuid
        (UserId -> ByteString)
-> (UserEntry -> UserId) -> UserEntry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UserId UserEntry UserId -> UserEntry -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId UserEntry UserId
forall (f :: * -> *) s a.
(Functor f, HasField s "user" a) =>
LensLike' f s a
Proto.Otr.user

    parseClientMap :: Proto.Otr.UserEntry -> Either String (Map ClientId ByteString)
    parseClientMap :: UserEntry -> Either String (Map ClientId ByteString)
parseClientMap UserEntry
entry = (ClientEntry -> Either String ClientId)
-> (ClientEntry -> Either String ByteString)
-> [ClientEntry]
-> Either String (Map ClientId ByteString)
forall (f :: * -> *) k a v.
(Applicative f, Ord k) =>
(a -> f k) -> (a -> f v) -> [a] -> f (Map k v)
parseMap ClientEntry -> Either String ClientId
parseClientId ClientEntry -> Either String ByteString
parseText ([ClientEntry] -> Either String (Map ClientId ByteString))
-> [ClientEntry] -> Either String (Map ClientId ByteString)
forall a b. (a -> b) -> a -> b
$ Getting [ClientEntry] UserEntry [ClientEntry]
-> UserEntry -> [ClientEntry]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ClientEntry] UserEntry [ClientEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "clients" a) =>
LensLike' f s a
Proto.Otr.clients UserEntry
entry

    parseClientId :: Proto.Otr.ClientEntry -> Either String ClientId
    parseClientId :: ClientEntry -> Either String ClientId
parseClientId = ClientId -> Either String ClientId
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientId -> Either String ClientId)
-> (ClientEntry -> ClientId)
-> ClientEntry
-> Either String ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientId -> ClientId
protolensToClientId (ClientId -> ClientId)
-> (ClientEntry -> ClientId) -> ClientEntry -> ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ClientId ClientEntry ClientId -> ClientEntry -> ClientId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ClientId ClientEntry ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.Otr.client

    parseText :: Proto.Otr.ClientEntry -> Either String ByteString
    parseText :: ClientEntry -> Either String ByteString
parseText = ByteString -> Either String ByteString
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> (ClientEntry -> ByteString)
-> ClientEntry
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ByteString ClientEntry ByteString
-> ClientEntry -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ClientEntry ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "text" a) =>
LensLike' f s a
Proto.Otr.text

qualifiedOtrRecipientsToProtolens :: QualifiedOtrRecipients -> [Proto.Otr.QualifiedUserEntry]
qualifiedOtrRecipientsToProtolens :: QualifiedOtrRecipients -> [QualifiedUserEntry]
qualifiedOtrRecipientsToProtolens (QualifiedOtrRecipients (QualifiedUserClientMap Map Domain (Map UserId (Map ClientId ByteString))
recipients)) =
  ((Domain, Map UserId (Map ClientId ByteString))
 -> QualifiedUserEntry)
-> [(Domain, Map UserId (Map ClientId ByteString))]
-> [QualifiedUserEntry]
forall a b. (a -> b) -> [a] -> [b]
map ((Domain
 -> Map UserId (Map ClientId ByteString) -> QualifiedUserEntry)
-> (Domain, Map UserId (Map ClientId ByteString))
-> QualifiedUserEntry
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Domain
-> Map UserId (Map ClientId ByteString) -> QualifiedUserEntry
quEntry) ([(Domain, Map UserId (Map ClientId ByteString))]
 -> [QualifiedUserEntry])
-> (Map Domain (Map UserId (Map ClientId ByteString))
    -> [(Domain, Map UserId (Map ClientId ByteString))])
-> Map Domain (Map UserId (Map ClientId ByteString))
-> [QualifiedUserEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Domain (Map UserId (Map ClientId ByteString))
-> [(Domain, Map UserId (Map ClientId ByteString))]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map Domain (Map UserId (Map ClientId ByteString))
 -> [QualifiedUserEntry])
-> Map Domain (Map UserId (Map ClientId ByteString))
-> [QualifiedUserEntry]
forall a b. (a -> b) -> a -> b
$ Map Domain (Map UserId (Map ClientId ByteString))
recipients
  where
    quEntry :: Domain -> Map UserId (Map ClientId ByteString) -> Proto.Otr.QualifiedUserEntry
    quEntry :: Domain
-> Map UserId (Map ClientId ByteString) -> QualifiedUserEntry
quEntry Domain
domain Map UserId (Map ClientId ByteString)
m =
      QualifiedUserEntry
forall msg. Message msg => msg
ProtoLens.defMessage
        QualifiedUserEntry
-> (QualifiedUserEntry -> QualifiedUserEntry) -> QualifiedUserEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedUserEntry Text
forall (f :: * -> *) s a.
(Functor f, HasField s "domain" a) =>
LensLike' f s a
Proto.Otr.domain LensLike' Identity QualifiedUserEntry Text
-> Text -> QualifiedUserEntry -> QualifiedUserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Domain -> Text
domainText Domain
domain
        QualifiedUserEntry
-> (QualifiedUserEntry -> QualifiedUserEntry) -> QualifiedUserEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedUserEntry [UserEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "entries" a) =>
LensLike' f s a
Proto.Otr.entries LensLike' Identity QualifiedUserEntry [UserEntry]
-> [UserEntry] -> QualifiedUserEntry -> QualifiedUserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((UserId, Map ClientId ByteString) -> UserEntry)
-> [(UserId, Map ClientId ByteString)] -> [UserEntry]
forall a b. (a -> b) -> [a] -> [b]
map ((UserId -> Map ClientId ByteString -> UserEntry)
-> (UserId, Map ClientId ByteString) -> UserEntry
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UserId -> Map ClientId ByteString -> UserEntry
uEntry) (Map UserId (Map ClientId ByteString)
-> [(UserId, Map ClientId ByteString)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map UserId (Map ClientId ByteString)
m)

    uEntry :: UserId -> Map ClientId ByteString -> Proto.Otr.UserEntry
    uEntry :: UserId -> Map ClientId ByteString -> UserEntry
uEntry UserId
uid Map ClientId ByteString
m =
      UserEntry
forall msg. Message msg => msg
ProtoLens.defMessage
        UserEntry -> (UserEntry -> UserEntry) -> UserEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity UserEntry UserId
forall (f :: * -> *) s a.
(Functor f, HasField s "user" a) =>
LensLike' f s a
Proto.Otr.user LensLike' Identity UserEntry UserId
-> ((ByteString -> Identity ByteString)
    -> UserId -> Identity UserId)
-> (ByteString -> Identity ByteString)
-> UserEntry
-> Identity UserEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Identity ByteString) -> UserId -> Identity UserId
forall (f :: * -> *) s a.
(Functor f, HasField s "uuid" a) =>
LensLike' f s a
Proto.Otr.uuid ((ByteString -> Identity ByteString)
 -> UserEntry -> Identity UserEntry)
-> ByteString -> UserEntry -> UserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString -> ByteString
LBS.toStrict (UUID -> ByteString
UUID.toByteString (UserId -> UUID
forall {k} (a :: k). Id a -> UUID
toUUID UserId
uid))
        UserEntry -> (UserEntry -> UserEntry) -> UserEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity UserEntry [ClientEntry]
forall (f :: * -> *) s a.
(Functor f, HasField s "clients" a) =>
LensLike' f s a
Proto.Otr.clients LensLike' Identity UserEntry [ClientEntry]
-> [ClientEntry] -> UserEntry -> UserEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((ClientId, ByteString) -> ClientEntry)
-> [(ClientId, ByteString)] -> [ClientEntry]
forall a b. (a -> b) -> [a] -> [b]
map ((ClientId -> ByteString -> ClientEntry)
-> (ClientId, ByteString) -> ClientEntry
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ClientId -> ByteString -> ClientEntry
cEntry) (Map ClientId ByteString -> [(ClientId, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map ClientId ByteString
m)

    cEntry :: ClientId -> ByteString -> Proto.Otr.ClientEntry
    cEntry :: ClientId -> ByteString -> ClientEntry
cEntry ClientId
cid ByteString
msg =
      ClientEntry
forall msg. Message msg => msg
ProtoLens.defMessage
        ClientEntry -> (ClientEntry -> ClientEntry) -> ClientEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity ClientEntry ClientId
forall (f :: * -> *) s a.
(Functor f, HasField s "client" a) =>
LensLike' f s a
Proto.Otr.client LensLike' Identity ClientEntry ClientId
-> ClientId -> ClientEntry -> ClientEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientId -> ClientId
clientIdToProtolens ClientId
cid
        ClientEntry -> (ClientEntry -> ClientEntry) -> ClientEntry
forall a b. a -> (a -> b) -> b
& LensLike' Identity ClientEntry ByteString
forall (f :: * -> *) s a.
(Functor f, HasField s "text" a) =>
LensLike' f s a
Proto.Otr.text LensLike' Identity ClientEntry ByteString
-> ByteString -> ClientEntry -> ClientEntry
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString
msg

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

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

data ClientMismatchStrategy
  = MismatchReportAll
  | MismatchIgnoreAll
  | MismatchReportOnly (Set (Qualified UserId))
  | MismatchIgnoreOnly (Set (Qualified UserId))
  deriving (ClientMismatchStrategy -> ClientMismatchStrategy -> Bool
(ClientMismatchStrategy -> ClientMismatchStrategy -> Bool)
-> (ClientMismatchStrategy -> ClientMismatchStrategy -> Bool)
-> Eq ClientMismatchStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientMismatchStrategy -> ClientMismatchStrategy -> Bool
== :: ClientMismatchStrategy -> ClientMismatchStrategy -> Bool
$c/= :: ClientMismatchStrategy -> ClientMismatchStrategy -> Bool
/= :: ClientMismatchStrategy -> ClientMismatchStrategy -> Bool
Eq, Int -> ClientMismatchStrategy -> ShowS
[ClientMismatchStrategy] -> ShowS
ClientMismatchStrategy -> String
(Int -> ClientMismatchStrategy -> ShowS)
-> (ClientMismatchStrategy -> String)
-> ([ClientMismatchStrategy] -> ShowS)
-> Show ClientMismatchStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientMismatchStrategy -> ShowS
showsPrec :: Int -> ClientMismatchStrategy -> ShowS
$cshow :: ClientMismatchStrategy -> String
show :: ClientMismatchStrategy -> String
$cshowList :: [ClientMismatchStrategy] -> ShowS
showList :: [ClientMismatchStrategy] -> ShowS
Show, (forall x. ClientMismatchStrategy -> Rep ClientMismatchStrategy x)
-> (forall x.
    Rep ClientMismatchStrategy x -> ClientMismatchStrategy)
-> Generic ClientMismatchStrategy
forall x. Rep ClientMismatchStrategy x -> ClientMismatchStrategy
forall x. ClientMismatchStrategy -> Rep ClientMismatchStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientMismatchStrategy -> Rep ClientMismatchStrategy x
from :: forall x. ClientMismatchStrategy -> Rep ClientMismatchStrategy x
$cto :: forall x. Rep ClientMismatchStrategy x -> ClientMismatchStrategy
to :: forall x. Rep ClientMismatchStrategy x -> ClientMismatchStrategy
Generic)
  deriving (Gen ClientMismatchStrategy
Gen ClientMismatchStrategy
-> (ClientMismatchStrategy -> [ClientMismatchStrategy])
-> Arbitrary ClientMismatchStrategy
ClientMismatchStrategy -> [ClientMismatchStrategy]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ClientMismatchStrategy
arbitrary :: Gen ClientMismatchStrategy
$cshrink :: ClientMismatchStrategy -> [ClientMismatchStrategy]
shrink :: ClientMismatchStrategy -> [ClientMismatchStrategy]
Arbitrary) via (GenericUniform ClientMismatchStrategy)

protolensToClientMismatchStrategy :: Maybe Proto.Otr.QualifiedNewOtrMessage'ClientMismatchStrategy -> Either String ClientMismatchStrategy
protolensToClientMismatchStrategy :: Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
-> Either String ClientMismatchStrategy
protolensToClientMismatchStrategy = \case
  Maybe QualifiedNewOtrMessage'ClientMismatchStrategy
Nothing -> String -> Either String ClientMismatchStrategy
forall a b. a -> Either a b
Left String
"ClientMismatchStrategy not specified!"
  Just (Proto.Otr.QualifiedNewOtrMessage'IgnoreAll ClientMismatchStrategy'IgnoreAll
_) -> ClientMismatchStrategy -> Either String ClientMismatchStrategy
forall a b. b -> Either a b
Right ClientMismatchStrategy
MismatchIgnoreAll
  Just (Proto.Otr.QualifiedNewOtrMessage'ReportAll ClientMismatchStrategy'ReportAll
_) -> ClientMismatchStrategy -> Either String ClientMismatchStrategy
forall a b. b -> Either a b
Right ClientMismatchStrategy
MismatchReportAll
  Just (Proto.Otr.QualifiedNewOtrMessage'IgnoreOnly ClientMismatchStrategy'IgnoreOnly
ignoreOnly) -> Set (Qualified UserId) -> ClientMismatchStrategy
MismatchIgnoreOnly (Set (Qualified UserId) -> ClientMismatchStrategy)
-> Either String (Set (Qualified UserId))
-> Either String ClientMismatchStrategy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMismatchStrategy'IgnoreOnly
-> Either String (Set (Qualified UserId))
forall s.
HasField s "userIds" [QualifiedUserId] =>
s -> Either String (Set (Qualified UserId))
protolensToSetQualifiedUserIds ClientMismatchStrategy'IgnoreOnly
ignoreOnly
  Just (Proto.Otr.QualifiedNewOtrMessage'ReportOnly ClientMismatchStrategy'ReportOnly
reportOnly) -> Set (Qualified UserId) -> ClientMismatchStrategy
MismatchReportOnly (Set (Qualified UserId) -> ClientMismatchStrategy)
-> Either String (Set (Qualified UserId))
-> Either String ClientMismatchStrategy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMismatchStrategy'ReportOnly
-> Either String (Set (Qualified UserId))
forall s.
HasField s "userIds" [QualifiedUserId] =>
s -> Either String (Set (Qualified UserId))
protolensToSetQualifiedUserIds ClientMismatchStrategy'ReportOnly
reportOnly

clientMismatchStrategyToProtolens ::
  ClientMismatchStrategy ->
  Proto.Otr.QualifiedNewOtrMessage'ClientMismatchStrategy
clientMismatchStrategyToProtolens :: ClientMismatchStrategy
-> QualifiedNewOtrMessage'ClientMismatchStrategy
clientMismatchStrategyToProtolens = \case
  ClientMismatchStrategy
MismatchIgnoreAll ->
    ClientMismatchStrategy'IgnoreAll
-> QualifiedNewOtrMessage'ClientMismatchStrategy
Proto.Otr.QualifiedNewOtrMessage'IgnoreAll ClientMismatchStrategy'IgnoreAll
forall msg. Message msg => msg
ProtoLens.defMessage
  ClientMismatchStrategy
MismatchReportAll ->
    ClientMismatchStrategy'ReportAll
-> QualifiedNewOtrMessage'ClientMismatchStrategy
Proto.Otr.QualifiedNewOtrMessage'ReportAll ClientMismatchStrategy'ReportAll
forall msg. Message msg => msg
ProtoLens.defMessage
  MismatchIgnoreOnly Set (Qualified UserId)
users ->
    ClientMismatchStrategy'IgnoreOnly
-> QualifiedNewOtrMessage'ClientMismatchStrategy
Proto.Otr.QualifiedNewOtrMessage'IgnoreOnly
      ( ClientMismatchStrategy'IgnoreOnly
forall msg. Message msg => msg
ProtoLens.defMessage
          ClientMismatchStrategy'IgnoreOnly
-> (ClientMismatchStrategy'IgnoreOnly
    -> ClientMismatchStrategy'IgnoreOnly)
-> ClientMismatchStrategy'IgnoreOnly
forall a b. a -> (a -> b) -> b
& LensLike'
  Identity ClientMismatchStrategy'IgnoreOnly [QualifiedUserId]
forall (f :: * -> *) s a.
(Functor f, HasField s "userIds" a) =>
LensLike' f s a
Proto.Otr.userIds LensLike'
  Identity ClientMismatchStrategy'IgnoreOnly [QualifiedUserId]
-> [QualifiedUserId]
-> ClientMismatchStrategy'IgnoreOnly
-> ClientMismatchStrategy'IgnoreOnly
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Qualified UserId -> QualifiedUserId)
-> [Qualified UserId] -> [QualifiedUserId]
forall a b. (a -> b) -> [a] -> [b]
map Qualified UserId -> QualifiedUserId
qualifiedUserIdToProtolens (Set (Qualified UserId) -> [Qualified UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (Qualified UserId)
users)
      )
  MismatchReportOnly Set (Qualified UserId)
users ->
    ClientMismatchStrategy'ReportOnly
-> QualifiedNewOtrMessage'ClientMismatchStrategy
Proto.Otr.QualifiedNewOtrMessage'ReportOnly
      ( ClientMismatchStrategy'ReportOnly
forall msg. Message msg => msg
ProtoLens.defMessage
          ClientMismatchStrategy'ReportOnly
-> (ClientMismatchStrategy'ReportOnly
    -> ClientMismatchStrategy'ReportOnly)
-> ClientMismatchStrategy'ReportOnly
forall a b. a -> (a -> b) -> b
& LensLike'
  Identity ClientMismatchStrategy'ReportOnly [QualifiedUserId]
forall (f :: * -> *) s a.
(Functor f, HasField s "userIds" a) =>
LensLike' f s a
Proto.Otr.userIds LensLike'
  Identity ClientMismatchStrategy'ReportOnly [QualifiedUserId]
-> [QualifiedUserId]
-> ClientMismatchStrategy'ReportOnly
-> ClientMismatchStrategy'ReportOnly
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Qualified UserId -> QualifiedUserId)
-> [Qualified UserId] -> [QualifiedUserId]
forall a b. (a -> b) -> [a] -> [b]
map Qualified UserId -> QualifiedUserId
qualifiedUserIdToProtolens (Set (Qualified UserId) -> [Qualified UserId]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (Qualified UserId)
users)
      )

protolensToSetQualifiedUserIds :: (ProtoLens.HasField s "userIds" [Proto.Otr.QualifiedUserId]) => s -> Either String (Set (Qualified UserId))
protolensToSetQualifiedUserIds :: forall s.
HasField s "userIds" [QualifiedUserId] =>
s -> Either String (Set (Qualified UserId))
protolensToSetQualifiedUserIds = ([Qualified UserId] -> Set (Qualified UserId))
-> Either String [Qualified UserId]
-> Either String (Set (Qualified UserId))
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Qualified UserId] -> Set (Qualified UserId)
forall a. Ord a => [a] -> Set a
Set.fromList (Either String [Qualified UserId]
 -> Either String (Set (Qualified UserId)))
-> (s -> Either String [Qualified UserId])
-> s
-> Either String (Set (Qualified UserId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedUserId -> Either String (Qualified UserId))
-> [QualifiedUserId] -> Either String [Qualified UserId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM QualifiedUserId -> Either String (Qualified UserId)
protolensToQualifiedUserId ([QualifiedUserId] -> Either String [Qualified UserId])
-> (s -> [QualifiedUserId])
-> s
-> Either String [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [QualifiedUserId] s [QualifiedUserId]
-> s -> [QualifiedUserId]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [QualifiedUserId] s [QualifiedUserId]
forall (f :: * -> *) s a.
(Functor f, HasField s "userIds" a) =>
LensLike' f s a
Proto.Otr.userIds

protolensToQualifiedUserId :: Proto.Otr.QualifiedUserId -> Either String (Qualified UserId)
protolensToQualifiedUserId :: QualifiedUserId -> Either String (Qualified UserId)
protolensToQualifiedUserId QualifiedUserId
protoQuid =
  UserId -> Domain -> Qualified UserId
forall a. a -> Domain -> Qualified a
Qualified
    (UserId -> Domain -> Qualified UserId)
-> Either String UserId
-> Either String (Domain -> Qualified UserId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String UserId
forall {k} (a :: k). Text -> Either String (Id a)
parseIdFromText (Getting Text QualifiedUserId Text -> QualifiedUserId -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text QualifiedUserId Text
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
Proto.Otr.id QualifiedUserId
protoQuid)
    Either String (Domain -> Qualified UserId)
-> Either String Domain -> Either String (Qualified UserId)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either String Domain
mkDomain (Getting Text QualifiedUserId Text -> QualifiedUserId -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text QualifiedUserId Text
forall (f :: * -> *) s a.
(Functor f, HasField s "domain" a) =>
LensLike' f s a
Proto.Otr.domain QualifiedUserId
protoQuid)

qualifiedUserIdToProtolens :: Qualified UserId -> Proto.Otr.QualifiedUserId
qualifiedUserIdToProtolens :: Qualified UserId -> QualifiedUserId
qualifiedUserIdToProtolens (Qualified UserId
uid Domain
domain) =
  QualifiedUserId
forall msg. Message msg => msg
ProtoLens.defMessage
    QualifiedUserId
-> (QualifiedUserId -> QualifiedUserId) -> QualifiedUserId
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedUserId Text
forall (f :: * -> *) s a.
(Functor f, HasField s "id" a) =>
LensLike' f s a
Proto.Otr.id LensLike' Identity QualifiedUserId Text
-> Text -> QualifiedUserId -> QualifiedUserId
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UserId -> Text
forall {k} (a :: k). Id a -> Text
idToText UserId
uid
    QualifiedUserId
-> (QualifiedUserId -> QualifiedUserId) -> QualifiedUserId
forall a b. a -> (a -> b) -> b
& LensLike' Identity QualifiedUserId Text
forall (f :: * -> *) s a.
(Functor f, HasField s "domain" a) =>
LensLike' f s a
Proto.Otr.domain LensLike' Identity QualifiedUserId Text
-> Text -> QualifiedUserId -> QualifiedUserId
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Domain -> Text
domainText Domain
domain

data ClientMismatch = ClientMismatch
  { ClientMismatch -> UTCTimeMillis
cmismatchTime :: UTCTimeMillis,
    -- | Clients that the message /should/ have been encrypted for, but wasn't.
    ClientMismatch -> UserClients
missingClients :: UserClients,
    -- | Clients that the message /should not/ have been encrypted for, but was.
    ClientMismatch -> UserClients
redundantClients :: UserClients,
    ClientMismatch -> UserClients
deletedClients :: UserClients
  }
  deriving stock (ClientMismatch -> ClientMismatch -> Bool
(ClientMismatch -> ClientMismatch -> Bool)
-> (ClientMismatch -> ClientMismatch -> Bool) -> Eq ClientMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientMismatch -> ClientMismatch -> Bool
== :: ClientMismatch -> ClientMismatch -> Bool
$c/= :: ClientMismatch -> ClientMismatch -> Bool
/= :: ClientMismatch -> ClientMismatch -> Bool
Eq, Int -> ClientMismatch -> ShowS
[ClientMismatch] -> ShowS
ClientMismatch -> String
(Int -> ClientMismatch -> ShowS)
-> (ClientMismatch -> String)
-> ([ClientMismatch] -> ShowS)
-> Show ClientMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientMismatch -> ShowS
showsPrec :: Int -> ClientMismatch -> ShowS
$cshow :: ClientMismatch -> String
show :: ClientMismatch -> String
$cshowList :: [ClientMismatch] -> ShowS
showList :: [ClientMismatch] -> ShowS
Show, (forall x. ClientMismatch -> Rep ClientMismatch x)
-> (forall x. Rep ClientMismatch x -> ClientMismatch)
-> Generic ClientMismatch
forall x. Rep ClientMismatch x -> ClientMismatch
forall x. ClientMismatch -> Rep ClientMismatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientMismatch -> Rep ClientMismatch x
from :: forall x. ClientMismatch -> Rep ClientMismatch x
$cto :: forall x. Rep ClientMismatch x -> ClientMismatch
to :: forall x. Rep ClientMismatch x -> ClientMismatch
Generic)
  deriving ([ClientMismatch] -> Value
[ClientMismatch] -> Encoding
ClientMismatch -> Value
ClientMismatch -> Encoding
(ClientMismatch -> Value)
-> (ClientMismatch -> Encoding)
-> ([ClientMismatch] -> Value)
-> ([ClientMismatch] -> Encoding)
-> ToJSON ClientMismatch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClientMismatch -> Value
toJSON :: ClientMismatch -> Value
$ctoEncoding :: ClientMismatch -> Encoding
toEncoding :: ClientMismatch -> Encoding
$ctoJSONList :: [ClientMismatch] -> Value
toJSONList :: [ClientMismatch] -> Value
$ctoEncodingList :: [ClientMismatch] -> Encoding
toEncodingList :: [ClientMismatch] -> Encoding
A.ToJSON, Value -> Parser [ClientMismatch]
Value -> Parser ClientMismatch
(Value -> Parser ClientMismatch)
-> (Value -> Parser [ClientMismatch]) -> FromJSON ClientMismatch
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClientMismatch
parseJSON :: Value -> Parser ClientMismatch
$cparseJSONList :: Value -> Parser [ClientMismatch]
parseJSONList :: Value -> Parser [ClientMismatch]
A.FromJSON, Typeable ClientMismatch
Typeable ClientMismatch =>
(Proxy ClientMismatch -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ClientMismatch
Proxy ClientMismatch -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ClientMismatch -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ClientMismatch -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ClientMismatch

instance Arbitrary ClientMismatch where
  arbitrary :: Gen ClientMismatch
arbitrary =
    UTCTimeMillis
-> UserClients -> UserClients -> UserClients -> ClientMismatch
ClientMismatch
      (UTCTimeMillis
 -> UserClients -> UserClients -> UserClients -> ClientMismatch)
-> Gen UTCTimeMillis
-> Gen
     (UserClients -> UserClients -> UserClients -> ClientMismatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTCTimeMillis
forall a. Arbitrary a => Gen a
arbitrary
      Gen (UserClients -> UserClients -> UserClients -> ClientMismatch)
-> Gen UserClients
-> Gen (UserClients -> UserClients -> ClientMismatch)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UserClients
forall a. Arbitrary a => Gen a
arbitrary
      Gen (UserClients -> UserClients -> ClientMismatch)
-> Gen UserClients -> Gen (UserClients -> ClientMismatch)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UserClients
forall a. Arbitrary a => Gen a
arbitrary
      Gen (UserClients -> ClientMismatch)
-> Gen UserClients -> Gen ClientMismatch
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UserClients
forall a. Arbitrary a => Gen a
arbitrary

instance ToSchema ClientMismatch where
  schema :: ValueSchema NamedSwaggerDoc ClientMismatch
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch ClientMismatch
-> ValueSchema NamedSwaggerDoc ClientMismatch
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ClientMismatch" (SchemaP SwaggerDoc Object [Pair] ClientMismatch ClientMismatch
 -> ValueSchema NamedSwaggerDoc ClientMismatch)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch ClientMismatch
-> ValueSchema NamedSwaggerDoc ClientMismatch
forall a b. (a -> b) -> a -> b
$
      UTCTimeMillis
-> UserClients -> UserClients -> UserClients -> ClientMismatch
ClientMismatch
        (UTCTimeMillis
 -> UserClients -> UserClients -> UserClients -> ClientMismatch)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UTCTimeMillis
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClientMismatch
     (UserClients -> UserClients -> UserClients -> ClientMismatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMismatch -> UTCTimeMillis
cmismatchTime (ClientMismatch -> UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UTCTimeMillis
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"time" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ClientMismatch
  (UserClients -> UserClients -> UserClients -> ClientMismatch)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClientMismatch
     (UserClients -> UserClients -> ClientMismatch)
forall a b.
SchemaP SwaggerDoc Object [Pair] ClientMismatch (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch a
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientMismatch -> UserClients
missingClients (ClientMismatch -> UserClients)
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"missing" SchemaP NamedSwaggerDoc Value Value UserClients UserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ClientMismatch
  (UserClients -> UserClients -> ClientMismatch)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     ClientMismatch
     (UserClients -> ClientMismatch)
forall a b.
SchemaP SwaggerDoc Object [Pair] ClientMismatch (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch a
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientMismatch -> UserClients
redundantClients (ClientMismatch -> UserClients)
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"redundant" SchemaP NamedSwaggerDoc Value Value UserClients UserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  ClientMismatch
  (UserClients -> ClientMismatch)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch ClientMismatch
forall a b.
SchemaP SwaggerDoc Object [Pair] ClientMismatch (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch a
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientMismatch -> UserClients
deletedClients (ClientMismatch -> UserClients)
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] ClientMismatch UserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserClients UserClients
-> SchemaP SwaggerDoc Object [Pair] UserClients UserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"deleted" SchemaP NamedSwaggerDoc Value Value UserClients UserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

data MessageSendingStatus = MessageSendingStatus
  { MessageSendingStatus -> UTCTimeMillis
mssTime :: UTCTimeMillis,
    MessageSendingStatus -> QualifiedUserClients
mssMissingClients :: QualifiedUserClients,
    MessageSendingStatus -> QualifiedUserClients
mssRedundantClients :: QualifiedUserClients,
    MessageSendingStatus -> QualifiedUserClients
mssDeletedClients :: QualifiedUserClients,
    MessageSendingStatus -> QualifiedUserClients
mssFailedToSend :: QualifiedUserClients,
    MessageSendingStatus -> QualifiedUserClients
mssFailedToConfirmClients :: QualifiedUserClients
  }
  deriving stock (MessageSendingStatus -> MessageSendingStatus -> Bool
(MessageSendingStatus -> MessageSendingStatus -> Bool)
-> (MessageSendingStatus -> MessageSendingStatus -> Bool)
-> Eq MessageSendingStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageSendingStatus -> MessageSendingStatus -> Bool
== :: MessageSendingStatus -> MessageSendingStatus -> Bool
$c/= :: MessageSendingStatus -> MessageSendingStatus -> Bool
/= :: MessageSendingStatus -> MessageSendingStatus -> Bool
Eq, Int -> MessageSendingStatus -> ShowS
[MessageSendingStatus] -> ShowS
MessageSendingStatus -> String
(Int -> MessageSendingStatus -> ShowS)
-> (MessageSendingStatus -> String)
-> ([MessageSendingStatus] -> ShowS)
-> Show MessageSendingStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageSendingStatus -> ShowS
showsPrec :: Int -> MessageSendingStatus -> ShowS
$cshow :: MessageSendingStatus -> String
show :: MessageSendingStatus -> String
$cshowList :: [MessageSendingStatus] -> ShowS
showList :: [MessageSendingStatus] -> ShowS
Show, (forall x. MessageSendingStatus -> Rep MessageSendingStatus x)
-> (forall x. Rep MessageSendingStatus x -> MessageSendingStatus)
-> Generic MessageSendingStatus
forall x. Rep MessageSendingStatus x -> MessageSendingStatus
forall x. MessageSendingStatus -> Rep MessageSendingStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageSendingStatus -> Rep MessageSendingStatus x
from :: forall x. MessageSendingStatus -> Rep MessageSendingStatus x
$cto :: forall x. Rep MessageSendingStatus x -> MessageSendingStatus
to :: forall x. Rep MessageSendingStatus x -> MessageSendingStatus
Generic)
  deriving ([MessageSendingStatus] -> Value
[MessageSendingStatus] -> Encoding
MessageSendingStatus -> Value
MessageSendingStatus -> Encoding
(MessageSendingStatus -> Value)
-> (MessageSendingStatus -> Encoding)
-> ([MessageSendingStatus] -> Value)
-> ([MessageSendingStatus] -> Encoding)
-> ToJSON MessageSendingStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MessageSendingStatus -> Value
toJSON :: MessageSendingStatus -> Value
$ctoEncoding :: MessageSendingStatus -> Encoding
toEncoding :: MessageSendingStatus -> Encoding
$ctoJSONList :: [MessageSendingStatus] -> Value
toJSONList :: [MessageSendingStatus] -> Value
$ctoEncodingList :: [MessageSendingStatus] -> Encoding
toEncodingList :: [MessageSendingStatus] -> Encoding
A.ToJSON, Value -> Parser [MessageSendingStatus]
Value -> Parser MessageSendingStatus
(Value -> Parser MessageSendingStatus)
-> (Value -> Parser [MessageSendingStatus])
-> FromJSON MessageSendingStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MessageSendingStatus
parseJSON :: Value -> Parser MessageSendingStatus
$cparseJSONList :: Value -> Parser [MessageSendingStatus]
parseJSONList :: Value -> Parser [MessageSendingStatus]
A.FromJSON, Typeable MessageSendingStatus
Typeable MessageSendingStatus =>
(Proxy MessageSendingStatus
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema MessageSendingStatus
Proxy MessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy MessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy MessageSendingStatus
-> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema MessageSendingStatus

instance ToSchema MessageSendingStatus where
  schema :: ValueSchema NamedSwaggerDoc MessageSendingStatus
schema =
    Text
-> (NamedSwaggerDoc -> NamedSwaggerDoc)
-> ObjectSchema SwaggerDoc MessageSendingStatus
-> ValueSchema NamedSwaggerDoc MessageSendingStatus
forall doc doc' a.
HasObject doc doc' =>
Text -> (doc' -> doc') -> ObjectSchema doc a -> ValueSchema doc' a
objectWithDocModifier
      Text
"MessageSendingStatus"
      ((Maybe Text -> Identity (Maybe Text))
-> NamedSwaggerDoc -> Identity NamedSwaggerDoc
forall s a. HasDescription s a => Lens' s a
Lens' NamedSwaggerDoc (Maybe Text)
description ((Maybe Text -> Identity (Maybe Text))
 -> NamedSwaggerDoc -> Identity NamedSwaggerDoc)
-> Text -> NamedSwaggerDoc -> NamedSwaggerDoc
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
combinedDesc)
      (ObjectSchema SwaggerDoc MessageSendingStatus
 -> ValueSchema NamedSwaggerDoc MessageSendingStatus)
-> ObjectSchema SwaggerDoc MessageSendingStatus
-> ValueSchema NamedSwaggerDoc MessageSendingStatus
forall a b. (a -> b) -> a -> b
$ UTCTimeMillis
-> QualifiedUserClients
-> QualifiedUserClients
-> QualifiedUserClients
-> QualifiedUserClients
-> QualifiedUserClients
-> MessageSendingStatus
MessageSendingStatus
        (UTCTimeMillis
 -> QualifiedUserClients
 -> QualifiedUserClients
 -> QualifiedUserClients
 -> QualifiedUserClients
 -> QualifiedUserClients
 -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus UTCTimeMillis
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageSendingStatus
     (QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> MessageSendingStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageSendingStatus -> UTCTimeMillis
mssTime (MessageSendingStatus -> UTCTimeMillis)
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus UTCTimeMillis
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
-> SchemaP SwaggerDoc Object [Pair] UTCTimeMillis UTCTimeMillis
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"time" SchemaP NamedSwaggerDoc Value Value UTCTimeMillis UTCTimeMillis
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageSendingStatus
  (QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageSendingStatus
     (QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> MessageSendingStatus)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageSendingStatus -> QualifiedUserClients
mssMissingClients (MessageSendingStatus -> QualifiedUserClients)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     QualifiedUserClients
     QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"missing" SchemaP
  NamedSwaggerDoc
  Value
  Value
  QualifiedUserClients
  QualifiedUserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageSendingStatus
  (QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageSendingStatus
     (QualifiedUserClients
      -> QualifiedUserClients
      -> QualifiedUserClients
      -> MessageSendingStatus)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageSendingStatus -> QualifiedUserClients
mssRedundantClients (MessageSendingStatus -> QualifiedUserClients)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     QualifiedUserClients
     QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"redundant" SchemaP
  NamedSwaggerDoc
  Value
  Value
  QualifiedUserClients
  QualifiedUserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageSendingStatus
  (QualifiedUserClients
   -> QualifiedUserClients
   -> QualifiedUserClients
   -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageSendingStatus
     (QualifiedUserClients
      -> QualifiedUserClients -> MessageSendingStatus)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageSendingStatus -> QualifiedUserClients
mssDeletedClients (MessageSendingStatus -> QualifiedUserClients)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     QualifiedUserClients
     QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"deleted" SchemaP
  NamedSwaggerDoc
  Value
  Value
  QualifiedUserClients
  QualifiedUserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageSendingStatus
  (QualifiedUserClients
   -> QualifiedUserClients -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     MessageSendingStatus
     (QualifiedUserClients -> MessageSendingStatus)
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageSendingStatus -> QualifiedUserClients
mssFailedToSend (MessageSendingStatus -> QualifiedUserClients)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     QualifiedUserClients
     QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"failed_to_send" SchemaP
  NamedSwaggerDoc
  Value
  Value
  QualifiedUserClients
  QualifiedUserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  MessageSendingStatus
  (QualifiedUserClients -> MessageSendingStatus)
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
-> ObjectSchema SwaggerDoc MessageSendingStatus
forall a b.
SchemaP SwaggerDoc Object [Pair] MessageSendingStatus (a -> b)
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus a
-> SchemaP SwaggerDoc Object [Pair] MessageSendingStatus b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MessageSendingStatus -> QualifiedUserClients
mssFailedToConfirmClients (MessageSendingStatus -> QualifiedUserClients)
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] MessageSendingStatus QualifiedUserClients
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP
     NamedSwaggerDoc
     Value
     Value
     QualifiedUserClients
     QualifiedUserClients
-> SchemaP
     SwaggerDoc Object [Pair] QualifiedUserClients QualifiedUserClients
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"failed_to_confirm_clients" SchemaP
  NamedSwaggerDoc
  Value
  Value
  QualifiedUserClients
  QualifiedUserClients
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
    where
      combinedDesc :: Text
combinedDesc =
        Text
"The Proteus message sending status. It has these fields:\n\
        \- `time`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
timeDesc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
             \- `missing`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
missingDesc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
             \- `redundant`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
redundantDesc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
             \- `deleted`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
deletedDesc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
             \- `failed_to_send`: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
failedToSendDesc
      timeDesc :: Text
timeDesc = Text
"Time of sending message."
      missingDesc :: Text
missingDesc = Text
"Clients that the message /should/ have been encrypted for, but wasn't."
      redundantDesc :: Text
redundantDesc = Text
"Clients that the message /should not/ have been encrypted for, but was."
      deletedDesc :: Text
deletedDesc = Text
"Clients that were deleted."
      failedToSendDesc :: Text
failedToSendDesc =
        Text
"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 (Int -> IgnoreMissing -> ShowS
[IgnoreMissing] -> ShowS
IgnoreMissing -> String
(Int -> IgnoreMissing -> ShowS)
-> (IgnoreMissing -> String)
-> ([IgnoreMissing] -> ShowS)
-> Show IgnoreMissing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IgnoreMissing -> ShowS
showsPrec :: Int -> IgnoreMissing -> ShowS
$cshow :: IgnoreMissing -> String
show :: IgnoreMissing -> String
$cshowList :: [IgnoreMissing] -> ShowS
showList :: [IgnoreMissing] -> ShowS
Show, IgnoreMissing -> IgnoreMissing -> Bool
(IgnoreMissing -> IgnoreMissing -> Bool)
-> (IgnoreMissing -> IgnoreMissing -> Bool) -> Eq IgnoreMissing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IgnoreMissing -> IgnoreMissing -> Bool
== :: IgnoreMissing -> IgnoreMissing -> Bool
$c/= :: IgnoreMissing -> IgnoreMissing -> Bool
/= :: IgnoreMissing -> IgnoreMissing -> Bool
Eq)

instance S.ToParamSchema IgnoreMissing where
  toParamSchema :: Proxy IgnoreMissing -> Schema
toParamSchema Proxy IgnoreMissing
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

instance FromHttpApiData IgnoreMissing where
  parseQueryParam :: Text -> Either Text IgnoreMissing
parseQueryParam = \case
    Text
"true" -> IgnoreMissing -> Either Text IgnoreMissing
forall a b. b -> Either a b
Right IgnoreMissing
IgnoreMissingAll
    Text
"false" -> IgnoreMissing -> Either Text IgnoreMissing
forall a b. b -> Either a b
Right (IgnoreMissing -> Either Text IgnoreMissing)
-> IgnoreMissing -> Either Text IgnoreMissing
forall a b. (a -> b) -> a -> b
$ Set UserId -> IgnoreMissing
IgnoreMissingList Set UserId
forall a. Monoid a => a
mempty
    Text
list -> Set UserId -> IgnoreMissing
IgnoreMissingList (Set UserId -> IgnoreMissing)
-> (CommaSeparatedList UserId -> Set UserId)
-> CommaSeparatedList UserId
-> IgnoreMissing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ([UserId] -> Set UserId)
-> (CommaSeparatedList UserId -> [UserId])
-> CommaSeparatedList UserId
-> Set UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaSeparatedList UserId -> [UserId]
forall a. CommaSeparatedList a -> [a]
fromCommaSeparatedList (CommaSeparatedList UserId -> IgnoreMissing)
-> Either Text (CommaSeparatedList UserId)
-> Either Text IgnoreMissing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text (CommaSeparatedList UserId)
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
list

data ReportMissing
  = ReportMissingAll
  | ReportMissingList (Set UserId)

instance S.ToParamSchema ReportMissing where
  toParamSchema :: Proxy ReportMissing -> Schema
toParamSchema Proxy ReportMissing
_ = Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString

instance FromHttpApiData ReportMissing where
  parseQueryParam :: Text -> Either Text ReportMissing
parseQueryParam = \case
    Text
"true" -> ReportMissing -> Either Text ReportMissing
forall a b. b -> Either a b
Right ReportMissing
ReportMissingAll
    Text
"false" -> ReportMissing -> Either Text ReportMissing
forall a b. b -> Either a b
Right (ReportMissing -> Either Text ReportMissing)
-> ReportMissing -> Either Text ReportMissing
forall a b. (a -> b) -> a -> b
$ Set UserId -> ReportMissing
ReportMissingList Set UserId
forall a. Monoid a => a
mempty
    Text
list -> Set UserId -> ReportMissing
ReportMissingList (Set UserId -> ReportMissing)
-> (CommaSeparatedList UserId -> Set UserId)
-> CommaSeparatedList UserId
-> ReportMissing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ([UserId] -> Set UserId)
-> (CommaSeparatedList UserId -> [UserId])
-> CommaSeparatedList UserId
-> Set UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaSeparatedList UserId -> [UserId]
forall a. CommaSeparatedList a -> [a]
fromCommaSeparatedList (CommaSeparatedList UserId -> ReportMissing)
-> Either Text (CommaSeparatedList UserId)
-> Either Text ReportMissing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text (CommaSeparatedList UserId)
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
list