Experiment with clearing symmetric key

This commit is contained in:
Sergey Ivanov 2023-07-04 19:24:35 +04:00
parent 01982d37c1
commit 5ecbd93594
2 changed files with 34 additions and 24 deletions

View File

@ -858,33 +858,36 @@ runPeer opts = U.handle (\e -> myException e
-- when allowed do -- when allowed do
-- sendTo proxy (To peer_e) (From me) (AnyMessage @(Encoded e) @e protoN (encode msg)) -- sendTo proxy (To peer_e) (From me) (AnyMessage @(Encoded e) @e protoN (encode msg))
when allowed do -- when allowed do
do
sendToPlainProxyMessaging (PlainProxyMessaging proxy) (To peer_e) (From me) sendToPlainProxyMessaging (PlainProxyMessaging proxy) (To peer_e) (From me)
-- (AnyMessage @(Encoded e) @e protoN (Proto.encode msg)) -- (AnyMessage @(Encoded e) @e protoN (Proto.encode msg))
(serialise (protoN, (Proto.encode msg))) (serialise (protoN, (Proto.encode msg)))
let -- let
sendPingCrypted' pip pubkey = do -- sendPingCrypted' pip pubkey = do
nonce <- newNonce @(PeerHandshake e) -- nonce <- newNonce @(PeerHandshake e)
tt <- liftIO $ getTimeCoarse -- tt <- liftIO $ getTimeCoarse
let pdd = PeerPingData nonce tt (Just pubkey) -- let pdd = PeerPingData nonce tt (Just pubkey)
update pdd (PeerHandshakeKey (nonce,pip)) id -- update pdd (PeerHandshakeKey (nonce,pip)) id
requestPlain pip (PeerPingCrypted @e nonce pubkey) -- requestPlain pip (PeerPingCrypted @e nonce pubkey)
let -- let
sendPing' pip = do -- sendPing' pip = do
nonce <- newNonce @(PeerHandshake e) -- nonce <- newNonce @(PeerHandshake e)
tt <- liftIO $ getTimeCoarse -- tt <- liftIO $ getTimeCoarse
let pdd = PeerPingData nonce tt Nothing -- let pdd = PeerPingData nonce tt Nothing
update pdd (PeerHandshakeKey (nonce,pip)) id -- update pdd (PeerHandshakeKey (nonce,pip)) id
requestPlain pip (PeerPing @e nonce) -- requestPlain pip (PeerPing @e nonce)
sendPingCrypted' pip (pubKeyFromKeypair @s (view envAsymmetricKeyPair penv)) -- sendPingCrypted' pip (pubKeyFromKeypair @s (view envAsymmetricKeyPair penv))
sendPing pip
pause $ case (requestPeriodLim @e @(PeerHandshake e)) of pause $ case (requestPeriodLim @e @(PeerHandshake e)) of
NoLimit -> 0 NoLimit -> 0
ReqLimPerProto t -> t + 0.1 ReqLimPerProto t -> t + 0.1
ReqLimPerMessage t -> t + 0.1 ReqLimPerMessage t -> t + 0.1
sendPing' pip -- sendPing' pip
sendPingCrypted pip (pubKeyFromKeypair @s (view envAsymmetricKeyPair penv))
ANNOUNCE h -> do ANNOUNCE h -> do
debug $ "got announce rpc" <+> pretty h debug $ "got announce rpc" <+> pretty h

View File

@ -39,7 +39,7 @@ import Data.String.Conversions (cs)
import Data.List qualified as L import Data.List qualified as L
import Data.Map (Map) import Data.Map (Map)
import Data.Map qualified as Map import Data.Map qualified as Map
import Lens.Micro.Platform import Lens.Micro.Platform as Lens
import Control.Monad import Control.Monad
-- TODO: protocol-encryption-goes-here -- TODO: protocol-encryption-goes-here
@ -146,12 +146,21 @@ receiveFromProxyMessaging bus _ = liftIO do
Nothing -> do Nothing -> do
trace $ "ENCRYPTION RECEIVE: we do not have a key to decode" <+> pretty whom trace $ "ENCRYPTION RECEIVE: we do not have a key to decode" <+> pretty whom
pure (Just msg) pure (Just msg)
Just k -> runMaybeT $ (<|> pure msg) $ do Just k -> runMaybeT $
-- А будем-ка мы просто передавать сообщение дальше как есть, если не смогли расшифровать
(<|> (do
-- И сотрём ключ из памяти
liftIO $ atomically $ modifyTVar' (view proxyEncryptionKeys bus) $ Lens.at whom .~ Nothing
trace $ "ENCRYPTION RECEIVE: got plain message. clearing key of" <+> pretty whom
pure msg
)) $
do
trace $ "ENCRYPTION RECEIVE: we have a key to decode from" <+> pretty whom <+> ":" <+> viaShow k trace $ "ENCRYPTION RECEIVE: we have a key to decode from" <+> pretty whom <+> ":" <+> viaShow k
case ((extractNonce . cs) msg) of case ((extractNonce . cs) msg) of
Nothing -> do Nothing -> do
trace $ "ENCRYPTION RECEIVE: can not extract nonce from" <+> pretty whom <+> "message" <+> viaShow msg trace $ "ENCRYPTION RECEIVE: can not extract nonce from" <+> pretty whom <+> "message" <+> viaShow msg
pure msg fail ""
Just (nonce, msg') -> Just (nonce, msg') ->
((MaybeT . pure) (boxOpenAfterNMLazy k nonce msg') ((MaybeT . pure) (boxOpenAfterNMLazy k nonce msg')
<* (trace $ "ENCRYPTION RECEIVE: message successfully decoded from" <+> pretty whom) <* (trace $ "ENCRYPTION RECEIVE: message successfully decoded from" <+> pretty whom)
@ -159,15 +168,13 @@ receiveFromProxyMessaging bus _ = liftIO do
<|> <|>
(do (do
(trace $ "ENCRYPTION RECEIVE: can not decode message from" <+> pretty whom) (trace $ "ENCRYPTION RECEIVE: can not decode message from" <+> pretty whom)
fail ""
-- А будем-ка мы просто передавать сообщение дальше как есть, если не смогли расшифровать
pure msg
-- -- Попытаться десериализовать сообщение как PeerPing или PeerPingCrypted -- -- Попытаться десериализовать сообщение как PeerPing или PeerPingCrypted
-- case deserialiseOrFail msg of -- case deserialiseOrFail msg of
-- Right (_ :: PeerHandshake L4Proto) -> do -- Right (_ :: PeerHandshake L4Proto) -> do
-- trace $ "ENCRYPTION RECEIVE: plain message decoded as PeerHandshake" <+> pretty whom -- trace $ "ENCRYPTION RECEIVE: plain message decoded as PeerHandshake" <+> pretty whom
-- pure msg -- fail ""
-- Left _ -> do -- Left _ -> do
-- trace $ "ENCRYPTION RECEIVE: failed" <+> pretty whom -- trace $ "ENCRYPTION RECEIVE: failed" <+> pretty whom
-- mzero -- mzero