{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.Messaging.Agent.Client
  ( AgentClient (..),
    newAgentClient,
    AgentMonad,
    withAgentLock,
    closeAgentClient,
    newRcvQueue,
    subscribeQueue,
    addSubscription,
    sendConfirmation,
    sendInvitation,
    RetryInterval (..),
    sendHello,
    secureQueue,
    sendAgentMessage,
    decryptAndVerify,
    verifyMessage,
    sendAck,
    suspendQueue,
    deleteQueue,
    logServer,
    removeSubscription,
    cryptoError,
    addActivation,
    getActivation,
    removeActivation,
  )
where

import Control.Concurrent.Async (Async, async, uninterruptibleCancel)
import Control.Concurrent.STM (stateTVar)
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.Maybe (isNothing)
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.RetryInterval
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.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)
subQ :: TBQueue (ATransmission 'Agent),
    AgentClient -> TBQueue SMPServerTransmission
msgQ :: TBQueue SMPServerTransmission,
    AgentClient -> TVar (Map SMPServer SMPClient)
smpClients :: TVar (Map SMPServer SMPClient),
    AgentClient -> TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue)),
    AgentClient -> TVar (Map ConnId SMPServer)
subscrConns :: TVar (Map ConnId SMPServer),
    AgentClient -> TVar (Map ConnId (Async ()))
activations :: TVar (Map ConnId (Async ())), -- activations of send queues in progress
    AgentClient -> TVar (Map ConnId (TQueue PendingMsg))
connMsgQueues :: TVar (Map ConnId (TQueue PendingMsg)),
    AgentClient -> TVar (Map ConnId (Async ()))
connMsgDeliveries :: TVar (Map ConnId (Async ())),
    AgentClient -> TVar (Map SMPServer (TQueue PendingMsg))
srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg)),
    AgentClient -> TVar (Map SMPServer (Async ()))
srvMsgDeliveries :: TVar (Map SMPServer (Async ())),
    AgentClient -> TVar [Async ()]
reconnections :: TVar [Async ()],
    AgentClient -> Int
clientId :: Int,
    AgentClient -> Env
agentEnv :: Env,
    AgentClient -> Async ()
smpSubscriber :: Async (),
    AgentClient -> TMVar ()
lock :: TMVar ()
  }

newAgentClient :: Env -> STM AgentClient
newAgentClient :: Env -> STM AgentClient
newAgentClient Env
agentEnv = do
  let qSize :: Natural
