From e3f89374125751103dc33df0ecfe3e0a8d34546b Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 12 Nov 2025 10:19:54 +0000
Subject: [PATCH] use dependent types for push providers and ntf tokens

---
 src/Simplex/Messaging/Agent.hs                |  22 +--
 src/Simplex/Messaging/Agent/Client.hs         |   4 +-
 .../Messaging/Agent/Store/AgentStore.hs       |   4 +-
 src/Simplex/Messaging/Notifications/Client.hs |   2 +-
 .../Messaging/Notifications/Protocol.hs       | 182 +++++++++++++-----
 src/Simplex/Messaging/Notifications/Server.hs |  24 +--
 .../Messaging/Notifications/Server/Env.hs     |  46 +++--
 .../Messaging/Notifications/Server/Push.hs    |   6 +-
 .../Notifications/Server/Push/APNS.hs         |   7 +-
 .../Notifications/Server/Push/WebPush.hs      |  16 +-
 .../Messaging/Notifications/Server/Store.hs   |   4 +-
 .../Notifications/Server/Store/Postgres.hs    |   2 +-
 .../Notifications/Server/Store/Types.hs       |   4 +-
 .../Notifications/Server/StoreLog.hs          |   4 +-
 src/Simplex/Messaging/Notifications/Types.hs  |   4 +-
 tests/AgentTests/NotificationTests.hs         |  40 ++--
 tests/NtfClient.hs                            |   9 +-
 tests/NtfServerTests.hs                       |   6 +-
 tests/NtfWPTests.hs                           |   4 +-
 19 files changed, 237 insertions(+), 153 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c19d4aeea..e75e356a2 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -201,7 +201,7 @@ import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
+import Simplex.Messaging.Notifications.Protocol (ADeviceToken, NtfRegCode (NtfRegCode), NtfTknStatus (..), NtfTokenId, PNMessageData (..), pnMessagesP)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (defaultJSON, parse)
 import Simplex.Messaging.Protocol
@@ -619,24 +619,24 @@ reconnectAllServers c = do
   reconnectServerClients c ntfClients
 
 -- | Register device notifications token
-registerNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> NotificationsMode -> AE NtfTknStatus
+registerNtfToken :: AgentClient -> NetworkRequestMode -> ADeviceToken -> NotificationsMode -> AE NtfTknStatus
 registerNtfToken c = withAgentEnv c .:. registerNtfToken' c
 {-# INLINE registerNtfToken #-}
 
 -- | Verify device notifications token
-verifyNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> C.CbNonce -> ByteString -> AE ()
+verifyNtfToken :: AgentClient -> NetworkRequestMode -> ADeviceToken -> C.CbNonce -> ByteString -> AE ()
 verifyNtfToken c = withAgentEnv c .:: verifyNtfToken' c
 {-# INLINE verifyNtfToken #-}
 
-checkNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> AE NtfTknStatus
+checkNtfToken :: AgentClient -> NetworkRequestMode -> ADeviceToken -> AE NtfTknStatus
 checkNtfToken c = withAgentEnv c .: checkNtfToken' c
 {-# INLINE checkNtfToken #-}
 
-deleteNtfToken :: AgentClient -> DeviceToken -> AE ()
+deleteNtfToken :: AgentClient -> ADeviceToken -> AE ()
 deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
 {-# INLINE deleteNtfToken #-}
 
-getNtfToken :: AgentClient -> AE (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
+getNtfToken :: AgentClient -> AE (ADeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken c = withAgentEnv c $ getNtfToken' c
 {-# INLINE getNtfToken #-}
 
@@ -2453,7 +2453,7 @@ checkUserServers name srvs =
   unless (any (\ServerCfg {enabled} -> enabled) srvs) $
     logWarn (name <> ": all passed servers are disabled, using all servers.")
 
-registerNtfToken' :: AgentClient -> NetworkRequestMode -> DeviceToken -> NotificationsMode -> AM NtfTknStatus
+registerNtfToken' :: AgentClient -> NetworkRequestMode -> ADeviceToken -> NotificationsMode -> AM NtfTknStatus
 registerNtfToken' c nm suppliedDeviceToken suppliedNtfMode =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId, ntfTknStatus, ntfTknAction, ntfMode = savedNtfMode} -> do
@@ -2530,7 +2530,7 @@ registerNtfToken' c nm suppliedDeviceToken suppliedNtfMode =
       ns <- asks ntfSupervisor
       atomically $ nsUpdateToken ns tkn {deviceToken = suppliedDeviceToken, ntfTknStatus = NTRegistered, ntfMode = suppliedNtfMode}
 
-verifyNtfToken' :: AgentClient -> NetworkRequestMode -> DeviceToken -> C.CbNonce -> ByteString -> AM ()
+verifyNtfToken' :: AgentClient -> NetworkRequestMode -> ADeviceToken -> C.CbNonce -> ByteString -> AM ()
 verifyNtfToken' c nm deviceToken nonce code =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId, ntfDhSecret = Just dhSecret, ntfMode} -> do
@@ -2549,7 +2549,7 @@ setCronInterval c nm tknId tkn = do
   cron <- asks $ ntfCron . config
   void $ forkIO $ void $ runExceptT $ agentNtfSetCronInterval c nm tknId tkn cron
 
-checkNtfToken' :: AgentClient -> NetworkRequestMode -> DeviceToken -> AM NtfTknStatus
+checkNtfToken' :: AgentClient -> NetworkRequestMode -> ADeviceToken -> AM NtfTknStatus
 checkNtfToken' c nm deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken, ntfTokenId = Just tknId, ntfTknAction} -> do
@@ -2563,7 +2563,7 @@ checkNtfToken' c nm deviceToken =
       pure status
     _ -> throwE $ CMD PROHIBITED "checkNtfToken: no token"
 
-deleteNtfToken' :: AgentClient -> DeviceToken -> AM ()
+deleteNtfToken' :: AgentClient -> ADeviceToken -> AM ()
 deleteNtfToken' c deviceToken =
   withStore' c getSavedNtfToken >>= \case
     Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do
@@ -2572,7 +2572,7 @@ deleteNtfToken' c deviceToken =
       deleteNtfSubs c NSCSmpDelete
     _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
 
-getNtfToken' :: AgentClient -> AM (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
+getNtfToken' :: AgentClient -> AM (ADeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken' c =
   withStore' c getSavedNtfToken >>= \case
     Just NtfToken {deviceToken, ntfTknStatus, ntfMode, ntfServer} -> pure (deviceToken, ntfTknStatus, ntfMode, ntfServer)
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index e06d0d637..8b845ffac 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1322,7 +1322,7 @@ runNTFServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
         (nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
         (dhKey, _) <- atomically $ C.generateKeyPair g
         r <- runExceptT $ do
-          let deviceToken = APNSDeviceToken PPApnsNull "test_ntf_token"
+          let deviceToken = ADT SAPNS $ APNSDeviceToken PPApnsNull "test_ntf_token"
           (tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf nm npKey (NewNtfTkn deviceToken nKey dhKey)
           liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf nm npKey tknId
         ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient ntf
@@ -1972,7 +1972,7 @@ agentNtfCheckToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToke
 agentNtfCheckToken c nm tknId NtfToken {ntfServer, ntfPrivKey} =
   withNtfClient c nm ntfServer tknId "TCHK" $ \ntf -> ntfCheckToken ntf nm ntfPrivKey tknId
 
-agentNtfReplaceToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> DeviceToken -> AM ()
+agentNtfReplaceToken :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> ADeviceToken -> AM ()
 agentNtfReplaceToken c nm tknId NtfToken {ntfServer, ntfPrivKey} token =
   withNtfClient c nm ntfServer tknId "TRPL" $ \ntf -> ntfReplaceToken ntf nm ntfPrivKey tknId token
 
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 091b8826f..dcc118265 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -294,7 +294,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), Ratc
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..), deviceTokenFields, deviceToken')
+import Simplex.Messaging.Notifications.Protocol (ADeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..), deviceToken', deviceTokenFields)
 import Simplex.Messaging.Notifications.Types
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol
@@ -1464,7 +1464,7 @@ updateNtfTokenRegistration db NtfToken {deviceToken, ntfServer = ProtocolServer
     |]
     (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)
 
-updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
+updateDeviceToken :: DB.Connection -> NtfToken -> ADeviceToken -> IO ()
 updateDeviceToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} toDt = do
   let (provider, token) = deviceTokenFields deviceToken
   updatedAt <- getCurrentTime
diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs
index a5c8f555a..339b8ff4a 100644
--- a/src/Simplex/Messaging/Notifications/Client.hs
+++ b/src/Simplex/Messaging/Notifications/Client.hs
@@ -43,7 +43,7 @@ ntfCheckToken c nm pKey tknId =
     NRTkn stat -> pure stat
     r -> throwE $ unexpectedResponse r
 
-ntfReplaceToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
+ntfReplaceToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ADeviceToken -> ExceptT NtfClientError IO ()
 ntfReplaceToken c nm pKey tknId token = okNtfCommand (TRPL token) c nm pKey tknId
 
 ntfDeleteToken :: NtfClient -> NetworkRequestMode -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClientError IO ()
diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs
index 42e6c09db..091e89759 100644
--- a/src/Simplex/Messaging/Notifications/Protocol.hs
+++ b/src/Simplex/Messaging/Notifications/Protocol.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -133,7 +134,7 @@ instance ToJSON NtfRegCode where
   toEncoding = strToJEncoding
 
 data NewNtfEntity (e :: NtfEntity) where
-  NewNtfTkn :: DeviceToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> NewNtfEntity 'Token
+  NewNtfTkn :: ADeviceToken -> NtfPublicAuthKey -> C.PublicKeyX25519 -> NewNtfEntity 'Token
   NewNtfSub :: NtfTokenId -> SMPQueueNtf -> NtfPrivateAuthKey -> NewNtfEntity 'Subscription
 
 deriving instance Show (NewNtfEntity e)
@@ -178,7 +179,7 @@ data NtfCommand (e :: NtfEntity) where
   -- | check token status
   TCHK :: NtfCommand 'Token
   -- | replace device token (while keeping all existing subscriptions)
-  TRPL :: DeviceToken -> NtfCommand 'Token
+  TRPL :: ADeviceToken -> NtfCommand 'Token
   -- | delete token - all subscriptions will be removed and no more notifications will be sent
   TDEL :: NtfCommand 'Token
   -- | enable periodic background notification to fetch the new messages - interval is in minutes, minimum is 20, 0 to disable
@@ -378,8 +379,58 @@ instance StrEncoding SMPQueueNtf where
     notifierId <- A.char '/' *> strP
     pure SMPQueueNtf {smpServer, notifierId}
 
-data PushProvider = PPAPNS APNSProvider | PPWP WPProvider
-  deriving (Eq, Ord, Show)
+data PushType = APNS | WebPush deriving (Eq, Ord, Show)
+
+data SPushType (p :: PushType) where
+  SAPNS :: SPushType 'APNS
+  SWebPush :: SPushType 'WebPush
+
+toPushType :: SPushType p -> PushType
+toPushType = \case
+  SAPNS -> APNS
+  SWebPush -> WebPush
+
+deriving instance Show (SPushType p)
+
+class PushTypeI (p :: PushType) where sPushType :: SPushType p
+
+instance PushTypeI 'APNS where sPushType = SAPNS
+
+instance PushTypeI 'WebPush where sPushType = SWebPush
+
+instance TestEquality SPushType where
+  testEquality SAPNS SAPNS = Just Refl
+  testEquality SWebPush SWebPush = Just Refl
+  testEquality _ _ = Nothing
+
+checkPushType :: forall t p p'. (PushTypeI p, PushTypeI p') => t p' -> Either String (t p)
+checkPushType c = case testEquality (sPushType @p) (sPushType @p') of
+  Just Refl -> Right c
+  Nothing -> Left "bad push type"
+
+data PushProvider (p :: PushType) where
+  PPAPNS :: APNSProvider -> PushProvider 'APNS
+  PPWP :: WPProvider -> PushProvider 'WebPush
+
+deriving instance Eq (PushProvider p)
+
+deriving instance Ord (PushProvider p)
+
+deriving instance Show (PushProvider p)
+
+data APushProvider = forall p. PushTypeI p => APP (SPushType p) (PushProvider p)
+
+instance Eq APushProvider where
+  APP pt p == APP pt' p' = case testEquality pt pt' of
+    Just Refl -> p == p'
+    Nothing -> False
+
+instance Ord APushProvider where
+  APP pt t `compare` APP pt' t' = case testEquality pt pt' of
+    Just Refl -> t `compare` t'
+    Nothing -> toPushType pt `compare` toPushType pt'
+
+deriving instance Show APushProvider
 
 data APNSProvider
   = PPApnsDev -- provider for Apple development environment
@@ -394,14 +445,18 @@ newtype WPSrvLoc = WPSrvLoc SrvLoc
 newtype WPProvider = WPP WPSrvLoc
   deriving (Eq, Ord, Show)
 
-instance Encoding PushProvider where
+instance PushTypeI p => Encoding (PushProvider p) where
   smpEncode = \case
     PPAPNS p -> smpEncode p
     PPWP p -> smpEncode p
+  smpP = (\(APP _ p) -> checkPushType p) <$?> smpP
+
+instance Encoding APushProvider where
+  smpEncode (APP _ p) = smpEncode p
   smpP =
     A.peekChar' >>= \case
-      'A' -> PPAPNS <$> smpP
-      _ -> PPWP <$> smpP
+      'A' -> APP SAPNS . PPAPNS <$> smpP
+      _ -> APP SWebPush . PPWP <$> smpP
 
 instance Encoding APNSProvider where
   smpEncode = \case
@@ -417,14 +472,18 @@ instance Encoding APNSProvider where
       "AN" -> pure PPApnsNull
       _ -> fail "bad APNSProvider"
 
-instance StrEncoding PushProvider where
+instance PushTypeI p => StrEncoding (PushProvider p) where
   strEncode = \case
     PPAPNS p -> strEncode p
     PPWP p -> strEncode p
+  strP = (\(APP _ p) -> checkPushType p) <$?> strP
+
+instance StrEncoding APushProvider where
+  strEncode (APP _ p) = strEncode p
   strP =
     A.peekChar' >>= \case
-      'a' -> PPAPNS <$> strP
-      _ -> PPWP <$> strP
+      'a' -> APP SAPNS . PPAPNS <$> strP
+      _ -> APP SWebPush . PPWP <$> strP
 
 instance StrEncoding APNSProvider where
   strEncode = \case
@@ -456,9 +515,9 @@ instance StrEncoding WPProvider where
   strEncode (WPP srv) = "webpush " <> strEncode srv
   strP = WPP <$> ("webpush " *> strP)
 
-instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
+instance FromField APushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
 
-instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
+instance ToField APushProvider where toField = toField . decodeLatin1 . strEncode
 
 newtype WPAuth = WPAuth {unWPAuth :: ByteString} deriving (Eq, Ord, Show)
 
@@ -592,81 +651,102 @@ instance StrEncoding WPTokenParams where
     wpKey <- strP
     pure WPTokenParams {wpPath, wpKey}
 
-data DeviceToken
-  = APNSDeviceToken APNSProvider ByteString
-  | WPDeviceToken WPProvider WPTokenParams
-  deriving (Eq, Ord, Show)
+data DeviceToken (p :: PushType) where
+  APNSDeviceToken :: APNSProvider -> ByteString -> DeviceToken 'APNS
+  WPDeviceToken :: WPProvider -> WPTokenParams -> DeviceToken 'WebPush
 
-tokenPushProvider :: DeviceToken -> PushProvider
+deriving instance Eq (DeviceToken p)
+
+deriving instance Ord (DeviceToken p)
+
+deriving instance Show (DeviceToken p)
+
+data ADeviceToken = forall p. PushTypeI p => ADT (SPushType p) (DeviceToken p)
+
+instance Eq ADeviceToken where
+  ADT p t == ADT p' t' = case testEquality p p' of
+    Just Refl -> t == t'
+    Nothing -> False
+
+instance Ord ADeviceToken where
+  ADT p t `compare` ADT p' t' = case testEquality p p' of
+    Just Refl -> t `compare` t'
+    Nothing -> toPushType p `compare` toPushType p'
+
+deriving instance Show ADeviceToken
+
+tokenPushProvider :: DeviceToken p -> PushProvider p
 tokenPushProvider = \case
-  APNSDeviceToken pp _ -> PPAPNS pp
-  WPDeviceToken pp _ -> PPWP pp
+  APNSDeviceToken p _ -> PPAPNS p
+  WPDeviceToken p _ -> PPWP p
 
-instance Encoding DeviceToken where
-  smpEncode token = case token of
+instance PushTypeI p => Encoding (DeviceToken p) where
+  smpEncode = \case
     APNSDeviceToken p t -> smpEncode (p, t)
     WPDeviceToken p t -> smpEncode (p, t)
+  smpP = (\(ADT _ t) -> checkPushType t) <$?> smpP
+
+instance Encoding ADeviceToken where
+  smpEncode (ADT _ t) = smpEncode t
   smpP =
     smpP >>= \case
-      PPAPNS p -> APNSDeviceToken p <$> smpP
-      PPWP p -> WPDeviceToken p <$> smpP
+      APP _ (PPAPNS p) -> ADT SAPNS . APNSDeviceToken p <$> smpP
+      APP _ (PPWP p) -> ADT SWebPush . WPDeviceToken p <$> smpP
 
-instance StrEncoding DeviceToken where
+instance PushTypeI p => StrEncoding (DeviceToken p) where
   strEncode token = case token of
     APNSDeviceToken p t -> strEncode p <> " " <> t
     -- We don't do strEncode (p, t), because we don't want any space between
     -- p (e.g. webpush https://localhost) and t.wpPath (e.g /random)
     WPDeviceToken p t -> strEncode p <> strEncode t
+  strP = (\(ADT _ t) -> checkPushType t) <$?> strP
+
+instance StrEncoding ADeviceToken where
+  strEncode (ADT _ t) = strEncode t
   strP = nullToken <|> deviceToken
     where
-      nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
+      nullToken = "apns_null test_ntf_token" $> ADT SAPNS (APNSDeviceToken PPApnsNull "test_ntf_token")
+      deviceToken :: A.Parser ADeviceToken
       deviceToken =
         strP >>= \case
-          PPAPNS p -> APNSDeviceToken p <$> hexStringP
-          PPWP p -> do
+          APP _ (PPAPNS p) -> ADT SAPNS . APNSDeviceToken p <$> hexStringP
+          APP _ (PPWP p) -> do
             t <- WPDeviceToken p <$> strP
             _ <- wpRequest t
-            pure t
+            pure $ ADT SWebPush t
       hexStringP = do
         _ <- A.space
         A.takeWhile (`B.elem` "0123456789abcdef") >>= \s ->
           if even (B.length s) then pure s else fail "odd number of hex characters"
 
-instance ToJSON DeviceToken where
-  toEncoding token = case token of
+instance ToJSON (DeviceToken 'APNS) where
+  toEncoding = \case
     APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t
-    -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
-    WPDeviceToken p _ -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p)
-    -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t
-  toJSON token = case token of
+  toJSON = \case
     APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t]
-    -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt
-    WPDeviceToken p _ -> J.object ["pushProvider" .= decodeLatin1 (strEncode p)]
-    -- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t]
 
-instance FromJSON DeviceToken where
+instance FromJSON (DeviceToken 'APNS) where
   parseJSON = J.withObject "DeviceToken" $ \o ->
-    (strDecode . encodeUtf8 <$?> o .: "pushProvider") >>= \case
+    (strDecode @(PushProvider 'APNS) . encodeUtf8 <$?> o .: "pushProvider") >>= \case
       PPAPNS p -> APNSDeviceToken p . encodeUtf8 <$> (o .: "token")
-      PPWP _ -> fail "FromJSON not implemented for WPDeviceToken"
 
 -- | Returns fields for the device token (pushProvider, token)
 -- TODO [webpush] save token as separate fields
-deviceTokenFields :: DeviceToken -> (PushProvider, ByteString)
-deviceTokenFields dt = case dt of
-  APNSDeviceToken p t -> (PPAPNS p, t)
-  WPDeviceToken p t -> (PPWP p, strEncode t)
+deviceTokenFields :: ADeviceToken -> (APushProvider, ByteString)
+deviceTokenFields = \case
+  ADT _ (APNSDeviceToken p t) -> (APP SAPNS (PPAPNS p), t)
+  ADT _ (WPDeviceToken p t) -> (APP SWebPush (PPWP p), strEncode t)
 
 -- | Returns the device token from the fields (pushProvider, token)
-deviceToken' :: PushProvider -> ByteString -> DeviceToken
+-- TODO [webpush] read token as separate fields, don't use `error`
+deviceToken' :: APushProvider -> ByteString -> ADeviceToken
 deviceToken' pp t = case pp of
-  PPAPNS p -> APNSDeviceToken p t
-  PPWP p -> WPDeviceToken p <$> either error id $ strDecode t
+  APP _ (PPAPNS p) -> ADT SAPNS $ APNSDeviceToken p t
+  APP _ (PPWP p) -> ADT SWebPush . WPDeviceToken p <$> either error id $ strDecode t
 
-wpRequest :: MonadFail m => DeviceToken -> m Request
-wpRequest (APNSDeviceToken _ _) = fail "Invalid device token"
-wpRequest (WPDeviceToken (WPP s) param) = do
-  let endpoint = strEncode s <> wpPath param
+wpRequest :: MonadFail m => DeviceToken 'WebPush -> m Request
+wpRequest (WPDeviceToken (WPP s) params) = do
+  let endpoint = strEncode s <> wpPath params
   case parseUrlThrow $ B.unpack endpoint of
     Left _ -> fail "Invalid URL"
     Right r -> pure r
diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs
index 46258c7f7..2ca59e863 100644
--- a/src/Simplex/Messaging/Notifications/Server.hs
+++ b/src/Simplex/Messaging/Notifications/Server.hs
@@ -629,18 +629,18 @@ showServer' = decodeLatin1 . strEncode . host
 
 ntfPush :: NtfPushServer -> M ()
 ntfPush s@NtfPushServer {pushQ} = forever $ do
-  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t, tknStatus}, ntf) <- atomically (readTBQueue pushQ)
-  logDebug $ "sending push notification to " <> tshow (tokenPushProvider t)
+  (srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(ADT _ token), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
+  logDebug $ "sending push notification to " <> tshow (tokenPushProvider token)
   st <- asks store
   case ntf of
     PNVerification _ ->
-      liftIO (deliverNotification st tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn token ntf) >>= \case
         Right _ -> do
           void $ liftIO $ setTknStatusConfirmed st tkn
           incNtfStatT t ntfVrfDelivered
         Left _ -> incNtfStatT t ntfVrfFailed
     PNCheckMessages -> do
-      liftIO (deliverNotification st tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn token ntf) >>= \case
         Right _ -> do
           void $ liftIO $ updateTokenCronSentAt st ntfTknId . systemSeconds =<< getSystemTime
           incNtfStatT t ntfCronDelivered
@@ -648,7 +648,7 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
     PNMessage {} -> checkActiveTkn tknStatus $ do
       stats <- asks serverStats
       liftIO $ updatePeriodStats (activeTokens stats) ntfTknId
-      liftIO (deliverNotification st tkn ntf) >>= \case
+      liftIO (deliverNotification st tkn token ntf) >>= \case
         Left _ -> do
           incNtfStatT t ntfFailed
           liftIO $ mapM_ (`incServerStat` ntfFailedOwn stats) srvHost_
@@ -661,10 +661,10 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
     checkActiveTkn status action
       | status == NTActive = action
       | otherwise = liftIO $ logError "bad notification token status"
-    deliverNotification :: NtfPostgresStore -> NtfTknRec -> PushNotification -> IO (Either PushProviderError ())
-    deliverNotification st tkn@NtfTknRec {ntfTknId, token} ntf = do
+    deliverNotification :: NtfPostgresStore -> NtfTknRec -> DeviceToken p -> PushNotification -> IO (Either PushProviderError ())
+    deliverNotification st tkn@NtfTknRec {ntfTknId} token ntf = do
       deliver <- getPushClient s pp
-      runExceptT (deliver tkn ntf) >>= \case
+      runExceptT (deliver tkn token ntf) >>= \case
         Right _ -> pure $ Right ()
         Left e -> case e of
           PPConnection _ -> retryDeliver
@@ -675,14 +675,13 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
             void $ updateTknStatus st tkn $ NTInvalid $ Just r
             err e
           PPPermanentError -> err e
-          PPInvalidPusher -> err e
           _ -> err e
       where
         pp = tokenPushProvider token
         retryDeliver :: IO (Either PushProviderError ())
         retryDeliver = do
           deliver <- newPushClient s pp
-          runExceptT (deliver tkn ntf) >>= \case
+          runExceptT (deliver tkn token ntf) >>= \case
             Right _ -> pure $ Right ()
             Left e -> case e of
               PPTokenInvalid r -> do
@@ -907,8 +906,9 @@ withNtfStore stAction continue = do
     Left e -> pure $ NRErr e
     Right a -> continue a
 
-incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
-incNtfStatT (APNSDeviceToken PPApnsNull _) _ = pure ()
+-- TODO [webpush] track webpush statistics separately
+incNtfStatT :: ADeviceToken -> (NtfServerStats -> IORef Int) -> M ()
+incNtfStatT (ADT _ (APNSDeviceToken PPApnsNull _)) _ = pure ()
 incNtfStatT _ statSel = incNtfStat statSel
 {-# INLINE incNtfStatT #-}
 
diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs
index 83608ebcd..44a8be4af 100644
--- a/src/Simplex/Messaging/Notifications/Server/Env.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Env.hs
@@ -152,35 +152,38 @@ data SMPSubscriber = SMPSubscriber
 
 data NtfPushServer = NtfPushServer
   { pushQ :: TBQueue (Maybe T.Text, NtfTknRec, PushNotification), -- Maybe Text is a hostname of "own" server
-    pushClients :: TMap PushProvider PushProviderClient,
+    apnsPushClients :: TMap APNSProvider (PushProviderClient 'APNS),
+    webPushClients :: TMap WPProvider (PushProviderClient 'WebPush),
     apnsConfig :: APNSPushClientConfig
   }
 
 newNtfPushServer :: Natural -> APNSPushClientConfig -> IO NtfPushServer
 newNtfPushServer qSize apnsConfig = do
   pushQ <- newTBQueueIO qSize
-  pushClients <- TM.emptyIO
-  pure NtfPushServer {pushQ, pushClients, apnsConfig}
+  apnsPushClients <- TM.emptyIO
+  webPushClients <- TM.emptyIO
+  pure NtfPushServer {pushQ, apnsPushClients, webPushClients, apnsConfig}
 
-newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
-newPushClient s pp = do
-  c <- case pp of
-    PPWP p -> newWPPushClient s p
-    PPAPNS p -> newAPNSPushClient s p
-  atomically $ TM.insert pp c $ pushClients s
-  pure c
+newPushClient :: NtfPushServer -> PushProvider p -> IO (PushProviderClient p)
+newPushClient s = \case
+  PPWP p -> newWPPushClient s p
+  PPAPNS p -> newAPNSPushClient s p
 
-newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO PushProviderClient
-newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
-  case apnsProviderHost pp of
-    Nothing -> pure $ \_ _ -> pure ()
-    Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
+newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO (PushProviderClient 'APNS)
+newAPNSPushClient NtfPushServer {apnsConfig, apnsPushClients} pp = case apnsProviderHost pp of
+  Nothing -> pure $ \_ _ _ -> pure ()
+  Just host -> do
+    c <- apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
+    atomically $ TM.insert pp c apnsPushClients
+    pure c
 
-newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
-newWPPushClient NtfPushServer {pushClients} pp = do
+newWPPushClient :: NtfPushServer -> WPProvider -> IO (PushProviderClient 'WebPush)
+newWPPushClient NtfPushServer {webPushClients} pp = do
   logDebug "New WP Client requested"
   -- We use one http manager per push server (which may be used by different clients)
-  wpPushProviderClient <$> wpHTTPManager
+  c <- wpPushProviderClient <$> wpHTTPManager
+  atomically $ TM.insert pp c webPushClients
+  pure c
 
 wpHTTPManager :: IO Manager
 wpHTTPManager = newManager tlsManagerSettings {
@@ -191,9 +194,10 @@ wpHTTPManager = newManager tlsManagerSettings {
     managerModifyRequest = \r -> pure r {redirectCount = 0}
   }
 
-getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient
-getPushClient s@NtfPushServer {pushClients} pp =
-  TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure
+getPushClient :: NtfPushServer -> PushProvider p -> IO (PushProviderClient p)
+getPushClient s = \case
+  PPAPNS p -> TM.lookupIO p (apnsPushClients s) >>= maybe (newAPNSPushClient s p) pure
+  PPWP p -> TM.lookupIO p (webPushClients s) >>= maybe (newWPPushClient s p) pure
 
 data NtfRequest
   = NtfReqNew CorrId ANewNtfEntity
diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs
index a2a954b08..48fee76f0 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push.hs
@@ -36,7 +36,6 @@ import Network.HTTP.Types (Status)
 import Control.Exception (Exception)
 import Simplex.Messaging.Notifications.Server.Store.Types (NtfTknRec)
 import Control.Monad.Except (ExceptT)
-import GHC.Exception (SomeException)
 
 data JWTHeader = JWTHeader
   { alg :: Text, -- key algorithm, ES256 for APNS
@@ -94,11 +93,10 @@ data PushProviderError
   | PPTokenInvalid NTInvalidReason
   | PPRetryLater
   | PPPermanentError
-  | PPInvalidPusher
   | PPWPInvalidUrl
   | PPWPRemovedEndpoint
   | PPWPRequestTooLong
-  | PPWPOtherError SomeException
+  | PPWPOtherError Text
   deriving (Show, Exception)
 
-type PushProviderClient = NtfTknRec -> PushNotification -> ExceptT PushProviderError IO ()
+type PushProviderClient p = NtfTknRec -> DeviceToken p -> PushNotification -> ExceptT PushProviderError IO ()
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
index 24652c81e..f4901b46f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -256,9 +258,8 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
 $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
 
 -- TODO [webpush] change type accept token components so it only allows APNS token
-apnsPushProviderClient :: APNSPushClient -> PushProviderClient
-apnsPushProviderClient _ NtfTknRec {token = WPDeviceToken _ _} _ = throwE PPInvalidPusher
-apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do
+apnsPushProviderClient :: APNSPushClient -> PushProviderClient 'APNS
+apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn (APNSDeviceToken _ tknStr) pn = do
   http2 <- liftHTTPS2 $ getApnsHTTP2Client c
   nonce <- atomically $ C.randomCbNonce nonceDrg
   apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
index 9b1ebb9f8..078458d99 100644
--- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -10,8 +12,7 @@ module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
 import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
-import Simplex.Messaging.Notifications.Server.Store.Types
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushType (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
 import Control.Logger.Simple (logDebug)
@@ -33,12 +34,11 @@ import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
 import qualified Crypto.PubKey.ECC.Types as ECC
 
-wpPushProviderClient :: Manager -> PushProviderClient
-wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do
+wpPushProviderClient :: Manager -> PushProviderClient 'WebPush
+wpPushProviderClient mg _ t@(WPDeviceToken _ params) pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
   -- parsing will happen in DeviceToken parser, so it won't fail here
-  r <- wpRequest token
+  r <- wpRequest t
   logDebug $ "Request to " <> tshow (host r)
   encBody <- body
   let requestHeaders =
@@ -58,7 +58,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d
   pure ()
   where
     body :: ExceptT PushProviderError IO B.ByteString
-    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
+    body = withExceptT PPCryptoError $ wpEncrypt (wpKey params) (BL.toStrict $ encodeWPN pn)
 
 -- | encrypt :: UA key -> clear -> cipher
 -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
@@ -123,7 +123,7 @@ toPPWPError :: SomeException -> PushProviderError
 toPPWPError e = case fromException e of
     Just (InvalidUrlException _ _) -> PPWPInvalidUrl
     Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
-    _ -> PPWPOtherError e
+    _ -> PPWPOtherError $ tshow e
   where
     fromStatusCode status reason
       | status == N.status200 = PPWPRemovedEndpoint
diff --git a/src/Simplex/Messaging/Notifications/Server/Store.hs b/src/Simplex/Messaging/Notifications/Server/Store.hs
index cb22af000..14d67350f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store.hs
@@ -33,7 +33,7 @@ import Simplex.Messaging.Util (whenM, ($>>=))
 data NtfSTMStore = NtfSTMStore
   { tokens :: TMap NtfTokenId NtfTknData,
     -- multiple registrations exist to protect from malicious registrations if token is compromised
-    tokenRegistrations :: TMap DeviceToken (TMap ByteString NtfTokenId),
+    tokenRegistrations :: TMap ADeviceToken (TMap ByteString NtfTokenId),
     subscriptions :: TMap NtfSubscriptionId NtfSubData,
     tokenSubscriptions :: TMap NtfTokenId (TVar (Set NtfSubscriptionId)),
     subscriptionLookup :: TMap SMPQueueNtf NtfSubscriptionId,
@@ -54,7 +54,7 @@ newNtfSTMStore = do
 
 data NtfTknData = NtfTknData
   { ntfTknId :: NtfTokenId,
-    token :: DeviceToken,
+    token :: ADeviceToken,
     tknStatus :: TVar NtfTknStatus,
     tknVerifyKey :: NtfPublicAuthKey,
     tknDhKeys :: C.KeyPairX25519,
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
index c1065ce11..63d21ff2b 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs
@@ -172,7 +172,7 @@ updateTokenDate st db NtfTknRec {ntfTknId, tknUpdatedAt} = do
     void $ DB.execute db "UPDATE tokens SET updated_at = ? WHERE token_id = ?" (ts, ntfTknId)
     withLog "updateTokenDate" st $ \sl -> logUpdateTokenTime sl ntfTknId ts
 
-type NtfTknRow = (NtfTokenId, PushProvider, Binary ByteString, NtfTknStatus, NtfPublicAuthKey, C.PrivateKeyX25519, C.DhSecretX25519, Binary ByteString, Word16, Maybe SystemDate)
+type NtfTknRow = (NtfTokenId, APushProvider, Binary ByteString, NtfTknStatus, NtfPublicAuthKey, C.PrivateKeyX25519, C.DhSecretX25519, Binary ByteString, Word16, Maybe SystemDate)
 
 ntfTknQuery :: Query
 ntfTknQuery =
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Types.hs b/src/Simplex/Messaging/Notifications/Server/Store/Types.hs
index abac8d14e..9f9e9e7f3 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/Types.hs
+++ b/src/Simplex/Messaging/Notifications/Server/Store/Types.hs
@@ -13,14 +13,14 @@ import Data.Maybe (fromMaybe)
 import Data.Word (Word16)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Notifications.Protocol (DeviceToken, NtfRegCode, NtfSubStatus, NtfSubscriptionId, NtfTokenId, NtfTknStatus, SMPQueueNtf)
+import Simplex.Messaging.Notifications.Protocol (ADeviceToken, NtfRegCode, NtfSubStatus, NtfSubscriptionId, NtfTokenId, NtfTknStatus, SMPQueueNtf)
 import Simplex.Messaging.Notifications.Server.Store (NtfSubData (..), NtfTknData (..))
 import Simplex.Messaging.Protocol (NotifierId, NtfPrivateAuthKey, NtfPublicAuthKey)
 import Simplex.Messaging.SystemTime
 
 data NtfTknRec = NtfTknRec
   { ntfTknId :: NtfTokenId,
-    token :: DeviceToken,
+    token :: ADeviceToken,
     tknStatus :: NtfTknStatus,
     tknVerifyKey :: NtfPublicAuthKey,
     tknDhPrivKey :: C.PrivateKeyX25519,
diff --git a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
index 7c71ddb08..8602f23e1 100644
--- a/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
+++ b/src/Simplex/Messaging/Notifications/Server/StoreLog.hs
@@ -46,7 +46,7 @@ import System.IO
 data NtfStoreLogRecord
   = CreateToken NtfTknRec
   | TokenStatus NtfTokenId NtfTknStatus
-  | UpdateToken NtfTokenId DeviceToken NtfRegCode
+  | UpdateToken NtfTokenId ADeviceToken NtfRegCode
   | TokenCron NtfTokenId Word16
   | DeleteToken NtfTokenId
   | UpdateTokenTime NtfTokenId SystemDate
@@ -94,7 +94,7 @@ logCreateToken s = logNtfStoreRecord s . CreateToken
 logTokenStatus :: StoreLog 'WriteMode -> NtfTokenId -> NtfTknStatus -> IO ()
 logTokenStatus s tknId tknStatus = logNtfStoreRecord s $ TokenStatus tknId tknStatus
 
-logUpdateToken :: StoreLog 'WriteMode -> NtfTokenId -> DeviceToken -> NtfRegCode -> IO ()
+logUpdateToken :: StoreLog 'WriteMode -> NtfTokenId -> ADeviceToken -> NtfRegCode -> IO ()
 logUpdateToken s tknId token regCode = logNtfStoreRecord s $ UpdateToken tknId token regCode
 
 logTokenCron :: StoreLog 'WriteMode -> NtfTokenId -> Word16 -> IO ()
diff --git a/src/Simplex/Messaging/Notifications/Types.hs b/src/Simplex/Messaging/Notifications/Types.hs
index a7665b5b2..a574ee40a 100644
--- a/src/Simplex/Messaging/Notifications/Types.hs
+++ b/src/Simplex/Messaging/Notifications/Types.hs
@@ -42,7 +42,7 @@ instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode
 instance ToField NtfTknAction where toField = toField . Binary . smpEncode
 
 data NtfToken = NtfToken
-  { deviceToken :: DeviceToken,
+  { deviceToken :: ADeviceToken,
     ntfServer :: NtfServer,
     ntfTokenId :: Maybe NtfTokenId,
     -- TODO combine keys to key pair as the types should match
@@ -63,7 +63,7 @@ data NtfToken = NtfToken
   }
   deriving (Show)
 
-newNtfToken :: DeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPairX25519 -> NotificationsMode -> NtfToken
+newNtfToken :: ADeviceToken -> NtfServer -> C.AAuthKeyPair -> C.KeyPairX25519 -> NotificationsMode -> NtfToken
 newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode =
   NtfToken
     { deviceToken,
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 0912e29b2..bce2361b5 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -196,13 +196,13 @@ testNtfMatrix ps@(_, msType) runTest = do
     cfg' = cfgMS msType
     cfgVPrev' = cfgVPrev msType
 
-registerNtfToken :: AgentClient -> DeviceToken -> NotificationsMode -> AE NtfTknStatus
+registerNtfToken :: AgentClient -> ADeviceToken -> NotificationsMode -> AE NtfTknStatus
 registerNtfToken c = A.registerNtfToken c NRMInteractive
 
-checkNtfToken :: AgentClient -> DeviceToken -> AE NtfTknStatus
+checkNtfToken :: AgentClient -> ADeviceToken -> AE NtfTknStatus
 checkNtfToken c = A.checkNtfToken c NRMInteractive
 
-verifyNtfToken :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AE ()
+verifyNtfToken :: AgentClient -> ADeviceToken -> C.CbNonce -> ByteString -> AE ()
 verifyNtfToken c = A.verifyNtfToken c NRMInteractive
 
 runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
@@ -218,7 +218,7 @@ runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
 testNotificationToken :: APNSMockServer -> IO ()
 testNotificationToken apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
-    let tkn = APNSDeviceToken PPApnsTest "abcd"
+    let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -242,7 +242,7 @@ v .-> key = do
 testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
 testNtfTokenRepeatRegistration apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
-    let tkn = APNSDeviceToken PPApnsTest "abcd"
+    let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -261,7 +261,7 @@ testNtfTokenRepeatRegistration apns = do
 testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
 testNtfTokenSecondRegistration apns =
   withAgentClients2 $ \a a' -> runRight_ $ do
-    let tkn = APNSDeviceToken PPApnsTest "abcd"
+    let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -290,7 +290,7 @@ testNtfTokenSecondRegistration apns =
 
 testNtfTokenServerRestart :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestart t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -311,7 +311,7 @@ testNtfTokenServerRestart t apns = do
 
 testNtfTokenServerRestartReverify :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverify t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
     ntfData <- withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -334,7 +334,7 @@ testNtfTokenServerRestartReverify t apns = do
 
 testNtfTokenServerRestartReverifyTimeout :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverifyTimeout t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     (nonce, verification) <- withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -355,7 +355,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
           SET tkn_status = ?, tkn_action = ?
           WHERE provider = ? AND device_token = ?
         |]
-        (NTConfirmed, Just (NTAVerify code), PPAPNS PPApnsTest, "abcd" :: ByteString)
+        (NTConfirmed, Just (NTAVerify code), APP SAPNS (PPAPNS PPApnsTest), "abcd" :: ByteString)
     Just NtfToken {ntfTknStatus = NTConfirmed, ntfTknAction = Just (NTAVerify _)} <- withTransaction store getSavedNtfToken
     pure ()
   threadDelay 1500000
@@ -369,7 +369,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
 
 testNtfTokenServerRestartReregister :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregister t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -393,7 +393,7 @@ testNtfTokenServerRestartReregister t apns = do
 
 testNtfTokenServerRestartReregisterTimeout :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregisterTimeout t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
     withNtfServer t $ runRight $ do
       NTRegistered <- registerNtfToken a tkn NMPeriodic
@@ -409,7 +409,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
           SET tkn_id = NULL, tkn_dh_secret = NULL, tkn_status = ?, tkn_action = ?
           WHERE provider = ? AND device_token = ?
         |]
-        (NTNew, Just NTARegister, PPAPNS PPApnsTest, "abcd" :: ByteString)
+        (NTNew, Just NTARegister, APP SAPNS (PPAPNS PPApnsTest), "abcd" :: ByteString)
     Just NtfToken {ntfTokenId = Nothing, ntfTknStatus = NTNew, ntfTknAction = Just NTARegister} <- withTransaction store getSavedNtfToken
     pure ()
   threadDelay 1000000
@@ -434,7 +434,7 @@ getTestNtfTokenPort a =
 
 testNtfTokenMultipleServers :: ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenMultipleServers t apns = do
-  let tkn = APNSDeviceToken PPApnsTest "abcd"
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
     withNtfServerThreadOn t ntfTestPort ntfTestDBCfg $ \ntf ->
       withNtfServerThreadOn t ntfTestPort2 ntfTestDBCfg2 $ \ntf2 -> runRight_ $ do
@@ -554,7 +554,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
     -- register notification token
-    let tkn = APNSDeviceToken PPApnsTest "abcd"
+    let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
     NTRegistered <- registerNtfToken alice tkn NMInstant
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
@@ -607,9 +607,9 @@ testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> A
 testNotificationSubscriptionNewConnection apns baseId alice bob =
   runRight_ $ do
     -- alice registers notification token
-    APNSDeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
+    ADT _ APNSDeviceToken {} <- registerTestToken alice "abcd" NMInstant apns
     -- bob registers notification token
-    APNSDeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
+    ADT _ APNSDeviceToken {} <- registerTestToken bob "bcde" NMInstant apns
     -- establish connection
     liftIO $ threadDelay 50000
     (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -643,9 +643,9 @@ testNotificationSubscriptionNewConnection apns baseId alice bob =
   where
     msgId = subtract baseId
 
-registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
+registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO ADeviceToken
 registerTestToken a token mode apns = do
-  let tkn = APNSDeviceToken PPApnsTest token
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest token
   NTRegistered <- registerNtfToken a tkn mode
   Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
     timeout 1000000 $ getMockNotification apns tkn
@@ -1023,7 +1023,7 @@ testMessage_ apns a aId b bId msg = do
   get a =##> \case ("", c, Msg msg') -> c == bId && msg == msg'; _ -> False
   ackMessage a bId msgId Nothing
 
-messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
+messageNotification :: HasCallStack => APNSMockServer -> ADeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
 messageNotification apns tkn = do
   500000 `timeout` getMockNotification apns tkn >>= \case
     Nothing -> error "no notification"
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index bdd57f61c..53e02a191 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -41,7 +42,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
+import Simplex.Messaging.Notifications.Protocol (ADeviceToken (..), DeviceToken (..), NtfResponse)
 import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
 import Simplex.Messaging.Notifications.Server.Env
 import Simplex.Messaging.Notifications.Server.Push.APNS
@@ -293,9 +294,9 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
           putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead
           sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
 
-getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
-getMockNotification _ (WPDeviceToken _ _) = liftIO . throwIO $ userError "Invalid pusher"
-getMockNotification APNSMockServer {notifications} (APNSDeviceToken _ token) = do
+getMockNotification :: MonadIO m => APNSMockServer -> ADeviceToken -> m APNSMockRequest
+getMockNotification _ (ADT _ WPDeviceToken {}) = liftIO . throwIO $ userError "Invalid pusher"
+getMockNotification APNSMockServer {notifications} (ADT _ (APNSDeviceToken _ token)) = do
   atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
 
 getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index c4dd72b24..8c295df15 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -107,7 +107,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
     (nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
     (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-    let tkn = APNSDeviceToken PPApnsTest "abcd"
+    let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest "abcd"
     withAPNSMockServer $ \apns ->
       smpTest2 t msType $ \rh sh ->
         ntfTest t $ \nh -> do
@@ -160,7 +160,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           (msgBody, "hello") #== "delivered from queue"
           Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, ACK mId1)
           -- replace token
-          let tkn' = APNSDeviceToken PPApnsTest "efgh"
+          let tkn' = ADT SAPNS $ APNSDeviceToken PPApnsTest "efgh"
           RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
           tId `shouldBe` tId'
           APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
@@ -237,7 +237,7 @@ registerToken nh apns token = do
   g <- C.newRandom
   (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
   (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-  let tkn = APNSDeviceToken PPApnsTest token
+  let tkn = ADT SAPNS $ APNSDeviceToken PPApnsTest token
   RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
   APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
     getMockNotification apns tkn
diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs
index 8a5fcf180..7bcd1e03b 100644
--- a/tests/NtfWPTests.hs
+++ b/tests/NtfWPTests.hs
@@ -34,7 +34,7 @@ testWPDeviceTokenStrEncoding = do
 
   let auth = either error id $ strDecode "AQ3VfRX3_F38J3ltcmMVRg"
   let pk = either error id $ strDecode "BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
+  let params :: WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
   wpPath params `shouldBe` "/secret"
   let key = wpKey params
   wpAuth key `shouldBe` auth
@@ -55,7 +55,7 @@ testInvalidWPDeviceTokenStrEncoding = do
   -- e.g "https://#1" is a valid URL. But that is the same parser
   -- we use to send the requests, so that's fine.
   let ts = "webpush https://localhost:/ AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
-  let t = strDecode ts :: Either String DeviceToken
+  let t = strDecode ts :: Either String ADeviceToken
   t `shouldSatisfy` isLeft
 
 -- | Example from RFC8291