From 5bdb2e12b5cb0159f2fa0cb80e01c06e37a1737c Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Fri, 1 Jun 2018 02:23:42 -0400
Subject: More ToxProgress states.

---
 Connection/Tox.hs | 37 +++++++++++++++++++++++++++++++++----
 1 file changed, 33 insertions(+), 4 deletions(-)

(limited to 'Connection')

diff --git a/Connection/Tox.hs b/Connection/Tox.hs
index 24ad220f..00d15aa7 100644
--- a/Connection/Tox.hs
+++ b/Connection/Tox.hs
@@ -11,7 +11,7 @@ import qualified Data.Map     as Map
 -- import Data.Maybe
 import Network.Tox
 import Network.Tox.NodeId
--- import PingMachine
+import PingMachine
 import Text.Read
 
 
@@ -70,7 +70,9 @@ import Text.Read
 --
 --                   Encrypted packets -> <- Encrypted packets
 data ToxProgress
-    = AcquiringCookie       -- ^ Attempting to obtain a cookie.
+    = 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)
@@ -86,18 +88,45 @@ data Parameters = Parameters
 
 data Key = Key NodeId{-me-} NodeId{-them-}
 
+instance Show Key where show = show . showKey_
+
+
+-- | A conneciton status that is tagged with a state type that is specific to
+-- the status.
 data Transient a where
     IsDormant               :: Transient ()
+    IsAwaitingDHTKey        :: Transient ()
+    IsAcquiringIPAddress    :: Transient ()
     IsAcquiringCookie       :: Transient ()
     IsAwaitingHandshake     :: Transient ()
     IsAwaitingSessionPacket :: Transient ()
     IsEstablished           :: Transient ()
 
+
+untag :: DSum Transient Identity -> G.Status ToxProgress
+untag (IsDormant               :=> _) = G.Dormant
+untag (IsAwaitingDHTKey        :=> _) = G.InProgress AwaitingDHTKey
+untag (IsAcquiringIPAddress    :=> _) = G.InProgress AcquiringIPAddress
+untag (IsAcquiringCookie       :=> _) = G.InProgress AcquiringCookie
+untag (IsAwaitingHandshake     :=> _) = G.InProgress AwaitingHandshake
+untag (IsAwaitingSessionPacket :=> _) = G.InProgress AwaitingSessionPacket
+untag (IsEstablished           :=> _) = G.Established
+
+
 data SessionState = SessionState
-    { sessionStatus :: G.Connection ToxProgress
-    , transient     :: DSum Transient Identity
+    { transient     :: TVar (DSum Transient Identity)
+    , connPolicy    :: TVar Policy
+    , connPingLogic :: PingMachine
+    }
+
+sessionStatus :: SessionState -> G.Connection ToxProgress
+sessionStatus st = G.Connection
+    { G.connStatus    = untag <$> readTVar (transient st)
+    , G.connPolicy    = readTVar (connPolicy st)
+    , G.connPingLogic = connPingLogic st
     }
 
+
 -- | This function will fork threads as necessary.
 setToxPolicy :: Parameters
              -> TVar (Map.Map Key SessionState)
-- 
cgit v1.2.3