This patch:

        *  integrates Connection.Tox and Network.Tox.Crypto.Handlers
        *  Network.Tox.netCrypto function uses freshCryptoSession

1 files changed, 20 insertions, 10 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index bcca65e6..dcae9f2f 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -50,6 +50,8 @@ import DPut
 import Debug.Trace
 import Text.Printf
 import Data.Bool
+import Connection (Status(..))
+import Connection.Tox (ToxProgress(..))
 
 
 -- * These types are isomorphic to Maybe, but have the advantage of documenting
@@ -99,8 +101,8 @@ instance AsMaybe UponCryptoPacket where
     frmMaybe (Just x) = HaveCryptoPacket x
 
 
-data NetCryptoSessionStatus = Unaccepted | Accepted {- InProgress AwaitingSessionPacket -} | Confirmed {- Established -}
-    deriving (Eq,Ord,Show,Enum)
+--data NetCryptoSessionStatus = Unaccepted | Accepted {- InProgress AwaitingSessionPacket -} | Confirmed {- Established -}
+--    deriving (Eq,Ord,Show,Enum)
 
 
 -- | The idea of IOHook is to replicate the familiar pattern
@@ -214,7 +216,7 @@ type SessionID = Word64
 type ListenerType = Word64
 
 data NetCryptoSession = NCrypto
-    { ncState              :: TVar NetCryptoSessionStatus
+    { ncState              :: TVar (Status ToxProgress)
     , ncMyPublicKey        :: PublicKey
     , ncSessionId          :: SessionID
     , ncTheirPublicKey     :: PublicKey -- Tox id w/o nospam
@@ -503,7 +505,10 @@ freshCryptoSession  sessions
         x <- readTVar (nextSessionId sessions)
         modifyTVar    (nextSessionId sessions) (+1)
         return x
-    ncState0 <- atomically $ newTVar Accepted -- (InProgress AwaitingSessionPacket)
+    -- ncState0 <- atomically $ newTVar Accepted -- (InProgress AwaitingSessionPacket)
+    ncState0 <- atomically $ newTVar (if isJust mbtheirBaseNonce
+                                        then InProgress AwaitingSessionPacket
+                                        else InProgress AwaitingHandshake)
     ncTheirBaseNonce0 <- atomically $ newTVar (frmMaybe mbtheirBaseNonce)
     n24 <- atomically $ transportNewNonce crypto
     state <- lookupSharedSecret crypto key remotePublicKey n24
@@ -551,7 +556,7 @@ freshCryptoSession  sessions
                     atomically $ do
                         n24 <- readTVar ncMyPacketNonce0
                         let n24plus1 = incrementNonce24 n24
-                        writeTVar ncMyPacketNonce0 n24plus1
+                        trace ("ncMyPacketNonce+1=" ++ show n24plus1) $ writeTVar ncMyPacketNonce0 n24plus1
                         return (return (f n24, n24, ncOutgoingIdMap0))
             pktoq <- atomically $ PQ.newOutGoing pktq ncToWire toWireIO 0 (outboundQueueCapacity sessions) 0
             return (HaveHandshake pktoq)
@@ -559,6 +564,8 @@ freshCryptoSession  sessions
     listeners <- atomically $ newTVar IntMap.empty
     msgNum <- atomically $ newTVar 0
     dropNum <- atomically $ newTVar 0
+    theirbasenonce <- atomically $ readTVar ncTheirBaseNonce0
+    dput XNetCrypto $ "freshCryptoSession: Session ncTheirBaseNonce=" ++ show theirbasenonce
     let netCryptoSession0 =
             NCrypto { ncState              = ncState0
                     , ncMyPublicKey        = toPublic key
@@ -635,8 +642,7 @@ updateCryptoSession :: NetCryptoSessions -> SockAddr -> HandshakeParams -> NetCr
 updateCryptoSession sessions addr hp session = do
     ncState0 <- atomically $ readTVar (ncState session)
     ncTheirBaseNonce0 <- atomically $ readTVar (ncTheirBaseNonce session)
-    -- if (ncState0 >= InProgress AwaitingSessionPacket)
-    if (ncState0 >= Accepted)
+    if (ncState0 >= {-Accepted-}InProgress AwaitingSessionPacket)
         -- If the nonce in the handshake and the dht key are both the same as
         -- the ones we have saved, assume we already handled this and this is a
         -- duplicate handshake packet, otherwise disregard everything, and
@@ -661,7 +667,7 @@ updateCryptoSession sessions addr hp session = do
                          ++ "hpTheirBaseNonce=" ++ show (hpTheirBaseNonce hp))
           if ( ncTheirBaseNonce0 /= frmMaybe (hpTheirBaseNonce hp))
             then freshCryptoSession sessions addr hp -- basenonce mismatch, trigger refresh
-            else atomically $ writeTVar (ncState session) Accepted -- (InProgress AwaitingSessionPacket)
+            else atomically $ writeTVar (ncState session) {-Accepted-}(InProgress AwaitingSessionPacket)
 
 
 cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto))
@@ -728,6 +734,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
                       , hpCookieRemotePubkey    = remotePublicKey
                       , hpCookieRemoteDhtkey    = remoteDhtPublicKey
                       }) -> do
+            dput XNetCrypto ("cryptoNetHandler: hpTheirBaseNonce = " ++ show theirBaseNonce)
             sessionsmap <- atomically $ readTVar allsessions
             -- Do a lookup, so we can handle the update case differently
             case Map.lookup addr sessionsmap of
@@ -752,7 +759,10 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
         Just session@(NCrypto { ncIncomingTypeArray, ncState, ncPacketQueue, ncHooks,
                                 ncSessionSecret, ncTheirSessionPublic, ncTheirBaseNonce,
                                 ncPingMachine}) -> do
-            HaveHandshake theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce
+         mbTheirBaseNonce <- atomically $ readTVar ncTheirBaseNonce
+         case mbTheirBaseNonce of
+          NeedHandshake -> dput XNetCrypto "CryptoPacket recieved, but we still dont have their base nonce?" >> return Nothing
+          HaveHandshake theirBaseNonce -> do
             -- Try to decrypt message
             let diff :: Word16
                 diff      = nonce16 - (last2Bytes theirBaseNonce) -- truncating to Word16
@@ -796,7 +806,7 @@ cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
                                     ++ " = " ++ show x) (return ())
                             writeTVar ncTheirBaseNonce (HaveHandshake y)
                     -- then set session confirmed,
-                    atomically $ writeTVar ncState Confirmed {-Established-}
+                    atomically $ writeTVar ncState {-Confirmed-}Established
                     -- bump ping machine
                     case ncPingMachine of
                         Just pingMachine -> pingBump pingMachine