summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Connection/Tox.hs37
1 files changed, 33 insertions, 4 deletions
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
11-- import Data.Maybe 11-- import Data.Maybe
12import Network.Tox 12import Network.Tox
13import Network.Tox.NodeId 13import Network.Tox.NodeId
14-- import PingMachine 14import PingMachine
15import Text.Read 15import Text.Read
16 16
17 17
@@ -70,7 +70,9 @@ import Text.Read
70-- 70--
71-- Encrypted packets -> <- Encrypted packets 71-- Encrypted packets -> <- Encrypted packets
72data ToxProgress 72data ToxProgress
73 = AcquiringCookie -- ^ Attempting to obtain a cookie. 73 = AwaitingDHTKey -- ^ Waiting to receive their DHT key.
74 | AcquiringIPAddress -- ^ Searching DHT to obtain their node's IP & port.
75 | AcquiringCookie -- ^ Attempting to obtain a cookie.
74 | AwaitingHandshake -- ^ Waiting to receive a handshake. 76 | AwaitingHandshake -- ^ Waiting to receive a handshake.
75 | AwaitingSessionPacket -- ^ Connection is "accepted" but not yet "confirmed". 77 | AwaitingSessionPacket -- ^ Connection is "accepted" but not yet "confirmed".
76 deriving (Eq,Ord,Enum,Show) 78 deriving (Eq,Ord,Enum,Show)
@@ -86,18 +88,45 @@ data Parameters = Parameters
86 88
87data Key = Key NodeId{-me-} NodeId{-them-} 89data Key = Key NodeId{-me-} NodeId{-them-}
88 90
91instance Show Key where show = show . showKey_
92
93
94-- | A conneciton status that is tagged with a state type that is specific to
95-- the status.
89data Transient a where 96data Transient a where
90 IsDormant :: Transient () 97 IsDormant :: Transient ()
98 IsAwaitingDHTKey :: Transient ()
99 IsAcquiringIPAddress :: Transient ()
91 IsAcquiringCookie :: Transient () 100 IsAcquiringCookie :: Transient ()
92 IsAwaitingHandshake :: Transient () 101 IsAwaitingHandshake :: Transient ()
93 IsAwaitingSessionPacket :: Transient () 102 IsAwaitingSessionPacket :: Transient ()
94 IsEstablished :: Transient () 103 IsEstablished :: Transient ()
95 104
105
106untag :: DSum Transient Identity -> G.Status ToxProgress
107untag (IsDormant :=> _) = G.Dormant
108untag (IsAwaitingDHTKey :=> _) = G.InProgress AwaitingDHTKey
109untag (IsAcquiringIPAddress :=> _) = G.InProgress AcquiringIPAddress
110untag (IsAcquiringCookie :=> _) = G.InProgress AcquiringCookie
111untag (IsAwaitingHandshake :=> _) = G.InProgress AwaitingHandshake
112untag (IsAwaitingSessionPacket :=> _) = G.InProgress AwaitingSessionPacket
113untag (IsEstablished :=> _) = G.Established
114
115
96data SessionState = SessionState 116data SessionState = SessionState
97 { sessionStatus :: G.Connection ToxProgress 117 { transient :: TVar (DSum Transient Identity)
98 , transient :: DSum Transient Identity 118 , connPolicy :: TVar Policy
119 , connPingLogic :: PingMachine
120 }
121
122sessionStatus :: SessionState -> G.Connection ToxProgress
123sessionStatus st = G.Connection
124 { G.connStatus = untag <$> readTVar (transient st)
125 , G.connPolicy = readTVar (connPolicy st)
126 , G.connPingLogic = connPingLogic st
99 } 127 }
100 128
129
101-- | This function will fork threads as necessary. 130-- | This function will fork threads as necessary.
102setToxPolicy :: Parameters 131setToxPolicy :: Parameters
103 -> TVar (Map.Map Key SessionState) 132 -> TVar (Map.Map Key SessionState)