{-# LANGUAGE TemplateHaskell #-}

module Wire.GundeckAPIAccess where

import Bilge
import Data.ByteString.Conversion
import Data.Id
import Imports
import Network.HTTP.Types
import Polysemy
import Util.Options
import Wire.API.Push.V2 qualified as V2
import Wire.Rpc

data GundeckAPIAccess m a where
  PushV2 :: [V2.Push] -> GundeckAPIAccess m ()
  UserDeleted :: UserId -> GundeckAPIAccess m ()
  UnregisterPushClient :: UserId -> ClientId -> GundeckAPIAccess m ()
  GetPushTokens :: UserId -> GundeckAPIAccess m [V2.PushToken]

makeSem ''GundeckAPIAccess

runGundeckAPIAccess :: (Member Rpc r, Member (Embed IO) r) => Endpoint -> Sem (GundeckAPIAccess : r) a -> Sem r a
runGundeckAPIAccess :: forall (r :: EffectRow) a.
(Member Rpc r, Member (Embed IO) r) =>
Endpoint -> Sem (GundeckAPIAccess : r) a -> Sem r a
runGundeckAPIAccess Endpoint
ep = (forall (rInitial :: EffectRow) x.
 GundeckAPIAccess (Sem rInitial) x -> Sem r x)
-> Sem (GundeckAPIAccess : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  GundeckAPIAccess (Sem rInitial) x -> Sem r x)
 -> Sem (GundeckAPIAccess : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    GundeckAPIAccess (Sem rInitial) x -> Sem r x)
-> Sem (GundeckAPIAccess : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  PushV2 [Push]
pushes -> do
    Request -> Request
chunkedReq <- [Push] -> Sem r (Request -> Request)
forall a (m :: * -> *).
(ToJSON a, MonadIO m) =>
a -> m (Request -> Request)
jsonChunkedIO [Push]
pushes
    -- No retries because the chunked request body cannot be replayed.
    Sem r (Response (Maybe LByteString)) -> Sem r x
Sem r (Response (Maybe LByteString)) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Response (Maybe LByteString)) -> Sem r x)
-> ((Request -> Request) -> Sem r (Response (Maybe LByteString)))
-> (Request -> Request)
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
forall (r :: EffectRow).
Member Rpc r =>
ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
rpc ServiceName
"gundeck" Endpoint
ep ((Request -> Request) -> Sem r x)
-> (Request -> Request) -> Sem r x
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
POST
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/push/v2"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
chunkedReq
  UserDeleted UserId
uid -> do
    Sem r (Response (Maybe LByteString)) -> Sem r x
Sem r (Response (Maybe LByteString)) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Response (Maybe LByteString)) -> Sem r x)
-> ((Request -> Request) -> Sem r (Response (Maybe LByteString)))
-> (Request -> Request)
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
forall (r :: EffectRow).
Member Rpc r =>
ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
rpcWithRetries ServiceName
"gundeck" Endpoint
ep ((Request -> Request) -> Sem r x)
-> (Request -> Request) -> Sem r x
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
DELETE
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Request -> Request
path ByteString
"/i/user"
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Request -> Request
zUser UserId
uid
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
  UnregisterPushClient UserId
uid ClientId
cid -> do
    Sem r (Response (Maybe LByteString)) -> Sem r x
Sem r (Response (Maybe LByteString)) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Response (Maybe LByteString)) -> Sem r x)
-> ((Request -> Request) -> Sem r (Response (Maybe LByteString)))
-> (Request -> Request)
-> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
forall (r :: EffectRow).
Member Rpc r =>
ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
rpcWithRetries ServiceName
"gundeck" Endpoint
ep ((Request -> Request) -> Sem r x)
-> (Request -> Request) -> Sem r x
forall a b. (a -> b) -> a -> b
$
      StdMethod -> Request -> Request
method StdMethod
DELETE
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"i", ByteString
"clients", ClientId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' ClientId
cid]
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Request -> Request
zUser UserId
uid
        (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Status] -> Request -> Request
expect [Status
status200, Status
status204, Status
status404]
  GetPushTokens UserId
uid -> do
    Response (Maybe LByteString)
rsp <-
      ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
forall (r :: EffectRow).
Member Rpc r =>
ServiceName
-> Endpoint
-> (Request -> Request)
-> Sem r (Response (Maybe LByteString))
rpcWithRetries ServiceName
"gundeck" Endpoint
ep ((Request -> Request) -> Sem r (Response (Maybe LByteString)))
-> (Request -> Request) -> Sem r (Response (Maybe LByteString))
forall a b. (a -> b) -> a -> b
$
        StdMethod -> Request -> Request
method StdMethod
GET
          (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Request -> Request
paths [ByteString
"i", ByteString
"push-tokens", UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' UserId
uid]
          (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Request -> Request
zUser UserId
uid
          (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
expect2xx
    Response (Maybe LByteString) -> Maybe PushTokenList
forall a.
(HasCallStack, Typeable a, FromJSON a) =>
Response (Maybe LByteString) -> Maybe a
responseJsonMaybe Response (Maybe LByteString)
rsp Maybe PushTokenList -> (Maybe PushTokenList -> Sem r x) -> Sem r x
forall a b. a -> (a -> b) -> b
& Sem r x
-> (PushTokenList -> Sem r x) -> Maybe PushTokenList -> Sem r x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Sem r x) -> (PushTokenList -> x) -> PushTokenList -> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushTokenList -> x
PushTokenList -> [PushToken]
V2.pushTokens)