delete /push/tokens/:pid

Author: battermann

libs/wire-api/src/Wire/API/Error/Gundeck.hs

@@ -25,6 +25,7 @@ data GundeckError
   | AddTokenErrorInvalid
   | AddTokenErrorTooLong
   | AddTokenErrorMetadataTooLong
+  | TokenNotFound
 
 instance KnownError (MapError e) => IsSwaggerError (e :: GundeckError) where
   addToSwagger = addStaticErrorToSwagger @(MapError e)
@@ -38,3 +39,5 @@ type instance MapError 'AddTokenErrorInvalid = 'StaticError 404 "invalid-token"
 type instance MapError 'AddTokenErrorTooLong = 'StaticError 413 "token-too-long" "Push token length must be < 8192 for GCM or 400 for APNS"
 
 type instance MapError 'AddTokenErrorMetadataTooLong = 'StaticError 413 "metadata-too-long" "Tried to add token to endpoint resulting in metadata length > 2048"
+
+type instance MapError 'TokenNotFound = 'StaticError 404 "not-found" "Push token not found"

libs/wire-api/src/Wire/API/Push/V2/Token.hs

@@ -38,6 +38,7 @@ module Wire.API.Push.V2.Token
     AddTokenError (..),
     AddTokenSuccess (..),
     AddTokenResponses,
+    DeleteTokenResponses,
 
     -- * Swagger
     modelPushToken,
@@ -205,7 +206,7 @@ instance ToSchema AppName where
 makeLenses ''PushToken
 
 --------------------------------------------------------------------------------
--- API types
+-- Add token types
 
 type AddTokenErrorResponses =
   '[ ErrorResponse 'E.AddTokenErrorNoBudget,
@@ -244,3 +245,11 @@ instance AsHeaders '[Token] PushToken AddTokenSuccess where
 instance (res ~ AddTokenResponses) => AsUnion res (Either AddTokenError AddTokenSuccess) where
   toUnion = eitherToUnion (toUnion @AddTokenErrorResponses) (Z . I)
   fromUnion = eitherFromUnion (fromUnion @AddTokenErrorResponses) (unI . unZ)
+
+--------------------------------------------------------------------------------
+-- Delete token types
+
+type DeleteTokenResponses =
+  '[ ErrorResponse 'E.TokenNotFound,
+     RespondEmpty 204 "Push token unregistered"
+   ]

libs/wire-api/src/Wire/API/Routes/Public/Gundeck.hs

@@ -38,6 +38,15 @@ type GundeckAPI =
         :> ReqBody '[JSON] PushToken
         :> MultiVerb 'POST '[JSON] AddTokenResponses (Either AddTokenError AddTokenSuccess)
     )
+    :<|> Named
+           "delete-push-token"
+           ( Summary "Unregister a native push token"
+               :> ZUser
+               :> "push"
+               :> "tokens"
+               :> Capture' '[Description "The push token to delete"] "pid" Token
+               :> MultiVerb 'DELETE '[JSON] DeleteTokenResponses (Maybe ())
+           )
 
 swaggerDoc :: Swagger.Swagger
 swaggerDoc = toSwagger (Proxy @GundeckAPI)

services/gundeck/src/Gundeck/API/Public.hs

@@ -40,7 +40,7 @@ import Network.Wai.Predicate hiding (setStatus)
 import Network.Wai.Routing hiding (route)
 import Network.Wai.Utilities as Wai
 import Network.Wai.Utilities.Swagger
-import Servant (HasServer (..))
+import Servant (HasServer (..), (:<|>) (..))
 import Wire.API.Notification (NotificationId)
 import qualified Wire.API.Notification as Public
 import qualified Wire.API.Push.Token as Public
@@ -52,7 +52,9 @@ import qualified Wire.API.Swagger as Public.Swagger
 -- Servant API
 
 servantSitemap :: ServerT GundeckAPI Gundeck
-servantSitemap = Named @"register-push-token" addToken
+servantSitemap =
+  Named @"register-push-token" addToken
+    :<|> Named @"delete-push-token" deleteToken
 
 --------------------------------------------------------------------------------
 -- Wai Routes API
