{-# LANGUAGE GADTs #-} module Connection.Tox where import qualified Connection as G ;import Connection (Manager (..), Policy (..)) import Control.Concurrent.STM -- import Crypto.Tox import Data.Dependent.Sum import Data.Functor.Identity import qualified Data.Map as Map -- import Data.Maybe import Network.Tox 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. toxTransports :: Tox -- | Thread to be forked when a connection is established. -- TODO: this function should accept relevant parameters. , onToxSession :: IO () } data Key = Key NodeId{-me-} NodeId{-them-} data Transient a where IsDormant :: Transient () IsAcquiringCookie :: Transient () IsAwaitingHandshake :: Transient () IsAwaitingSessionPacket :: Transient () IsEstablished :: Transient () data SessionState = SessionState { sessionStatus :: G.Connection ToxProgress , transient :: DSum Transient Identity } -- | This function will fork threads as necessary. setToxPolicy :: Parameters -> TVar (Map.Map Key SessionState) -> Key -> 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 () showKey_ :: Key -> String showKey_ (Key me them) = show me ++ ":" ++ show them stringToKey_ :: String -> Maybe Key stringToKey_ s = let (xs,ys) = break (==':') s in if null ys then Nothing else do me <- readMaybe xs them <- readMaybe (drop 1 ys) return $ Key me them toxManager :: Parameters -> IO (Manager ToxProgress Key) toxManager params = do conmap <- newTVarIO Map.empty return Manager { setPolicy = setToxPolicy params conmap -- k -> Policy -> IO () , connections = fmap sessionStatus <$> readTVar conmap -- STM (Map k (Connection status)) , stringToKey = stringToKey_ -- String -> Maybe k , showProgress = show -- status -> String , showKey = showKey_ -- k -> String }