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

* 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
+5 -5
View File
@@ -66,7 +66,7 @@ import Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (ATransport (..), THandle (..), TLS, TProxy, Transport (..), TransportError)
import Simplex.Messaging.Transport.Client (runTransportClient, smpClientHandshake)
import Simplex.Messaging.Transport.Client (runTransportClient)
import Simplex.Messaging.Transport.KeepAlive
import Simplex.Messaging.Transport.WebSockets (WS)
import Simplex.Messaging.Util (bshow, liftError, raceAny_)
@@ -132,11 +132,11 @@ type Response msg = Either ProtocolClientError msg
-- as 'SMPServerTransmission' includes server information.
getProtocolClient :: forall msg. Protocol msg => ProtocolServer -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing} msgQ disconnected =
(atomically mkSMPClient >>= runClient useTransport)
(atomically mkProtocolClient >>= runClient useTransport)
`catch` \(e :: IOException) -> pure . Left $ PCEIOError e
where
mkSMPClient :: STM (ProtocolClient msg)
mkSMPClient = do
mkProtocolClient :: STM (ProtocolClient msg)
mkProtocolClient = do
connected <- newTVar False
clientCorrId <- newTVar 0
sentCommands <- TM.empty
@@ -177,7 +177,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
client :: forall c. Transport c => TProxy c -> ProtocolClient msg -> TMVar (Either ProtocolClientError (THandle c)) -> c -> IO ()
client _ c thVar h =
runExceptT (smpClientHandshake h $ keyHash protocolServer) >>= \case
runExceptT (protocolClientHandshake @msg h $ keyHash protocolServer) >>= \case
Left e -> atomically . putTMVar thVar . Left $ PCETransportError e
Right th@THandle {sessionId} -> do
atomically $ do