{-# LANGUAGE TemplateHaskell #-}

module Wire.NotificationSubsystem where

import Control.Concurrent.Async (Async)
import Control.Lens (makeLenses)
import Data.Aeson
import Data.Id
import Data.List.NonEmpty (NonEmpty ((:|)))
import Imports
import Polysemy
import Wire.API.Push.V2 hiding (Push (..), Recipient, newPush)
import Wire.Arbitrary

data Recipient = Recipient
  { Recipient -> UserId
recipientUserId :: UserId,
    Recipient -> RecipientClients
recipientClients :: RecipientClients
  }
  deriving stock (Int -> Recipient -> ShowS
[Recipient] -> ShowS
Recipient -> String
(Int -> Recipient -> ShowS)
-> (Recipient -> String)
-> ([Recipient] -> ShowS)
-> Show Recipient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recipient -> ShowS
showsPrec :: Int -> Recipient -> ShowS
$cshow :: Recipient -> String
show :: Recipient -> String
$cshowList :: [Recipient] -> ShowS
showList :: [Recipient] -> ShowS
Show, Eq Recipient
Eq Recipient =>
(Recipient -> Recipient -> Ordering)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Recipient)
-> (Recipient -> Recipient -> Recipient)
-> Ord Recipient
Recipient -> Recipient -> Bool
Recipient -> Recipient -> Ordering
Recipient -> Recipient -> Recipient
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 :: Recipient -> Recipient -> Ordering
compare :: Recipient -> Recipient -> Ordering
$c< :: Recipient -> Recipient -> Bool
< :: Recipient -> Recipient -> Bool
$c<= :: Recipient -> Recipient -> Bool
<= :: Recipient -> Recipient -> Bool
$c> :: Recipient -> Recipient -> Bool
> :: Recipient -> Recipient -> Bool
$c>= :: Recipient -> Recipient -> Bool
>= :: Recipient -> Recipient -> Bool
$cmax :: Recipient -> Recipient -> Recipient
max :: Recipient -> Recipient -> Recipient
$cmin :: Recipient -> Recipient -> Recipient
min :: Recipient -> Recipient -> Recipient
Ord, Recipient -> Recipient -> Bool
(Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool) -> Eq Recipient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Recipient -> Recipient -> Bool
== :: Recipient -> Recipient -> Bool
$c/= :: Recipient -> Recipient -> Bool
/= :: Recipient -> Recipient -> Bool
Eq, (forall x. Recipient -> Rep Recipient x)
-> (forall x. Rep Recipient x -> Recipient) -> Generic Recipient
forall x. Rep Recipient x -> Recipient
forall x. Recipient -> Rep Recipient x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Recipient -> Rep Recipient x
from :: forall x. Recipient -> Rep Recipient x
$cto :: forall x. Rep Recipient x -> Recipient
to :: forall x. Rep Recipient x -> Recipient
Generic)
  deriving (Gen Recipient
Gen Recipient -> (Recipient -> [Recipient]) -> Arbitrary Recipient
Recipient -> [Recipient]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Recipient
arbitrary :: Gen Recipient
$cshrink :: Recipient -> [Recipient]
shrink :: Recipient -> [Recipient]
Arbitrary) via GenericUniform Recipient

data Push = Push
  { Push -> Maybe ConnId
_pushConn :: Maybe ConnId,
    Push -> Bool
_pushTransient :: Bool,
    Push -> Route
_pushRoute :: Route,
    Push -> Maybe Priority
_pushNativePriority :: Maybe Priority,
    Push -> Maybe UserId
pushOrigin :: Maybe UserId,
    Push -> NonEmpty Recipient
_pushRecipients :: NonEmpty Recipient,
    Push -> Object
pushJson :: Object,
    Push -> Maybe ApsData
_pushApsData :: Maybe ApsData
  }
  deriving stock (Push -> Push -> Bool
(Push -> Push -> Bool) -> (Push -> Push -> Bool) -> Eq Push
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Push -> Push -> Bool
== :: Push -> Push -> Bool
$c/= :: Push -> Push -> Bool
/= :: Push -> Push -> Bool
Eq, (forall x. Push -> Rep Push x)
-> (forall x. Rep Push x -> Push) -> Generic Push
forall x. Rep Push x -> Push
forall x. Push -> Rep Push x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Push -> Rep Push x
from :: forall x. Push -> Rep Push x
$cto :: forall x. Rep Push x -> Push
to :: forall x. Rep Push x -> Push
Generic, Int -> Push -> ShowS
[Push] -> ShowS
Push -> String
(Int -> Push -> ShowS)
-> (Push -> String) -> ([Push] -> ShowS) -> Show Push
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Push -> ShowS
showsPrec :: Int -> Push -> ShowS
$cshow :: Push -> String
show :: Push -> String
$cshowList :: [Push] -> ShowS
showList :: [Push] -> ShowS
Show)
  deriving (Gen Push
Gen Push -> (Push -> [Push]) -> Arbitrary Push
Push -> [Push]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Push
arbitrary :: Gen Push
$cshrink :: Push -> [Push]
shrink :: Push -> [Push]
Arbitrary) via GenericUniform Push