qSize = AgentConfig -> Natural
tbqSize (AgentConfig -> Natural) -> AgentConfig -> Natural
forall a b. (a -> b) -> a -> b
$ Env -> AgentConfig
config Env
agentEnv
  TBQueue (ATransmission 'Client)
rcvQ <- Natural -> STM (TBQueue (ATransmission 'Client))
forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
qSize
  TBQueue (ATransmission 'Agent)
subQ <- Natural -> STM (TBQueue (ATransmission 'Agent))
forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
qSize
  TBQueue SMPServerTransmission
msgQ <- Natural -> STM (TBQueue SMPServerTransmission)
forall a. Natural -> STM (TBQueue a)
newTBQueue Natural
qSize
  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 (Map ConnId RcvQueue))
subscrSrvrs <- Map SMPServer (Map ConnId RcvQueue)
-> STM (TVar (Map SMPServer (Map ConnId RcvQueue)))
forall a. a -> STM (TVar a)
newTVar Map SMPServer (Map ConnId RcvQueue)
forall k a. Map k a
M.empty
  TVar (Map ConnId SMPServer)
subscrConns <- Map ConnId SMPServer -> STM (TVar (Map ConnId SMPServer))
forall a. a -> STM (TVar a)
newTVar Map ConnId SMPServer
forall k a. Map k a
M.empty
  TVar (Map ConnId (Async ()))
activations <- Map ConnId (Async ()) -> STM (TVar (Map ConnId (Async ())))
forall a. a -> STM (TVar a)
newTVar Map ConnId (Async ())
forall k a. Map k a
M.empty
  TVar (Map ConnId (TQueue PendingMsg))
connMsgQueues <- Map ConnId (TQueue PendingMsg)
-> STM (TVar (Map ConnId (TQueue PendingMsg)))
forall a. a -> STM (TVar a)
newTVar Map ConnId (TQueue PendingMsg)
forall k a. Map k a
M.empty
  TVar (Map ConnId (Async ()))
connMsgDeliveries <- Map ConnId (Async ()) -> STM (TVar (Map ConnId (Async ())))
forall a. a -> STM (TVar a)
newTVar Map ConnId (Async ())
forall k a. Map k a
M.empty
  TVar (Map SMPServer (TQueue PendingMsg))
srvMsgQueues <- Map SMPServer (TQueue PendingMsg)
-> STM (TVar (Map SMPServer (TQueue PendingMsg)))
forall a. a -> STM (TVar a)
newTVar Map SMPServer (TQueue PendingMsg)
forall k a. Map k a
M.empty
  TVar (Map SMPServer (Async ()))
srvMsgDeliveries <- Map SMPServer (Async ()) -> STM (TVar (Map SMPServer (Async ())))
forall a. a -> STM (TVar a)
newTVar Map SMPServer (Async ())
forall k a. Map k a
M.empty
  TVar [Async ()]
reconnections <- [Async ()] -> STM (TVar [Async ()])
forall a. a -> STM (TVar a)
newTVar []
  Int
clientId <- TVar Int -> (Int -> (Int, Int)) -> STM Int
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar (Env -> TVar Int
clientCounter Env
agentEnv) ((Int -> (Int, Int)) -> STM Int) -> (Int -> (Int, Int)) -> STM Int
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  TMVar ()
lock <- () -> STM (TMVar ())
forall a. a -> STM (TMVar a)
newTMVar ()
  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 (Map ConnId RcvQueue))
-> TVar (Map ConnId SMPServer)
-> TVar (Map ConnId (Async ()))
-> TVar (Map ConnId (TQueue PendingMsg))
-> TVar (Map ConnId (Async ()))
-> TVar (Map SMPServer (TQueue PendingMsg))
-> TVar (Map SMPServer (Async ()))
-> TVar [Async ()]
-> Int
-> Env
-> Async ()
-> TMVar ()
-> AgentClient
AgentClient {TBQueue (ATransmission 'Client)
rcvQ :: TBQueue (ATransmission 'Client)
$sel:rcvQ:AgentClient :: TBQueue (ATransmission 'Client)
rcvQ, TBQueue (ATransmission 'Agent)
subQ :: TBQueue (ATransmission 'Agent)
$sel:subQ:AgentClient :: TBQueue (ATransmission 'Agent)
subQ, 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 (Map ConnId RcvQueue))
subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue))
$sel:subscrSrvrs:AgentClient :: TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs, TVar (Map ConnId SMPServer)
subscrConns :: TVar (Map ConnId SMPServer)
$sel:subscrConns:AgentClient :: TVar (Map ConnId SMPServer)
subscrConns, TVar (Map ConnId (Async ()))
activations :: TVar (Map ConnId (Async ()))
$sel:activations:AgentClient :: TVar (Map ConnId (Async ()))
activations, TVar (Map ConnId (TQueue PendingMsg))
connMsgQueues :: TVar (Map ConnId (TQueue PendingMsg))
$sel:connMsgQueues:AgentClient :: TVar (Map ConnId (TQueue PendingMsg))
connMsgQueues, TVar (Map ConnId (Async ()))
connMsgDeliveries :: TVar (Map ConnId (Async ()))
$sel:connMsgDeliveries:AgentClient :: TVar (Map ConnId (Async ()))
connMsgDeliveries, TVar (Map SMPServer (TQueue PendingMsg))
srvMsgQueues :: TVar (Map SMPServer (TQueue PendingMsg))
$sel:srvMsgQueues:AgentClient :: TVar (Map SMPServer (TQueue PendingMsg))
srvMsgQueues, TVar (Map SMPServer (Async ()))
srvMsgDeliveries :: TVar (Map SMPServer (Async ()))
$sel:srvMsgDeliveries:AgentClient :: TVar (Map SMPServer (Async ()))
srvMsgDeliveries, TVar [Async ()]
reconnections :: TVar [Async ()]
$sel:reconnections:AgentClient :: TVar [Async ()]
reconnections, Int
clientId :: Int
$sel:clientId:AgentClient :: Int
clientId, Env
agentEnv :: Env
$sel:agentEnv:AgentClient :: Env
agentEnv, $sel:smpSubscriber:AgentClient :: Async ()
smpSubscriber = Async ()
forall a. HasCallStack => a
undefined, TMVar ()
lock :: TMVar ()
$sel:lock:AgentClient :: TMVar ()
lock}

-- | Agent monad with MonadReader Env and MonadError AgentErrorType
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} 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 :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logInfo (Text -> m ()) -> (ConnId -> Text) -> ConnId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnId -> Text
decodeUtf8 (ConnId -> m ()) -> ConnId -> m ()
forall a b. (a -> b) -> a -> b
$ ConnId
"Agent connected to " ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> SMPServer -> ConnId
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
      UnliftIO m
u <- m (UnliftIO m)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
      (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 () -> IO (Either SMPClientError SMPClient))
-> IO () -> IO (Either SMPClientError SMPClient)
forall a b. (a -> b) -> a -> b
$ UnliftIO m -> IO ()
clientDisconnected UnliftIO m
u)
        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 :: UnliftIO m -> IO ()
    clientDisconnected :: UnliftIO m -> IO ()
clientDisconnected UnliftIO m
u = do
      IO (Maybe (Map ConnId RcvQueue))
removeClientSubs IO (Maybe (Map ConnId RcvQueue))
-> (Maybe (Map ConnId RcvQueue) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (Map ConnId RcvQueue)
-> (Map ConnId RcvQueue -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` UnliftIO m -> Map ConnId RcvQueue -> IO ()
serverDown UnliftIO m
u)
      Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logInfo (Text -> IO ()) -> (ConnId -> Text) -> ConnId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnId -> Text
decodeUtf8 (ConnId -> IO ()) -> ConnId -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnId
"Agent disconnected from " ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> SMPServer -> ConnId
showServer SMPServer
srv

    removeClientSubs :: IO (Maybe (Map ConnId RcvQueue))
    removeClientSubs :: IO (Maybe (Map ConnId RcvQueue))
removeClientSubs = STM (Maybe (Map ConnId RcvQueue))
-> IO (Maybe (Map ConnId RcvQueue))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe (Map ConnId RcvQueue))
 -> IO (Maybe (Map ConnId RcvQueue)))
-> STM (Maybe (Map ConnId RcvQueue))
-> IO (Maybe (Map ConnId RcvQueue))
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 (Map ConnId RcvQueue)
cs <- SMPServer
-> Map SMPServer (Map ConnId RcvQueue)
-> Maybe (Map ConnId RcvQueue)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SMPServer
srv (Map SMPServer (Map ConnId RcvQueue)
 -> Maybe (Map ConnId RcvQueue))
-> STM (Map SMPServer (Map ConnId RcvQueue))
-> STM (Maybe (Map ConnId RcvQueue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map SMPServer (Map ConnId RcvQueue))
-> STM (Map SMPServer (Map ConnId RcvQueue))
forall a. TVar a -> STM a
readTVar (AgentClient -> TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs AgentClient
c)
      TVar (Map SMPServer (Map ConnId RcvQueue))
-> (Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs AgentClient
c) ((Map SMPServer (Map ConnId RcvQueue)
  -> Map SMPServer (Map ConnId RcvQueue))
 -> STM ())
-> (Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> STM ()
forall a b. (a -> b) -> a -> b
$ SMPServer
-> Map SMPServer (Map ConnId RcvQueue)
-> Map SMPServer (Map ConnId RcvQueue)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete SMPServer
srv
      TVar (Map ConnId SMPServer)
-> (Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map ConnId SMPServer)
subscrConns AgentClient
c) ((Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ())
-> (Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ()
forall a b. (a -> b) -> a -> b
$ (Map ConnId SMPServer -> Map ConnId SMPServer)
-> (Map ConnId RcvQueue
    -> Map ConnId SMPServer -> Map ConnId SMPServer)
-> Maybe (Map ConnId RcvQueue)
-> Map ConnId SMPServer
-> Map ConnId SMPServer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map ConnId SMPServer -> Map ConnId SMPServer
forall a. a -> a
id (Set ConnId -> Map ConnId SMPServer -> Map ConnId SMPServer
forall k a. Ord k => Set k -> Map k a -> Map k a
deleteKeys (Set ConnId -> Map ConnId SMPServer -> Map ConnId SMPServer)
-> (Map ConnId RcvQueue -> Set ConnId)
-> Map ConnId RcvQueue
-> Map ConnId SMPServer
-> Map ConnId SMPServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ConnId RcvQueue -> Set ConnId
forall k a. Map k a -> Set k
M.keysSet) Maybe (Map ConnId RcvQueue)
cs
      Maybe (Map ConnId RcvQueue) -> STM (Maybe (Map ConnId RcvQueue))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map ConnId RcvQueue)
cs
      where
        deleteKeys :: Ord k => Set k -> Map k a -> Map k a
        deleteKeys :: Set k -> Map k a -> Map k a
deleteKeys Set k
ks 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

    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
    serverDown :: UnliftIO m -> Map ConnId RcvQueue -> IO ()
serverDown UnliftIO m
u Map ConnId RcvQueue
cs = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map ConnId RcvQueue -> Bool
forall k a. Map k a -> Bool
M.null Map ConnId RcvQueue
cs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      (ConnId -> IO ()) -> Set ConnId -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ACommand 'Agent -> ConnId -> IO ()
notifySub ACommand 'Agent
DOWN) (Set ConnId -> IO ()) -> Set ConnId -> IO ()
forall a b. (a -> b) -> a -> b
$ Map ConnId RcvQueue -> Set ConnId
forall k a. Map k a -> Set k
M.keysSet Map ConnId RcvQueue
cs
      Async ()
a <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ()))
-> (m () -> IO ()) -> m () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnliftIO m -> forall a. m a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO m
u (m () -> IO (Async ())) -> m () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Map ConnId RcvQueue -> m ()
tryReconnectClient Map ConnId RcvQueue
cs
      STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [Async ()] -> ([Async ()] -> [Async ()]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar [Async ()]
reconnections AgentClient
c) (Async ()
a Async () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
:)

    tryReconnectClient :: Map ConnId RcvQueue -> m ()
    tryReconnectClient :: Map ConnId RcvQueue -> m ()
tryReconnectClient Map ConnId RcvQueue
cs = do
      RetryInterval
ri <- (Env -> RetryInterval) -> m RetryInterval
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Env -> RetryInterval) -> m RetryInterval)
-> (Env -> RetryInterval) -> m RetryInterval
forall a b. (a -> b) -> a -> b
$ AgentConfig -> RetryInterval
reconnectInterval (AgentConfig -> RetryInterval)
-> (Env -> AgentConfig) -> Env -> RetryInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> AgentConfig
config
      RetryInterval -> (m () -> m ()) -> m ()
forall (m :: * -> *).
MonadIO m =>
RetryInterval -> (m () -> m ()) -> m ()
withRetryInterval RetryInterval
ri ((m () -> m ()) -> m ()) -> (m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \m ()
loop ->
        Map ConnId RcvQueue -> m ()
reconnectClient Map ConnId RcvQueue
cs m () -> (AgentErrorType -> m ()) -> m ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` m () -> AgentErrorType -> m ()
forall a b. a -> b -> a
const m ()
loop

    reconnectClient :: Map ConnId RcvQueue -> m ()
    reconnectClient :: Map ConnId RcvQueue -> m ()
reconnectClient Map ConnId RcvQueue
cs = do
      AgentClient -> m () -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
AgentClient -> m a -> m a
withAgentLock AgentClient
c (m () -> m ())
-> ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentClient
-> SMPServer -> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a
withSMP AgentClient
c SMPServer
srv ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> do
        Map ConnId SMPServer
subs <- TVar (Map ConnId SMPServer)
-> ExceptT SMPClientError IO (Map ConnId SMPServer)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar (Map ConnId SMPServer)
 -> ExceptT SMPClientError IO (Map ConnId SMPServer))
-> TVar (Map ConnId SMPServer)
-> ExceptT SMPClientError IO (Map ConnId SMPServer)
forall a b. (a -> b) -> a -> b
$ AgentClient -> TVar (Map ConnId SMPServer)
subscrConns AgentClient
c
        [(ConnId, RcvQueue)]
-> ((ConnId, RcvQueue) -> ExceptT SMPClientError IO ())
-> ExceptT SMPClientError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map ConnId RcvQueue -> [(ConnId, RcvQueue)]
forall k a. Map k a -> [(k, a)]
M.toList Map ConnId RcvQueue
cs) (((ConnId, RcvQueue) -> ExceptT SMPClientError IO ())
 -> ExceptT SMPClientError IO ())
-> ((ConnId, RcvQueue) -> ExceptT SMPClientError IO ())
-> ExceptT SMPClientError IO ()
forall a b. (a -> b) -> a -> b
$ \(ConnId
connId, rq :: RcvQueue
rq@RcvQueue {RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
rcvPrivateKey, ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId :: ConnId
rcvId}) ->
          Bool
-> ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe SMPServer -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe SMPServer -> Bool) -> Maybe SMPServer -> Bool
forall a b. (a -> b) -> a -> b
$ ConnId -> Map ConnId SMPServer -> Maybe SMPServer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ConnId
connId Map ConnId SMPServer
subs) (ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ())
-> ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ()
forall a b. (a -> b) -> a -> b
$ do
            SMPClient
-> RecipientPrivateKey -> ConnId -> ExceptT SMPClientError IO ()
subscribeSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId
              ExceptT SMPClientError IO ()
-> (SMPClientError -> ExceptT SMPClientError IO ())
-> ExceptT SMPClientError IO ()
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \case
                SMPServerError ErrorType
e -> IO () -> ExceptT SMPClientError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SMPClientError IO ())
-> IO () -> ExceptT SMPClientError IO ()
forall a b. (a -> b) -> a -> b
$ ACommand 'Agent -> ConnId -> IO ()
notifySub (AgentErrorType -> ACommand 'Agent
ERR (AgentErrorType -> ACommand 'Agent)
-> AgentErrorType -> ACommand 'Agent
forall a b. (a -> b) -> a -> b
$ ErrorType -> AgentErrorType
SMP ErrorType
e) ConnId
connId
                SMPClientError
e -> SMPClientError -> ExceptT SMPClientError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError SMPClientError
e
            AgentClient -> RcvQueue -> ConnId -> ExceptT SMPClientError IO ()
forall (m :: * -> *).
MonadUnliftIO m =>
AgentClient -> RcvQueue -> ConnId -> m ()
addSubscription AgentClient
c RcvQueue
rq ConnId
connId
            IO () -> ExceptT SMPClientError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SMPClientError IO ())
-> IO () -> ExceptT SMPClientError IO ()
forall a b. (a -> b) -> a -> b
$ ACommand 'Agent -> ConnId -> IO ()
notifySub ACommand 'Agent
UP ConnId
connId

    notifySub :: ACommand 'Agent -> ConnId -> IO ()
    notifySub :: ACommand 'Agent -> ConnId -> IO ()
notifySub ACommand 'Agent
cmd ConnId
connId = 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)
subQ AgentClient
c) (ConnId
"", ConnId
connId, ACommand 'Agent
cmd)

