gundeck: Fix parsing errors for SNS ARN for VOIP Tokens

changelog.d/3-bug-fixes/gundeck-arn-parsing

@@ -0,0 +1 @@
+gundeck: Fix parsing errors for SNS ARN for VOIP Tokens

deploy/dockerephemeral/init.sh

@@ -32,6 +32,7 @@ for suffix in "" "2" "3" "4" "5" "-federation-v0"; do
     # Create SNS resources for gundeck's notifications
     exec_until_ready "aws --endpoint-url=http://sns:4575 sns create-platform-application --name integration-test$suffix --platform GCM --attributes PlatformCredential=testkey"
     exec_until_ready "aws --endpoint-url=http://sns:4575 sns create-platform-application --name integration-test$suffix --platform APNS_SANDBOX --attributes PlatformCredential=testprivatekey"
+    exec_until_ready "aws --endpoint-url=http://sns:4575 sns create-platform-application --name integration-test$suffix --platform APNS_VOIP_SANDBOX --attributes PlatformCredential=testprivatekey"
     exec_until_ready "aws --endpoint-url=http://sns:4575 sns create-platform-application --name integration-com.wire.ent$suffix --platform APNS_SANDBOX --attributes PlatformCredential=testprivatekey"
 
     # Cargohold's bucket; creating a bucket is not idempotent so we just try once and wait until it is ready

integration/default.nix

@@ -10,6 +10,7 @@
 , async
 , attoparsec
 , base
+, base16-bytestring
 , base64-bytestring
 , bytestring
 , bytestring-conversion