makeLenses ''Push

-- | This subsystem governs mechanisms to send notifications to users.
data NotificationSubsystem m a where
  -- | Bulk push notifications
  PushNotifications :: [Push] -> NotificationSubsystem m ()
  -- | Bulk push notifications, but slowly. This should be used when there are
  -- many notifications to be sent which could cause too much resource usage.
  PushNotificationsSlowly :: [Push] -> NotificationSubsystem m ()
  -- | Bulk push notifications, but async. This should be used when failure to
  -- send notifications is not critical.
  --
  -- See 'Polysemy.Async' to know more about the 'Maybe'
  PushNotificationAsync :: Push -> NotificationSubsystem m (Async (Maybe ()))
  CleanupUser :: UserId -> NotificationSubsystem m ()
  UnregisterPushClient :: UserId -> ClientId -> NotificationSubsystem m ()
  GetPushTokens :: UserId -> NotificationSubsystem m [PushToken]

makeSem ''NotificationSubsystem

newPush1 :: Maybe UserId -> Object -> NonEmpty Recipient -> Push
newPush1 :: Maybe UserId -> Object -> NonEmpty Recipient -> Push
newPush1 Maybe UserId
from Object
e NonEmpty Recipient
rr =
  Push
    { $sel:_pushConn:Push :: Maybe ConnId
_pushConn = Maybe ConnId
forall a. Maybe a
Nothing,
      $sel:_pushTransient:Push :: Bool
_pushTransient = Bool
False,
      $sel:_pushRoute:Push :: Route
_pushRoute = Route
RouteAny,
      $sel:_pushNativePriority:Push :: Maybe Priority
_pushNativePriority = Maybe Priority
forall a. Maybe a
Nothing,
      $sel:_pushApsData:Push :: Maybe ApsData
_pushApsData = Maybe ApsData
forall a. Maybe a
Nothing,
      $sel:pushJson:Push :: Object
pushJson = Object
e,
      $sel:pushOrigin:Push :: Maybe UserId
pushOrigin = Maybe UserId
from,
      $sel:_pushRecipients:Push :: NonEmpty Recipient
_pushRecipients = NonEmpty Recipient
rr
    }

newPush :: Maybe UserId -> Object -> [Recipient] -> Maybe Push
newPush :: Maybe UserId -> Object -> [Recipient] -> Maybe Push
newPush Maybe UserId
_ Object
_ [] = Maybe Push
forall a. Maybe a
Nothing
newPush Maybe UserId
u Object
e (Recipient
r : [Recipient]
rr) = Push -> Maybe Push
forall a. a -> Maybe a
Just (Push -> Maybe Push) -> Push -> Maybe Push
forall a b. (a -> b) -> a -> b
$ Maybe UserId -> Object -> NonEmpty Recipient -> Push
newPush1 Maybe UserId
u Object
e (Recipient
r Recipient -> [Recipient] -> NonEmpty Recipient
forall a. a -> [a] -> NonEmpty a
:| [Recipient]
rr)

newPushLocal :: UserId -> Object -> [Recipient] -> Maybe Push
newPushLocal :: UserId -> Object -> [Recipient] -> Maybe Push
newPushLocal UserId
uid = Maybe UserId -> Object -> [Recipient] -> Maybe Push
newPush (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
uid)

newPushLocal1 :: UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 :: UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 UserId
uid = Maybe UserId -> Object -> NonEmpty Recipient -> Push
newPush1 (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
uid)