dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-06-08 21:42:06 +00:00
Code Issues Packages Projects Releases Wiki Activity

agent schema/methods/types/store methods for notifications tokens (#348)

Browse Source 
* agent schema/methods/types/store methods for notifications tokens

* register notification token on the server

* agent commands for notification tokens

* refactor initial servers from AgentConfig

* agent store functions for notification tokens

* server STM store methods for tokens

* fix protocol client for ntfs (use generic handshake), minimal server and agent tests

* server command to verify ntf token
This commit is contained in:
Evgeny Poberezkin
2022-04-08 08:47:04 +01:00
committed by GitHub
parent fb26916eea
commit f577fcdacf
25 changed files with 732 additions and 147 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Notifications/Client.hs
+79 -14
View File
@@ -1,5 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
@@ -7,42 +9,50 @@ module Simplex.Messaging.Notifications.Client where
import Control.Monad.Except
import Control.Monad.Trans.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Word (Word16)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Messaging.Client
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Notifications.Protocol
import Simplex.Messaging.Parsers (blobFieldDecoder)
import Simplex.Messaging.Protocol (ProtocolServer)
type NtfServer = ProtocolServer
type NtfClient = ProtocolClient NtfResponse
registerNtfToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519)
registerNtfToken c pKey newTkn =
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)
_ -> throwE PCEUnexpectedResponse
verifyNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegistrationCode -> ExceptT ProtocolClientError IO ()
verifyNtfToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
ntfVerifyToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegCode -> ExceptT ProtocolClientError IO ()
ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
deleteNtfToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
deleteNtfToken = okNtfCommand TDEL
ntfDeleteToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> ExceptT ProtocolClientError IO ()
ntfDeleteToken = okNtfCommand TDEL
enableNtfCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
enableNtfCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
ntfEnableCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
createNtfSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
createNtfSubsciption c pKey newSub =
ntfCreateSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
ntfCreateSubsciption c pKey newSub =
sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
NRId tknId dhKey -> pure (tknId, dhKey)
_ -> throwE PCEUnexpectedResponse
checkNtfSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
checkNtfSubscription c pKey subId =
ntfCheckSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus
ntfCheckSubscription c pKey subId =
sendNtfCommand c (Just pKey) subId SCHK >>= \case
NRStat stat -> pure stat
_ -> throwE PCEUnexpectedResponse
deleteNfgSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
deleteNfgSubscription = okNtfCommand SDEL
ntfDeleteSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO ()
ntfDeleteSubscription = okNtfCommand SDEL
-- | Send notification server command
sendNtfCommand :: NtfEntityI e => NtfClient -> Maybe C.APrivateSignKey -> NtfEntityId -> NtfCommand e -> ExceptT ProtocolClientError IO NtfResponse
@@ -53,3 +63,58 @@ okNtfCommand cmd c pKey entId =
sendNtfCommand c (Just pKey) entId cmd >>= \case
NROk -> return ()
_ -> throwE PCEUnexpectedResponse
data NtfTknAction
= NTARegister C.APublicVerifyKey -- public key to send to the server
| NTAVerify NtfRegCode -- code to verify token
| NTACheck
| NTACron Word16
| NTADelete
deriving (Show)
instance Encoding NtfTknAction where
smpEncode = \case
NTARegister key -> smpEncode ('R', key)
NTAVerify code -> smpEncode ('V', code)
NTACheck -> "C"
NTACron interval -> smpEncode ('I', interval)
NTADelete -> "D"
smpP =
A.anyChar >>= \case
'R' -> NTARegister <$> smpP
'V' -> NTAVerify <$> smpP
'C' -> pure NTACheck
'I' -> NTACron <$> smpP
'D' -> pure NTADelete
_ -> fail "bad NtfTknAction"
instance FromField NtfTknAction where fromField = blobFieldDecoder smpDecode
instance ToField NtfTknAction where toField = toField . smpEncode
data NtfToken = NtfToken
{ deviceToken :: DeviceToken,
ntfServer :: NtfServer,
ntfTokenId :: Maybe NtfTokenId,
-- | key used by the ntf client to sign transmissions
ntfPrivKey :: C.APrivateSignKey,
-- | shared DH secret used to encrypt/decrypt notifications e2e
ntfDhSecret :: Maybe C.DhSecretX25519,
-- | token status
ntfTknStatus :: NtfTknStatus,
-- | pending token action and the earliest time
ntfTknAction :: Maybe NtfTknAction
}
deriving (Show)
newNtfToken :: DeviceToken -> NtfServer -> C.APrivateSignKey -> C.APublicVerifyKey -> NtfToken
newNtfToken deviceToken ntfServer ntfPrivKey ntfPubKey =
NtfToken
{ deviceToken,
ntfServer,
ntfTokenId = Nothing,
ntfPrivKey,
ntfDhSecret = Nothing,
ntfTknStatus = NTNew,
ntfTknAction = Just $ NTARegister ntfPubKey
}