voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
hbs2-peer/app/PeerMain.hs
View File

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

21
hbs2-peer/app/ProxyMessaging.hs
View File

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