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

pass peer to setEncryptionKey

This commit is contained in:
Sergey Ivanov 2023-07-19 00:42:37 +04:00
parent 3316bb3d44
commit 15b9438406
2 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hbs2-core/lib/HBS2/Actors/Peer.hs
View File

@ -163,9 +163,15 @@ data PeerEnv e =
setEncryptionKey :: setEncryptionKey ::
( Hashable (PubKey 'Sign (Encryption L4Proto)) ( Hashable (PubKey 'Sign (Encryption L4Proto))
, Hashable PeerNonce , Hashable PeerNonce
) => PeerEnv L4Proto -> PeerData L4Proto -> Maybe (CommonSecret (Encryption L4Proto)) -> IO () , Show (PubKey 'Sign (Encryption L4Proto))
setEncryptionKey penv pd msecret = , Show PeerNonce
, Show (CommonSecret (Encryption L4Proto))
) => PeerEnv L4Proto -> Peer L4Proto -> PeerData L4Proto -> Maybe (CommonSecret (Encryption L4Proto)) -> IO ()
setEncryptionKey penv peer pd msecret = do
atomically $ modifyTVar' (_envEncryptionKeys penv) $ Lens.at pd .~ msecret atomically $ modifyTVar' (_envEncryptionKeys penv) $ Lens.at pd .~ msecret
case msecret of
Nothing -> trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow pd
Just k -> trace $ "ENCRYPTION store key" <+> pretty peer <+> viaShow pd <+> viaShow k
getEncryptionKey :: getEncryptionKey ::
( Hashable (PubKey 'Sign (Encryption L4Proto)) ( Hashable (PubKey 'Sign (Encryption L4Proto))

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

@ -594,7 +594,7 @@ runPeer opts = U.handle (\e -> myException e
, _proxy_clearEncryptionKey = \peer -> do , _proxy_clearEncryptionKey = \peer -> do
mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
forM_ mpeerData \peerData -> setEncryptionKey penv peerData Nothing forM_ mpeerData \peerData -> setEncryptionKey penv peer peerData Nothing
-- deletePeerAsymmKey brains peer -- deletePeerAsymmKey brains peer
forM_ mpeerData \peerData -> forM_ mpeerData \peerData ->
deletePeerAsymmKey' brains (show peerData) deletePeerAsymmKey' brains (show peerData)
@ -686,7 +686,7 @@ runPeer opts = U.handle (\e -> myException e
mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
case mpubkey of case mpubkey of
Nothing -> do Nothing -> do
trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow mpeerData -- trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow mpeerData
-- deletePeerAsymmKey brains peer -- deletePeerAsymmKey brains peer
forM_ mpeerData \peerData -> forM_ mpeerData \peerData ->
deletePeerAsymmKey' brains (show peerData) deletePeerAsymmKey' brains (show peerData)
@ -695,11 +695,11 @@ runPeer opts = U.handle (\e -> myException e
let symmk = genCommonSecret @s let symmk = genCommonSecret @s
(privKeyFromKeypair @s (view envAsymmetricKeyPair penv)) (privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
pk pk
trace $ "ENCRYPTION store key" <+> pretty peer <+> viaShow mpeerData
case mpeerData of case mpeerData of
Nothing -> do Nothing -> do
-- insertPeerAsymmKey brains peer pk symmk -- insertPeerAsymmKey brains peer pk symmk
pure () trace $ "ENCRYPTION can not store key. No peerData"
<+> pretty peer <+> viaShow mpeerData
Just peerData -> Just peerData ->
insertPeerAsymmKey' brains (show peerData) pk symmk insertPeerAsymmKey' brains (show peerData) pk symmk
@ -715,7 +715,7 @@ runPeer opts = U.handle (\e -> myException e
subscribe @e PeerExpiredEventKey \(PeerExpiredEvent peer {-mpeerData-}) -> liftIO do subscribe @e PeerExpiredEventKey \(PeerExpiredEvent peer {-mpeerData-}) -> liftIO do
mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
forM_ mpeerData \peerData -> setEncryptionKey penv peerData Nothing forM_ mpeerData \peerData -> setEncryptionKey penv peer peerData Nothing
-- deletePeerAsymmKey brains peer -- deletePeerAsymmKey brains peer
forM_ mpeerData \peerData -> forM_ mpeerData \peerData ->
deletePeerAsymmKey' brains (show peerData) deletePeerAsymmKey' brains (show peerData)