persueContact wip

1 files changed, 58 insertions, 11 deletions

diff --git a/Connection/Tox/Threads.hs b/Connection/Tox/Threads.hs
index 2ff058b3..12ac9682 100644
--- a/Connection/Tox/Threads.hs
+++ b/Connection/Tox/Threads.hs
@@ -15,8 +15,10 @@ import Connection
 -- import Connection.Tox
 import Data.IP (IP)
 import Network.Tox.Crypto.Transport
+import Network.Tox.Crypto.Handlers
 import Network.Tox.NodeId
--- import Network.Tox.DHT.Handlers (nodeSearch)
+import Network.Tox.ContactInfo
+import Network.Tox.DHT.Handlers {- (nodeSearch) -} as DHT
 import Network.Socket
 import Network.Kademlia.Search
 import Network.Kademlia.Routing (BucketList)
@@ -144,11 +146,21 @@ whileTryingAndNotEstablished getPolicy getStatus writeStatus body = fix $ \loop
                        (body retryAfterTimeout))
 
 data PersueContactMethods params = PersueContactMethods
-    { getHandshakeParams :: STM params
-    , sendHandshake      :: params -> IO ()
+    { allsessions        :: NetCryptoSessions
+    , myseckey           :: SecretKey
+    , theirpubkey        :: PublicKey
+    , client             :: DHT.Client
     , retryInterval      :: Int
+    , contact            :: Contact
     }
 
+retryUntilJust :: TVar (Maybe a) -> STM a
+retryUntilJust tvar = do
+    mb <- readTVar tvar
+    case mb of
+        mempty -> retry
+        Just x -> return x
+
 -- | Continuously attempt to send handshake packets until a connection is
 -- established.
 --
@@ -163,15 +175,50 @@ persueContact getPolicy getStatus PersueContactMethods{..} writeStatus
     = whileTryingAndNotEstablished getPolicy getStatus writeStatus
         $ \retryAfterTimeout -> do
             -- AwaitingDHTKey
+            atomically $ writeStatus (InProgress AwaitingDHTKey)
+            keypkt <- atomically $ retryUntilJust (contactKeyPacket contact)
+            let theirDhtKey = DHT.dhtpk keypkt
             -- AcquiringIPAddress
-            params <- getHandshakeParams
-            writeStatus (InProgress AcquiringCookie)
-            return $ do -- AcquiringCookie
-                        -- AwaitingHandshake
-                        -- AwaitingSessionPacket
-                        sendHandshake params
-                        atomically $ writeStatus $ InProgress AwaitingHandshake
-                        retryAfterTimeout retryInterval
+            atomically $ writeStatus (InProgress AcquiringIPAddress)
+            ni <- atomically $ do
+                 saddr <- retryUntilJust (contactLastSeenAddr contact)
+                 either retry return $ nodeInfo (key2id theirDhtKey) saddr
+            let mykeyAsId    = key2id (toPublic myseckey)
+                theirkeyAsId = key2id theirpubkey
+            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
+                  Nothing -> do
+                    hPutStrLn stderr ("persueContact: (" ++ show mykeyAsId ++") <--> (" ++ show theirkeyAsId ++ ").")
+                    hPutStrLn stderr ("persueContact: CookieRequest failed. TODO: dhtpkNodes thingy")
+                  Just cookie -> do
+                    hPutStrLn stderr "Have cookie, creating handshake packet..."
+                    let hp = HParam { hpOtherCookie = cookie
+                                    , hpMySecretKey = myseckey
+                                    , hpCookieRemotePubkey = theirpubkey
+                                    , hpCookieRemoteDhtkey = theirDhtKey
+                                    , hpTheirBaseNonce = Nothing
+                                    , hpTheirSessionKeyPublic = Nothing
+                                    }
+                    newsession <- generateSecretKey
+                    timestamp <- getPOSIXTime
+                    (myhandshake,ioAction)
+                            <- atomically $ freshCryptoSession allsessions saddr newsession timestamp hp
+                    ioAction
+                    -- send handshake
+                    forM myhandshake $ \response_handshake -> do
+                            sendHandshake (toxCryptoSessions tox) saddr response_handshake
+                    atomically $ writeStatus $ InProgress AwaitingHandshake
+            -- AwaitingHandshake
+            -- AwaitingSessionPacket
+            retryAfterTimeout retryInterval
 
 data FreshenContactMethods = FreshenContactMethods
     { dhtkeyInterval   :: Int