diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs index 3a5e8c827..13971e13e 100644 --- a/src/Simplex/Messaging/Notifications/Client.hs +++ b/src/Simplex/Messaging/Notifications/Client.hs @@ -27,7 +27,7 @@ type NtfClient = ProtocolClient NtfResponse ntfRegisterToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519) ntfRegisterToken c pKey newTkn = sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case - NRId tknId dhKey -> pure (tknId, dhKey) + NRTknId tknId dhKey -> pure (tknId, dhKey) _ -> throwE PCEUnexpectedResponse ntfVerifyToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegCode -> ExceptT ProtocolClientError IO () @@ -45,10 +45,10 @@ ntfDeleteToken = okNtfCommand TDEL ntfEnableCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO () ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId -ntfCreateSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519) -ntfCreateSubsciption c pKey newSub = +ntfCreateSubscription :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO NtfSubscriptionId +ntfCreateSubscription c pKey newSub = sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case - NRId subId dhKey -> pure (subId, dhKey) + NRSubId subId -> pure subId _ -> throwE PCEUnexpectedResponse ntfCheckSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 8830ff457..4ff643136 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -231,7 +231,8 @@ instance ProtocolEncoding NtfCmd where checkCredentials t (NtfCmd e c) = NtfCmd e <$> checkCredentials t c data NtfResponseTag - = NRId_ + = NRTknId_ + | NRSubId_ | NROk_ | NRErr_ | NRTkn_ @@ -241,7 +242,8 @@ data NtfResponseTag instance Encoding NtfResponseTag where smpEncode = \case - NRId_ -> "ID" + NRTknId_ -> "IDTKN" + NRSubId_ -> "IDSUB" NROk_ -> "OK" NRErr_ -> "ERR" NRTkn_ -> "TKN" @@ -251,7 +253,8 @@ instance Encoding NtfResponseTag where instance ProtocolMsgTag NtfResponseTag where decodeTag = \case - "ID" -> Just NRId_ + "IDTKN" -> Just NRTknId_ + "IDSUB" -> Just NRSubId_ "OK" -> Just NROk_ "ERR" -> Just NRErr_ "TKN" -> Just NRTkn_ @@ -260,7 +263,8 @@ instance ProtocolMsgTag NtfResponseTag where _ -> Nothing data NtfResponse - = NRId NtfEntityId C.PublicKeyX25519 + = NRTknId NtfEntityId C.PublicKeyX25519 + | NRSubId NtfEntityId | NROk | NRErr ErrorType | NRTkn NtfTknStatus @@ -271,7 +275,8 @@ data NtfResponse instance ProtocolEncoding NtfResponse where type Tag NtfResponse = NtfResponseTag encodeProtocol = \case - NRId entId dhKey -> e (NRId_, ' ', entId, dhKey) + NRTknId entId dhKey -> e (NRTknId_, ' ', entId, dhKey) + NRSubId entId -> e (NRSubId_, ' ', entId) NROk -> e NROk_ NRErr err -> e (NRErr_, ' ', err) NRTkn stat -> e (NRTkn_, ' ', stat) @@ -282,7 +287,8 @@ instance ProtocolEncoding NtfResponse where e = smpEncode protocolP = \case - NRId_ -> NRId <$> _smpP <*> smpP + NRTknId_ -> NRTknId <$> _smpP <*> smpP + NRSubId_ -> NRSubId <$> _smpP NROk_ -> pure NROk NRErr_ -> NRErr <$> _smpP NRTkn_ -> NRTkn <$> _smpP @@ -290,8 +296,10 @@ instance ProtocolEncoding NtfResponse where NRPong_ -> pure NRPong checkCredentials (_, _, entId, _) cmd = case cmd of - -- ID response must not have queue ID - NRId {} -> noEntity + -- IDTKN response must not have queue ID + NRTknId {} -> noEntity + -- IDSUB response must not have queue ID + NRSubId {} -> noEntity -- ERR response does not always have entity ID NRErr _ -> Right cmd -- PONG response must not have queue ID diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 18448c19e..715ea9a99 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -208,7 +208,6 @@ verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn)) else VRFailed NtfCmd SToken c -> do - -- TODO move active token check here to differentiate error t_ <- atomically $ getNtfToken st entId pure $ case t_ of Just t@NtfTknData {tknVerifyKey} @@ -229,6 +228,7 @@ verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do else VRFailed _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFailed NtfCmd SSubscription c -> do + -- TODO move active token check here to differentiate error r_ <- atomically $ getNtfSubscription st entId pure $ case r_ of Just (s, NtfTknData {tknVerifyKey}) @@ -259,7 +259,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ tkn <- mkNtfTknData tknId newTkn ks dhSecret regCode addNtfToken st tknId tkn writeTBQueue pushQ (tkn, PNVerification regCode) - pure (corrId, "", NRId tknId srvDhPubKey) + pure (corrId, "", NRTknId tknId srvDhPubKey) NtfReqCmd SToken (NtfTkn tkn@NtfTknData {ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey)}) (corrId, tknId, cmd) -> do status <- readTVarIO tknStatus (corrId,tknId,) <$> case cmd of @@ -270,7 +270,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ if tknDhSecret == dhSecret then do atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode) - pure $ NRId ntfTknId srvDhPubKey + pure $ NRTknId ntfTknId srvDhPubKey else pure $ NRErr AUTH TVFY code -- this allows repeated verification for cases when client connection dropped before server response | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do @@ -315,24 +315,25 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ threadDelay delay atomically $ writeTBQueue pushQ (tkn, PNCheckMessages) NtfReqNew corrId (ANE SSubscription newSub) -> do + logDebug "SNEW - new subscription" st <- asks store subId <- getId atomically $ do sub <- mkNtfSubData newSub (corrId,"",) <$> ( addNtfSubscription st subId sub >>= \case - -- TODO response ID - Just _ -> writeTBQueue newSubQ (NtfSub sub) $> NROk + Just _ -> writeTBQueue newSubQ (NtfSub sub) $> NRSubId subId _ -> pure $ NRErr AUTH ) - NtfReqCmd SSubscription _sub (corrId, subId, cmd) -> + NtfReqCmd SSubscription (NtfSub NtfSubData {notifierKey = registeredNKey}) (corrId, subId, cmd) -> (corrId,subId,) <$> case cmd of - SNEW _newSub -> do - logDebug "SNEW - registered subscription" - -- st <- asks store - -- TODO check NKEY? - -- TODO response ID - pure NROk + SNEW (NewNtfSub _ _ notifierKey) -> do + logDebug "SNEW - existing subscription" + -- TODO retry if subscription failed, if pending or AUTH do nothing + pure $ + if notifierKey == registeredNKey + then NRSubId subId + else NRErr AUTH SCHK -> pure NROk SDEL -> pure NROk PING -> pure NRPong