{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Simplex.Messaging.Agent.Client ( AgentClient (..), newAgentClient, AgentMonad, getSMPServerClient, closeSMPServerClients, newReceiveQueue, subscribeQueue, sendConfirmation, sendHello, secureQueue, sendAgentMessage, decryptAndVerify, verifyMessage, sendAck, suspendQueue, deleteQueue, logServer, removeSubscription, cryptoError, ) where import Control.Logger.Simple import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader import Control.Monad.Trans.Except import Data.ByteString.Base64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Set (Set) import qualified Data.Set as S import Data.Text.Encoding import Data.Time.Clock import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgBody, QueueId, SenderPublicKey) import Simplex.Messaging.Util (bshow, liftEitherError, liftError) import UnliftIO.Concurrent import UnliftIO.Exception (IOException) import qualified UnliftIO.Exception as E import UnliftIO.STM data AgentClient = AgentClient { AgentClient -> TBQueue (ATransmission 'Client) rcvQ :: TBQueue (ATransmission 'Client), AgentClient -> TBQueue (ATransmission 'Agent) sndQ :: TBQueue (ATransmission 'Agent), AgentClient -> TBQueue SMPServerTransmission msgQ :: TBQueue SMPServerTransmission, AgentClient -> TVar (Map SMPServer SMPClient) smpClients :: TVar (Map SMPServer SMPClient), AgentClient -> TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs :: TVar (Map SMPServer (Set ConnAlias)), AgentClient -> TVar (Map ConnAlias SMPServer) subscrConns :: TVar (Map ConnAlias SMPServer), AgentClient -> Int clientId :: Int } newAgentClient :: TVar Int -> AgentConfig -> STM AgentClient newAgentClient :: TVar Int -> AgentConfig -> STM AgentClient newAgentClient cc :: TVar Int cc AgentConfig {Natural $sel:tbqSize:AgentConfig :: AgentConfig -> Natural tbqSize :: Natural tbqSize} = do TBQueue (ATransmission 'Client) rcvQ <- Natural -> STM (TBQueue (ATransmission 'Client)) forall a. Natural -> STM (TBQueue a) newTBQueue Natural tbqSize TBQueue (ATransmission 'Agent) sndQ <- Natural -> STM (TBQueue (ATransmission 'Agent)) forall a. Natural -> STM (TBQueue a) newTBQueue Natural tbqSize TBQueue SMPServerTransmission msgQ <- Natural -> STM (TBQueue SMPServerTransmission) forall a. Natural -> STM (TBQueue a) newTBQueue Natural tbqSize TVar (Map SMPServer SMPClient) smpClients <- Map SMPServer SMPClient -> STM (TVar (Map SMPServer SMPClient)) forall a. a -> STM (TVar a) newTVar Map SMPServer SMPClient forall k a. Map k a M.empty TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs <- Map SMPServer (Set ConnAlias) -> STM (TVar (Map SMPServer (Set ConnAlias))) forall a. a -> STM (TVar a) newTVar Map SMPServer (Set ConnAlias) forall k a. Map k a M.empty TVar (Map ConnAlias SMPServer) subscrConns <- Map ConnAlias SMPServer -> STM (TVar (Map ConnAlias SMPServer)) forall a. a -> STM (TVar a) newTVar Map ConnAlias SMPServer forall k a. Map k a M.empty Int clientId <- (Int -> Int -> Int forall a. Num a => a -> a -> a + 1) (Int -> Int) -> STM Int -> STM Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TVar Int -> STM Int forall a. TVar a -> STM a readTVar TVar Int cc TVar Int -> Int -> STM () forall a. TVar a -> a -> STM () writeTVar TVar Int cc Int clientId AgentClient -> STM AgentClient forall (m :: * -> *) a. Monad m => a -> m a return AgentClient :: TBQueue (ATransmission 'Client) -> TBQueue (ATransmission 'Agent) -> TBQueue SMPServerTransmission -> TVar (Map SMPServer SMPClient) -> TVar (Map SMPServer (Set ConnAlias)) -> TVar (Map ConnAlias SMPServer) -> Int -> AgentClient AgentClient {TBQueue (ATransmission 'Client) rcvQ :: TBQueue (ATransmission 'Client) $sel:rcvQ:AgentClient :: TBQueue (ATransmission 'Client) rcvQ, TBQueue (ATransmission 'Agent) sndQ :: TBQueue (ATransmission 'Agent) $sel:sndQ:AgentClient :: TBQueue (ATransmission 'Agent) sndQ, TBQueue SMPServerTransmission msgQ :: TBQueue SMPServerTransmission $sel:msgQ:AgentClient :: TBQueue SMPServerTransmission msgQ, TVar (Map SMPServer SMPClient) smpClients :: TVar (Map SMPServer SMPClient) $sel:smpClients:AgentClient :: TVar (Map SMPServer SMPClient) smpClients, TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs :: TVar (Map SMPServer (Set ConnAlias)) $sel:subscrSrvrs:AgentClient :: TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs, TVar (Map ConnAlias SMPServer) subscrConns :: TVar (Map ConnAlias SMPServer) $sel:subscrConns:AgentClient :: TVar (Map ConnAlias SMPServer) subscrConns, Int clientId :: Int $sel:clientId:AgentClient :: Int clientId} type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorType m) getSMPServerClient :: forall m. AgentMonad m => AgentClient -> SMPServer -> m SMPClient getSMPServerClient :: AgentClient -> SMPServer -> m SMPClient getSMPServerClient c :: AgentClient c@AgentClient {TVar (Map SMPServer SMPClient) smpClients :: TVar (Map SMPServer SMPClient) $sel:smpClients:AgentClient :: AgentClient -> TVar (Map SMPServer SMPClient) smpClients, TBQueue SMPServerTransmission msgQ :: TBQueue SMPServerTransmission $sel:msgQ:AgentClient :: AgentClient -> TBQueue SMPServerTransmission msgQ} srv :: SMPServer srv = TVar (Map SMPServer SMPClient) -> m (Map SMPServer SMPClient) forall (m :: * -> *) a. MonadIO m => TVar a -> m a readTVarIO TVar (Map SMPServer SMPClient) smpClients m (Map SMPServer SMPClient) -> (Map SMPServer SMPClient -> m SMPClient) -> m SMPClient forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= m SMPClient -> (SMPClient -> m SMPClient) -> Maybe SMPClient -> m SMPClient forall b a. b -> (a -> b) -> Maybe a -> b maybe m SMPClient newSMPClient SMPClient -> m SMPClient forall (m :: * -> *) a. Monad m => a -> m a return (Maybe SMPClient -> m SMPClient) -> (Map SMPServer SMPClient -> Maybe SMPClient) -> Map SMPServer SMPClient -> m SMPClient forall b c a. (b -> c) -> (a -> b) -> a -> c . SMPServer -> Map SMPServer SMPClient -> Maybe SMPClient forall k a. Ord k => k -> Map k a -> Maybe a M.lookup SMPServer srv where newSMPClient :: m SMPClient newSMPClient :: m SMPClient newSMPClient = do SMPClient smp <- m SMPClient connectClient Text -> m () forall (m :: * -> *). (?callStack::CallStack, MonadIO m) => Text -> m () logInfo (Text -> m ()) -> (ConnAlias -> Text) -> ConnAlias -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . ConnAlias -> Text decodeUtf8 (ConnAlias -> m ()) -> ConnAlias -> m () forall a b. (a -> b) -> a -> b $ "Agent connected to " ConnAlias -> ConnAlias -> ConnAlias forall a. Semigroup a => a -> a -> a <> SMPServer -> ConnAlias showServer SMPServer srv STM () -> m () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> ((Map SMPServer SMPClient -> Map SMPServer SMPClient) -> STM ()) -> (Map SMPServer SMPClient -> Map SMPServer SMPClient) -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . TVar (Map SMPServer SMPClient) -> (Map SMPServer SMPClient -> Map SMPServer SMPClient) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Map SMPServer SMPClient) smpClients ((Map SMPServer SMPClient -> Map SMPServer SMPClient) -> m ()) -> (Map SMPServer SMPClient -> Map SMPServer SMPClient) -> m () forall a b. (a -> b) -> a -> b $ SMPServer -> SMPClient -> Map SMPServer SMPClient -> Map SMPServer SMPClient forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert SMPServer srv SMPClient smp SMPClient -> m SMPClient forall (m :: * -> *) a. Monad m => a -> m a return SMPClient smp connectClient :: m SMPClient connectClient :: m SMPClient connectClient = do SMPClientConfig cfg <- (Env -> SMPClientConfig) -> m SMPClientConfig forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((Env -> SMPClientConfig) -> m SMPClientConfig) -> (Env -> SMPClientConfig) -> m SMPClientConfig forall a b. (a -> b) -> a -> b $ AgentConfig -> SMPClientConfig smpCfg (AgentConfig -> SMPClientConfig) -> (Env -> AgentConfig) -> Env -> SMPClientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c . Env -> AgentConfig config (SMPClientError -> AgentErrorType) -> IO (Either SMPClientError SMPClient) -> m SMPClient forall (m :: * -> *) e' e a. (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a liftEitherError SMPClientError -> AgentErrorType smpClientError (SMPServer -> SMPClientConfig -> TBQueue SMPServerTransmission -> IO () -> IO (Either SMPClientError SMPClient) getSMPClient SMPServer srv SMPClientConfig cfg TBQueue SMPServerTransmission msgQ IO () clientDisconnected) m SMPClient -> (IOException -> m SMPClient) -> m SMPClient forall (m :: * -> *) e a. (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a `E.catch` IOException -> m SMPClient internalError where internalError :: IOException -> m SMPClient internalError :: IOException -> m SMPClient internalError = AgentErrorType -> m SMPClient forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (AgentErrorType -> m SMPClient) -> (IOException -> AgentErrorType) -> IOException -> m SMPClient forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> AgentErrorType INTERNAL (String -> AgentErrorType) -> (IOException -> String) -> IOException -> AgentErrorType forall b c a. (b -> c) -> (a -> b) -> a -> c . IOException -> String forall a. Show a => a -> String show clientDisconnected :: IO () clientDisconnected :: IO () clientDisconnected = do IO (Maybe (Set ConnAlias)) removeSubs IO (Maybe (Set ConnAlias)) -> (Maybe (Set ConnAlias) -> IO ()) -> IO () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (Set ConnAlias -> IO ()) -> Maybe (Set ConnAlias) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ((ConnAlias -> IO ()) -> Set ConnAlias -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ ConnAlias -> IO () notifySub) Text -> IO () forall (m :: * -> *). (?callStack::CallStack, MonadIO m) => Text -> m () logInfo (Text -> IO ()) -> (ConnAlias -> Text) -> ConnAlias -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . ConnAlias -> Text decodeUtf8 (ConnAlias -> IO ()) -> ConnAlias -> IO () forall a b. (a -> b) -> a -> b $ "Agent disconnected from " ConnAlias -> ConnAlias -> ConnAlias forall a. Semigroup a => a -> a -> a <> SMPServer -> ConnAlias showServer SMPServer srv removeSubs :: IO (Maybe (Set ConnAlias)) removeSubs :: IO (Maybe (Set ConnAlias)) removeSubs = STM (Maybe (Set ConnAlias)) -> IO (Maybe (Set ConnAlias)) forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM (Maybe (Set ConnAlias)) -> IO (Maybe (Set ConnAlias))) -> STM (Maybe (Set ConnAlias)) -> IO (Maybe (Set ConnAlias)) forall a b. (a -> b) -> a -> b $ do TVar (Map SMPServer SMPClient) -> (Map SMPServer SMPClient -> Map SMPServer SMPClient) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Map SMPServer SMPClient) smpClients ((Map SMPServer SMPClient -> Map SMPServer SMPClient) -> STM ()) -> (Map SMPServer SMPClient -> Map SMPServer SMPClient) -> STM () forall a b. (a -> b) -> a -> b $ SMPServer -> Map SMPServer SMPClient -> Map SMPServer SMPClient forall k a. Ord k => k -> Map k a -> Map k a M.delete SMPServer srv Maybe (Set ConnAlias) cs <- SMPServer -> Map SMPServer (Set ConnAlias) -> Maybe (Set ConnAlias) forall k a. Ord k => k -> Map k a -> Maybe a M.lookup SMPServer srv (Map SMPServer (Set ConnAlias) -> Maybe (Set ConnAlias)) -> STM (Map SMPServer (Set ConnAlias)) -> STM (Maybe (Set ConnAlias)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TVar (Map SMPServer (Set ConnAlias)) -> STM (Map SMPServer (Set ConnAlias)) forall a. TVar a -> STM a readTVar (AgentClient -> TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs AgentClient c) TVar (Map SMPServer (Set ConnAlias)) -> (Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (AgentClient -> TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs AgentClient c) ((Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM ()) -> (Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM () forall a b. (a -> b) -> a -> b $ SMPServer -> Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias) forall k a. Ord k => k -> Map k a -> Map k a M.delete SMPServer srv TVar (Map ConnAlias SMPServer) -> (Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (AgentClient -> TVar (Map ConnAlias SMPServer) subscrConns AgentClient c) ((Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM ()) -> (Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM () forall a b. (a -> b) -> a -> b $ (Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> (Set ConnAlias -> Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> Maybe (Set ConnAlias) -> Map ConnAlias SMPServer -> Map ConnAlias SMPServer forall b a. b -> (a -> b) -> Maybe a -> b maybe Map ConnAlias SMPServer -> Map ConnAlias SMPServer forall a. a -> a id Set ConnAlias -> Map ConnAlias SMPServer -> Map ConnAlias SMPServer forall k a. Ord k => Set k -> Map k a -> Map k a deleteKeys Maybe (Set ConnAlias) cs Maybe (Set ConnAlias) -> STM (Maybe (Set ConnAlias)) forall (m :: * -> *) a. Monad m => a -> m a return Maybe (Set ConnAlias) cs where deleteKeys :: Ord k => Set k -> Map k a -> Map k a deleteKeys :: Set k -> Map k a -> Map k a deleteKeys ks :: Set k ks m :: Map k a m = (k -> Map k a -> Map k a) -> Map k a -> Set k -> Map k a forall a b. (a -> b -> b) -> b -> Set a -> b S.foldr' k -> Map k a -> Map k a forall k a. Ord k => k -> Map k a -> Map k a M.delete Map k a m Set k ks notifySub :: ConnAlias -> IO () notifySub :: ConnAlias -> IO () notifySub connAlias :: ConnAlias connAlias = STM () -> IO () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> IO ()) -> STM () -> IO () forall a b. (a -> b) -> a -> b $ TBQueue (ATransmission 'Agent) -> ATransmission 'Agent -> STM () forall a. TBQueue a -> a -> STM () writeTBQueue (AgentClient -> TBQueue (ATransmission 'Agent) sndQ AgentClient c) ("", ConnAlias connAlias, ACommand 'Agent END) closeSMPServerClients :: MonadUnliftIO m => AgentClient -> m () closeSMPServerClients :: AgentClient -> m () closeSMPServerClients c :: AgentClient c = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ TVar (Map SMPServer SMPClient) -> IO (Map SMPServer SMPClient) forall (m :: * -> *) a. MonadIO m => TVar a -> m a readTVarIO (AgentClient -> TVar (Map SMPServer SMPClient) smpClients AgentClient c) IO (Map SMPServer SMPClient) -> (Map SMPServer SMPClient -> IO ()) -> IO () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (SMPClient -> IO ()) -> Map SMPServer SMPClient -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ SMPClient -> IO () closeSMPClient withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a withSMP_ :: AgentClient -> SMPServer -> (SMPClient -> m a) -> m a withSMP_ c :: AgentClient c srv :: SMPServer srv action :: SMPClient -> m a action = (AgentClient -> SMPServer -> m SMPClient forall (m :: * -> *). AgentMonad m => AgentClient -> SMPServer -> m SMPClient getSMPServerClient AgentClient c SMPServer srv m SMPClient -> (SMPClient -> m a) -> m a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= SMPClient -> m a action) m a -> (AgentErrorType -> m a) -> m a forall e (m :: * -> *) a. MonadError e m => m a -> (e -> m a) -> m a `catchError` AgentErrorType -> m a logServerError where logServerError :: AgentErrorType -> m a logServerError :: AgentErrorType -> m a logServerError e :: AgentErrorType e = do ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () forall (m :: * -> *). AgentMonad m => ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer "<--" AgentClient c SMPServer srv "" (ConnAlias -> m ()) -> ConnAlias -> m () forall a b. (a -> b) -> a -> b $ AgentErrorType -> ConnAlias forall a. Show a => a -> ConnAlias bshow AgentErrorType e AgentErrorType -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError AgentErrorType e withLogSMP_ :: AgentMonad m => AgentClient -> SMPServer -> QueueId -> ByteString -> (SMPClient -> m a) -> m a withLogSMP_ :: AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a withLogSMP_ c :: AgentClient c srv :: SMPServer srv qId :: ConnAlias qId cmdStr :: ConnAlias cmdStr action :: SMPClient -> m a action = do ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () forall (m :: * -> *). AgentMonad m => ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer "-->" AgentClient c SMPServer srv ConnAlias qId ConnAlias cmdStr a res <- AgentClient -> SMPServer -> (SMPClient -> m a) -> m a forall a (m :: * -> *). AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a withSMP_ AgentClient c SMPServer srv SMPClient -> m a action ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () forall (m :: * -> *). AgentMonad m => ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer "<--" AgentClient c SMPServer srv ConnAlias qId "OK" a -> m a forall (m :: * -> *) a. Monad m => a -> m a return a res withSMP :: AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withSMP :: AgentClient -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withSMP c :: AgentClient c srv :: SMPServer srv action :: SMPClient -> ExceptT SMPClientError IO a action = AgentClient -> SMPServer -> (SMPClient -> m a) -> m a forall a (m :: * -> *). AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a withSMP_ AgentClient c SMPServer srv ((SMPClient -> m a) -> m a) -> (SMPClient -> m a) -> m a forall a b. (a -> b) -> a -> b $ ExceptT SMPClientError IO a -> m a forall (m :: * -> *) a. AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP (ExceptT SMPClientError IO a -> m a) -> (SMPClient -> ExceptT SMPClientError IO a) -> SMPClient -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . SMPClient -> ExceptT SMPClientError IO a action withLogSMP :: AgentMonad m => AgentClient -> SMPServer -> QueueId -> ByteString -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP :: AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP c :: AgentClient c srv :: SMPServer srv qId :: ConnAlias qId cmdStr :: ConnAlias cmdStr action :: SMPClient -> ExceptT SMPClientError IO a action = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a withLogSMP_ AgentClient c SMPServer srv ConnAlias qId ConnAlias cmdStr ((SMPClient -> m a) -> m a) -> (SMPClient -> m a) -> m a forall a b. (a -> b) -> a -> b $ ExceptT SMPClientError IO a -> m a forall (m :: * -> *) a. AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP (ExceptT SMPClientError IO a -> m a) -> (SMPClient -> ExceptT SMPClientError IO a) -> SMPClient -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . SMPClient -> ExceptT SMPClientError IO a action liftSMP :: AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP :: ExceptT SMPClientError IO a -> m a liftSMP = (SMPClientError -> AgentErrorType) -> ExceptT SMPClientError IO a -> m a forall (m :: * -> *) e' e a. (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a liftError SMPClientError -> AgentErrorType smpClientError smpClientError :: SMPClientError -> AgentErrorType smpClientError :: SMPClientError -> AgentErrorType smpClientError = \case SMPServerError e :: ErrorType e -> ErrorType -> AgentErrorType SMP ErrorType e SMPResponseError e :: ErrorType e -> BrokerErrorType -> AgentErrorType BROKER (BrokerErrorType -> AgentErrorType) -> BrokerErrorType -> AgentErrorType forall a b. (a -> b) -> a -> b $ ErrorType -> BrokerErrorType RESPONSE ErrorType e SMPUnexpectedResponse -> BrokerErrorType -> AgentErrorType BROKER BrokerErrorType UNEXPECTED SMPResponseTimeout -> BrokerErrorType -> AgentErrorType BROKER BrokerErrorType TIMEOUT SMPNetworkError -> BrokerErrorType -> AgentErrorType BROKER BrokerErrorType NETWORK SMPTransportError e :: TransportError e -> BrokerErrorType -> AgentErrorType BROKER (BrokerErrorType -> AgentErrorType) -> BrokerErrorType -> AgentErrorType forall a b. (a -> b) -> a -> b $ TransportError -> BrokerErrorType TRANSPORT TransportError e e :: SMPClientError e -> String -> AgentErrorType INTERNAL (String -> AgentErrorType) -> String -> AgentErrorType forall a b. (a -> b) -> a -> b $ SMPClientError -> String forall a. Show a => a -> String show SMPClientError e newReceiveQueue :: AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> m (RcvQueue, SMPQueueInfo) newReceiveQueue :: AgentClient -> SMPServer -> ConnAlias -> m (RcvQueue, SMPQueueInfo) newReceiveQueue c :: AgentClient c srv :: SMPServer srv connAlias :: ConnAlias connAlias = do Int size <- (Env -> Int) -> m Int forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((Env -> Int) -> m Int) -> (Env -> Int) -> m Int forall a b. (a -> b) -> a -> b $ AgentConfig -> Int rsaKeySize (AgentConfig -> Int) -> (Env -> AgentConfig) -> Env -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Env -> AgentConfig config (recipientKey :: PublicKey recipientKey, rcvPrivateKey :: RecipientPrivateKey rcvPrivateKey) <- IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey)) -> IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey) forall a b. (a -> b) -> a -> b $ Int -> IO (PublicKey, RecipientPrivateKey) forall k. PrivateKey k => Int -> IO (KeyPair k) C.generateKeyPair Int size ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () forall (m :: * -> *). AgentMonad m => ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer "-->" AgentClient c SMPServer srv "" "NEW" (rcvId :: ConnAlias rcvId, sId :: ConnAlias sId) <- AgentClient -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO (ConnAlias, ConnAlias)) -> m (ConnAlias, ConnAlias) forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withSMP AgentClient c SMPServer srv ((SMPClient -> ExceptT SMPClientError IO (ConnAlias, ConnAlias)) -> m (ConnAlias, ConnAlias)) -> (SMPClient -> ExceptT SMPClientError IO (ConnAlias, ConnAlias)) -> m (ConnAlias, ConnAlias) forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> PublicKey -> ExceptT SMPClientError IO (ConnAlias, ConnAlias) createSMPQueue SMPClient smp RecipientPrivateKey rcvPrivateKey PublicKey recipientKey ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () forall (m :: * -> *). AgentMonad m => ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer "<--" AgentClient c SMPServer srv "" (ConnAlias -> m ()) -> ConnAlias -> m () forall a b. (a -> b) -> a -> b $ [ConnAlias] -> ConnAlias B.unwords ["IDS", ConnAlias -> ConnAlias logSecret ConnAlias rcvId, ConnAlias -> ConnAlias logSecret ConnAlias sId] (encryptKey :: PublicKey encryptKey, decryptKey :: RecipientPrivateKey decryptKey) <- IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey)) -> IO (PublicKey, RecipientPrivateKey) -> m (PublicKey, RecipientPrivateKey) forall a b. (a -> b) -> a -> b $ Int -> IO (PublicKey, RecipientPrivateKey) forall k. PrivateKey k => Int -> IO (KeyPair k) C.generateKeyPair Int size let rq :: RcvQueue rq = RcvQueue :: SMPServer -> ConnAlias -> ConnAlias -> RecipientPrivateKey -> Maybe ConnAlias -> Maybe PublicKey -> RecipientPrivateKey -> Maybe PublicKey -> QueueStatus -> RcvQueue RcvQueue { $sel:server:RcvQueue :: SMPServer server = SMPServer srv, ConnAlias $sel:rcvId:RcvQueue :: ConnAlias rcvId :: ConnAlias rcvId, ConnAlias $sel:connAlias:RcvQueue :: ConnAlias connAlias :: ConnAlias connAlias, RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey rcvPrivateKey, $sel:sndId:RcvQueue :: Maybe ConnAlias sndId = ConnAlias -> Maybe ConnAlias forall a. a -> Maybe a Just ConnAlias sId, $sel:sndKey:RcvQueue :: Maybe PublicKey sndKey = Maybe PublicKey forall a. Maybe a Nothing, RecipientPrivateKey $sel:decryptKey:RcvQueue :: RecipientPrivateKey decryptKey :: RecipientPrivateKey decryptKey, $sel:verifyKey:RcvQueue :: Maybe PublicKey verifyKey = Maybe PublicKey forall a. Maybe a Nothing, $sel:status:RcvQueue :: QueueStatus status = QueueStatus New } AgentClient -> RcvQueue -> ConnAlias -> m () forall (m :: * -> *). MonadUnliftIO m => AgentClient -> RcvQueue -> ConnAlias -> m () addSubscription AgentClient c RcvQueue rq ConnAlias connAlias (RcvQueue, SMPQueueInfo) -> m (RcvQueue, SMPQueueInfo) forall (m :: * -> *) a. Monad m => a -> m a return (RcvQueue rq, SMPServer -> ConnAlias -> PublicKey -> SMPQueueInfo SMPQueueInfo SMPServer srv ConnAlias sId PublicKey encryptKey) subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnAlias -> m () subscribeQueue :: AgentClient -> RcvQueue -> ConnAlias -> m () subscribeQueue c :: AgentClient c rq :: RcvQueue rq@RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server, RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey rcvPrivateKey, ConnAlias rcvId :: ConnAlias $sel:rcvId:RcvQueue :: RcvQueue -> ConnAlias rcvId} connAlias :: ConnAlias connAlias = do AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP AgentClient c SMPServer server ConnAlias rcvId "SUB" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ()) -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> ConnAlias -> ExceptT SMPClientError IO () subscribeSMPQueue SMPClient smp RecipientPrivateKey rcvPrivateKey ConnAlias rcvId AgentClient -> RcvQueue -> ConnAlias -> m () forall (m :: * -> *). MonadUnliftIO m => AgentClient -> RcvQueue -> ConnAlias -> m () addSubscription AgentClient c RcvQueue rq ConnAlias connAlias addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnAlias -> m () addSubscription :: AgentClient -> RcvQueue -> ConnAlias -> m () addSubscription c :: AgentClient c RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server} connAlias :: ConnAlias connAlias = STM () -> m () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> STM () -> m () forall a b. (a -> b) -> a -> b $ do TVar (Map ConnAlias SMPServer) -> (Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (AgentClient -> TVar (Map ConnAlias SMPServer) subscrConns AgentClient c) ((Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM ()) -> (Map ConnAlias SMPServer -> Map ConnAlias SMPServer) -> STM () forall a b. (a -> b) -> a -> b $ ConnAlias -> SMPServer -> Map ConnAlias SMPServer -> Map ConnAlias SMPServer forall k a. Ord k => k -> a -> Map k a -> Map k a M.insert ConnAlias connAlias SMPServer server TVar (Map SMPServer (Set ConnAlias)) -> (Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (AgentClient -> TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs AgentClient c) ((Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM ()) -> (Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM () forall a b. (a -> b) -> a -> b $ (Maybe (Set ConnAlias) -> Maybe (Set ConnAlias)) -> SMPServer -> Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias) forall k a. Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a M.alter (Set ConnAlias -> Maybe (Set ConnAlias) forall a. a -> Maybe a Just (Set ConnAlias -> Maybe (Set ConnAlias)) -> (Maybe (Set ConnAlias) -> Set ConnAlias) -> Maybe (Set ConnAlias) -> Maybe (Set ConnAlias) forall b c a. (b -> c) -> (a -> b) -> a -> c . Maybe (Set ConnAlias) -> Set ConnAlias addSub) SMPServer server where addSub :: Maybe (Set ConnAlias) -> Set ConnAlias addSub :: Maybe (Set ConnAlias) -> Set ConnAlias addSub (Just cs :: Set ConnAlias cs) = ConnAlias -> Set ConnAlias -> Set ConnAlias forall a. Ord a => a -> Set a -> Set a S.insert ConnAlias connAlias Set ConnAlias cs addSub _ = ConnAlias -> Set ConnAlias forall a. a -> Set a S.singleton ConnAlias connAlias removeSubscription :: AgentMonad m => AgentClient -> ConnAlias -> m () removeSubscription :: AgentClient -> ConnAlias -> m () removeSubscription AgentClient {TVar (Map ConnAlias SMPServer) subscrConns :: TVar (Map ConnAlias SMPServer) $sel:subscrConns:AgentClient :: AgentClient -> TVar (Map ConnAlias SMPServer) subscrConns, TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs :: TVar (Map SMPServer (Set ConnAlias)) $sel:subscrSrvrs:AgentClient :: AgentClient -> TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs} connAlias :: ConnAlias connAlias = STM () -> m () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> STM () -> m () forall a b. (a -> b) -> a -> b $ do Map ConnAlias SMPServer cs <- TVar (Map ConnAlias SMPServer) -> STM (Map ConnAlias SMPServer) forall a. TVar a -> STM a readTVar TVar (Map ConnAlias SMPServer) subscrConns TVar (Map ConnAlias SMPServer) -> Map ConnAlias SMPServer -> STM () forall a. TVar a -> a -> STM () writeTVar TVar (Map ConnAlias SMPServer) subscrConns (Map ConnAlias SMPServer -> STM ()) -> Map ConnAlias SMPServer -> STM () forall a b. (a -> b) -> a -> b $ ConnAlias -> Map ConnAlias SMPServer -> Map ConnAlias SMPServer forall k a. Ord k => k -> Map k a -> Map k a M.delete ConnAlias connAlias Map ConnAlias SMPServer cs (SMPServer -> STM ()) -> Maybe SMPServer -> STM () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (TVar (Map SMPServer (Set ConnAlias)) -> (Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar TVar (Map SMPServer (Set ConnAlias)) subscrSrvrs ((Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> STM ()) -> (SMPServer -> Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias)) -> SMPServer -> STM () forall b c a. (b -> c) -> (a -> b) -> a -> c . (Maybe (Set ConnAlias) -> Maybe (Set ConnAlias)) -> SMPServer -> Map SMPServer (Set ConnAlias) -> Map SMPServer (Set ConnAlias) forall k a. Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a M.alter (Maybe (Set ConnAlias) -> (Set ConnAlias -> Maybe (Set ConnAlias)) -> Maybe (Set ConnAlias) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Set ConnAlias -> Maybe (Set ConnAlias) delSub)) (ConnAlias -> Map ConnAlias SMPServer -> Maybe SMPServer forall k a. Ord k => k -> Map k a -> Maybe a M.lookup ConnAlias connAlias Map ConnAlias SMPServer cs) where delSub :: Set ConnAlias -> Maybe (Set ConnAlias) delSub :: Set ConnAlias -> Maybe (Set ConnAlias) delSub cs :: Set ConnAlias cs = let cs' :: Set ConnAlias cs' = ConnAlias -> Set ConnAlias -> Set ConnAlias forall a. Ord a => a -> Set a -> Set a S.delete ConnAlias connAlias Set ConnAlias cs in if Set ConnAlias -> Bool forall a. Set a -> Bool S.null Set ConnAlias cs' then Maybe (Set ConnAlias) forall a. Maybe a Nothing else Set ConnAlias -> Maybe (Set ConnAlias) forall a. a -> Maybe a Just Set ConnAlias cs' logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m () logServer :: ConnAlias -> AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> m () logServer dir :: ConnAlias dir AgentClient {Int clientId :: Int $sel:clientId:AgentClient :: AgentClient -> Int clientId} srv :: SMPServer srv qId :: ConnAlias qId cmdStr :: ConnAlias cmdStr = Text -> m () forall (m :: * -> *). (?callStack::CallStack, MonadIO m) => Text -> m () logInfo (Text -> m ()) -> (ConnAlias -> Text) -> ConnAlias -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . ConnAlias -> Text decodeUtf8 (ConnAlias -> m ()) -> ConnAlias -> m () forall a b. (a -> b) -> a -> b $ [ConnAlias] -> ConnAlias B.unwords ["A", "(" ConnAlias -> ConnAlias -> ConnAlias forall a. Semigroup a => a -> a -> a <> Int -> ConnAlias forall a. Show a => a -> ConnAlias bshow Int clientId ConnAlias -> ConnAlias -> ConnAlias forall a. Semigroup a => a -> a -> a <> ")", ConnAlias dir, SMPServer -> ConnAlias showServer SMPServer srv, ":", ConnAlias -> ConnAlias logSecret ConnAlias qId, ConnAlias cmdStr] showServer :: SMPServer -> ByteString showServer :: SMPServer -> ConnAlias showServer srv :: SMPServer srv = String -> ConnAlias B.pack (String -> ConnAlias) -> String -> ConnAlias forall a b. (a -> b) -> a -> b $ SMPServer -> String host SMPServer srv String -> String -> String forall a. Semigroup a => a -> a -> a <> String -> (String -> String) -> Maybe String -> String forall b a. b -> (a -> b) -> Maybe a -> b maybe "" (":" String -> String -> String forall a. Semigroup a => a -> a -> a <>) (SMPServer -> Maybe String port SMPServer srv) logSecret :: ByteString -> ByteString logSecret :: ConnAlias -> ConnAlias logSecret bs :: ConnAlias bs = ConnAlias -> ConnAlias encode (ConnAlias -> ConnAlias) -> ConnAlias -> ConnAlias forall a b. (a -> b) -> a -> b $ Int -> ConnAlias -> ConnAlias B.take 3 ConnAlias bs sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> m () sendConfirmation :: AgentClient -> SndQueue -> PublicKey -> m () sendConfirmation c :: AgentClient c sq :: SndQueue sq@SndQueue {SMPServer $sel:server:SndQueue :: SndQueue -> SMPServer server :: SMPServer server, ConnAlias $sel:sndId:SndQueue :: SndQueue -> ConnAlias sndId :: ConnAlias sndId} senderKey :: PublicKey senderKey = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a withLogSMP_ AgentClient c SMPServer server ConnAlias sndId "SEND <KEY>" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> do ConnAlias msg <- SMPClient -> m ConnAlias mkConfirmation SMPClient smp ExceptT SMPClientError IO () -> m () forall (m :: * -> *) a. AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP (ExceptT SMPClientError IO () -> m ()) -> ExceptT SMPClientError IO () -> m () forall a b. (a -> b) -> a -> b $ SMPClient -> Maybe RecipientPrivateKey -> ConnAlias -> ConnAlias -> ExceptT SMPClientError IO () sendSMPMessage SMPClient smp Maybe RecipientPrivateKey forall a. Maybe a Nothing ConnAlias sndId ConnAlias msg where mkConfirmation :: SMPClient -> m MsgBody mkConfirmation :: SMPClient -> m ConnAlias mkConfirmation smp :: SMPClient smp = SMPClient -> SndQueue -> ConnAlias -> m ConnAlias forall (m :: * -> *). AgentMonad m => SMPClient -> SndQueue -> ConnAlias -> m ConnAlias encryptAndSign SMPClient smp SndQueue sq (ConnAlias -> m ConnAlias) -> (SMPMessage -> ConnAlias) -> SMPMessage -> m ConnAlias forall b c a. (b -> c) -> (a -> b) -> a -> c . SMPMessage -> ConnAlias serializeSMPMessage (SMPMessage -> m ConnAlias) -> SMPMessage -> m ConnAlias forall a b. (a -> b) -> a -> b $ PublicKey -> SMPMessage SMPConfirmation PublicKey senderKey sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> m () sendHello :: AgentClient -> SndQueue -> PublicKey -> m () sendHello c :: AgentClient c sq :: SndQueue sq@SndQueue {SMPServer server :: SMPServer $sel:server:SndQueue :: SndQueue -> SMPServer server, ConnAlias sndId :: ConnAlias $sel:sndId:SndQueue :: SndQueue -> ConnAlias sndId, RecipientPrivateKey $sel:sndPrivateKey:SndQueue :: SndQueue -> RecipientPrivateKey sndPrivateKey :: RecipientPrivateKey sndPrivateKey} verifyKey :: PublicKey verifyKey = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a withLogSMP_ AgentClient c SMPServer server ConnAlias sndId "SEND <HELLO> (retrying)" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> do ConnAlias msg <- SMPClient -> AckMode -> m ConnAlias mkHello SMPClient smp (AckMode -> m ConnAlias) -> AckMode -> m ConnAlias forall a b. (a -> b) -> a -> b $ OnOff -> AckMode AckMode OnOff On ExceptT SMPClientError IO () -> m () forall (m :: * -> *) a. AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP (ExceptT SMPClientError IO () -> m ()) -> ExceptT SMPClientError IO () -> m () forall a b. (a -> b) -> a -> b $ Int -> Int -> ConnAlias -> SMPClient -> ExceptT SMPClientError IO () send 8 100000 ConnAlias msg SMPClient smp where mkHello :: SMPClient -> AckMode -> m ByteString mkHello :: SMPClient -> AckMode -> m ConnAlias mkHello smp :: SMPClient smp ackMode :: AckMode ackMode = do UTCTime senderTimestamp <- IO UTCTime -> m UTCTime forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO UTCTime getCurrentTime SMPClient -> SndQueue -> ConnAlias -> m ConnAlias forall (m :: * -> *). AgentMonad m => SMPClient -> SndQueue -> ConnAlias -> m ConnAlias encryptAndSign SMPClient smp SndQueue sq (ConnAlias -> m ConnAlias) -> (SMPMessage -> ConnAlias) -> SMPMessage -> m ConnAlias forall b c a. (b -> c) -> (a -> b) -> a -> c . SMPMessage -> ConnAlias serializeSMPMessage (SMPMessage -> m ConnAlias) -> SMPMessage -> m ConnAlias forall a b. (a -> b) -> a -> b $ SMPMessage :: AgentMsgId -> UTCTime -> ConnAlias -> AMessage -> SMPMessage SMPMessage { senderMsgId :: AgentMsgId senderMsgId = 0, UTCTime senderTimestamp :: UTCTime senderTimestamp :: UTCTime senderTimestamp, previousMsgHash :: ConnAlias previousMsgHash = "", agentMessage :: AMessage agentMessage = PublicKey -> AckMode -> AMessage HELLO PublicKey verifyKey AckMode ackMode } send :: Int -> Int -> ByteString -> SMPClient -> ExceptT SMPClientError IO () send :: Int -> Int -> ConnAlias -> SMPClient -> ExceptT SMPClientError IO () send 0 _ _ _ = SMPClientError -> ExceptT SMPClientError IO () forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE (SMPClientError -> ExceptT SMPClientError IO ()) -> SMPClientError -> ExceptT SMPClientError IO () forall a b. (a -> b) -> a -> b $ ErrorType -> SMPClientError SMPServerError ErrorType AUTH send retry :: Int retry delay :: Int delay msg :: ConnAlias msg smp :: SMPClient smp = SMPClient -> Maybe RecipientPrivateKey -> ConnAlias -> ConnAlias -> ExceptT SMPClientError IO () sendSMPMessage SMPClient smp (RecipientPrivateKey -> Maybe RecipientPrivateKey forall a. a -> Maybe a Just RecipientPrivateKey sndPrivateKey) ConnAlias sndId ConnAlias msg ExceptT SMPClientError IO () -> (SMPClientError -> ExceptT SMPClientError IO ()) -> ExceptT SMPClientError IO () forall (m :: * -> *) e a e'. Monad m => ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a `catchE` \case SMPServerError AUTH -> do Int -> ExceptT SMPClientError IO () forall (m :: * -> *). MonadIO m => Int -> m () threadDelay Int delay Int -> Int -> ConnAlias -> SMPClient -> ExceptT SMPClientError IO () send (Int retry Int -> Int -> Int forall a. Num a => a -> a -> a - 1) (Int delay Int -> Int -> Int forall a. Num a => a -> a -> a * 3 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` 2) ConnAlias msg SMPClient smp e :: SMPClientError e -> SMPClientError -> ExceptT SMPClientError IO () forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE SMPClientError e secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m () secureQueue :: AgentClient -> RcvQueue -> PublicKey -> m () secureQueue c :: AgentClient c RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server, ConnAlias rcvId :: ConnAlias $sel:rcvId:RcvQueue :: RcvQueue -> ConnAlias rcvId, RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey rcvPrivateKey} senderKey :: PublicKey senderKey = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP AgentClient c SMPServer server ConnAlias rcvId "KEY <key>" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ()) -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> ConnAlias -> PublicKey -> ExceptT SMPClientError IO () secureSMPQueue SMPClient smp RecipientPrivateKey rcvPrivateKey ConnAlias rcvId PublicKey senderKey sendAck :: AgentMonad m => AgentClient -> RcvQueue -> m () sendAck :: AgentClient -> RcvQueue -> m () sendAck c :: AgentClient c RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server, ConnAlias rcvId :: ConnAlias $sel:rcvId:RcvQueue :: RcvQueue -> ConnAlias rcvId, RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey rcvPrivateKey} = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP AgentClient c SMPServer server ConnAlias rcvId "ACK" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ()) -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> ConnAlias -> ExceptT SMPClientError IO () ackSMPMessage SMPClient smp RecipientPrivateKey rcvPrivateKey ConnAlias rcvId suspendQueue :: AgentMonad m => AgentClient -> RcvQueue -> m () suspendQueue :: AgentClient -> RcvQueue -> m () suspendQueue c :: AgentClient c RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server, ConnAlias rcvId :: ConnAlias $sel:rcvId:RcvQueue :: RcvQueue -> ConnAlias rcvId, RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey rcvPrivateKey} = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP AgentClient c SMPServer server ConnAlias rcvId "OFF" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ()) -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> ConnAlias -> ExceptT SMPClientError IO () suspendSMPQueue SMPClient smp RecipientPrivateKey rcvPrivateKey ConnAlias rcvId deleteQueue :: AgentMonad m => AgentClient -> RcvQueue -> m () deleteQueue :: AgentClient -> RcvQueue -> m () deleteQueue c :: AgentClient c RcvQueue {SMPServer server :: SMPServer $sel:server:RcvQueue :: RcvQueue -> SMPServer server, ConnAlias rcvId :: ConnAlias $sel:rcvId:RcvQueue :: RcvQueue -> ConnAlias rcvId, RecipientPrivateKey rcvPrivateKey :: RecipientPrivateKey $sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey rcvPrivateKey} = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> ExceptT SMPClientError IO a) -> m a withLogSMP AgentClient c SMPServer server ConnAlias rcvId "DEL" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ()) -> (SMPClient -> ExceptT SMPClientError IO ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> SMPClient -> RecipientPrivateKey -> ConnAlias -> ExceptT SMPClientError IO () deleteSMPQueue SMPClient smp RecipientPrivateKey rcvPrivateKey ConnAlias rcvId sendAgentMessage :: AgentMonad m => AgentClient -> SndQueue -> ByteString -> m () sendAgentMessage :: AgentClient -> SndQueue -> ConnAlias -> m () sendAgentMessage c :: AgentClient c sq :: SndQueue sq@SndQueue {SMPServer server :: SMPServer $sel:server:SndQueue :: SndQueue -> SMPServer server, ConnAlias sndId :: ConnAlias $sel:sndId:SndQueue :: SndQueue -> ConnAlias sndId, RecipientPrivateKey sndPrivateKey :: RecipientPrivateKey $sel:sndPrivateKey:SndQueue :: SndQueue -> RecipientPrivateKey sndPrivateKey} msg :: ConnAlias msg = AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m ()) -> m () forall (m :: * -> *) a. AgentMonad m => AgentClient -> SMPServer -> ConnAlias -> ConnAlias -> (SMPClient -> m a) -> m a withLogSMP_ AgentClient c SMPServer server ConnAlias sndId "SEND <message>" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m () forall a b. (a -> b) -> a -> b $ \smp :: SMPClient smp -> do ConnAlias msg' <- SMPClient -> SndQueue -> ConnAlias -> m ConnAlias forall (m :: * -> *). AgentMonad m => SMPClient -> SndQueue -> ConnAlias -> m ConnAlias encryptAndSign SMPClient smp SndQueue sq ConnAlias msg ExceptT SMPClientError IO () -> m () forall (m :: * -> *) a. AgentMonad m => ExceptT SMPClientError IO a -> m a liftSMP (ExceptT SMPClientError IO () -> m ()) -> ExceptT SMPClientError IO () -> m () forall a b. (a -> b) -> a -> b $ SMPClient -> Maybe RecipientPrivateKey -> ConnAlias -> ConnAlias -> ExceptT SMPClientError IO () sendSMPMessage SMPClient smp (RecipientPrivateKey -> Maybe RecipientPrivateKey forall a. a -> Maybe a Just RecipientPrivateKey sndPrivateKey) ConnAlias sndId ConnAlias msg' encryptAndSign :: AgentMonad m => SMPClient -> SndQueue -> ByteString -> m ByteString encryptAndSign :: SMPClient -> SndQueue -> ConnAlias -> m ConnAlias encryptAndSign smp :: SMPClient smp SndQueue {PublicKey $sel:encryptKey:SndQueue :: SndQueue -> PublicKey encryptKey :: PublicKey encryptKey, RecipientPrivateKey $sel:signKey:SndQueue :: SndQueue -> RecipientPrivateKey signKey :: RecipientPrivateKey signKey} msg :: ConnAlias msg = do Int paddedSize <- (Env -> Int) -> m Int forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((Env -> Int) -> m Int) -> (Env -> Int) -> m Int forall a b. (a -> b) -> a -> b $ (SMPClient -> Int blockSize SMPClient smp Int -> Int -> Int forall a. Num a => a -> a -> a -) (Int -> Int) -> (Env -> Int) -> Env -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Env -> Int reservedMsgSize (CryptoError -> AgentErrorType) -> ExceptT CryptoError IO ConnAlias -> m ConnAlias forall (m :: * -> *) e' e a. (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a liftError CryptoError -> AgentErrorType cryptoError (ExceptT CryptoError IO ConnAlias -> m ConnAlias) -> ExceptT CryptoError IO ConnAlias -> m ConnAlias forall a b. (a -> b) -> a -> b $ do ConnAlias enc <- PublicKey -> Int -> ConnAlias -> ExceptT CryptoError IO ConnAlias C.encrypt PublicKey encryptKey Int paddedSize ConnAlias msg C.Signature sig :: ConnAlias sig <- RecipientPrivateKey -> ConnAlias -> ExceptT CryptoError IO Signature forall k. PrivateKey k => k -> ConnAlias -> ExceptT CryptoError IO Signature C.sign RecipientPrivateKey signKey ConnAlias enc ConnAlias -> ExceptT CryptoError IO ConnAlias forall (f :: * -> *) a. Applicative f => a -> f a pure (ConnAlias -> ExceptT CryptoError IO ConnAlias) -> ConnAlias -> ExceptT CryptoError IO ConnAlias forall a b. (a -> b) -> a -> b $ ConnAlias sig ConnAlias -> ConnAlias -> ConnAlias forall a. Semigroup a => a -> a -> a <> ConnAlias enc decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString decryptAndVerify :: RcvQueue -> ConnAlias -> m ConnAlias decryptAndVerify RcvQueue {RecipientPrivateKey decryptKey :: RecipientPrivateKey $sel:decryptKey:RcvQueue :: RcvQueue -> RecipientPrivateKey decryptKey, Maybe PublicKey verifyKey :: Maybe PublicKey $sel:verifyKey:RcvQueue :: RcvQueue -> Maybe PublicKey verifyKey} msg :: ConnAlias msg = Maybe PublicKey -> ConnAlias -> m ConnAlias forall (m :: * -> *). AgentMonad m => Maybe PublicKey -> ConnAlias -> m ConnAlias verifyMessage Maybe PublicKey verifyKey ConnAlias msg m ConnAlias -> (ConnAlias -> m ConnAlias) -> m ConnAlias forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (CryptoError -> AgentErrorType) -> ExceptT CryptoError IO ConnAlias -> m ConnAlias forall (m :: * -> *) e' e a. (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a liftError CryptoError -> AgentErrorType cryptoError (ExceptT CryptoError IO ConnAlias -> m ConnAlias) -> (ConnAlias -> ExceptT CryptoError IO ConnAlias) -> ConnAlias -> m ConnAlias forall b c a. (b -> c) -> (a -> b) -> a -> c . RecipientPrivateKey -> ConnAlias -> ExceptT CryptoError IO ConnAlias forall k. PrivateKey k => k -> ConnAlias -> ExceptT CryptoError IO ConnAlias C.decrypt RecipientPrivateKey decryptKey verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString verifyMessage :: Maybe PublicKey -> ConnAlias -> m ConnAlias verifyMessage verifyKey :: Maybe PublicKey verifyKey msg :: ConnAlias msg = do Int size <- (Env -> Int) -> m Int forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ((Env -> Int) -> m Int) -> (Env -> Int) -> m Int forall a b. (a -> b) -> a -> b $ AgentConfig -> Int rsaKeySize (AgentConfig -> Int) -> (Env -> AgentConfig) -> Env -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Env -> AgentConfig config let (sig :: ConnAlias sig, enc :: ConnAlias enc) = Int -> ConnAlias -> (ConnAlias, ConnAlias) B.splitAt Int size ConnAlias msg case Maybe PublicKey verifyKey of Nothing -> ConnAlias -> m ConnAlias forall (f :: * -> *) a. Applicative f => a -> f a pure ConnAlias enc Just k :: PublicKey k | PublicKey -> Signature -> ConnAlias -> Bool C.verify PublicKey k (ConnAlias -> Signature C.Signature ConnAlias sig) ConnAlias enc -> ConnAlias -> m ConnAlias forall (f :: * -> *) a. Applicative f => a -> f a pure ConnAlias enc | Bool otherwise -> AgentErrorType -> m ConnAlias forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (AgentErrorType -> m ConnAlias) -> AgentErrorType -> m ConnAlias forall a b. (a -> b) -> a -> b $ SMPAgentError -> AgentErrorType AGENT SMPAgentError A_SIGNATURE cryptoError :: C.CryptoError -> AgentErrorType cryptoError :: CryptoError -> AgentErrorType cryptoError = \case C.CryptoLargeMsgError -> CommandErrorType -> AgentErrorType CMD CommandErrorType LARGE C.RSADecryptError _ -> SMPAgentError -> AgentErrorType AGENT SMPAgentError A_ENCRYPTION C.CryptoHeaderError _ -> SMPAgentError -> AgentErrorType AGENT SMPAgentError A_ENCRYPTION C.AESDecryptError -> SMPAgentError -> AgentErrorType AGENT SMPAgentError A_ENCRYPTION e :: CryptoError e -> String -> AgentErrorType INTERNAL (String -> AgentErrorType) -> String -> AgentErrorType forall a b. (a -> b) -> a -> b $ CryptoError -> String forall a. Show a => a -> String show CryptoError e