Rename APNSDeviceToken

This commit is contained in:
sim
2025-08-27 12:47:19 +02:00
parent c08c3794ba
commit e7e7c9bfa1
9 changed files with 44 additions and 43 deletions
@@ -411,32 +411,33 @@ instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe
instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode
data DeviceToken = DeviceToken PushProvider ByteString
data DeviceToken
= APNSDeviceToken PushProvider ByteString
deriving (Eq, Ord, Show)
instance Encoding DeviceToken where
smpEncode (DeviceToken p t) = smpEncode (p, t)
smpP = DeviceToken <$> smpP <*> smpP
smpEncode (APNSDeviceToken p t) = smpEncode (p, t)
smpP = APNSDeviceToken <$> smpP <*> smpP
instance StrEncoding DeviceToken where
strEncode (DeviceToken p t) = strEncode p <> " " <> t
strEncode (APNSDeviceToken p t) = strEncode p <> " " <> t
strP = nullToken <|> hexToken
where
nullToken = "apns_null test_ntf_token" $> DeviceToken PPApnsNull "test_ntf_token"
hexToken = DeviceToken <$> strP <* A.space <*> hexStringP
nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
hexToken = APNSDeviceToken <$> strP <* A.space <*> hexStringP
hexStringP =
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 (DeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
toJSON (DeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
toEncoding (APNSDeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
toJSON (APNSDeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
instance FromJSON DeviceToken where
parseJSON = J.withObject "DeviceToken" $ \o -> do
pp <- strDecode . encodeUtf8 <$?> o .: "pushProvider"
t <- encodeUtf8 <$> o .: "token"
pure $ DeviceToken pp t
pure $ APNSDeviceToken pp t
-- List of PNMessageData uses semicolon-separated encoding instead of strEncode,
-- because strEncode of NonEmpty list uses comma for separator,
@@ -629,7 +629,7 @@ showServer' = decodeLatin1 . strEncode . host
ntfPush :: NtfPushServer -> M ()
ntfPush s@NtfPushServer {pushQ} = forever $ do
(srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(DeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
(srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(APNSDeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ)
liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp)
st <- asks store
case ntf of
@@ -906,7 +906,7 @@ withNtfStore stAction continue = do
Right a -> continue a
incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
incNtfStatT (DeviceToken PPApnsNull _) _ = pure ()
incNtfStatT (APNSDeviceToken PPApnsNull _) _ = pure ()
incNtfStatT _ statSel = incNtfStat statSel
{-# INLINE incNtfStatT #-}
@@ -256,7 +256,7 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
$(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
apnsPushProviderClient :: APNSPushClient -> PushProviderClient
apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = DeviceToken _ tknStr} pn = do
apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do
http2 <- liftHTTPS2 $ getApnsHTTP2Client c
nonce <- atomically $ C.randomCbNonce nonceDrg
apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
@@ -126,7 +126,7 @@ insertNtfTknQuery =
|]
replaceNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
replaceNtfToken st NtfTknRec {ntfTknId, token = token@(DeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} =
withFastDB "replaceNtfToken" st $ \db -> runExceptT $ do
ExceptT $ assertUpdated <$>
DB.execute
@@ -141,7 +141,7 @@ replaceNtfToken st NtfTknRec {ntfTknId, token = token@(DeviceToken pp ppToken),
ntfTknToRow :: NtfTknRec -> NtfTknRow
ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} =
let DeviceToken pp ppToken = token
let APNSDeviceToken pp ppToken = token
NtfRegCode regCode = tknRegCode
in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt)
@@ -151,7 +151,7 @@ getNtfToken st tknId =
getNtfToken_ st " WHERE token_id = ?" (Only tknId)
findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec))
findNtfTokenRegistration st (NewNtfTkn (DeviceToken pp ppToken) tknVerifyKey _) =
findNtfTokenRegistration st (NewNtfTkn (APNSDeviceToken pp ppToken) tknVerifyKey _) =
getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey)
getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec))
@@ -179,7 +179,7 @@ ntfTknQuery =
rowToNtfTkn :: NtfTknRow -> NtfTknRec
rowToNtfTkn (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt) =
let token = DeviceToken pp ppToken
let token = APNSDeviceToken pp ppToken
tknRegCode = NtfRegCode regCode
in NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt}
@@ -374,7 +374,7 @@ setTknStatusConfirmed st NtfTknRec {ntfTknId} =
when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId NTConfirmed
setTokenActive :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ())
setTokenActive st tkn@NtfTknRec {ntfTknId, token = DeviceToken pp ppToken} =
setTokenActive st tkn@NtfTknRec {ntfTknId, token = APNSDeviceToken pp ppToken} =
withFastDB' "setTokenActive" st $ \db -> do
updateTknStatus_ st db tkn NTActive
-- this removes other instances of the same token, e.g. because of repeated token registration attempts