try recreating ARN when token exists in Cassandra

changelog.d/5-internal/SQPIT-1544

@@ -0,0 +1,4 @@
+When sending a push message, stop deleting the push token and start recreating
+ARN when ARN is reported as invalid on AWS, but push token still is present in
+Cassandra. This allows on-demand migrations from one AWS account used for push
+notifications to another one.

services/gundeck/src/Gundeck/Push/Data.hs

@@ -17,6 +17,7 @@
 
 module Gundeck.Push.Data
   ( insert,
+    updateArn,
     delete,
     lookup,
     erase,
@@ -47,6 +48,12 @@ insert u t a p e o c = retry x5 $ write q (params LocalQuorum (u, t, a, p, e, o,
     q :: PrepQuery W (UserId, Transport, AppName, Token, EndpointArn, ConnId, ClientId) ()
     q = "insert into user_push (usr, transport, app, ptoken, arn, connection, client) values (?, ?, ?, ?, ?, ?, ?)"
 
+updateArn :: MonadClient m => UserId -> Transport -> AppName -> Token -> EndpointArn -> m ()
+updateArn u t a p arn = retry x5 $ write q (params LocalQuorum (arn, u, t, a, p))
+  where
+    q :: PrepQuery W (EndpointArn, UserId, Transport, AppName, Token) ()
+    q = "update user_push set arn = ? where usr = ? and transport = ? and app = ? and ptoken = ?"
+
 delete :: MonadClient m => UserId -> Transport -> AppName -> Token -> m ()
 delete u t a p = retry x5 $ write q (params LocalQuorum (u, t, a, p))
   where

services/gundeck/src/Gundeck/Push/Native.hs

@@ -43,7 +43,7 @@ import Gundeck.Push.Native.Types as Types
 import Gundeck.Types
 import Gundeck.Util
 import Imports
-import System.Logger.Class (MonadLogger, field, msg, val, (~~))
+import System.Logger.Class (MonadLogger, field, msg, val, (.=), (~~))
 import qualified System.Logger.Class as Log
 import UnliftIO (handleAny, mapConcurrently, pooledMapConcurrentlyN_)
 import Wire.API.Internal.Notification
@@ -61,58 +61,90 @@ push m addrs = do
     Just chunkSize -> pooledMapConcurrentlyN_ chunkSize (push1 m) addrs
 
 push1 :: NativePush -> Address -> Gundeck ()
-push1 m a = do
-  e <- view awsEnv
-  r <- Aws.execute e $ publish m a
-  case r of
-    Success _ -> do
-      Log.debug $
-        field "user" (toByteString (a ^. addrUser))
-          ~~ field "notificationId" (toText (npNotificationid m))
-          ~~ Log.msg (val "Native push success")
-      view monitor >>= counterIncr (path "push.native.success")
-    Failure EndpointDisabled _ -> onDisabled
-    Failure PayloadTooLarge _ -> onPayloadTooLarge
-    Failure EndpointInvalid _ -> onInvalidEndpoint
-    Failure (PushException ex) _ -> do
-      logError a "Native push failed" ex
-      view monitor >>= counterIncr (path "push.native.errors")
+push1 = push1' 0
   where
-    onDisabled =
-      handleAny (logError a "Failed to cleanup disabled endpoint") $ do
-        Log.info $
-          field "user" (toByteString (a ^. addrUser))
-            ~~ field "arn" (toText (a ^. addrEndpoint))
-            ~~ field "cause" ("EndpointDisabled" :: Text)
-            ~~ msg (val "Removing disabled endpoint and token")
-        view monitor >>= counterIncr (path "push.native.disabled")
-        Data.delete (a ^. addrUser) (a ^. addrTransport) (a ^. addrApp) (a ^. addrToken)
-        onTokenRemoved
-        e <- view awsEnv
-        Aws.execute e (Aws.deleteEndpoint (a ^. addrEndpoint))
-    onPayloadTooLarge = do
-      view monitor >>= counterIncr (path "push.native.too_large")
-      Log.warn $
-        field "user" (toByteString (a ^. addrUser))
-          ~~ field "arn" (toText (a ^. addrEndpoint))
-          ~~ msg (val "Payload too large")
-    onInvalidEndpoint =
-      handleAny (logError a "Failed to cleanup orphaned push token") $ do
-        Log.warn $
-          field "user" (toByteString (a ^. addrUser))
-            ~~ field "arn" (toText (a ^. addrEndpoint))
-            ~~ field "cause" ("InvalidEndpoint" :: Text)
-            ~~ msg (val "Invalid ARN. Deleting orphaned push token")
-        view monitor >>= counterIncr (path "push.native.invalid")
-        Data.delete (a ^. addrUser) (a ^. addrTransport) (a ^. addrApp) (a ^. addrToken)
-        onTokenRemoved
-    onTokenRemoved = do
-      i <- mkNotificationId
-      let c = a ^. addrClient
-      let r = singleton (target (a ^. addrUser) & targetClients .~ [c])
-      let t = a ^. addrPushToken
-      let p = singletonPayload (PushRemove t)
-      Stream.add i r p =<< view (options . optSettings . setNotificationTTL)
+    push1' :: Int -> NativePush -> Address -> Gundeck ()
+    push1' n m a = do
+      if n > retryInvalidThreshold
+        then onPersistentlyInvalidEndpoint
+        else do
+          e <- view awsEnv
+          r <- Aws.execute e $ publish m a
+          case r of
+            Success _ -> do
+              Log.debug $
+                field "user" (toByteString (a ^. addrUser))
+                  ~~ field "notificationId" (toText (npNotificationid m))
+                  ~~ Log.msg (val "Native push success")
+              view monitor >>= counterIncr (path "push.native.success")
+            Failure EndpointDisabled _ -> onDisabled
+            Failure PayloadTooLarge _ -> onPayloadTooLarge
+            Failure EndpointInvalid _ ->
+              if n < retryInvalidThreshold
+                then onInvalidEndpoint
+                else onPersistentlyInvalidEndpoint
+            Failure (PushException ex) _ -> do
+              logError a "Native push failed" ex
+              view monitor >>= counterIncr (path "push.native.errors")
+      where
+        onDisabled =
+          handleAny (logError a "Failed to cleanup disabled endpoint") $ do
+            Log.info $
+              field "user" (toByteString (a ^. addrUser))
+                ~~ field "arn" (toText (a ^. addrEndpoint))
+                ~~ field "cause" ("EndpointDisabled" :: Text)
+                ~~ msg (val "Removing disabled endpoint and token")
+            view monitor >>= counterIncr (path "push.native.disabled")
+            Data.delete (a ^. addrUser) (a ^. addrTransport) (a ^. addrApp) (a ^. addrToken)
+            onTokenRemoved
+            e <- view awsEnv
+            Aws.execute e (Aws.deleteEndpoint (a ^. addrEndpoint))
+        onPayloadTooLarge = do
+          view monitor >>= counterIncr (path "push.native.too_large")
+          Log.warn $
+            field "user" (toByteString (a ^. addrUser))
+              ~~ field "arn" (toText (a ^. addrEndpoint))
+              ~~ msg (val "Payload too large")
+        retryInvalidThreshold = 1
+        onInvalidEndpoint = do
+          -- try to recreate ARN (cf. Gundeck.Push.addToken.create)
+          let uid = a ^. addrUser
+          let t = a ^. addrPushToken
+          let trp = t ^. tokenTransport
+          let app = t ^. tokenApp
+          let tok = t ^. token
+          env <- view (options . optAws . awsArnEnv)
+          aws <- view awsEnv
+          ept <- Aws.execute aws (Aws.createEndpoint uid trp env app tok)
+          case ept of
+            Left (Aws.EndpointInUse arn) -> do
+              Log.info $ "arn" .= toText arn ~~ msg (val "ARN in use")
+            Left (Aws.AppNotFound app') -> do
+              Log.info $ msg ("Push token of unknown application: '" <> appNameText app' <> "'")
+            Left (Aws.InvalidToken _) -> do
+              Log.info $
+                "token"
+                  .= tokenText tok
+                  ~~ msg (val "Invalid push token.")
+            Left (Aws.TokenTooLong l) -> do
+              Log.info $ msg ("Push token is too long: token length = " ++ show l)
+            Right arn -> do
+              Data.updateArn uid trp app tok arn
+              push1' (succ n) m (a & addrEndpoint .~ arn) -- try to send the push message with the new ARN
+        onPersistentlyInvalidEndpoint = handleAny (logError a "Found orphaned push token") $ do
+          Log.warn $
+            field "user" (toByteString (a ^. addrUser))
+              ~~ field "arn" (toText (a ^. addrEndpoint))
+              ~~ field "cause" ("InvalidEndpoint" :: Text)
+              ~~ msg (val "Invalid ARN. Dropping push message.")
+          view monitor >>= counterIncr (path "push.native.invalid")
+        onTokenRemoved = do
+          i <- mkNotificationId
+          let c = a ^. addrClient
+          let r = singleton (target (a ^. addrUser) & targetClients .~ [c])
+          let t = a ^. addrPushToken
+          let p = singletonPayload (PushRemove t)
+          Stream.add i r p =<< view (options . optSettings . setNotificationTTL)
 
 publish :: NativePush -> Address -> Aws.Amazon Result
 publish m a = flip catches pushException $ do