closeAgentClient :: MonadUnliftIO m => AgentClient -> m ()
closeAgentClient :: AgentClient -> m ()
closeAgentClient 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
$ do
  AgentClient -> IO ()
closeSMPServerClients AgentClient
c
  TVar (Map ConnId (Async ())) -> IO ()
forall (f :: * -> *). Foldable f => TVar (f (Async ())) -> IO ()
cancelActions (TVar (Map ConnId (Async ())) -> IO ())
-> TVar (Map ConnId (Async ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ AgentClient -> TVar (Map ConnId (Async ()))
activations AgentClient
c
  TVar [Async ()] -> IO ()
forall (f :: * -> *). Foldable f => TVar (f (Async ())) -> IO ()
cancelActions (TVar [Async ()] -> IO ()) -> TVar [Async ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ AgentClient -> TVar [Async ()]
reconnections AgentClient
c
  TVar (Map ConnId (Async ())) -> IO ()
forall (f :: * -> *). Foldable f => TVar (f (Async ())) -> IO ()
cancelActions (TVar (Map ConnId (Async ())) -> IO ())
-> TVar (Map ConnId (Async ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ AgentClient -> TVar (Map ConnId (Async ()))
connMsgDeliveries AgentClient
c
  TVar (Map SMPServer (Async ())) -> IO ()
forall (f :: * -> *). Foldable f => TVar (f (Async ())) -> IO ()
cancelActions (TVar (Map SMPServer (Async ())) -> IO ())
-> TVar (Map SMPServer (Async ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ AgentClient -> TVar (Map SMPServer (Async ()))
srvMsgDeliveries AgentClient
c

closeSMPServerClients :: AgentClient -> IO ()
closeSMPServerClients :: AgentClient -> IO ()
closeSMPServerClients AgentClient
c = 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

cancelActions :: Foldable f => TVar (f (Async ())) -> IO ()
cancelActions :: TVar (f (Async ())) -> IO ()
cancelActions TVar (f (Async ()))
as = TVar (f (Async ())) -> IO (f (Async ()))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (f (Async ()))
as IO (f (Async ())) -> (f (Async ()) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Async () -> IO ()) -> f (Async ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall a. Async a -> IO ()
uninterruptibleCancel

withAgentLock :: MonadUnliftIO m => AgentClient -> m a -> m a
withAgentLock :: AgentClient -> m a -> m a
withAgentLock AgentClient {TMVar ()
lock :: TMVar ()
$sel:lock:AgentClient :: AgentClient -> TMVar ()
lock} =
  m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
E.bracket_
    (m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> (STM () -> m ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> STM ()
forall a. TMVar a -> STM a
takeTMVar TMVar ()
lock)
    (STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> () -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
lock ())

withSMP_ :: forall a m. AgentMonad m => AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
withSMP_ :: AgentClient -> SMPServer -> (SMPClient -> m a) -> m a
withSMP_ AgentClient
c SMPServer
srv 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 AgentErrorType
e = do
      ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
forall (m :: * -> *).
AgentMonad m =>
ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
"<--" AgentClient
c SMPServer
srv ConnId
"" (ConnId -> m ()) -> ConnId -> m ()
forall a b. (a -> b) -> a -> b
$ AgentErrorType -> ConnId
forall a. Show a => a -> ConnId
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 -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
srv ConnId
qId ConnId
cmdStr SMPClient -> m a
action = do
  ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
forall (m :: * -> *).
AgentMonad m =>
ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
"-->" AgentClient
c SMPServer
srv ConnId
qId ConnId
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
  ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
forall (m :: * -> *).
AgentMonad m =>
ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
"<--" AgentClient
c SMPServer
srv ConnId
qId ConnId
"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 AgentClient
c SMPServer
srv 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
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
srv ConnId
qId ConnId
cmdStr SMPClient -> ExceptT SMPClientError IO a
action = AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
srv ConnId
qId ConnId
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 ErrorType
e -> ErrorType -> AgentErrorType
SMP ErrorType
e
  SMPResponseError ErrorType
e -> BrokerErrorType -> AgentErrorType
BROKER (BrokerErrorType -> AgentErrorType)
-> BrokerErrorType -> AgentErrorType
forall a b. (a -> b) -> a -> b
$ ErrorType -> BrokerErrorType
RESPONSE ErrorType
e
  SMPClientError
SMPUnexpectedResponse -> BrokerErrorType -> AgentErrorType
BROKER BrokerErrorType
UNEXPECTED
  SMPClientError
SMPResponseTimeout -> BrokerErrorType -> AgentErrorType
BROKER BrokerErrorType
TIMEOUT
  SMPClientError
SMPNetworkError -> BrokerErrorType -> AgentErrorType
BROKER BrokerErrorType
NETWORK
  SMPTransportError TransportError
e -> BrokerErrorType -> AgentErrorType
BROKER (BrokerErrorType -> AgentErrorType)
-> BrokerErrorType -> AgentErrorType
forall a b. (a -> b) -> a -> b
$ TransportError -> BrokerErrorType
TRANSPORT TransportError
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

newRcvQueue :: AgentMonad m => AgentClient -> SMPServer -> m (RcvQueue, SMPQueueUri, EncryptionKey)
newRcvQueue :: AgentClient
-> SMPServer -> m (RcvQueue, SMPQueueUri, EncryptionKey)
newRcvQueue AgentClient
c SMPServer
srv = 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
  (EncryptionKey
recipientKey, RecipientPrivateKey
rcvPrivateKey) <- IO (EncryptionKey, RecipientPrivateKey)
-> m (EncryptionKey, RecipientPrivateKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EncryptionKey, RecipientPrivateKey)
 -> m (EncryptionKey, RecipientPrivateKey))
-> IO (EncryptionKey, RecipientPrivateKey)
-> m (EncryptionKey, RecipientPrivateKey)
forall a b. (a -> b) -> a -> b
$ Int -> IO (EncryptionKey, RecipientPrivateKey)
forall k. PrivateKey k => Int -> IO (KeyPair k)
C.generateKeyPair Int
size
  ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
forall (m :: * -> *).
AgentMonad m =>
ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
"-->" AgentClient
c SMPServer
srv ConnId
"" ConnId
"NEW"
  (ConnId
rcvId, ConnId
sId) <- AgentClient
-> SMPServer
-> (SMPClient -> ExceptT SMPClientError IO (ConnId, ConnId))
-> m (ConnId, ConnId)
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> (SMPClient -> ExceptT SMPClientError IO a) -> m a
withSMP AgentClient
c SMPServer
srv ((SMPClient -> ExceptT SMPClientError IO (ConnId, ConnId))
 -> m (ConnId, ConnId))
-> (SMPClient -> ExceptT SMPClientError IO (ConnId, ConnId))
-> m (ConnId, ConnId)
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> SMPClient
-> RecipientPrivateKey
-> EncryptionKey
-> ExceptT SMPClientError IO (ConnId, ConnId)
createSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey EncryptionKey
recipientKey
  ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
forall (m :: * -> *).
AgentMonad m =>
ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
"<--" AgentClient
c SMPServer
srv ConnId
"" (ConnId -> m ()) -> ConnId -> m ()
forall a b. (a -> b) -> a -> b
$ [ConnId] -> ConnId
B.unwords [ConnId
"IDS", ConnId -> ConnId
logSecret ConnId
rcvId, ConnId -> ConnId
logSecret ConnId
sId]
  (EncryptionKey
encryptKey, RecipientPrivateKey
decryptKey) <- IO (EncryptionKey, RecipientPrivateKey)
-> m (EncryptionKey, RecipientPrivateKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EncryptionKey, RecipientPrivateKey)
 -> m (EncryptionKey, RecipientPrivateKey))
-> IO (EncryptionKey, RecipientPrivateKey)
-> m (EncryptionKey, RecipientPrivateKey)
forall a b. (a -> b) -> a -> b
$ Int -> IO (EncryptionKey, RecipientPrivateKey)
forall k. PrivateKey k => Int -> IO (KeyPair k)
C.generateKeyPair Int
size
  let rq :: RcvQueue
rq =
        RcvQueue :: SMPServer
-> ConnId
-> RecipientPrivateKey
-> Maybe ConnId
-> RecipientPrivateKey
-> Maybe EncryptionKey
-> QueueStatus
-> RcvQueue
RcvQueue
          { $sel:server:RcvQueue :: SMPServer
server = SMPServer
srv,
            ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: ConnId
rcvId,
            RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RecipientPrivateKey
rcvPrivateKey,
            $sel:sndId:RcvQueue :: Maybe ConnId
sndId = ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
sId,
            RecipientPrivateKey
$sel:decryptKey:RcvQueue :: RecipientPrivateKey
decryptKey :: RecipientPrivateKey
decryptKey,
            $sel:verifyKey:RcvQueue :: Maybe EncryptionKey
verifyKey = Maybe EncryptionKey
forall a. Maybe a
Nothing,
            $sel:status:RcvQueue :: QueueStatus
status = QueueStatus
New
          }
  (RcvQueue, SMPQueueUri, EncryptionKey)
-> m (RcvQueue, SMPQueueUri, EncryptionKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RcvQueue
rq, SMPServer -> ConnId -> EncryptionKey -> SMPQueueUri
SMPQueueUri SMPServer
srv ConnId
sId EncryptionKey
reservedServerKey, EncryptionKey
encryptKey)

subscribeQueue :: AgentMonad m => AgentClient -> RcvQueue -> ConnId -> m ()
subscribeQueue :: AgentClient -> RcvQueue -> ConnId -> m ()
subscribeQueue AgentClient
c rq :: RcvQueue
rq@RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey, ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId} ConnId
connId = do
  AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
server ConnId
rcvId ConnId
"SUB" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp ->
    SMPClient
-> RecipientPrivateKey -> ConnId -> ExceptT SMPClientError IO ()
subscribeSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId
  AgentClient -> RcvQueue -> ConnId -> m ()
forall (m :: * -> *).
MonadUnliftIO m =>
AgentClient -> RcvQueue -> ConnId -> m ()
addSubscription AgentClient
c RcvQueue
rq ConnId
connId

addSubscription :: MonadUnliftIO m => AgentClient -> RcvQueue -> ConnId -> m ()
addSubscription :: AgentClient -> RcvQueue -> ConnId -> m ()
addSubscription AgentClient
c rq :: RcvQueue
rq@RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server} ConnId
connId = 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 ConnId SMPServer)
-> (Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map ConnId SMPServer)
subscrConns AgentClient
c) ((Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ())
-> (Map ConnId SMPServer -> Map ConnId SMPServer) -> STM ()
forall a b. (a -> b) -> a -> b
$ ConnId -> SMPServer -> Map ConnId SMPServer -> Map ConnId SMPServer
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ConnId
connId SMPServer
server
  TVar (Map SMPServer (Map ConnId RcvQueue))
-> (Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs AgentClient
c) ((Map SMPServer (Map ConnId RcvQueue)
  -> Map SMPServer (Map ConnId RcvQueue))
 -> STM ())
-> (Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> STM ()
forall a b. (a -> b) -> a -> b
$ (Maybe (Map ConnId RcvQueue) -> Maybe (Map ConnId RcvQueue))
-> SMPServer
-> Map SMPServer (Map ConnId RcvQueue)
-> Map SMPServer (Map ConnId RcvQueue)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
forall a. a -> Maybe a
Just (Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue))
-> (Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue)
-> Maybe (Map ConnId RcvQueue)
-> Maybe (Map ConnId RcvQueue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue
addSub) SMPServer
server
  where
    addSub :: Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue
    addSub :: Maybe (Map ConnId RcvQueue) -> Map ConnId RcvQueue
addSub (Just Map ConnId RcvQueue
cs) = ConnId -> RcvQueue -> Map ConnId RcvQueue -> Map ConnId RcvQueue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ConnId
connId RcvQueue
rq Map ConnId RcvQueue
cs
    addSub Maybe (Map ConnId RcvQueue)
_ = ConnId -> RcvQueue -> Map ConnId RcvQueue
forall k a. k -> a -> Map k a
M.singleton ConnId
connId RcvQueue
rq

removeSubscription :: AgentMonad m => AgentClient -> ConnId -> m ()
removeSubscription :: AgentClient -> ConnId -> m ()
removeSubscription AgentClient {TVar (Map ConnId SMPServer)
subscrConns :: TVar (Map ConnId SMPServer)
$sel:subscrConns:AgentClient :: AgentClient -> TVar (Map ConnId SMPServer)
subscrConns, TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs :: TVar (Map SMPServer (Map ConnId RcvQueue))
$sel:subscrSrvrs:AgentClient :: AgentClient -> TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs} ConnId
connId = 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 ConnId SMPServer
cs <- TVar (Map ConnId SMPServer) -> STM (Map ConnId SMPServer)
forall a. TVar a -> STM a
readTVar TVar (Map ConnId SMPServer)
subscrConns
  TVar (Map ConnId SMPServer) -> Map ConnId SMPServer -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map ConnId SMPServer)
subscrConns (Map ConnId SMPServer -> STM ()) -> Map ConnId SMPServer -> STM ()
forall a b. (a -> b) -> a -> b
$ ConnId -> Map ConnId SMPServer -> Map ConnId SMPServer
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ConnId
connId Map ConnId 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 (Map ConnId RcvQueue))
-> (Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map SMPServer (Map ConnId RcvQueue))
subscrSrvrs ((Map SMPServer (Map ConnId RcvQueue)
  -> Map SMPServer (Map ConnId RcvQueue))
 -> STM ())
-> (SMPServer
    -> Map SMPServer (Map ConnId RcvQueue)
    -> Map SMPServer (Map ConnId RcvQueue))
-> SMPServer
-> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map ConnId RcvQueue) -> Maybe (Map ConnId RcvQueue))
-> SMPServer
-> Map SMPServer (Map ConnId RcvQueue)
-> Map SMPServer (Map ConnId RcvQueue)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Maybe (Map ConnId RcvQueue)
-> (Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue))
-> Maybe (Map ConnId RcvQueue)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
delSub))
    (ConnId -> Map ConnId SMPServer -> Maybe SMPServer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ConnId
connId Map ConnId SMPServer
cs)
  where
    delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
    delSub :: Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
