{-# 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
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)