diff options
Diffstat (limited to 'dht/src/Network/Tox/Session.hs')
-rw-r--r-- | dht/src/Network/Tox/Session.hs | 17 |
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. |
185 | decryptPacket :: SessionKeys -> addr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) | 186 | decryptPacket :: SessionKeys -> String -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ())) |
186 | decryptPacket sk saddr (CryptoPacket n16 ciphered) = do | 187 | decryptPacket 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. |
206 | encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted) | 207 | encryptPacket :: SessionKeys -> String -> CryptoData -> IO (CryptoPacket Encrypted) |
207 | encryptPacket sk plain = do | 208 | encryptPacket 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 | ||