tox: persueContact, fixed build errors.

1 files changed, 54 insertions, 51 deletions

diff --git a/Connection/Tox/Threads.hs b/Connection/Tox/Threads.hs
index 3cf9486d..b3527ed2 100644
--- a/Connection/Tox/Threads.hs
+++ b/Connection/Tox/Threads.hs
@@ -29,6 +29,8 @@ import Control.Concurrent.STM
 import Control.Monad
 import Data.Function
 import Data.Functor.Identity
+import Data.Time.Clock.POSIX
+import System.IO
 import System.Timeout
 
 
@@ -96,11 +98,7 @@ data PersueContactMethods params = PersueContactMethods
     }
 
 retryUntilJust :: TVar (Maybe a) -> STM a
-retryUntilJust tvar = do
-    mb <- readTVar tvar
-    case mb of
-        mempty -> retry
-        Just x -> return x
+retryUntilJust tvar = maybe retry return =<< readTVar tvar
 
 -- | Continuously attempt to send handshake packets until a connection is
 -- established.
@@ -112,52 +110,57 @@ persueContact :: STM Policy
                  -> PersueContactMethods a
                  -> (Status ToxProgress -> STM ())
                  -> IO ()
-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
-            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
-                crypto       = transportCrypto allsessions
-            -- AcquiringCookie
-            atomically $ writeStatus (InProgress AcquiringCookie)
-            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
-                                    , 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
-                    return shortRetryInterval
-            -- AwaitingHandshake
-            -- AwaitingSessionPacket
-            retryAfterTimeout interval
+persueContact getPolicy getStatus PersueContactMethods{..} writeStatus = do
+    -- AwaitingDHTKey
+    atomically $ writeStatus (InProgress AwaitingDHTKey)
+    whileTryingAndNotEstablished getPolicy getStatus writeStatus
+        $ \retryAfterTimeout ->
+            orElse (do
+                    theirDhtKey <- DHT.dhtpk <$> retryUntilJust (contactKeyPacket contact)
+                    -- We don't have an IP address yet.
+                    maybe (return ()) (const retry) =<< readTVar (contactLastSeenAddr contact)
+                    return $ do -- AcquiringIPAddress
+                                atomically $ writeStatus (InProgress AcquiringIPAddress)
+                                retryAfterTimeout 0)
+                   (do
+                    theirDhtKey <- DHT.dhtpk <$> retryUntilJust (contactKeyPacket contact)
+                    saddr <- retryUntilJust (contactLastSeenAddr contact)
+                    ni <- either (const retry) return $ nodeInfo (key2id theirDhtKey) saddr
+                    return $ do
+                    -- AcquiringCookie
+                    atomically $ writeStatus (InProgress AcquiringCookie)
+                    let mykeyAsId    = key2id (toPublic myseckey)
+                        theirkeyAsId = key2id theirpubkey
+                        crypto       = transportCrypto allsessions
+                    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
+                                            , 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 allsessions saddr response_handshake
+                            atomically $ writeStatus $ InProgress AwaitingHandshake
+                            return shortRetryInterval
+                    -- AwaitingHandshake
+                    -- AwaitingSessionPacket
+                    retryAfterTimeout interval)
 
 data FreshenContactMethods = FreshenContactMethods
     { dhtkeyInterval   :: Int