Connection.hs

{-|
Module      : Net.Mptcp.Connection
Description : Basic MPTCP connection description
Maintainer  : matt
License     : GPL-3
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Net.Mptcp.Connection (
  -- * Types
    MptcpConnection(..)
  , mpconSubflows, mpconServerConfig, mpconClientConfig
  , MptcpSubflow(..)
  , MptcpEndpointConfiguration(..)
  , mecKey, mecToken, mecVersion
  , showMptcpConnectionText

  , mptcpConnAddSubflow
  , mptcpConnRemoveSubflow
  , getMasterSubflow
  , getSubflowFromStreamId

  , tokenBelongToConnection
)
where

import Net.IP
import Net.Tcp
import Net.Stream

-- import MptcpAnalyzer.Arti
import Control.Lens
import qualified Data.Set as Set
import Data.Text as TS
import Data.Word (Word16, Word32, Word64, Word8)
-- import MptcpAnalyzer.ArtificialFields

data MptcpEndpointConfiguration = MptcpEndpointConfiguration {
  -- |key exchanged during the handshake
    _mecKey :: Word64
  , _mecToken :: Word32
  -- ^Hash of the server key
  , _mecVersion :: Int -- ^ 0 or 1 at least for now
  -- , mecIdsn :: Word64
  -- ^ Initial data sequence number
  } deriving (Show, Eq)

makeLenses ''MptcpEndpointConfiguration


-- | Holds all necessary information about a multipath TCP connection
-- TODO add an imcomplete constructor ?
data MptcpConnection = MptcpConnection {
  -- todo prefix as mpcon
  -- |The wireshark mptcp.stream identifier (a number)
    mpconStreamId :: StreamIdMptcp
  -- |Server key exchanged during the handshake
  , _mpconServerConfig :: MptcpEndpointConfiguration
  , _mpconClientConfig :: MptcpEndpointConfiguration
  -- | Mptcp version negotiated during the handshake Not implemented yet ?
  -- , mptcpNegotiatedVersion :: Word8  -- ^ 0 or 1 at least for now
  -- ^ List of past/present/future subflows seen during communication
  , _mpconSubflows :: Set.Set MptcpSubflow

-- Ord to be able to use fromList
} deriving (Show, Eq)


-- | Extension of @TcpConnection@
-- master subflow has implicit addrid 0
-- TODO add start/end dates ?
data MptcpSubflow = MptcpSubflow {
        sfConn :: TcpConnection
      -- shall keep token instead ? or as a boolean ?
      -- Todo token
      -- , sfMptcpDest :: ConnectionRole -- ^ Destination
      , sfJoinToken :: Maybe Word32 -- ^ token of sendkey to authentify itself, Nothing -> Master subflow
      , sfPriority :: Maybe Word8 -- ^subflow priority
      , sfLocalId :: Word8  -- ^ Convert to AddressFamily
      , sfRemoteId :: Word8
      --conTcp TODO remove could be deduced from srcIp / dstIp ?
      -- allow 
      , sfInterface :: Maybe Word32 -- ^Interface of Maybe ? why a maybe ?
      -- Maybe Word32 -- ^Interface of Maybe ? why a maybe ?
    } deriving (Show, Eq, Ord)

makeLenses ''MptcpConnection

tshow :: Show a => a -> TS.Text
tshow = TS.pack . Prelude.show

-- |Pretty print an MPTCP connection
showMptcpConnectionText :: MptcpConnection -> Text
showMptcpConnectionText con =
  -- showIp (srcIp con) <> ":" <> tshow (srcPort con) <> " -> " <> showIp (dstIp con) <> ":" <> tshow (dstPort con)
  tpl <> "\nSubflows:\n" <> TS.unlines (Prelude.map (showTcpConnectionText . sfConn) (Set.toList $ _mpconSubflows con))
  where
    -- todo show version
    tpl :: Text
    tpl = TS.unlines [
        "Server key/token: " <> tshow (con ^. mpconServerConfig ^. mecKey) <> "/" <> tshow (con ^. mpconServerConfig ^. mecToken)
      , "Client key/token: " <> tshow (con ^. mpconClientConfig ^. mecKey) <> "/" <> tshow (con ^. mpconClientConfig ^. mecToken)
      ]

---- add a maybe ?
getMasterSubflow :: MptcpConnection -> Maybe MptcpSubflow
getMasterSubflow mptcpCon = case Prelude.filter (\sf -> sfLocalId sf == 0) (Set.toList $ _mpconSubflows mptcpCon) of
  [] -> Nothing
  [x] -> Just x
  (_:_) -> error "There can be only one master subflow"


getSubflowFromStreamId :: MptcpConnection -> StreamIdTcp -> Maybe MptcpSubflow
getSubflowFromStreamId con streamId = 
  case Prelude.filter (\sf -> (conTcpStreamId . sfConn) sf == streamId) (Set.toList $ _mpconSubflows con) of 
    [] -> Nothing
    (x:_) -> Just x

-- TODO test
tokenBelongToConnection :: Word32 -> MptcpConnection -> Bool
tokenBelongToConnection rcvToken con = 
  if rcvToken == con ^. mpconClientConfig ^. mecToken then
    True
  else if rcvToken == con ^. mpconServerConfig ^. mecToken then
    True
  else
    False

-- |Adds a subflow to the connection
-- Runs some extra checks
-- TODO compose with mptcpConnAddLocalId
mptcpConnAddSubflow :: MptcpConnection -> MptcpSubflow -> MptcpConnection
mptcpConnAddSubflow mptcpConn sf =
  -- TODO check that there are no duplicates / only one master etc
  (mptcpConn { _mpconSubflows = Set.insert sf (_mpconSubflows mptcpConn) })


-- |Remove subflow from an MPTCP connection
mptcpConnRemoveSubflow :: MptcpConnection -> MptcpSubflow -> MptcpConnection
mptcpConnRemoveSubflow con sf = con {
  _mpconSubflows = Set.delete sf (_mpconSubflows con)
  -- TODO remove associated local/remote Id ?
}