@@ -99,6 +100,7 @@ mkDerivation {
     async
     attoparsec
     base
+    base16-bytestring
     base64-bytestring
     bytestring
     bytestring-conversion

integration/integration.cabal

@@ -136,6 +136,7 @@ library
     Test.MLS.Unreachable
     Test.Notifications
     Test.Presence
+    Test.PushToken
     Test.Roles
     Test.Search
     Test.Services
@@ -174,6 +175,7 @@ library
     , async
     , attoparsec
     , base
+    , base16-bytestring
     , base64-bytestring
     , bytestring
     , bytestring-conversion

integration/test/API/Common.hs

@@ -4,7 +4,8 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Data.Array ((!))
 import qualified Data.Array as Array
-import System.Random (randomRIO)
+import qualified Data.ByteString as BS
+import System.Random (randomIO, randomRIO)
 import Testlib.Prelude
 
 teamRole :: String -> Int
@@ -43,14 +44,24 @@ randomHandleWithRange min' max' = liftIO $ do
     chars = mkArray $ ['a' .. 'z'] <> ['0' .. '9'] <> "_-."
     pick = (chars !) <$> randomRIO (Array.bounds chars)
 
+randomBytes :: Int -> App ByteString
+randomBytes n = liftIO $ BS.pack <$> replicateM n randomIO
+
 randomHex :: Int -> App String
 randomHex n = liftIO $ replicateM n pick
   where
     chars = mkArray (['0' .. '9'] <> ['a' .. 'f'])
     pick = (chars !) <$> randomRIO (Array.bounds chars)
 
+-- Should not have leading 0.
 randomClientId :: App String
-randomClientId = randomHex 16
+randomClientId = do
+  second <- randomHex 15
+  first <- pick
+  pure $ first : second
+  where
+    chars = mkArray (['1' .. '9'] <> ['a' .. 'f'])
+    pick = (chars !) <$> randomRIO (Array.bounds chars)
 
 mkArray :: [a] -> Array.Array Int a
 mkArray l = Array.listArray (0, length l - 1) l

integration/test/API/Gundeck.hs

@@ -1,6 +1,9 @@
 module API.Gundeck where
 
 import API.Common
+import qualified Data.ByteString.Base16 as Base16
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 import Testlib.Prelude
 
 data GetNotifications = GetNotifications
@@ -58,37 +61,83 @@ getLastNotification user opts = do
     baseRequest user Gundeck Versioned "/notifications/last"
   submit "GET" $ req & addQueryParams [("client", c) | c <- toList opts.client]
 
-data PostPushToken = PostPushToken
+data GeneratePushToken = GeneratePushToken
   { transport :: String,
     app :: String,
-    token :: Maybe String,
     tokenSize :: Int
   }
 
-instance Default PostPushToken where
+instance Default GeneratePushToken where
   def =
-    PostPushToken
+    GeneratePushToken
       { transport = "GCM",
         app = "test",
-        token = Nothing,
         tokenSize = 16
       }
 
+generateAndPostPushToken ::
+  (HasCallStack, MakesValue user, MakesValue client) =>
+  user ->
+  client ->
+  GeneratePushToken ->
+  App Response
+generateAndPostPushToken user client args = do
+  token <- generateToken args.tokenSize
+  clientId <- make client & asString
+  postPushToken user $ PushToken args.transport args.app token clientId
+
+data PushToken = PushToken
+  { transport :: String,
+    app :: String,
+    token :: String,
+    client :: String
+  }
+  deriving (Show, Eq)
+
+instance ToJSON PushToken where
+  toJSON pt =
+    object
+      [ "transport" .= pt.transport,
+        "app" .= pt.app,
+        "token" .= pt.token,
+        "client" .= pt.client
+      ]
+
+instance MakesValue PushToken where
+  make = pure . toJSON
+
+generateToken :: Int -> App String
+generateToken =
+  fmap (Text.unpack . Text.decodeUtf8 . Base16.encode) . randomBytes
+
 postPushToken ::
-  (HasCallStack, MakesValue u, MakesValue c) =>
-  u ->
-  c ->
-  PostPushToken ->
+  ( HasCallStack,
+    MakesValue token,
+    MakesValue user
+  ) =>
+  user ->
+  token ->
   App Response
-postPushToken u client args = do
-  req <- baseRequest u Gundeck Versioned "/push/tokens"
-  token <- maybe (randomHex (args.tokenSize * 2)) pure args.token
-  c <- make client
-  let t =
-        object
-          [ "transport" .= args.transport,
-            "app" .= args.app,
-            "token" .= token,
-            "client" .= c
-          ]
-  submit "POST" $ req & addJSON t
+postPushToken user token = do
+  req <- baseRequest user Gundeck Versioned "/push/tokens"
+  tokenJson <- make token
+  submit "POST" $ req & addJSON tokenJson
+
+listPushTokens :: (MakesValue user) => user -> App Response
+listPushTokens user = do
+  req <-
+    baseRequest user Gundeck Versioned $
+      joinHttpPath ["/push/tokens"]
+  submit "GET" req
+
+unregisterClient ::
+  (MakesValue user, MakesValue client) =>
+  user ->
+  client ->
+  App Response
+unregisterClient user client = do
+  cid <- asString client
+  req <-
+    baseRequest user Gundeck Unversioned $
+      joinHttpPath ["/i/clients", cid]
+  submit "DELETE" req

integration/test/SetupHelpers.hs

@@ -13,12 +13,15 @@ import Control.Monad.Reader
 import Crypto.Random (getRandomBytes)
 import Data.Aeson hiding ((.=))
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Base64.URL as B64Url
 import Data.ByteString.Char8 (unpack)
 import qualified Data.CaseInsensitive as CI
 import Data.Default
 import Data.Function
 import Data.String.Conversions (cs)
+import qualified Data.Text as Text
+import Data.Text.Encoding (decodeUtf8)
 import Data.UUID.V1 (nextUUID)
 import Data.UUID.V4 (nextRandom)
 import GHC.Stack
@@ -183,6 +186,15 @@ createMLSOne2OnePartner domain other convDomain = loop
 randomToken :: HasCallStack => App String
 randomToken = unpack . B64Url.encode <$> liftIO (getRandomBytes 16)
 
+data TokenLength = GCM | APNS
+
+randomSnsToken :: HasCallStack => TokenLength -> App String
+randomSnsToken = \case
+  GCM -> mkTok 16
+  APNS -> mkTok 32
+  where
+    mkTok = fmap (Text.unpack . decodeUtf8 . Base16.encode) . randomBytes
+
 randomId :: HasCallStack => App String
 randomId = liftIO (show <$> nextRandom)
 

integration/test/Test/EJPD.hs

@@ -44,23 +44,23 @@ setupEJPD =
 
     toks1 <- do
       cl11 <- objId $ addClient (usr1 %. "qualified_id") def >>= getJSON 201
-      bindResponse (postPushToken usr1 cl11 def) $ \resp -> do
+      bindResponse (generateAndPostPushToken usr1 cl11 def) $ \resp -> do
         resp.status `shouldMatchInt` 201
         tok <- resp.json %. "token" & asString
         pure [tok]
     toks2 <- do
       cl21 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201
       cl22 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201
-      t1 <- bindResponse (postPushToken usr2 cl21 def) $ \resp -> do
+      t1 <- bindResponse (generateAndPostPushToken usr2 cl21 def) $ \resp -> do
         resp.status `shouldMatchInt` 201
         resp.json %. "token" & asString
-      t2 <- bindResponse (postPushToken usr2 cl22 def) $ \resp -> do
+      t2 <- bindResponse (generateAndPostPushToken usr2 cl22 def) $ \resp -> do
         resp.status `shouldMatchInt` 201
         resp.json %. "token" & asString
       pure [t1, t2]
     toks4 <- do
       cl41 <- objId $ addClient (usr4 %. "qualified_id") def >>= getJSON 201
-      bindResponse (postPushToken usr4 cl41 def) $ \resp -> do
+      bindResponse (generateAndPostPushToken usr4 cl41 def) $ \resp -> do
         resp.status `shouldMatchInt` 201
         tok <- resp.json %. "token" & asString
         pure [tok]

integration/test/Test/Presence.hs

@@ -27,7 +27,7 @@ testRemoveUser :: HasCallStack => App ()
 testRemoveUser = do
   -- register alice and add a push token
   (alice, c) <- registerUser
-  void $ postPushToken alice c def >>= getJSON 201
+  void $ generateAndPostPushToken alice c def >>= getJSON 201
   do
     t <- getPushTokens alice >>= getJSON 200
     tokens <- t %. "tokens" & asList

integration/test/Test/PushToken.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
+
+module Test.PushToken where
+
+import API.Common
+import API.Gundeck
+import SetupHelpers
+import Testlib.Prelude
+
+testRegisterPushToken :: App ()
+testRegisterPushToken = do
+  alice <- randomUser OwnDomain def
+  aliceC2 <- randomClientId
+  aliceC1 <- randomClientId
+
+  -- Client 1 with 4 tokens
+  c1Apns1 <- randomSnsToken APNS
+  c1Apns1Overlap <- randomSnsToken APNS
+  c1Apns2 <- randomSnsToken APNS
+  c1Gcm1 <- randomSnsToken GCM
+
+  -- Client 2 with 1 token
+  c2Apns1 <- randomSnsToken APNS
+  c2Gcm1 <- randomSnsToken GCM
+  c2Gcm1Overlap <- randomSnsToken GCM
+
+  let apnsToken = PushToken "APNS_SANDBOX" "test"
+  let gcmToken = PushToken "GCM" "test"
+
+  let c1Apns1Token = apnsToken c1Apns1 aliceC1
+  let c1Apns1OverlapToken = apnsToken c1Apns1Overlap aliceC1
+  let c1Apns2Token = (apnsToken c1Apns2 aliceC1 :: PushToken) {app = "com.wire.ent"} -- diff app prevents overlap
+  let c1Gcm1Token = gcmToken c1Gcm1 aliceC1
+
+  let c2Apns1Token = apnsToken c2Apns1 aliceC2
+  let c2Gcm1Token = gcmToken c2Gcm1 aliceC2
+  let c2Gcm1OverlapToken = gcmToken c2Gcm1Overlap aliceC2
+
+  -- Register non-overlapping tokens for client 1
+  assertStatus 201 =<< (postPushToken alice c1Apns1Token)
+  assertStatus 201 =<< (postPushToken alice c1Apns2Token)
+  assertStatus 201 =<< (postPushToken alice c1Gcm1Token)
+
+  -- register non-overlapping tokens for client 2
+  assertStatus 201 =<< (postPushToken alice c2Apns1Token)
+  assertStatus 201 =<< (postPushToken alice c2Gcm1Token)
+
+  bindResponse (listPushTokens alice) \resp -> do
+    resp.status `shouldMatchInt` 200
+    allTokens <- resp.json %. "tokens"
+    allTokens
+      `shouldMatchSet` [ c1Apns1Token,
+                         c1Apns2Token,
+                         c1Gcm1Token,
+                         c2Apns1Token,
+                         c2Gcm1Token
+                       ]
+
+  -- Resistering an overlapping token overwrites it.
+  assertStatus 201 =<< postPushToken alice c1Apns1OverlapToken
+  assertStatus 201 =<< postPushToken alice c2Gcm1OverlapToken
+
+  bindResponse (listPushTokens alice) \resp -> do
+    resp.status `shouldMatchInt` 200
+    allTokens <- resp.json %. "tokens"
+    allTokens
+      `shouldMatchSet` [ c1Apns1OverlapToken,
+                         c1Apns2Token,
+                         c1Gcm1Token,
+                         c2Apns1Token,
+                         c2Gcm1OverlapToken
+                       ]
+
+  -- Push tokens are deleted alongside clients
+  assertStatus 200 =<< unregisterClient alice aliceC1
+  assertStatus 200 =<< unregisterClient alice aliceC2
+
+  bindResponse (listPushTokens alice) \resp -> do
+    resp.status `shouldMatchInt` 200
+    allTokens <- resp.json %. "tokens"
+    allTokens
+      `shouldMatchSet` ([] :: [PushToken])
+
+testVoipTokenRegistrationFails :: App ()
+testVoipTokenRegistrationFails = do
+  alice <- randomUser OwnDomain def
+  aliceC2 <- randomClientId
+
+  token <- randomSnsToken APNS
+  let apnsVoipToken = PushToken "APNS_VOIP_SANDBOX" "test" token aliceC2
+  postPushToken alice apnsVoipToken `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 400
+    resp.json %. "label" `shouldMatch` "apns-voip-not-supported"