more persueContact wip

1 files changed, 12 insertions, 73 deletions

diff --git a/Connection/Tox/Threads.hs b/Connection/Tox/Threads.hs
index 12ac9682..3cf9486d 100644
--- a/Connection/Tox/Threads.hs
+++ b/Connection/Tox/Threads.hs
@@ -13,12 +13,14 @@ module Connection.Tox.Threads where
 
 import Connection
 -- import Connection.Tox
+import Crypto.Tox
 import Data.IP (IP)
 import Network.Tox.Crypto.Transport
 import Network.Tox.Crypto.Handlers
 import Network.Tox.NodeId
 import Network.Tox.ContactInfo
 import Network.Tox.DHT.Handlers {- (nodeSearch) -} as DHT
+import Network.Tox.DHT.Transport as DHT (dhtpk)
 import Network.Socket
 import Network.Kademlia.Search
 import Network.Kademlia.Routing (BucketList)
@@ -30,68 +32,6 @@ import Data.Functor.Identity
 import System.Timeout
 
 
--- | This type indicates the progress of a tox encrypted friend link
--- connection.  Two scenarios are illustrated below.  The parenthesis show the
--- current 'G.Status' 'ToxProgress' of the session.
---
---
--- Perfect handshake scenario:
---
---  Peer 1                                  Peer 2
---  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
---                     Cookie request ->
---                                       <- Cookie response
---  (InProgress AwaitingHandshake)          (Dormant/InProgress AcquiringCookie)
---                   Handshake packet ->
---                                          * accepts connection
---                                          (InProgress AwaitingSessionPacket)
---                                       <- Handshake packet
---  *accepts connection
---  (InProgress AwaitingSessionPacket)
---                   Encrypted packet -> <- Encrypted packet
---  *confirms connection                    *confirms connection
---  (Established)                           (Established)
---
---                           Connection successful.
---
---                  Encrypted packets -> <- Encrypted packets
---
---
---
---
---  More realistic handshake scenario:
---  Peer 1                                  Peer 2
---  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
---                      Cookie request ->   *packet lost*
---                      Cookie request ->
---                                        <- Cookie response
---  (InProgress AwaitingHandshake)           (Dormant/InProgress AcquiringCookie)
---
---                                           *Peer 2 randomly starts new connection to peer 1
---                                           (InProgress AcquiringCookie)
---                                        <- Cookie request
---                     Cookie response ->
---                                           (InProgress AwaitingHandshake)
---
---                    Handshake packet -> <- Handshake packet
---  *accepts connection                      * accepts connection
---  (InProgress AwaitingSessionPacket)      (InProgress AwaitingSessionPacket)
---
---                    Encrypted packet -> <- Encrypted packet
---  *confirms connection                     *confirms connection
---  (Established)                           (Established)
---
---                              Connection successful.
---
---                   Encrypted packets -> <- Encrypted packets
-data ToxProgress
-    = AwaitingDHTKey        -- ^ Waiting to receive their DHT key.
-    | AcquiringIPAddress    -- ^ Searching DHT to obtain their node's IP & port.
-    | AcquiringCookie       -- ^ Attempting to obtain a cookie.
-    | AwaitingHandshake     -- ^ Waiting to receive a handshake.
-    | AwaitingSessionPacket -- ^ Connection is "accepted" but not yet "confirmed".
-    deriving (Eq,Ord,Enum,Show)
-
 
 type NodeSearch = Search NodeId (IP,PortNumber) () NodeInfo NodeInfo
 
@@ -150,7 +90,8 @@ data PersueContactMethods params = PersueContactMethods
     , myseckey           :: SecretKey
     , theirpubkey        :: PublicKey
     , client             :: DHT.Client
-    , retryInterval      :: Int
+    , shortRetryInterval :: Int -- successful cookie, try again soon.
+    , longRetryInterval  :: Int -- no cookie, he's offline, give it some time.
     , contact            :: Contact
     }
 
@@ -185,19 +126,16 @@ persueContact getPolicy getStatus PersueContactMethods{..} writeStatus
                  either retry return $ nodeInfo (key2id theirDhtKey) saddr
             let mykeyAsId    = key2id (toPublic myseckey)
                 theirkeyAsId = key2id theirpubkey
+                crypto       = transportCrypto allsessions
+            -- AcquiringCookie
             atomically $ writeStatus (InProgress AcquiringCookie)
-            -- if no session:
-            -- Convert to NodeInfo, so we can send cookieRequest
-            let crypto = transportCrypto allsessions
-            case nodeInfo (key2id theirDhtKey) saddr of
-             Left e   -> hPutStrLn stderr ("persueContact: nodeInfo fail... " ++ e)
-             Right ni -> do
-                -- AcquiringCookie
-                mbCookie <- DHT.cookieRequest crypto client (toPublic myseckey) ni
-                case mbCookie of
+            mbCookie <- -- TODO: Check for recent cached cookie.
+                        DHT.cookieRequest crypto client (toPublic myseckey) ni
+            interval <- case mbCookie of
                   Nothing -> do
                     hPutStrLn stderr ("persueContact: (" ++ show mykeyAsId ++") <--> (" ++ show theirkeyAsId ++ ").")
                     hPutStrLn stderr ("persueContact: CookieRequest failed. TODO: dhtpkNodes thingy")
+                    return longRetryInterval
                   Just cookie -> do
                     hPutStrLn stderr "Have cookie, creating handshake packet..."
                     let hp = HParam { hpOtherCookie = cookie
@@ -216,9 +154,10 @@ persueContact getPolicy getStatus PersueContactMethods{..} writeStatus
                     forM myhandshake $ \response_handshake -> do
                             sendHandshake (toxCryptoSessions tox) saddr response_handshake
                     atomically $ writeStatus $ InProgress AwaitingHandshake
+                    return shortRetryInterval
             -- AwaitingHandshake
             -- AwaitingSessionPacket
-            retryAfterTimeout retryInterval
+            retryAfterTimeout interval
 
 data FreshenContactMethods = FreshenContactMethods
     { dhtkeyInterval   :: Int