delSub Map ConnId RcvQueue
cs =
      let cs' :: Map ConnId RcvQueue
cs' = ConnId -> Map ConnId RcvQueue -> Map ConnId RcvQueue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ConnId
connId Map ConnId RcvQueue
cs
       in if Map ConnId RcvQueue -> Bool
forall k a. Map k a -> Bool
M.null Map ConnId RcvQueue
cs' then Maybe (Map ConnId RcvQueue)
forall a. Maybe a
Nothing else Map ConnId RcvQueue -> Maybe (Map ConnId RcvQueue)
forall a. a -> Maybe a
Just Map ConnId RcvQueue
cs'

addActivation :: MonadUnliftIO m => AgentClient -> ConnId -> Async () -> m ()
addActivation :: AgentClient -> ConnId -> Async () -> m ()
addActivation AgentClient
c ConnId
connId Async ()
a = STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ())
-> ((Map ConnId (Async ()) -> Map ConnId (Async ())) -> STM ())
-> (Map ConnId (Async ()) -> Map ConnId (Async ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Map ConnId (Async ()))
-> (Map ConnId (Async ()) -> Map ConnId (Async ())) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map ConnId (Async ()))
activations AgentClient
c) ((Map ConnId (Async ()) -> Map ConnId (Async ())) -> m ())
-> (Map ConnId (Async ()) -> Map ConnId (Async ())) -> m ()
forall a b. (a -> b) -> a -> b
$ ConnId
-> Async () -> Map ConnId (Async ()) -> Map ConnId (Async ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ConnId
connId Async ()
a

getActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m (Maybe (Async ()))
getActivation :: AgentClient -> ConnId -> m (Maybe (Async ()))
getActivation AgentClient
c ConnId
connId = ConnId -> Map ConnId (Async ()) -> Maybe (Async ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ConnId
connId (Map ConnId (Async ()) -> Maybe (Async ()))
-> m (Map ConnId (Async ())) -> m (Maybe (Async ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map ConnId (Async ())) -> m (Map ConnId (Async ()))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (AgentClient -> TVar (Map ConnId (Async ()))
activations AgentClient
c)

removeActivation :: MonadUnliftIO m => AgentClient -> ConnId -> m ()
removeActivation :: AgentClient -> ConnId -> m ()
removeActivation AgentClient
c ConnId
connId = STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ())
-> ((Map ConnId (Async ()) -> Map ConnId (Async ())) -> STM ())
-> (Map ConnId (Async ()) -> Map ConnId (Async ()))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Map ConnId (Async ()))
-> (Map ConnId (Async ()) -> Map ConnId (Async ())) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (AgentClient -> TVar (Map ConnId (Async ()))
activations AgentClient
c) ((Map ConnId (Async ()) -> Map ConnId (Async ())) -> m ())
-> (Map ConnId (Async ()) -> Map ConnId (Async ())) -> m ()
forall a b. (a -> b) -> a -> b
$ ConnId -> Map ConnId (Async ()) -> Map ConnId (Async ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ConnId
connId

logServer :: AgentMonad m => ByteString -> AgentClient -> SMPServer -> QueueId -> ByteString -> m ()
logServer :: ConnId -> AgentClient -> SMPServer -> ConnId -> ConnId -> m ()
logServer ConnId
dir AgentClient {Int
clientId :: Int
$sel:clientId:AgentClient :: AgentClient -> Int
clientId} SMPServer
srv ConnId
qId ConnId
cmdStr =
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logInfo (Text -> m ()) -> (ConnId -> Text) -> ConnId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnId -> Text
decodeUtf8 (ConnId -> m ()) -> ConnId -> m ()
forall a b. (a -> b) -> a -> b
$ [ConnId] -> ConnId
B.unwords [ConnId
"A", ConnId
"(" ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> Int -> ConnId
forall a. Show a => a -> ConnId
bshow Int
clientId ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> ConnId
")", ConnId
dir, SMPServer -> ConnId
showServer SMPServer
srv, ConnId
":", ConnId -> ConnId
logSecret ConnId
qId, ConnId
cmdStr]

showServer :: SMPServer -> ByteString
showServer :: SMPServer -> ConnId
showServer SMPServer
srv = String -> ConnId
B.pack (String -> ConnId) -> String -> ConnId
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 -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (SMPServer -> Maybe String
port SMPServer
srv)

logSecret :: ByteString -> ByteString
logSecret :: ConnId -> ConnId
logSecret ConnId
bs = ConnId -> ConnId
encode (ConnId -> ConnId) -> ConnId -> ConnId
forall a b. (a -> b) -> a -> b
$ Int -> ConnId -> ConnId
B.take Int
3 ConnId
bs

sendConfirmation :: forall m. AgentMonad m => AgentClient -> SndQueue -> SenderPublicKey -> ConnInfo -> m ()
sendConfirmation :: AgentClient -> SndQueue -> EncryptionKey -> ConnId -> m ()
sendConfirmation AgentClient
c sq :: SndQueue
sq@SndQueue {SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server :: SMPServer
server, ConnId
$sel:sndId:SndQueue :: SndQueue -> ConnId
sndId :: ConnId
sndId} EncryptionKey
senderKey ConnId
cInfo =
  AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m ()) -> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
server ConnId
sndId ConnId
"SEND <KEY>" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> do
    ConnId
msg <- SMPClient -> m ConnId
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
-> ConnId
-> ConnId
-> ExceptT SMPClientError IO ()
sendSMPMessage SMPClient
smp Maybe RecipientPrivateKey
forall a. Maybe a
Nothing ConnId
sndId ConnId
msg
  where
    mkConfirmation :: SMPClient -> m MsgBody
    mkConfirmation :: SMPClient -> m ConnId
mkConfirmation SMPClient
smp = SMPClient -> SndQueue -> ConnId -> m ConnId
forall (m :: * -> *).
AgentMonad m =>
SMPClient -> SndQueue -> ConnId -> m ConnId
encryptAndSign SMPClient
smp SndQueue
sq (ConnId -> m ConnId)
-> (SMPMessage -> ConnId) -> SMPMessage -> m ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPMessage -> ConnId
serializeSMPMessage (SMPMessage -> m ConnId) -> SMPMessage -> m ConnId
forall a b. (a -> b) -> a -> b
$ EncryptionKey -> ConnId -> SMPMessage
SMPConfirmation EncryptionKey
senderKey ConnId
cInfo

sendHello :: forall m. AgentMonad m => AgentClient -> SndQueue -> VerificationKey -> RetryInterval -> m ()
sendHello :: AgentClient -> SndQueue -> EncryptionKey -> RetryInterval -> m ()
sendHello AgentClient
c sq :: SndQueue
sq@SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server, ConnId
sndId :: ConnId
$sel:sndId:SndQueue :: SndQueue -> ConnId
sndId, RecipientPrivateKey
$sel:sndPrivateKey:SndQueue :: SndQueue -> RecipientPrivateKey
sndPrivateKey :: RecipientPrivateKey
sndPrivateKey} EncryptionKey
verifyKey RetryInterval
ri =
  AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m ()) -> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
