summaryrefslogtreecommitdiff
path: root/Connection/Tox.hs
blob: 29f6b0e4c0da89bbf9a1fb9a21612585bc422dd3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
module Connection.Tox where

import qualified Connection   as G
         ;import Connection   (Manager (..), Policy (..))
import Control.Concurrent.STM
import Crypto.Tox
import Network.Tox
import qualified Data.Map     as Map
import Network.Tox.NodeId
import PingMachine
import Text.Read


-- | This type indicates the progress of a tox encrypted friend link
-- connection.  Two scenarios are illustrated below.  The parenthesis show the
-- current 'G.Status' 'ToxProgress' of the session.
--
--
-- Perfect handshake scenario:
--
--  Peer 1                                  Peer 2
--  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
--                     Cookie request ->
--                                       <- Cookie response
--  (InProgress AwaitingHandshake)          (Dormant/InProgress AcquiringCookie)
--                   Handshake packet ->
--                                          * accepts connection
--                                          (InProgress AwaitingSessionPacket)
--                                       <- Handshake packet
--  *accepts connection
--  (InProgress AwaitingSessionPacket)
--                   Encrypted packet -> <- Encrypted packet
--  *confirms connection                    *confirms connection
--  (Established)                           (Established)
--
--                           Connection successful.
--
--                  Encrypted packets -> <- Encrypted packets
--
--
--
--
--  More realistic handshake scenario:
--  Peer 1                                  Peer 2
--  (InProgress AcquiringCookie)            (Dormant/InProgress AcquiringCookie)
--                      Cookie request ->   *packet lost*
--                      Cookie request ->
--                                        <- Cookie response
--  (InProgress AwaitingHandshake)           (Dormant/InProgress AcquiringCookie)
--
--                                           *Peer 2 randomly starts new connection to peer 1
--                                           (InProgress AcquiringCookie)
--                                        <- Cookie request
--                     Cookie response ->
--                                           (InProgress AwaitingHandshake)
--
--                    Handshake packet -> <- Handshake packet
--  *accepts connection                      * accepts connection
--  (InProgress AwaitingSessionPacket)      (InProgress AwaitingSessionPacket)
--
--                    Encrypted packet -> <- Encrypted packet
--  *confirms connection                     *confirms connection
--  (Established)                           (Established)
--
--                              Connection successful.
--
--                   Encrypted packets -> <- Encrypted packets
data ToxProgress
    = 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)


data Parameters = Parameters
    { -- | Various Tox transports and clients.  XXX: This includes a lot of
      -- irrelevant secret keys.
      toxTransports :: Tox
      -- | This node's public user key.  The relevant secret key will be obtained
      -- from 'toxTransports'.
    , myToxIdentity :: NodeId
      -- | Thread to be forked when a connection is established.
      -- TODO: this function should accept relevant parameters.
    , onToxSession  :: IO ()
    }

-- | This function will fork threads as necessary.
setToxPolicy :: Parameters
             -> TVar (Map.Map NodeId (G.Connection ToxProgress))
             -> NodeId {- their public userkey -}
             -> Policy
             -> IO ()
setToxPolicy params conmap k policy = case policy of
    TryingToConnect -> do
        -- TODO initiate connecting if we haven't already
        -- When established, invoke 'onToxSession'.
        return ()
    RefusingToConnect -> do
        -- TODO disconnect or cancel any pending connection
        return ()
    OpenToConnect -> do
        -- TODO passively accept connections if they initiate.
        return ()


toxManager :: Parameters -> IO (Manager ToxProgress NodeId{- their public userkey -})
toxManager params = do
    conmap <- newTVarIO Map.empty
    return Manager
        { setPolicy    = setToxPolicy params conmap -- k -> Policy -> IO ()
        , connections  = readTVar conmap            -- STM (Map k (Connection status))
        , stringToKey  = readMaybe                  -- String -> Maybe k
        , showProgress = show                       -- status -> String
        , showKey      = show                       -- k -> String
        }