mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
Sergey Ivanov
parent
9eed3a6d3f
commit
e43f2c439d
|
|
@ -85,7 +85,7 @@ sendBeginEncryptionExchange penv creds peer pubkey = do
|
|||
request peer (BeginEncryptionExchange @e nonce0 sign pubkey)
|
||||
|
||||
data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter
|
||||
{ encHandshake_considerPeerAsymmKey :: PeerAddr e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m ()
|
||||
{ encHandshake_considerPeerAsymmKey :: Peer e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m ()
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -121,11 +121,10 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
|
|||
|
||||
ResetEncryptionKeys -> do
|
||||
peer <- thatPeer proto
|
||||
paddr <- toPeerAddr peer
|
||||
mpeerData <- find (KnownPeerKey peer) id
|
||||
-- TODO: check theirsign
|
||||
trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, paddr, mpeerData)
|
||||
encHandshake_considerPeerAsymmKey paddr mpeerData Nothing
|
||||
trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData)
|
||||
encHandshake_considerPeerAsymmKey peer mpeerData Nothing
|
||||
|
||||
creds <- getCredentials @s
|
||||
let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv
|
||||
|
|
@ -133,13 +132,10 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
|
|||
|
||||
BeginEncryptionExchange nonce0 theirsign theirpubkey -> do
|
||||
peer <- thatPeer proto
|
||||
paddr <- toPeerAddr peer
|
||||
mpeerData <- find (KnownPeerKey peer) id
|
||||
-- TODO: check theirsign
|
||||
|
||||
trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, paddr, mpeerData)
|
||||
|
||||
encHandshake_considerPeerAsymmKey paddr mpeerData (Just theirpubkey)
|
||||
trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, mpeerData)
|
||||
|
||||
-- взять свои ключи
|
||||
creds <- getCredentials @s
|
||||
|
|
@ -150,21 +146,23 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
|
|||
let sign = makeSign @s (view peerSignSk creds) (unEENonce nonce0 <> (cs . serialise) ourpubkey)
|
||||
|
||||
-- отправить обратно вместе с публичным ключом
|
||||
-- отправится пока ещё в плоском виде
|
||||
response (AckEncryptionExchange @e nonce0 sign ourpubkey)
|
||||
|
||||
emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
|
||||
-- Только после этого прописываем его ключ у себя
|
||||
encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey)
|
||||
-- emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
|
||||
|
||||
AckEncryptionExchange nonce0 theirsign theirpubkey -> do
|
||||
peer <- thatPeer proto
|
||||
paddr <- toPeerAddr peer
|
||||
mpeerData <- find (KnownPeerKey peer) id
|
||||
-- TODO: check theirsign
|
||||
|
||||
trace $ "EHSP AckEncryptionExchange from" <+> viaShow (peer, paddr, mpeerData)
|
||||
trace $ "EHSP AckEncryptionExchange from" <+> viaShow (peer, mpeerData)
|
||||
|
||||
encHandshake_considerPeerAsymmKey paddr mpeerData (Just theirpubkey)
|
||||
|
||||
emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
|
||||
-- Прописываем его ключ у себя
|
||||
encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey)
|
||||
-- emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
|
||||
|
||||
where
|
||||
proto = Proxy @(EncryptionHandshake e)
|
||||
|
|
|
|||
|
|
@ -610,7 +610,7 @@ insertPeerAsymmKey :: forall e m .
|
|||
, MonadIO m
|
||||
)
|
||||
=> BasicBrains e
|
||||
-> PeerAddr e
|
||||
-> Peer e
|
||||
-> Encrypt.PublicKey
|
||||
-> m ()
|
||||
|
||||
|
|
@ -630,7 +630,7 @@ insertPeerSymmKey :: forall e m .
|
|||
, MonadIO m
|
||||
)
|
||||
=> BasicBrains e
|
||||
-> PeerAddr e
|
||||
-> Peer e
|
||||
-> Encrypt.CombinedKey
|
||||
-> m ()
|
||||
|
||||
|
|
@ -646,7 +646,7 @@ insertPeerSymmKey br peer hSymmKey = do
|
|||
|] (show $ pretty peer, show hSymmKey)
|
||||
|
||||
deletePeerAsymmKey :: forall e m . (e ~ L4Proto, MonadIO m)
|
||||
=> BasicBrains e -> PeerAddr e -> m ()
|
||||
=> BasicBrains e -> Peer e -> m ()
|
||||
|
||||
deletePeerAsymmKey br peer =
|
||||
void $ liftIO $ execute (view brainsDb br) [qc|
|
||||
|
|
@ -655,7 +655,7 @@ deletePeerAsymmKey br peer =
|
|||
|] (Only (show $ pretty peer))
|
||||
|
||||
deletePeerSymmKey :: forall e m . (e ~ L4Proto, MonadIO m)
|
||||
=> BasicBrains e -> PeerAddr e -> m ()
|
||||
=> BasicBrains e -> Peer e -> m ()
|
||||
|
||||
deletePeerSymmKey br peer =
|
||||
void $ liftIO $ execute (view brainsDb br) [qc|
|
||||
|
|
|
|||
|
|
@ -650,13 +650,13 @@ runPeer opts = U.handle (\e -> myException e
|
|||
( MonadIO m
|
||||
) => EncryptionHandshakeAdapter L4Proto m s
|
||||
encryptionHshakeAdapter = EncryptionHandshakeAdapter
|
||||
{ encHandshake_considerPeerAsymmKey = \addr mpeerData -> \case
|
||||
{ encHandshake_considerPeerAsymmKey = \peer mpeerData -> \case
|
||||
Nothing -> do
|
||||
deletePeerAsymmKey brains addr
|
||||
deletePeerSymmKey brains addr
|
||||
deletePeerAsymmKey brains peer
|
||||
deletePeerSymmKey brains peer
|
||||
Just pk -> do
|
||||
insertPeerAsymmKey brains addr pk
|
||||
insertPeerSymmKey brains addr $
|
||||
insertPeerAsymmKey brains peer pk
|
||||
insertPeerSymmKey brains peer $
|
||||
genCommonSecret @s
|
||||
(privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
|
||||
pk
|
||||
|
|
|
|||
|
|
@ -151,6 +151,16 @@ receiveFromProxyMessaging bus _ = liftIO do
|
|||
encKeys <- (liftIO . readTVarIO) (view proxyEncryptionKeys bus)
|
||||
fmap (w, ) <$> dfm whom (Map.lookup whom encKeys) msg
|
||||
|
||||
-- Здесь:
|
||||
-- 1. У нас есть ключ сессии и мы не смогли расшифровать -> do
|
||||
-- удаляем у себя ключ
|
||||
-- отправляем sendResetEncryptionKeys
|
||||
-- 2. У нас нет ключа сессии -> do
|
||||
-- просто передаём сообщение как есть
|
||||
|
||||
-- В протоколе пингов:
|
||||
-- 1. Если слишком долго нет ответа на ping, то удаляем у себя ключ, отправляем sendResetEncryptionKeys
|
||||
|
||||
-- TODO:
|
||||
-- Если мы не смогли, по любой причине, расшифровать сообщение,
|
||||
-- то нужно стереть у себя ключ
|
||||
|
|
|
|||
Loading…
Reference in New Issue