server ConnId
sndId ConnId
"SEND <HELLO> (retrying)" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> do
    ConnId
msg <- SMPClient -> AckMode -> m ConnId
mkHello SMPClient
smp (AckMode -> m ConnId) -> AckMode -> m ConnId
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 () -> ExceptT SMPClientError IO ())
    -> ExceptT SMPClientError IO ())
-> (ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ())
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetryInterval
-> (ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ())
-> ExceptT SMPClientError IO ()
forall (m :: * -> *).
MonadIO m =>
RetryInterval -> (m () -> m ()) -> m ()
withRetryInterval RetryInterval
ri ((ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ())
 -> m ())
-> (ExceptT SMPClientError IO () -> ExceptT SMPClientError IO ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \ExceptT SMPClientError IO ()
loop ->
      SMPClient
-> Maybe RecipientPrivateKey
-> ConnId
-> ConnId
-> ExceptT SMPClientError IO ()
sendSMPMessage SMPClient
smp (RecipientPrivateKey -> Maybe RecipientPrivateKey
forall a. a -> Maybe a
Just RecipientPrivateKey
sndPrivateKey) ConnId
sndId ConnId
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 ErrorType
AUTH -> ExceptT SMPClientError IO ()
loop
        SMPClientError
e -> SMPClientError -> ExceptT SMPClientError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE SMPClientError
e
  where
    mkHello :: SMPClient -> AckMode -> m ByteString
    mkHello :: SMPClient -> AckMode -> m ConnId
mkHello SMPClient
smp AckMode
ackMode = do
      UTCTime
senderTimestamp <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      SMPClient -> SndQueue -> ConnId -> m ConnId
forall (m :: * -> *).
AgentMonad m =>
SMPClient -> SndQueue -> ConnId -> m ConnId
encryptAndSign SMPClient
smp SndQueue
sq (ConnId -> m ConnId)
-> (SMPMessage -> ConnId) -> SMPMessage -> m ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPMessage -> ConnId
serializeSMPMessage (SMPMessage -> m ConnId) -> SMPMessage -> m ConnId
forall a b. (a -> b) -> a -> b
$
        SMPMessage :: AgentMsgId -> UTCTime -> ConnId -> AMessage -> SMPMessage
SMPMessage
          { senderMsgId :: AgentMsgId
senderMsgId = AgentMsgId
0,
            UTCTime
senderTimestamp :: UTCTime
senderTimestamp :: UTCTime
senderTimestamp,
            previousMsgHash :: ConnId
previousMsgHash = ConnId
"",
            agentMessage :: AMessage
agentMessage = EncryptionKey -> AckMode -> AMessage
HELLO EncryptionKey
verifyKey AckMode
ackMode
          }

sendInvitation :: forall m. AgentMonad m => AgentClient -> SMPQueueUri -> EncryptionKey -> ConnectionRequest 'CMInvitation -> ConnInfo -> m ()
sendInvitation :: AgentClient
-> SMPQueueUri
-> EncryptionKey
-> ConnectionRequest 'CMInvitation
-> ConnId
-> m ()
sendInvitation AgentClient
c SMPQueueUri {SMPServer
smpServer :: SMPQueueUri -> SMPServer
smpServer :: SMPServer
smpServer, ConnId
senderId :: SMPQueueUri -> ConnId
senderId :: ConnId
senderId} EncryptionKey
encryptKey ConnectionRequest 'CMInvitation
cReq ConnId
connInfo = do
  AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m ()) -> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
smpServer ConnId
senderId ConnId
"SEND <INV>" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> do
    ConnId
msg <- SMPClient -> m ConnId
mkInvitation 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
-> ConnId
-> ConnId
-> ExceptT SMPClientError IO ()
sendSMPMessage SMPClient
smp Maybe RecipientPrivateKey
forall a. Maybe a
Nothing ConnId
senderId ConnId
msg
  where
    mkInvitation :: SMPClient -> m ByteString
    mkInvitation :: SMPClient -> m ConnId
mkInvitation SMPClient
smp = do
      UTCTime
senderTimestamp <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      SMPClient -> EncryptionKey -> ConnId -> m ConnId
forall (m :: * -> *).
AgentMonad m =>
SMPClient -> EncryptionKey -> ConnId -> m ConnId
encryptUnsigned SMPClient
smp EncryptionKey
encryptKey (ConnId -> m ConnId)
-> (SMPMessage -> ConnId) -> SMPMessage -> m ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SMPMessage -> ConnId
serializeSMPMessage (SMPMessage -> m ConnId) -> SMPMessage -> m ConnId
forall a b. (a -> b) -> a -> b
$
        SMPMessage :: AgentMsgId -> UTCTime -> ConnId -> AMessage -> SMPMessage
SMPMessage
          { senderMsgId :: AgentMsgId
senderMsgId = AgentMsgId
0,
            UTCTime
senderTimestamp :: UTCTime
senderTimestamp :: UTCTime
senderTimestamp,
            previousMsgHash :: ConnId
previousMsgHash = ConnId
"",
            agentMessage :: AMessage
agentMessage = ConnectionRequest 'CMInvitation -> ConnId -> AMessage
A_INV ConnectionRequest 'CMInvitation
cReq ConnId
connInfo
          }

