-- 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/>.

-- | Types and utilies around unreachable backends and failing to process
-- various kinds of messages.
module Wire.API.Unreachable
  ( -- * Failed to process
    UnreachableUsers (unreachableUsers),
    unreachableFromList,
  )
where

import Data.Aeson qualified as A
import Data.Id
import Data.List.NonEmpty
import Data.List.NonEmpty qualified as NE
import Data.OpenApi qualified as S
import Data.Qualified
import Data.Schema
import Imports

newtype UnreachableUsers = UnreachableUsers {UnreachableUsers -> NonEmpty (Qualified UserId)
unreachableUsers :: NonEmpty (Qualified UserId)}
  deriving stock (UnreachableUsers -> UnreachableUsers -> Bool
(UnreachableUsers -> UnreachableUsers -> Bool)
-> (UnreachableUsers -> UnreachableUsers -> Bool)
-> Eq UnreachableUsers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnreachableUsers -> UnreachableUsers -> Bool
== :: UnreachableUsers -> UnreachableUsers -> Bool
$c/= :: UnreachableUsers -> UnreachableUsers -> Bool
/= :: UnreachableUsers -> UnreachableUsers -> Bool
Eq, Int -> UnreachableUsers -> ShowS
[UnreachableUsers] -> ShowS
UnreachableUsers -> String
(Int -> UnreachableUsers -> ShowS)
-> (UnreachableUsers -> String)
-> ([UnreachableUsers] -> ShowS)
-> Show UnreachableUsers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnreachableUsers -> ShowS
showsPrec :: Int -> UnreachableUsers -> ShowS
$cshow :: UnreachableUsers -> String
show :: UnreachableUsers -> String
$cshowList :: [UnreachableUsers] -> ShowS
showList :: [UnreachableUsers] -> ShowS
Show)
  deriving ([UnreachableUsers] -> Value
[UnreachableUsers] -> Encoding
UnreachableUsers -> Value
UnreachableUsers -> Encoding
(UnreachableUsers -> Value)
-> (UnreachableUsers -> Encoding)
-> ([UnreachableUsers] -> Value)
-> ([UnreachableUsers] -> Encoding)
-> ToJSON UnreachableUsers
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: UnreachableUsers -> Value
toJSON :: UnreachableUsers -> Value
$ctoEncoding :: UnreachableUsers -> Encoding
toEncoding :: UnreachableUsers -> Encoding
$ctoJSONList :: [UnreachableUsers] -> Value
toJSONList :: [UnreachableUsers] -> Value
$ctoEncodingList :: [UnreachableUsers] -> Encoding
toEncodingList :: [UnreachableUsers] -> Encoding
A.ToJSON, Value -> Parser [UnreachableUsers]
Value -> Parser UnreachableUsers
(Value -> Parser UnreachableUsers)
-> (Value -> Parser [UnreachableUsers])
-> FromJSON UnreachableUsers
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser UnreachableUsers
parseJSON :: Value -> Parser UnreachableUsers
$cparseJSONList :: Value -> Parser [UnreachableUsers]
parseJSONList :: Value -> Parser [UnreachableUsers]
A.FromJSON, Typeable UnreachableUsers
Typeable UnreachableUsers =>
(Proxy UnreachableUsers
 -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UnreachableUsers
Proxy UnreachableUsers -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy UnreachableUsers -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy UnreachableUsers -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema UnreachableUsers

instance Semigroup UnreachableUsers where
  (UnreachableUsers NonEmpty (Qualified UserId)
m) <> :: UnreachableUsers -> UnreachableUsers -> UnreachableUsers
<> (UnreachableUsers NonEmpty (Qualified UserId)
n) = NonEmpty (Qualified UserId) -> UnreachableUsers
UnreachableUsers (NonEmpty (Qualified UserId) -> UnreachableUsers)
-> (NonEmpty (Qualified UserId) -> NonEmpty (Qualified UserId))
-> NonEmpty (Qualified UserId)
-> UnreachableUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> NonEmpty (Qualified UserId)
forall a. Eq a => NonEmpty a -> NonEmpty a
NE.nub (NonEmpty (Qualified UserId) -> UnreachableUsers)
-> NonEmpty (Qualified UserId) -> UnreachableUsers
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
m NonEmpty (Qualified UserId)
-> NonEmpty (Qualified UserId) -> NonEmpty (Qualified UserId)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (Qualified UserId)
n

instance ToSchema UnreachableUsers where
  schema :: ValueSchema NamedSwaggerDoc UnreachableUsers
schema =
    Text
-> SchemaP SwaggerDoc Value Value UnreachableUsers UnreachableUsers
-> ValueSchema NamedSwaggerDoc UnreachableUsers
forall doc doc' v m a b.
HasObject doc doc' =>
Text -> SchemaP doc v m a b -> SchemaP doc' v m a b
named Text
"UnreachableUsers" (SchemaP SwaggerDoc Value Value UnreachableUsers UnreachableUsers
 -> ValueSchema NamedSwaggerDoc UnreachableUsers)
-> SchemaP SwaggerDoc Value Value UnreachableUsers UnreachableUsers
-> ValueSchema NamedSwaggerDoc UnreachableUsers
forall a b. (a -> b) -> a -> b
$
      NonEmpty (Qualified UserId) -> UnreachableUsers
UnreachableUsers
        (NonEmpty (Qualified UserId) -> UnreachableUsers)
-> SchemaP
     SwaggerDoc
     Value
     Value
     UnreachableUsers
     (NonEmpty (Qualified UserId))
-> SchemaP SwaggerDoc Value Value UnreachableUsers UnreachableUsers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnreachableUsers -> NonEmpty (Qualified UserId)
unreachableUsers
          (UnreachableUsers -> NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
-> SchemaP
     SwaggerDoc
     Value
     Value
     UnreachableUsers
     (NonEmpty (Qualified UserId))
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ValueSchema NamedSwaggerDoc (Qualified UserId)
-> SchemaP
     SwaggerDoc
     Value
     Value
     (NonEmpty (Qualified UserId))
     (NonEmpty (Qualified UserId))
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
nonEmptyArray ValueSchema NamedSwaggerDoc (Qualified UserId)
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

unreachableFromList :: [Qualified UserId] -> Maybe UnreachableUsers
unreachableFromList :: [Qualified UserId] -> Maybe UnreachableUsers
unreachableFromList = (NonEmpty (Qualified UserId) -> UnreachableUsers)
-> Maybe (NonEmpty (Qualified UserId)) -> Maybe UnreachableUsers
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty (Qualified UserId) -> UnreachableUsers
UnreachableUsers (NonEmpty (Qualified UserId) -> UnreachableUsers)
-> (NonEmpty (Qualified UserId) -> NonEmpty (Qualified UserId))
-> NonEmpty (Qualified UserId)
-> UnreachableUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> NonEmpty (Qualified UserId)
forall a. Eq a => NonEmpty a -> NonEmpty a
NE.nub) (Maybe (NonEmpty (Qualified UserId)) -> Maybe UnreachableUsers)
-> ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId)))
-> [Qualified UserId]
-> Maybe UnreachableUsers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty