{-|
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
    MptcpEndpointConfiguration -> Word64
_mecKey :: Word64
  , MptcpEndpointConfiguration -> Word32
_mecToken :: Word32
  -- ^Hash of the server key
  , MptcpEndpointConfiguration -> Int
_mecVersion :: Int -- ^ 0 or 1 at least for now
  -- , mecIdsn :: Word64
  -- ^ Initial data sequence number
  } deriving (Int -> MptcpEndpointConfiguration -> ShowS
[MptcpEndpointConfiguration] -> ShowS
MptcpEndpointConfiguration -> String
(Int -> MptcpEndpointConfiguration -> ShowS)
-> (MptcpEndpointConfiguration -> String)
-> ([MptcpEndpointConfiguration] -> ShowS)
-> Show MptcpEndpointConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MptcpEndpointConfiguration] -> ShowS
$cshowList :: [MptcpEndpointConfiguration] -> ShowS
show :: MptcpEndpointConfiguration -> String
$cshow :: MptcpEndpointConfiguration -> String
showsPrec :: Int -> MptcpEndpointConfiguration -> ShowS
$cshowsPrec :: Int -> MptcpEndpointConfiguration -> ShowS
Show, MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool
(MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool)
-> (MptcpEndpointConfiguration
    -> MptcpEndpointConfiguration -> Bool)
-> Eq MptcpEndpointConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool
$c/= :: MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool
== :: MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool
$c== :: MptcpEndpointConfiguration -> MptcpEndpointConfiguration -> Bool
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)
    MptcpConnection -> StreamIdMptcp
mpconStreamId :: StreamIdMptcp
  -- |Server key exchanged during the handshake
  , MptcpConnection -> MptcpEndpointConfiguration
_mpconServerConfig :: MptcpEndpointConfiguration
  , MptcpConnection -> 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
  , MptcpConnection -> Set MptcpSubflow
_mpconSubflows :: Set.Set MptcpSubflow

-- Ord to be able to use fromList
} deriving (Int -> MptcpConnection -> ShowS
[MptcpConnection] -> ShowS
MptcpConnection -> String
(Int -> MptcpConnection -> ShowS)
-> (MptcpConnection -> String)
-> ([MptcpConnection] -> ShowS)
-> Show MptcpConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MptcpConnection] -> ShowS
$cshowList :: [MptcpConnection] -> ShowS
show :: MptcpConnection -> String
$cshow :: MptcpConnection -> String
showsPrec :: Int -> MptcpConnection -> ShowS
$cshowsPrec :: Int -> MptcpConnection -> ShowS
Show, MptcpConnection -> MptcpConnection -> Bool
(MptcpConnection -> MptcpConnection -> Bool)
-> (MptcpConnection -> MptcpConnection -> Bool)
-> Eq MptcpConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MptcpConnection -> MptcpConnection -> Bool
$c/= :: MptcpConnection -> MptcpConnection -> Bool
== :: MptcpConnection -> MptcpConnection -> Bool
$c== :: MptcpConnection -> MptcpConnection -> Bool
Eq)


-- | Extension of @TcpConnection@
-- master subflow has implicit addrid 0
-- TODO add start/end dates ?
data MptcpSubflow = MptcpSubflow {
        MptcpSubflow -> TcpConnection
sfConn :: TcpConnection
      -- shall keep token instead ? or as a boolean ?
      -- Todo token
      -- , sfMptcpDest :: ConnectionRole -- ^ Destination
      , MptcpSubflow -> Maybe Word32
sfJoinToken :: Maybe Word32 -- ^ token of sendkey to authentify itself, Nothing -> Master subflow
      , MptcpSubflow -> Maybe Word8
sfPriority :: Maybe Word8 -- ^subflow priority
      , MptcpSubflow -> Word8
sfLocalId :: Word8  -- ^ Convert to AddressFamily
      , MptcpSubflow -> Word8
sfRemoteId :: Word8
      --conTcp TODO remove could be deduced from srcIp / dstIp ?
      -- allow 
      , MptcpSubflow -> Maybe Word32
sfInterface :: Maybe Word32 -- ^Interface of Maybe ? why a maybe ?
      -- Maybe Word32 -- ^Interface of Maybe ? why a maybe ?
    } deriving (Int -> MptcpSubflow -> ShowS
[MptcpSubflow] -> ShowS
MptcpSubflow -> String
(Int -> MptcpSubflow -> ShowS)
-> (MptcpSubflow -> String)
-> ([MptcpSubflow] -> ShowS)
-> Show MptcpSubflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MptcpSubflow] -> ShowS
$cshowList :: [MptcpSubflow] -> ShowS
show :: MptcpSubflow -> String
$cshow :: MptcpSubflow -> String
showsPrec :: Int -> MptcpSubflow -> ShowS
$cshowsPrec :: Int -> MptcpSubflow -> ShowS
Show, MptcpSubflow -> MptcpSubflow -> Bool
(MptcpSubflow -> MptcpSubflow -> Bool)
-> (MptcpSubflow -> MptcpSubflow -> Bool) -> Eq MptcpSubflow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MptcpSubflow -> MptcpSubflow -> Bool
$c/= :: MptcpSubflow -> MptcpSubflow -> Bool
== :: MptcpSubflow -> MptcpSubflow -> Bool
$c== :: MptcpSubflow -> MptcpSubflow -> Bool
Eq, Eq MptcpSubflow
Eq MptcpSubflow
-> (MptcpSubflow -> MptcpSubflow -> Ordering)
-> (MptcpSubflow -> MptcpSubflow -> Bool)
-> (MptcpSubflow -> MptcpSubflow -> Bool)
-> (MptcpSubflow -> MptcpSubflow -> Bool)
-> (MptcpSubflow -> MptcpSubflow -> Bool)
-> (MptcpSubflow -> MptcpSubflow -> MptcpSubflow)
-> (MptcpSubflow -> MptcpSubflow -> MptcpSubflow)
-> Ord MptcpSubflow
MptcpSubflow -> MptcpSubflow -> Bool
MptcpSubflow -> MptcpSubflow -> Ordering
MptcpSubflow -> MptcpSubflow -> MptcpSubflow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MptcpSubflow -> MptcpSubflow -> MptcpSubflow
$cmin :: MptcpSubflow -> MptcpSubflow -> MptcpSubflow
max :: MptcpSubflow -> MptcpSubflow -> MptcpSubflow
$cmax :: MptcpSubflow -> MptcpSubflow -> MptcpSubflow
>= :: MptcpSubflow -> MptcpSubflow -> Bool
$c>= :: MptcpSubflow -> MptcpSubflow -> Bool
> :: MptcpSubflow -> MptcpSubflow -> Bool
$c> :: MptcpSubflow -> MptcpSubflow -> Bool
<= :: MptcpSubflow -> MptcpSubflow -> Bool
$c<= :: MptcpSubflow -> MptcpSubflow -> Bool
< :: MptcpSubflow -> MptcpSubflow -> Bool
$c< :: MptcpSubflow -> MptcpSubflow -> Bool
compare :: MptcpSubflow -> MptcpSubflow -> Ordering
$ccompare :: MptcpSubflow -> MptcpSubflow -> Ordering
$cp1Ord :: Eq MptcpSubflow
Ord)