secureQueue :: AgentMonad m => AgentClient -> RcvQueue -> SenderPublicKey -> m ()
secureQueue :: AgentClient -> RcvQueue -> EncryptionKey -> m ()
secureQueue AgentClient
c RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId, RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey} EncryptionKey
senderKey =
  AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
server ConnId
rcvId ConnId
"KEY <key>" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp ->
    SMPClient
-> RecipientPrivateKey
-> ConnId
-> EncryptionKey
-> ExceptT SMPClientError IO ()
secureSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId EncryptionKey
senderKey

sendAck :: AgentMonad m => AgentClient -> RcvQueue -> m ()
sendAck :: AgentClient -> RcvQueue -> m ()
sendAck AgentClient
c RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId, RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey} =
  AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
server ConnId
rcvId ConnId
"ACK" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp ->
    SMPClient
-> RecipientPrivateKey -> ConnId -> ExceptT SMPClientError IO ()
ackSMPMessage SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId

suspendQueue :: AgentMonad m => AgentClient -> RcvQueue -> m ()
suspendQueue :: AgentClient -> RcvQueue -> m ()
suspendQueue AgentClient
c RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId, RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey} =
  AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
server ConnId
rcvId ConnId
"OFF" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp ->
    SMPClient
-> RecipientPrivateKey -> ConnId -> ExceptT SMPClientError IO ()
suspendSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId

deleteQueue :: AgentMonad m => AgentClient -> RcvQueue -> m ()
deleteQueue :: AgentClient -> RcvQueue -> m ()
deleteQueue AgentClient
c RcvQueue {SMPServer
server :: SMPServer
$sel:server:RcvQueue :: RcvQueue -> SMPServer
server, ConnId
rcvId :: ConnId
$sel:rcvId:RcvQueue :: RcvQueue -> ConnId
rcvId, RecipientPrivateKey
rcvPrivateKey :: RecipientPrivateKey
$sel:rcvPrivateKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
rcvPrivateKey} =
  AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO ())
-> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer
-> ConnId
-> ConnId
-> (SMPClient -> ExceptT SMPClientError IO a)
-> m a
withLogSMP AgentClient
c SMPServer
server ConnId
rcvId ConnId
"DEL" ((SMPClient -> ExceptT SMPClientError IO ()) -> m ())
-> (SMPClient -> ExceptT SMPClientError IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp ->
    SMPClient
-> RecipientPrivateKey -> ConnId -> ExceptT SMPClientError IO ()
deleteSMPQueue SMPClient
smp RecipientPrivateKey
rcvPrivateKey ConnId
rcvId

sendAgentMessage :: AgentMonad m => AgentClient -> SndQueue -> ByteString -> m ()
sendAgentMessage :: AgentClient -> SndQueue -> ConnId -> m ()
sendAgentMessage AgentClient
c sq :: SndQueue
sq@SndQueue {SMPServer
server :: SMPServer
$sel:server:SndQueue :: SndQueue -> SMPServer
server, ConnId
sndId :: ConnId
$sel:sndId:SndQueue :: SndQueue -> ConnId
sndId, RecipientPrivateKey
sndPrivateKey :: RecipientPrivateKey
$sel:sndPrivateKey:SndQueue :: SndQueue -> RecipientPrivateKey
sndPrivateKey} ConnId
msg =
  AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m ()) -> m ()