@@ -61,17 +63,6 @@ sitemap :: Routes ApiBuilder Gundeck ()
 sitemap = do
   -- Push API -----------------------------------------------------------
 
-  delete "/push/tokens/:pid" (continue deleteTokenH) $
-    header "Z-User"
-      .&. param "pid"
-      .&. accept "application" "json"
-  document "DELETE" "unregisterPushToken" $ do
-    summary "Unregister a native push token"
-    parameter Path "pid" bytes' $
-      description "The push token to delete"
-    response 204 "Push token unregistered" end
-    response 404 "Push token does not exist" end
-
   get "/push/tokens" (continue listTokensH) $
     header "Z-User"
       .&. accept "application" "json"
@@ -154,9 +145,8 @@ addToken uid cid newtok =
     Push.AddTokenTooLong -> Left Public.AddTokenErrorTooLong
     Push.AddTokenMetadataTooLong -> Left Public.AddTokenErrorMetadataTooLong
 
-deleteTokenH :: UserId ::: Public.Token ::: JSON -> Gundeck Response
-deleteTokenH (uid ::: tok ::: _) =
-  setStatus status204 empty <$ Push.deleteToken uid tok
+deleteToken :: UserId -> Public.Token -> Gundeck (Maybe ())
+deleteToken = Push.deleteToken
 
 listTokensH :: UserId ::: JSON -> Gundeck Response
 listTokensH (uid ::: _) =

services/gundeck/src/Gundeck/Push.hs

@@ -414,8 +414,10 @@ addToken :: UserId -> ConnId -> PushToken -> Gundeck AddTokenResponse
 addToken uid cid newtok = mpaRunWithBudget 1 AddTokenNoBudget $ do
   (cur, old) <- foldl' (matching newtok) (Nothing, []) <$> Data.lookup uid Data.LocalQuorum
   Log.info $
-    "user" .= UUID.toASCIIBytes (toUUID uid)
-      ~~ "token" .= Text.take 16 (tokenText (newtok ^. token))
+    "user"
+      .= UUID.toASCIIBytes (toUUID uid)
+      ~~ "token"
+      .= Text.take 16 (tokenText (newtok ^. token))
       ~~ msg (val "Registering push token")
   continue newtok cur
     >>= either
@@ -466,7 +468,8 @@ addToken uid cid newtok = mpaRunWithBudget 1 AddTokenNoBudget $ do
           pure (Left AddTokenNotFound)
         Left (Aws.InvalidToken _) -> do
           Log.info $
-            "token" .= tokenText tok
+            "token"
+              .= tokenText tok
               ~~ msg (val "Invalid push token.")
           pure (Left AddTokenInvalid)
         Left (Aws.TokenTooLong l) -> do
@@ -537,17 +540,22 @@ updateEndpoint uid t arn e = do
     equalTransport = t ^. tokenTransport == arn ^. snsTopic . endpointTransport
     equalApp = t ^. tokenApp == arn ^. snsTopic . endpointAppName
     logMessage a r tk m =
-      "user" .= UUID.toASCIIBytes (toUUID a)
-        ~~ "token" .= Text.take 16 (tokenText tk)
-        ~~ "arn" .= toText r
+      "user"
+        .= UUID.toASCIIBytes (toUUID a)
+        ~~ "token"
+        .= Text.take 16 (tokenText tk)
+        ~~ "arn"
+        .= toText r
         ~~ msg (val m)
 
-deleteToken :: UserId -> Token -> Gundeck ()
+deleteToken :: UserId -> Token -> Gundeck (Maybe ())
 deleteToken uid tok = do
-  as <- filter (\x -> x ^. addrToken == tok) <$> Data.lookup uid Data.LocalQuorum
-  when (null as) $
-    throwM (mkError status404 "not-found" "Push token not found")
-  Native.deleteTokens as Nothing
+  Data.lookup uid Data.LocalQuorum
+    >>= ( \case
+            [] -> pure Nothing
+            xs -> Native.deleteTokens xs Nothing $> Just ()
+        )
+      . filter (\x -> x ^. addrToken == tok)
 
 listTokens :: UserId -> Gundeck PushTokenList
 listTokens uid = PushTokenList . map (^. addrPushToken) <$> Data.lookup uid Data.LocalQuorum