Fixed handling of lossy outgoing in Network.Lossless.

1 files changed, 21 insertions, 8 deletions

diff --git a/src/Network/Tox/Session.hs b/src/Network/Tox/Session.hs
index 88221b11..7b84ba80 100644
--- a/src/Network/Tox/Session.hs
+++ b/src/Network/Tox/Session.hs
@@ -15,7 +15,7 @@ import Network.Lossless
 import Network.QueryResponse
 import Network.SessionTransports
 import Network.Tox.Crypto.Transport
-import Network.Tox.DHT.Transport    (Cookie)
+import Network.Tox.DHT.Transport    (Cookie,key2id)
 import Network.Tox.Handshake
 
 type SessionKey = SecretKey
@@ -69,7 +69,7 @@ plainHandshakeH sp saddr skey handshake = do
     dput XNetCrypto $ prelude ++ "handshake: " ++ show (otherCookie hd, baseNonce hd)
     sent <- spGetSentHandshake sp skey saddr (handshakeCookie handshake) (otherCookie hd)
     -- TODO: this is always returning sent = Nothing
-    dput XNetCrypto $ prelude ++ "plainHandshakeH: cached outgoing: " ++ show (fmap (baseNonce . snd) sent)
+    dput XNetCrypto $ " <-- (cached) handshake baseNonce" ++ show (fmap (baseNonce . snd) sent)
     forM_ sent $ \(hd_skey,hd_sent) -> do
     sk <- SessionKeys (spCrypto sp)
                       hd_skey
@@ -81,7 +81,9 @@ plainHandshakeH sp saddr skey handshake = do
     forM_ m $ \(sid, t) -> do
         (t2,resend,getMissing)
             <- lossless (\cp a -> return $ fmap (,a) $ checkLossless $ runIdentity $ pktData cp)
-                        (\seqno p _ -> encryptPacket sk $ bookKeeping seqno p)
+                        (\seqno p _ -> do
+                            y <- encryptPacket sk $ bookKeeping seqno p
+                            return (lossyness (msgID p) == Lossy, y))
                         ()
                         t
         let _ = t :: TransportA String () (CryptoPacket Identity) (CryptoPacket Encrypted)
@@ -101,16 +103,22 @@ plainHandshakeH sp saddr skey handshake = do
 
 decryptPacket :: SessionKeys -> SockAddr -> CryptoPacket Encrypted -> IO (Maybe (CryptoPacket Identity, ()))
 decryptPacket sk saddr (CryptoPacket n16 ciphered) = do
-    (n,δ) <- atomically $ do
+    (n24,δ) <- atomically $ do
         n <- readTVar (skNonceIncoming sk)
         let δ = n16 - nonce24ToWord16 n
         return ( n `addtoNonce24` fromIntegral δ, δ )
-    secret <- lookupSharedSecret (skCrypto sk) (skMe sk) (skThem sk) n
+    secret <- lookupSharedSecret (skCrypto sk) (skMe sk) (skThem sk) n24
     case decodePlain =<< decrypt secret ciphered of
         Left e  -> return Nothing
         Right x -> do
             when ( δ  > 43690 )
-                $ atomically $ writeTVar (skNonceIncoming sk) (n `addtoNonce24` 21845)
+                $ atomically $ writeTVar (skNonceIncoming sk) (n24 `addtoNonce24` 21845)
+
+            do let them = key2id $ skThem sk
+                   CryptoData ack seqno _ = x
+                   cm = decodeRawCryptoMsg x
+               dput XNetCrypto $ unwords [take 8 (show them),"-->",show (msgID cm),show (n24,ack,seqno)]
+
             return $ Just ( CryptoPacket n16 (pure x), () )
 
 encryptPacket :: SessionKeys -> CryptoData -> IO (CryptoPacket Encrypted)
@@ -121,12 +129,17 @@ encryptPacket sk plain = do
         return n24
     secret <- lookupSharedSecret (skCrypto sk) (skMe sk) (skThem sk) n24
     let ciphered = encrypt secret $ encodePlain $ plain
+
+    do let them = key2id $ skThem sk
+           CryptoData ack seqno cm = plain
+       dput XNetCrypto $ unwords [take 8 (show them),"<--",show (msgID cm),show (n24,ack,seqno)]
+
     return $ CryptoPacket (nonce24ToWord16 n24) ciphered
 
 data SessionKeys = SessionKeys
     { skCrypto        :: TransportCrypto
-    , skMe            :: SecretKey
-    , skThem          :: PublicKey
+    , skMe            :: SecretKey -- My session key
+    , skThem          :: PublicKey -- Their session key
     , skNonceIncoming :: TVar Nonce24 -- +21845 when a threshold is reached.
     , skNonceOutgoing :: TVar Nonce24 -- +1 on every packet
     }