forall (m :: * -> *) a.
AgentMonad m =>
AgentClient
-> SMPServer -> ConnId -> ConnId -> (SMPClient -> m a) -> m a
withLogSMP_ AgentClient
c SMPServer
server ConnId
sndId ConnId
"SEND <message>" ((SMPClient -> m ()) -> m ()) -> (SMPClient -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \SMPClient
smp -> do
    ConnId
msg' <- SMPClient -> SndQueue -> ConnId -> m ConnId
forall (m :: * -> *).
AgentMonad m =>
SMPClient -> SndQueue -> ConnId -> m ConnId
encryptAndSign SMPClient
smp SndQueue
sq ConnId
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
-> ConnId
-> ConnId
-> ExceptT SMPClientError IO ()
sendSMPMessage SMPClient
smp (RecipientPrivateKey -> Maybe RecipientPrivateKey
forall a. a -> Maybe a
Just RecipientPrivateKey
sndPrivateKey) ConnId
sndId ConnId
msg'

encryptAndSign :: AgentMonad m => SMPClient -> SndQueue -> ByteString -> m ByteString
encryptAndSign :: SMPClient -> SndQueue -> ConnId -> m ConnId
encryptAndSign SMPClient
smp SndQueue {EncryptionKey
$sel:encryptKey:SndQueue :: SndQueue -> EncryptionKey
encryptKey :: EncryptionKey
encryptKey, SignatureKey
$sel:signKey:SndQueue :: SndQueue -> SignatureKey
signKey :: SignatureKey
signKey} ConnId
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 ConnId -> m ConnId
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 ConnId -> m ConnId)
-> ExceptT CryptoError IO ConnId -> m ConnId
forall a b. (a -> b) -> a -> b
$ do
    ConnId
enc <- EncryptionKey -> Int -> ConnId -> ExceptT CryptoError IO ConnId
C.encrypt EncryptionKey
encryptKey Int
paddedSize ConnId
msg
    C.Signature ConnId
sig <- SignatureKey -> ConnId -> ExceptT CryptoError IO Signature
forall k.
PrivateKey k =>
k -> ConnId -> ExceptT CryptoError IO Signature
C.sign SignatureKey
signKey ConnId
enc
    ConnId -> ExceptT CryptoError IO ConnId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnId -> ExceptT CryptoError IO ConnId)
-> ConnId -> ExceptT CryptoError IO ConnId
forall a b. (a -> b) -> a -> b
$ ConnId
sig ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> ConnId
enc

decryptAndVerify :: AgentMonad m => RcvQueue -> ByteString -> m ByteString
decryptAndVerify :: RcvQueue -> ConnId -> m ConnId
decryptAndVerify RcvQueue {RecipientPrivateKey
decryptKey :: RecipientPrivateKey
$sel:decryptKey:RcvQueue :: RcvQueue -> RecipientPrivateKey
decryptKey, Maybe EncryptionKey
verifyKey :: Maybe EncryptionKey
$sel:verifyKey:RcvQueue :: RcvQueue -> Maybe EncryptionKey
verifyKey} ConnId
msg =
  Maybe EncryptionKey -> ConnId -> m ConnId
forall (m :: * -> *).
AgentMonad m =>
Maybe EncryptionKey -> ConnId -> m ConnId
verifyMessage Maybe EncryptionKey
verifyKey ConnId
msg
    m ConnId -> (ConnId -> m ConnId) -> m ConnId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CryptoError -> AgentErrorType)
-> ExceptT CryptoError IO ConnId -> m ConnId
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 ConnId -> m ConnId)
-> (ConnId -> ExceptT CryptoError IO ConnId) -> ConnId -> m ConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecipientPrivateKey -> ConnId -> ExceptT CryptoError IO ConnId
forall k.
PrivateKey k =>
k -> ConnId -> ExceptT CryptoError IO ConnId
C.decrypt RecipientPrivateKey
decryptKey

encryptUnsigned :: AgentMonad m => SMPClient -> EncryptionKey -> ByteString -> m ByteString
encryptUnsigned :: SMPClient -> EncryptionKey -> ConnId -> m ConnId
encryptUnsigned SMPClient
smp EncryptionKey
encryptKey ConnId
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
  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
  (CryptoError -> AgentErrorType)
-> ExceptT CryptoError IO ConnId -> m ConnId
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 ConnId -> m ConnId)
-> ExceptT CryptoError IO ConnId -> m ConnId
forall a b. (a -> b) -> a -> b
$ do
    ConnId
enc <- EncryptionKey -> Int -> ConnId -> ExceptT CryptoError IO ConnId
C.encrypt EncryptionKey
encryptKey Int
paddedSize ConnId
msg
    let sig :: ConnId
sig = Int -> Char -> ConnId
B.replicate Int
size Char
' '
    ConnId -> ExceptT CryptoError IO ConnId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnId -> ExceptT CryptoError IO ConnId)
-> ConnId -> ExceptT CryptoError IO ConnId
forall a b. (a -> b) -> a -> b
$ ConnId
sig ConnId -> ConnId -> ConnId
forall a. Semigroup a => a -> a -> a
<> ConnId
enc

verifyMessage :: AgentMonad m => Maybe VerificationKey -> ByteString -> m ByteString
verifyMessage :: Maybe EncryptionKey -> ConnId -> m ConnId
verifyMessage Maybe EncryptionKey
verifyKey ConnId
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 (ConnId
sig, ConnId
enc) = Int -> ConnId -> (ConnId, ConnId)
B.splitAt Int
size ConnId
msg
  case Maybe EncryptionKey
verifyKey of
    Maybe EncryptionKey
Nothing -> ConnId -> m ConnId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnId
enc
    Just EncryptionKey
k
      | EncryptionKey -> Signature -> ConnId -> Bool
C.verify EncryptionKey
k (ConnId -> Signature
C.Signature ConnId
sig) ConnId
enc -> ConnId -> m ConnId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnId
enc
      | Bool
otherwise -> AgentErrorType -> m ConnId
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AgentErrorType -> m ConnId) -> AgentErrorType -> m ConnId
forall a b. (a -> b) -> a -> b
$ SMPAgentError -> AgentErrorType
AGENT SMPAgentError
A_SIGNATURE

cryptoError :: C.CryptoError -> AgentErrorType
cryptoError :: CryptoError -> AgentErrorType
cryptoError = \case
  CryptoError
C.CryptoLargeMsgError -> CommandErrorType -> AgentErrorType
CMD CommandErrorType
LARGE
  C.RSADecryptError Error
_ -> SMPAgentError -> AgentErrorType
AGENT SMPAgentError
A_ENCRYPTION
  C.CryptoHeaderError String
_ -> SMPAgentError -> AgentErrorType
AGENT SMPAgentError
A_ENCRYPTION
  CryptoError
C.AESDecryptError -> SMPAgentError -> AgentErrorType
AGENT SMPAgentError
A_ENCRYPTION
  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