mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-10-23 06:32:22 +00:00
GADTs for cryptographic keys (#208)
* GADTs for cryptographic keys * update tests (signature timing tests still fail) * fix signature verification timing tests * configurable algorithm to sign commands to SMP queues (Ed448 by default) * add dummy Ed keys, add timing tests for Ed keys * re-enable Connection subscriptions tests
This commit is contained in:
1 parent
99b3749890
commit
e1002d5ac0
17 files changed
+938
-338
No files matched your search
@@ -82,7 +82,7 @@ data SMPClient = SMPClient
|
||||
tcpTimeout :: Int,
|
||||
clientCorrId :: TVar Natural,
|
||||
sentCommands :: TVar (Map CorrId Request),
|
||||
sndQ :: TBQueue SignedRawTransmission,
|
||||
sndQ :: TBQueue SentRawTransmission,
|
||||
rcvQ :: TBQueue SignedTransmissionOrError,
|
||||
msgQ :: TBQueue SMPServerTransmission,
|
||||
blockSize :: Int
|
||||
@@ -333,14 +333,14 @@ suspendSMPQueue = okSMPCommand $ Cmd SRecipient OFF
|
||||
deleteSMPQueue :: SMPClient -> RecipientPrivateKey -> QueueId -> ExceptT SMPClientError IO ()
|
||||
deleteSMPQueue = okSMPCommand $ Cmd SRecipient DEL
|
||||
|
||||
okSMPCommand :: Cmd -> SMPClient -> C.PrivateKey -> QueueId -> ExceptT SMPClientError IO ()
|
||||
okSMPCommand :: Cmd -> SMPClient -> C.APrivateSignKey -> QueueId -> ExceptT SMPClientError IO ()
|
||||
okSMPCommand cmd c pKey qId =
|
||||
sendSMPCommand c (Just pKey) qId cmd >>= \case
|
||||
Cmd _ OK -> return ()
|
||||
_ -> throwE SMPUnexpectedResponse
|
||||
|
||||
-- | Send any SMP command ('Cmd' type).
|
||||
sendSMPCommand :: SMPClient -> Maybe C.PrivateKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
|
||||
sendSMPCommand :: SMPClient -> Maybe C.APrivateSignKey -> QueueId -> Cmd -> ExceptT SMPClientError IO Cmd
|
||||
sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId cmd = do
|
||||
corrId <- lift_ getNextCorrId
|
||||
t <- signTransmission $ serializeTransmission (corrId, qId, cmd)
|
||||
@@ -354,20 +354,20 @@ sendSMPCommand SMPClient {sndQ, sentCommands, clientCorrId, tcpTimeout} pKey qId
|
||||
i <- stateTVar clientCorrId $ \i -> (i, i + 1)
|
||||
pure . CorrId $ bshow i
|
||||
|
||||
signTransmission :: ByteString -> ExceptT SMPClientError IO SignedRawTransmission
|
||||
signTransmission :: ByteString -> ExceptT SMPClientError IO SentRawTransmission
|
||||
signTransmission t = case pKey of
|
||||
Nothing -> return ("", t)
|
||||
Nothing -> return (Nothing, t)
|
||||
Just pk -> do
|
||||
sig <- liftError SMPSignatureError $ C.sign pk t
|
||||
return (sig, t)
|
||||
return (Just sig, t)
|
||||
|
||||
-- two separate "atomically" needed to avoid blocking
|
||||
sendRecv :: CorrId -> SignedRawTransmission -> IO Response
|
||||
sendRecv :: CorrId -> SentRawTransmission -> IO Response
|
||||
sendRecv corrId t = atomically (send corrId t) >>= withTimeout . atomically . takeTMVar
|
||||
where
|
||||
withTimeout a = fromMaybe (Left SMPResponseTimeout) <$> timeout tcpTimeout a
|
||||
|
||||
send :: CorrId -> SignedRawTransmission -> STM (TMVar Response)
|
||||
send :: CorrId -> SentRawTransmission -> STM (TMVar Response)
|
||||
send corrId t = do
|
||||
r <- newEmptyTMVar
|
||||
modifyTVar sentCommands . M.insert corrId $ Request qId r
|
||||
|
||||
Reference in new issue
Block a user