diff options
-rw-r--r-- | Connection/Tox.hs | 37 |
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 |
12 | import Network.Tox | 12 | import Network.Tox |
13 | import Network.Tox.NodeId | 13 | import Network.Tox.NodeId |
14 | -- import PingMachine | 14 | import PingMachine |
15 | import Text.Read | 15 | import 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 |
72 | data ToxProgress | 72 | data 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 | ||
87 | data Key = Key NodeId{-me-} NodeId{-them-} | 89 | data Key = Key NodeId{-me-} NodeId{-them-} |
88 | 90 | ||
91 | instance 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. | ||
89 | data Transient a where | 96 | data 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 | |||
106 | untag :: DSum Transient Identity -> G.Status ToxProgress | ||
107 | untag (IsDormant :=> _) = G.Dormant | ||
108 | untag (IsAwaitingDHTKey :=> _) = G.InProgress AwaitingDHTKey | ||
109 | untag (IsAcquiringIPAddress :=> _) = G.InProgress AcquiringIPAddress | ||
110 | untag (IsAcquiringCookie :=> _) = G.InProgress AcquiringCookie | ||
111 | untag (IsAwaitingHandshake :=> _) = G.InProgress AwaitingHandshake | ||
112 | untag (IsAwaitingSessionPacket :=> _) = G.InProgress AwaitingSessionPacket | ||
113 | untag (IsEstablished :=> _) = G.Established | ||
114 | |||
115 | |||
96 | data SessionState = SessionState | 116 | data 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 | |||
122 | sessionStatus :: SessionState -> G.Connection ToxProgress | ||
123 | sessionStatus 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. |
102 | setToxPolicy :: Parameters | 131 | setToxPolicy :: Parameters |
103 | -> TVar (Map.Map Key SessionState) | 132 | -> TVar (Map.Map Key SessionState) |