{-# LANGUAGE TemplateHaskell #-}

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

module Wire.API.Internal.Notification
  ( -- * Notification
    Notification (..),
    NotificationId,

    -- * NotificationTarget
    NotificationTarget,
    target,
    targetUser,
    targetClients,

    -- * QueuedNotification (re-export)
    QueuedNotification,
    queuedNotification,
    queuedNotificationId,
    queuedNotificationPayload,
    QueuedNotificationList,
    queuedNotificationList,
    queuedNotifications,
    queuedHasMore,
    queuedTime,
  )
where

import Control.Lens (makeLenses)
import Data.Aeson
import Data.Id
import Data.List1
import Data.OpenApi qualified as Swagger
import Data.Schema qualified as S
import Imports
import Wire.API.Notification

-------------------------------------------------------------------------------
-- Notification

data Notification = Notification
  { Notification -> NotificationId
ntfId :: !NotificationId,
    Notification -> Bool
ntfTransient :: !Bool,
    Notification -> List1 Object
ntfPayload :: !(List1 Object)
  }
  deriving (Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
/= :: Notification -> Notification -> Bool
Eq, Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Notification -> ShowS
showsPrec :: Int -> Notification -> ShowS
$cshow :: Notification -> String
show :: Notification -> String
$cshowList :: [Notification] -> ShowS
showList :: [Notification] -> ShowS
Show)
  deriving (Value -> Parser [Notification]
Value -> Parser Notification
(Value -> Parser Notification)
-> (Value -> Parser [Notification]) -> FromJSON Notification
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Notification
parseJSON :: Value -> Parser Notification
$cparseJSONList :: Value -> Parser [Notification]
parseJSONList :: Value -> Parser [Notification]
FromJSON, [Notification] -> Value
[Notification] -> Encoding
Notification -> Value
Notification -> Encoding
(Notification -> Value)
-> (Notification -> Encoding)
-> ([Notification] -> Value)
-> ([Notification] -> Encoding)
-> ToJSON Notification
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Notification -> Value
toJSON :: Notification -> Value
$ctoEncoding :: Notification -> Encoding
toEncoding :: Notification -> Encoding
$ctoJSONList :: [Notification] -> Value
toJSONList :: [Notification] -> Value
$ctoEncodingList :: [Notification] -> Encoding
toEncodingList :: [Notification] -> Encoding
ToJSON, Typeable Notification
Typeable Notification =>
(Proxy Notification -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Notification
Proxy Notification -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Notification -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Notification -> Declare (Definitions Schema) NamedSchema
Swagger.ToSchema) via S.Schema Notification

instance S.ToSchema Notification where
  schema :: ValueSchema NamedSwaggerDoc Notification
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Notification Notification
-> ValueSchema NamedSwaggerDoc Notification
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
S.object Text
"Notification" (SchemaP SwaggerDoc Object [Pair] Notification Notification
 -> ValueSchema NamedSwaggerDoc Notification)
-> SchemaP SwaggerDoc Object [Pair] Notification Notification
-> ValueSchema NamedSwaggerDoc Notification
forall a b. (a -> b) -> a -> b
$
      NotificationId -> Bool -> List1 Object -> Notification
Notification
        (NotificationId -> Bool -> List1 Object -> Notification)
-> SchemaP SwaggerDoc Object [Pair] Notification NotificationId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Notification
     (Bool -> List1 Object -> Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Notification -> NotificationId
ntfId (Notification -> NotificationId)
-> SchemaP SwaggerDoc Object [Pair] NotificationId NotificationId
-> SchemaP SwaggerDoc Object [Pair] Notification NotificationId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= Text
-> SchemaP
     NamedSwaggerDoc Value Value NotificationId NotificationId
-> SchemaP SwaggerDoc Object [Pair] NotificationId NotificationId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"id" SchemaP NamedSwaggerDoc Value Value NotificationId NotificationId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Notification
  (Bool -> List1 Object -> Notification)
-> SchemaP SwaggerDoc Object [Pair] Notification Bool
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     Notification
     (List1 Object -> Notification)
forall a b.
SchemaP SwaggerDoc Object [Pair] Notification (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Notification a
-> SchemaP SwaggerDoc Object [Pair] Notification b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Notification -> Bool
ntfTransient (Notification -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
-> SchemaP SwaggerDoc Object [Pair] Notification Bool
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool (Maybe Bool)
-> SchemaP SwaggerDoc Object [Pair] Bool Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
S.optField Text
"transient" SchemaP NamedSwaggerDoc Value Value Bool Bool
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
S.schema)
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  Notification
  (List1 Object -> Notification)
-> SchemaP SwaggerDoc Object [Pair] Notification (List1 Object)
-> SchemaP SwaggerDoc Object [Pair] Notification Notification
forall a b.
SchemaP SwaggerDoc Object [Pair] Notification (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Notification a
-> SchemaP SwaggerDoc Object [Pair] Notification b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (List1 Object -> NonEmpty Object
forall a. List1 a -> NonEmpty a
toNonEmpty (List1 Object -> NonEmpty Object)
-> (Notification -> List1 Object)
-> Notification
-> NonEmpty Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notification -> List1 Object
ntfPayload) (Notification -> NonEmpty Object)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty Object) (List1 Object)
-> SchemaP SwaggerDoc Object [Pair] Notification (List1 Object)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
S..= (NonEmpty Object -> List1 Object)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty Object) (NonEmpty Object)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty Object) (List1 Object)
forall a b.
(a -> b)
-> SchemaP SwaggerDoc Object [Pair] (NonEmpty Object) a
-> SchemaP SwaggerDoc Object [Pair] (NonEmpty Object) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Object -> List1 Object
forall a. NonEmpty a -> List1 a
List1 (Text
-> SchemaP
     SwaggerDoc Value Value (NonEmpty Object) (NonEmpty Object)
-> SchemaP
     SwaggerDoc Object [Pair] (NonEmpty Object) (NonEmpty Object)
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
S.field Text
"payload" (ValueSchema SwaggerDoc Object
-> SchemaP
     SwaggerDoc Value Value (NonEmpty Object) (NonEmpty Object)
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc,
 HasMinItems doc (Maybe Integer)) =>
ValueSchema ndoc a -> ValueSchema doc (NonEmpty a)
S.nonEmptyArray ValueSchema SwaggerDoc Object
S.jsonObject))

--------------------------------------------------------------------------------
-- NotificationTarget

data NotificationTarget = NotificationTarget
  { NotificationTarget -> UserId
_targetUser :: !UserId,
    NotificationTarget -> [ClientId]
_targetClients :: ![ClientId]
  }
  deriving (NotificationTarget -> NotificationTarget -> Bool
(NotificationTarget -> NotificationTarget -> Bool)
-> (NotificationTarget -> NotificationTarget -> Bool)
-> Eq NotificationTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationTarget -> NotificationTarget -> Bool
== :: NotificationTarget -> NotificationTarget -> Bool
$c/= :: NotificationTarget -> NotificationTarget -> Bool
/= :: NotificationTarget -> NotificationTarget -> Bool
Eq, Int -> NotificationTarget -> ShowS
[NotificationTarget] -> ShowS
NotificationTarget -> String
(Int -> NotificationTarget -> ShowS)
-> (NotificationTarget -> String)
-> ([NotificationTarget] -> ShowS)
-> Show NotificationTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationTarget -> ShowS
showsPrec :: Int -> NotificationTarget -> ShowS
$cshow :: NotificationTarget -> String
show :: NotificationTarget -> String
$cshowList :: [NotificationTarget] -> ShowS
showList :: [NotificationTarget] -> ShowS
Show)

makeLenses ''NotificationTarget

target :: UserId -> NotificationTarget
target :: UserId -> NotificationTarget
target UserId
u = UserId -> [ClientId] -> NotificationTarget
NotificationTarget UserId
u []

instance FromJSON NotificationTarget where
  parseJSON :: Value -> Parser NotificationTarget
parseJSON = String
-> (Object -> Parser NotificationTarget)
-> Value
-> Parser NotificationTarget
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NotificationTarget" ((Object -> Parser NotificationTarget)
 -> Value -> Parser NotificationTarget)
-> (Object -> Parser NotificationTarget)
-> Value
-> Parser NotificationTarget
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    UserId -> [ClientId] -> NotificationTarget
NotificationTarget
      (UserId -> [ClientId] -> NotificationTarget)
-> Parser UserId -> Parser ([ClientId] -> NotificationTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser UserId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      Parser ([ClientId] -> NotificationTarget)
-> Parser [ClientId] -> Parser NotificationTarget
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [ClientId]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"clients"

instance ToJSON NotificationTarget where
  toJSON :: NotificationTarget -> Value
toJSON (NotificationTarget UserId
u [ClientId]
cs) =
    [Pair] -> Value
object
      [ Key
"user" Key -> UserId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UserId
u,
        Key
"clients" Key -> [ClientId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [ClientId]
cs
      ]