refactor

Author: epoberezkin

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -597,6 +597,11 @@ data DeviceToken
   | WPDeviceToken WPProvider WPTokenParams
   deriving (Eq, Ord, Show)
 
+tokenPushProvider :: DeviceToken -> PushProvider
+tokenPushProvider = \case
+  APNSDeviceToken pp _ -> PPAPNS pp
+  WPDeviceToken pp _ -> PPWP pp
+
 instance Encoding DeviceToken where
   smpEncode token = case token of
     APNSDeviceToken p t -> smpEncode (p, t)

src/Simplex/Messaging/Notifications/Server.hs

@@ -630,26 +630,25 @@ showServer' = decodeLatin1 . strEncode . host
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
   (srvHost_, tkn@NtfTknRec {ntfTknId, token = t, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
-  let (pp, _) = deviceTokenFields t
-  liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
+  logDebug $ "sending push notification to " <> tshow (tokenPushProvider t)
   st <- asks store
   case ntf of
     PNVerification _ ->
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Right _ -> do
           void $ liftIO $ setTknStatusConfirmed st tkn
           incNtfStatT t ntfVrfDelivered
         Left _ -> incNtfStatT t ntfVrfFailed
     PNCheckMessages -> do
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Right _ -> do
           void $ liftIO $ updateTokenCronSentAt st ntfTknId . systemSeconds =<< getSystemTime
           incNtfStatT t ntfCronDelivered
         Left _ -> incNtfStatT t ntfCronFailed
     PNMessage {} -> checkActiveTkn tknStatus $ do
       stats <- asks serverStats
       liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
-      liftIO (deliverNotification st pp tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn ntf) >>= \case
         Left _ -> do
           incNtfStatT t ntfFailed
           liftIO $ mapM_ (`incServerStat` ntfFailedOwn stats) srvHost_
@@ -662,8 +661,8 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
     checkActiveTkn status action
       | status == NTActive = action
       | otherwise = liftIO $ logError "bad notification token status"
-    deliverNotification :: NtfPostgresStore -> PushProvider -> NtfTknRec -> PushNotification -> IO (Either PushProviderError ())
-    deliverNotification st pp tkn@NtfTknRec {ntfTknId} ntf = do
+    deliverNotification :: NtfPostgresStore -> NtfTknRec -> PushNotification -> IO (Either PushProviderError ())
+    deliverNotification st tkn@NtfTknRec {ntfTknId, token} ntf = do
       deliver <- getPushClient s pp
       runExceptT (deliver tkn ntf) >>= \case
         Right _ -> pure $ Right ()
@@ -679,6 +678,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
           PPInvalidPusher -> err e
           _ -> err e
       where
+        pp = tokenPushProvider token
         retryDeliver :: IO (Either PushProviderError ())
         retryDeliver = do
           deliver <- newPushClient s pp

src/Simplex/Messaging/Notifications/Server/Env.hs

@@ -164,34 +164,31 @@ newNtfPushServer qSize apnsConfig = do
 
 newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
 newPushClient s pp = do
-  case pp of
+  c <- case pp of
     PPWP p -> newWPPushClient s p
     PPAPNS p -> newAPNSPushClient s p
+  atomically $ TM.insert pp c $ pushClients s
+  pure c
 
 newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO PushProviderClient
 newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
-  c <- case apnsProviderHost pp of
+  case apnsProviderHost pp of
     Nothing -> pure $ \_ _ -> pure ()
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
-  atomically $ TM.insert (PPAPNS pp) c pushClients
-  pure c
 
 newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
 newWPPushClient NtfPushServer {pushClients} pp = do
   logDebug "New WP Client requested"
   -- We use one http manager per push server (which may be used by different clients)
-  manager <- wpHTTPManager
-  let c = wpPushProviderClient manager
-  atomically $ TM.insert (PPWP pp) c pushClients
-  pure c
+  wpPushProviderClient <$> wpHTTPManager
 
 wpHTTPManager :: IO Manager
 wpHTTPManager = newManager tlsManagerSettings {
     -- Ideally, we should be able to override the domain resolution to
     -- disable requests to non-public IPs. The risk is very limited as
     -- we allow https only, and the body is encrypted. Disabling redirections
     -- avoids cross-protocol redir (https => http/unix)
-    managerModifyRequest = \r -> pure r { redirectCount = 0 }
+    managerModifyRequest = \r -> pure r {redirectCount = 0}
   }
 
 getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient