summaryrefslogtreecommitdiff
path: root/dht/src/Network/Tox/Session.hs
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src/Network/Tox/Session.hs')
-rw-r--r--dht/src/Network/Tox/Session.hs17
1 files changed, 9 insertions, 8 deletions
diff --git a/dht/src/Network/Tox/Session.hs b/dht/src/Network/Tox/Session.hs
index cbb516a7..457ed1a0 100644
--- a/dht/src/Network/Tox/Session.hs
+++ b/dht/src/Network/Tox/Session.hs
@@ -136,14 +136,15 @@ plainHandshakeH sp saddr0 skey handshake = do
136 (sessionKey hd) 136 (sessionKey hd)
137 <$> atomically (newTVar $ baseNonce hd) 137 <$> atomically (newTVar $ baseNonce hd)
138 <*> atomically (newTVar $ baseNonce hd_sent) 138 <*> atomically (newTVar $ baseNonce hd_sent)
139 m <- newSession (spSessions sp) (\() p -> return p) (decryptPacket sk) saddr 139 let addr_lbl = Multi.showSessionAddr saddr
140 m <- newSession (spSessions sp) (\() p -> return p) (\_ -> decryptPacket sk addr_lbl) saddr
140 dput XNetCrypto $ prelude ++ "plainHandshakeH: session " ++ maybe "Nothing" (const "Just") m 141 dput XNetCrypto $ prelude ++ "plainHandshakeH: session " ++ maybe "Nothing" (const "Just") m
141 forM_ m $ \(sid, t) -> do 142 forM_ m $ \(sid, t) -> do
142 (t2,resend,getMissing) 143 (t2,resend,getMissing)
143 <- lossless (take 8 (showKey256 them) ++ "." ++ Multi.showSessionAddr saddr) 144 <- lossless (take 8 (showKey256 them) ++ "." ++ Multi.showSessionAddr saddr)
144 (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp) 145 (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp)
145 (\seqno p@(Pkt m :=> _) _ -> do 146 (\seqno p@(Pkt m :=> _) _ -> do
146 y <- encryptPacket sk $ bookKeeping seqno p 147 y <- encryptPacket sk addr_lbl $ bookKeeping seqno p
147 return OutgoingInfo 148 return OutgoingInfo
148 { oIsLossy = lossyness m == Lossy 149 { oIsLossy = lossyness m == Lossy
149 , oEncoded = y 150 , oEncoded = y
@@ -182,8 +183,8 @@ data SessionKeys = SessionKeys
182 } 183 }
183 184
184-- | Decrypt an inbound session packet and update the nonce for the next one. 185-- | Decrypt an inbound session packet and update the nonce for the next one.
185decryptPacket :: SessionKeys -> addr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) 186decryptPacket :: SessionKeys -> String -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ()))
186decryptPacket sk saddr (CryptoPacket n16 ciphered) = do 187decryptPacket sk lbl (CryptoPacket n16 ciphered) = do
187 (n24,δ) <- atomically $ do 188 (n24,δ) <- atomically $ do
188 n <- readTVar (skNonceIncoming sk) 189 n <- readTVar (skNonceIncoming sk)
189 let δ = n16 - nonce24ToWord16 n 190 let δ = n16 - nonce24ToWord16 n
@@ -198,13 +199,13 @@ decryptPacket sk saddr (CryptoPacket n16 ciphered) = do
198 do let them = key2id $ skThem sk 199 do let them = key2id $ skThem sk
199 CryptoData ack seqno _ = x 200 CryptoData ack seqno _ = x
200 cm = decodeRawCryptoMsg x 201 cm = decodeRawCryptoMsg x
201 dput XNetCrypto $ unwords [take 8 (show them),"-->",show (msgID cm),show (n24,ack,seqno)] 202 dput XNetCrypto $ unwords [lbl,"-->",show (msgID cm),show (n24,ack,seqno)]
202 203
203 return $ Just ( CryptoPacket n16 (pure x), () ) 204 return $ Just ( CryptoPacket n16 (pure x), () )
204 205
205-- | Encrypt an outbound session packet and update the nonce for the next one. 206-- | Encrypt an outbound session packet and update the nonce for the next one.
206encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted) 207encryptPacket :: SessionKeys -> String -> CryptoData -> IO (CryptoPacket Encrypted)
207encryptPacket sk plain = do 208encryptPacket sk lbl plain = do
208 n24 <- atomically $ do 209 n24 <- atomically $ do
209 n24 <- readTVar (skNonceOutgoing sk) 210 n24 <- readTVar (skNonceOutgoing sk)
210 modifyTVar' (skNonceOutgoing sk) incrementNonce24 211 modifyTVar' (skNonceOutgoing sk) incrementNonce24
@@ -214,7 +215,7 @@ encryptPacket sk plain = do
214 215
215 do let them = key2id $ skThem sk 216 do let them = key2id $ skThem sk
216 CryptoData ack seqno cm = plain 217 CryptoData ack seqno cm = plain
217 dput XNetCrypto $ unwords [take 8 (show them),"<--",show (msgID cm),show (n24,ack,seqno)] 218 dput XNetCrypto $ unwords [lbl,"<--",show (msgID cm),show (n24,ack,seqno)]
218 219
219 return $ CryptoPacket (nonce24ToWord16 n24) ciphered 220 return $ CryptoPacket (nonce24ToWord16 n24) ciphered
220 221