makeLenses ''MptcpConnection

tshow :: Show a => a -> TS.Text
tshow :: a -> Text
tshow = String -> Text
TS.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
Prelude.show

-- |Pretty print an MPTCP connection
showMptcpConnectionText :: MptcpConnection -> Text
showMptcpConnectionText :: MptcpConnection -> Text
showMptcpConnectionText MptcpConnection
con =
  -- showIp (srcIp con) <> ":" <> tshow (srcPort con) <> " -> " <> showIp (dstIp con) <> ":" <> tshow (dstPort con)
  Text
tpl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\nSubflows:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
TS.unlines ((MptcpSubflow -> Text) -> [MptcpSubflow] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (TcpConnection -> Text
showTcpConnectionText (TcpConnection -> Text)
-> (MptcpSubflow -> TcpConnection) -> MptcpSubflow -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MptcpSubflow -> TcpConnection
sfConn) (Set MptcpSubflow -> [MptcpSubflow]
forall a. Set a -> [a]
Set.toList (Set MptcpSubflow -> [MptcpSubflow])
-> Set MptcpSubflow -> [MptcpSubflow]
forall a b. (a -> b) -> a -> b
$ MptcpConnection -> Set MptcpSubflow
_mpconSubflows MptcpConnection
con))
  where
    -- todo show version
    tpl :: Text
    tpl :: Text
tpl = [Text] -> Text
TS.unlines [
        Text
"Server key/token: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow (MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconServerConfig MptcpEndpointConfiguration
-> Getting Word64 MptcpEndpointConfiguration Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 MptcpEndpointConfiguration Word64
Lens' MptcpEndpointConfiguration Word64
mecKey) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
tshow (MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconServerConfig MptcpEndpointConfiguration
-> Getting Word32 MptcpEndpointConfiguration Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 MptcpEndpointConfiguration Word32
Lens' MptcpEndpointConfiguration Word32
mecToken)
      , Text
"Client key/token: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
tshow (MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconClientConfig MptcpEndpointConfiguration
-> Getting Word64 MptcpEndpointConfiguration Word64 -> Word64
forall s a. s -> Getting a s a -> a
^. Getting Word64 MptcpEndpointConfiguration Word64
Lens' MptcpEndpointConfiguration Word64
mecKey) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
tshow (MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconClientConfig MptcpEndpointConfiguration
-> Getting Word32 MptcpEndpointConfiguration Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 MptcpEndpointConfiguration Word32
Lens' MptcpEndpointConfiguration Word32
mecToken)
      ]

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


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

-- TODO test
tokenBelongToConnection :: Word32 -> MptcpConnection -> Bool
tokenBelongToConnection :: Word32 -> MptcpConnection -> Bool
tokenBelongToConnection Word32
rcvToken MptcpConnection
con = 
  if Word32
rcvToken Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconClientConfig MptcpEndpointConfiguration
-> Getting Word32 MptcpEndpointConfiguration Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 MptcpEndpointConfiguration Word32
Lens' MptcpEndpointConfiguration Word32
mecToken then
    Bool
True
  else if Word32
rcvToken Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== MptcpConnection
con MptcpConnection
-> Getting
     MptcpEndpointConfiguration
     MptcpConnection
     MptcpEndpointConfiguration
-> MptcpEndpointConfiguration
forall s a. s -> Getting a s a -> a
^. Getting
  MptcpEndpointConfiguration
  MptcpConnection
  MptcpEndpointConfiguration
Lens' MptcpConnection MptcpEndpointConfiguration
mpconServerConfig MptcpEndpointConfiguration
-> Getting Word32 MptcpEndpointConfiguration Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 MptcpEndpointConfiguration Word32
Lens' MptcpEndpointConfiguration Word32
mecToken then
    Bool
True
  else
    Bool
False

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


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