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 } s#\([A-Za-z]\+ [A-Za-z]\+\)\( *\) ->#\2\1#