This patch:

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

2 files changed, 48 insertions, 36 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 018361aa..9d785f67 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -258,6 +258,7 @@ netCrypto tox myseckey theirpubkey = netCryptoWithBackoff 1000000 tox myseckey t
 netCryptoWithBackoff :: Int -> Tox -> SecretKey -> PublicKey -> IO [NetCryptoSession]
 netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
     let mykeyAsId = key2id (toPublic myseckey)
+    -- TODO: check status of connection here:
     mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
     case mbContactsVar of
       Nothing -> do
@@ -321,32 +322,33 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
                                         , hpTheirBaseNonce = error "netCrypto: Unreachable! hpTheirBaseNonce"
                                         , hpTheirSessionKeyPublic = error "netCrypto: Unreachable! hpTheirSessionKeyPublic"
                                         }
-                        myhandshake <- do
-                            n24' <- atomically $ transportNewNonce crypto
-                            dput XNetCrypto ("Handshake Nonce24: " <> show n24')
-                            newBaseNonce <- atomically $ transportNewNonce crypto
-                            mbMyhandshakeData <- newHandShakeData crypto newBaseNonce hp saddr
-                            forM mbMyhandshakeData $ \hsdata -> do
-                                state <- lookupSharedSecret crypto myseckey theirpubkey n24'
-                                return Handshake { handshakeCookie = cookie
-                                                 , handshakeNonce = n24'
-                                                 , handshakeData = encrypt state $ encodePlain hsdata
-                                                 }
-                        case myhandshake of
-                            Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return []
-                            Just handshake -> do
-                                sendMessage (toxCrypto tox) saddr (NetHandshake handshake)
-                                let secnum :: Double
-                                    secnum = fromIntegral millisecs / 1000000
-                                    delay = (millisecs * 5 `div` 4)
-                                if secnum < 20000000
-                                  then do
-                                    hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ "  second(s).."
-                                    threadDelay delay
-                                    netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time.
-                                  else do
-                                    hPutStrLn stderr "Unable to establish session..."
-                                    return []
+                        freshCryptoSession (toxCryptoSessions tox) saddr hp
+--                      myhandshake <- do
+--                          n24' <- atomically $ transportNewNonce crypto
+--                          dput XNetCrypto ("Handshake Nonce24: " <> show n24')
+--                          newBaseNonce <- atomically $ transportNewNonce crypto
+--                          mbMyhandshakeData <- newHandShakeData crypto newBaseNonce hp saddr
+--                          forM mbMyhandshakeData $ \hsdata -> do
+--                              state <- lookupSharedSecret crypto myseckey theirpubkey n24'
+--                              return Handshake { handshakeCookie = cookie
+--                                               , handshakeNonce = n24'
+--                                               , handshakeData = encrypt state $ encodePlain hsdata
+--                                               }
+--                      case myhandshake of
+--                          Nothing -> hPutStrLn stderr "netCrypto: failed to create HandshakeData." >> return []
+--                          Just handshake -> do
+--                              sendMessage (toxCrypto tox) saddr (NetHandshake handshake)
+                        let secnum :: Double
+                            secnum = fromIntegral millisecs / 1000000
+                            delay = (millisecs * 5 `div` 4)
+                        if secnum < 20000000
+                          then do
+                            hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ "  second(s).."
+                            threadDelay delay
+                            netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time.
+                          else do
+                            hPutStrLn stderr "Unable to establish session..."
+                            return []
 
 getContactInfo :: Tox -> IO DHT.DHTPublicKey
 getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do
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