Connection/Tox.hs


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

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


data ToxProgress = ToxInProgress -- TODO
    deriving 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
        }