summaryrefslogtreecommitdiff
path: root/src/Network.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-09-12 22:08:54 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-09-16 09:58:13 +0200
commit07893b2edd6f872f9549b3e0eb5443208cdea66a (patch)
treefdb18dd8b6b478c6a0a021a4c342fcfe6a64154a /src/Network.hs
parente6a5ec99e0f94ec33c0e52e6cf64cfbb7f7d5e97 (diff)
Protocol: use cookies during whole plaintext phase
Diffstat (limited to 'src/Network.hs')
-rw-r--r--src/Network.hs40
1 files changed, 21 insertions, 19 deletions
diff --git a/src/Network.hs b/src/Network.hs
index 5455c07..8cb2ed5 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -420,9 +420,9 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
[ [ storedRef sidentity ]
, map storedRef $ idUpdates identity
, case ochannel of
- ChannelOurRequest req -> [ storedRef req ]
- ChannelOurAccept acc _ -> [ storedRef acc ]
- _ -> []
+ ChannelOurRequest _ req -> [ storedRef req ]
+ ChannelOurAccept _ acc _ -> [ storedRef acc ]
+ _ -> []
]
runPacketHandler secure peer $ do
@@ -430,7 +430,7 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
forM_ headers $ \case
Acknowledged dgst -> do
liftSTM (getPeerChannel peer) >>= \case
- ChannelOurAccept acc ch | refDigest (storedRef acc) == dgst -> do
+ ChannelOurAccept _ acc ch | refDigest (storedRef acc) == dgst -> do
liftSTM $ finalizedChannel peer ch identity
_ -> return ()
@@ -474,21 +474,22 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
_ -> return ()
TrChannelRequest dgst -> do
- let process = do
+ let process cookie = do
addHeader $ Acknowledged dgst
wref <- newWaitingRef dgst $ handleChannelRequest peer identity
- liftSTM $ setPeerChannel peer $ ChannelPeerRequest wref
+ liftSTM $ setPeerChannel peer $ ChannelPeerRequest cookie wref
reject = addHeader $ Rejected dgst
liftSTM (getPeerChannel peer) >>= \case
- ChannelNone {} -> process
- ChannelCookieWait {} -> process
- ChannelCookieReceived {} -> process
- ChannelOurRequest our | dgst < refDigest (storedRef our) -> process
- | otherwise -> reject
- ChannelPeerRequest {} -> process
+ ChannelNone {} -> return ()
+ ChannelCookieWait {} -> return ()
+ ChannelCookieReceived cookie -> process $ Just cookie
+ ChannelCookieConfirmed cookie -> process $ Just cookie
+ ChannelOurRequest mbcookie our | dgst < refDigest (storedRef our) -> process mbcookie
+ | otherwise -> reject
+ ChannelPeerRequest mbcookie _ -> process mbcookie
ChannelOurAccept {} -> reject
- ChannelEstablished {} -> process
+ ChannelEstablished {} -> process Nothing
TrChannelAccept dgst -> do
let process = do
@@ -498,10 +499,11 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
ChannelNone {} -> reject
ChannelCookieWait {} -> reject
ChannelCookieReceived {} -> reject
+ ChannelCookieConfirmed {} -> reject
ChannelOurRequest {} -> process
ChannelPeerRequest {} -> process
- ChannelOurAccept our _ | dgst < refDigest (storedRef our) -> process
- | otherwise -> addHeader $ Rejected dgst
+ ChannelOurAccept _ our _ | dgst < refDigest (storedRef our) -> process
+ | otherwise -> addHeader $ Rejected dgst
ChannelEstablished {} -> process
ServiceType _ -> return ()
@@ -538,10 +540,10 @@ setupChannel identity peer upid = do
]
liftIO $ atomically $ do
getPeerChannel peer >>= \case
- ChannelCookieReceived {} -> do
+ ChannelCookieConfirmed cookie -> do
sendToPeerPlain peer [ Acknowledged reqref, Rejected reqref ] $
TransportPacket (TransportHeader hitems) [storedRef req]
- setPeerChannel peer $ ChannelOurRequest req
+ setPeerChannel peer $ ChannelOurRequest (Just cookie) req
_ -> return ()
handleChannelRequest :: Peer -> UnifiedIdentity -> Ref -> WaitingRefCallback
@@ -550,8 +552,8 @@ handleChannelRequest peer identity req = do
(acc, ch) <- flip runReaderT (peerStorage peer) $ acceptChannelRequest identity upid (wrappedLoad req)
liftIO $ atomically $ do
getPeerChannel peer >>= \case
- ChannelPeerRequest wr | wrDigest wr == refDigest req -> do
- setPeerChannel peer $ ChannelOurAccept acc ch
+ ChannelPeerRequest mbcookie wr | wrDigest wr == refDigest req -> do
+ setPeerChannel peer $ ChannelOurAccept mbcookie acc ch
let accref = refDigest $ storedRef acc
header = TrChannelAccept accref
ackedBy = [ Acknowledged accref, Rejected accref ]