{-# LANGUAGE OverloadedStrings #-}

module Net.Tcp.Connection (
    TcpConnection(..)
  , TcpConnectionOriented(..)
  , tcpConnectionToOriented
  , showTcpConnectionText
  , reverseTcpConnectionTuple
  , tcpConnectionFromOriented
)
where
import Data.Text as TS
import Data.Word (Word16, Word32, Word64, Word8)
import Net.Stream
import Net.IP

-- | Identifies a TCP connection
-- TODO TcpTsharkConnection
data TcpConnection = TcpConnection {
  -- TODO use libraries to deal with that ? filter from the command line for instance ?
    TcpConnection -> IP
conTcpClientIp :: IP -- ^Client ip
  , TcpConnection -> IP
conTcpServerIp :: IP -- ^Server ip
  , TcpConnection -> Word16
conTcpClientPort :: Word16  -- ^ Source port
  , TcpConnection -> Word16
conTcpServerPort :: Word16  -- ^Destination port
  -- Could be a maybe ?
  , TcpConnection -> StreamIdTcp
conTcpStreamId :: StreamIdTcp -- ^ @tcp.stream@ in wireshark
  } deriving (Int -> TcpConnection -> ShowS
[TcpConnection] -> ShowS
TcpConnection -> String
(Int -> TcpConnection -> ShowS)
-> (TcpConnection -> String)
-> ([TcpConnection] -> ShowS)
-> Show TcpConnection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TcpConnection] -> ShowS
$cshowList :: [TcpConnection] -> ShowS
show :: TcpConnection -> String
$cshow :: TcpConnection -> String
showsPrec :: Int -> TcpConnection -> ShowS
$cshowsPrec :: Int -> TcpConnection -> ShowS
Show, TcpConnection -> TcpConnection -> Bool
(TcpConnection -> TcpConnection -> Bool)
-> (TcpConnection -> TcpConnection -> Bool) -> Eq TcpConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TcpConnection -> TcpConnection -> Bool
$c/= :: TcpConnection -> TcpConnection -> Bool
== :: TcpConnection -> TcpConnection -> Bool
$c== :: TcpConnection -> TcpConnection -> Bool
Eq, Eq TcpConnection
Eq TcpConnection
-> (TcpConnection -> TcpConnection -> Ordering)
-> (TcpConnection -> TcpConnection -> Bool)
-> (TcpConnection -> TcpConnection -> Bool)
-> (TcpConnection -> TcpConnection -> Bool)
-> (TcpConnection -> TcpConnection -> Bool)
-> (TcpConnection -> TcpConnection -> TcpConnection)
-> (TcpConnection -> TcpConnection -> TcpConnection)
-> Ord TcpConnection
TcpConnection -> TcpConnection -> Bool
TcpConnection -> TcpConnection -> Ordering
TcpConnection -> TcpConnection -> TcpConnection
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 :: TcpConnection -> TcpConnection -> TcpConnection
$cmin :: TcpConnection -> TcpConnection -> TcpConnection
max :: TcpConnection -> TcpConnection -> TcpConnection
$cmax :: TcpConnection -> TcpConnection -> TcpConnection
>= :: TcpConnection -> TcpConnection -> Bool
$c>= :: TcpConnection -> TcpConnection -> Bool
> :: TcpConnection -> TcpConnection -> Bool
$c> :: TcpConnection -> TcpConnection -> Bool
<= :: TcpConnection -> TcpConnection -> Bool
$c<= :: TcpConnection -> TcpConnection -> Bool
< :: TcpConnection -> TcpConnection -> Bool
$c< :: TcpConnection -> TcpConnection -> Bool
compare :: TcpConnection -> TcpConnection -> Ordering
$ccompare :: TcpConnection -> TcpConnection -> Ordering
$cp1Ord :: Eq TcpConnection
Ord)


-- |
data TcpConnectionOriented = TcpConnectionOriented {
    TcpConnectionOriented -> IP
conTcpSourceIp :: IP -- ^Source ip
  , TcpConnectionOriented -> IP
conTcpDestinationIp :: IP -- ^Destination ip
  , TcpConnectionOriented -> Word16
conTcpSourcePort :: Word16  -- ^ Source port
  , TcpConnectionOriented -> Word16
conTcpDestinationPort :: Word16  -- ^Destination port
  } deriving (Int -> TcpConnectionOriented -> ShowS
[TcpConnectionOriented] -> ShowS
TcpConnectionOriented -> String
(Int -> TcpConnectionOriented -> ShowS)
-> (TcpConnectionOriented -> String)
-> ([TcpConnectionOriented] -> ShowS)
-> Show TcpConnectionOriented
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TcpConnectionOriented] -> ShowS
$cshowList :: [TcpConnectionOriented] -> ShowS
show :: TcpConnectionOriented -> String
$cshow :: TcpConnectionOriented -> String
showsPrec :: Int -> TcpConnectionOriented -> ShowS
$cshowsPrec :: Int -> TcpConnectionOriented -> ShowS
Show, TcpConnectionOriented -> TcpConnectionOriented -> Bool
(TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> (TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> Eq TcpConnectionOriented
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c/= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
== :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c== :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
Eq, Eq TcpConnectionOriented
Eq TcpConnectionOriented
-> (TcpConnectionOriented -> TcpConnectionOriented -> Ordering)
-> (TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> (TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> (TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> (TcpConnectionOriented -> TcpConnectionOriented -> Bool)
-> (TcpConnectionOriented
    -> TcpConnectionOriented -> TcpConnectionOriented)
-> (TcpConnectionOriented
    -> TcpConnectionOriented -> TcpConnectionOriented)
-> Ord TcpConnectionOriented
TcpConnectionOriented -> TcpConnectionOriented -> Bool
TcpConnectionOriented -> TcpConnectionOriented -> Ordering
TcpConnectionOriented
-> TcpConnectionOriented -> TcpConnectionOriented
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 :: TcpConnectionOriented
-> TcpConnectionOriented -> TcpConnectionOriented
$cmin :: TcpConnectionOriented
-> TcpConnectionOriented -> TcpConnectionOriented
max :: TcpConnectionOriented
-> TcpConnectionOriented -> TcpConnectionOriented
$cmax :: TcpConnectionOriented
-> TcpConnectionOriented -> TcpConnectionOriented
>= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c>= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
> :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c> :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
<= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c<= :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
< :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
$c< :: TcpConnectionOriented -> TcpConnectionOriented -> Bool
compare :: TcpConnectionOriented -> TcpConnectionOriented -> Ordering
$ccompare :: TcpConnectionOriented -> TcpConnectionOriented -> Ordering
$cp1Ord :: Eq TcpConnectionOriented
Ord)


reverseTcpConnectionTuple :: TcpConnectionOriented -> TcpConnectionOriented
reverseTcpConnectionTuple :: TcpConnectionOriented -> TcpConnectionOriented
reverseTcpConnectionTuple TcpConnectionOriented
con = TcpConnectionOriented :: IP -> IP -> Word16 -> Word16 -> TcpConnectionOriented
TcpConnectionOriented {
    conTcpSourceIp :: IP
conTcpSourceIp = TcpConnectionOriented -> IP
conTcpDestinationIp TcpConnectionOriented
con
  , conTcpDestinationIp :: IP
conTcpDestinationIp = TcpConnectionOriented -> IP
conTcpSourceIp TcpConnectionOriented
con
  , conTcpSourcePort :: Word16
conTcpSourcePort = TcpConnectionOriented -> Word16
conTcpDestinationPort TcpConnectionOriented
con
  , conTcpDestinationPort :: Word16
conTcpDestinationPort = TcpConnectionOriented -> Word16
conTcpSourcePort TcpConnectionOriented
con
  }


-- | Uses the source as client. Use 'reverseTcpConnectionTuple' to assign the server as source
tcpConnectionFromOriented ::
     TcpConnectionOriented
  -- ^ Source is the client
  -> TcpConnection
tcpConnectionFromOriented :: TcpConnectionOriented -> TcpConnection
tcpConnectionFromOriented TcpConnectionOriented
tup = TcpConnection :: IP -> IP -> Word16 -> Word16 -> StreamIdTcp -> TcpConnection
TcpConnection {

    conTcpClientIp :: IP
conTcpClientIp = TcpConnectionOriented -> IP
conTcpSourceIp TcpConnectionOriented
tup
  , conTcpServerIp :: IP
conTcpServerIp = TcpConnectionOriented -> IP
conTcpDestinationIp TcpConnectionOriented
tup
  , conTcpClientPort :: Word16
conTcpClientPort = TcpConnectionOriented -> Word16
conTcpSourcePort TcpConnectionOriented
tup
  , conTcpServerPort :: Word16
conTcpServerPort = TcpConnectionOriented -> Word16
conTcpDestinationPort TcpConnectionOriented
tup
  , conTcpStreamId :: StreamIdTcp
conTcpStreamId = Word32 -> StreamIdTcp
forall a. Word32 -> StreamId a
StreamId Word32
0
  }

tcpConnectionToOriented ::
     TcpConnection
  -- ^ Source is the client
  -> TcpConnectionOriented
tcpConnectionToOriented :: TcpConnection -> TcpConnectionOriented
tcpConnectionToOriented TcpConnection
con = TcpConnectionOriented :: IP -> IP -> Word16 -> Word16 -> TcpConnectionOriented
TcpConnectionOriented {

    conTcpSourceIp :: IP
conTcpSourceIp = TcpConnection -> IP
conTcpClientIp TcpConnection
con
  , conTcpDestinationIp :: IP
conTcpDestinationIp = TcpConnection -> IP
conTcpServerIp TcpConnection
con
  , conTcpSourcePort :: Word16
conTcpSourcePort = TcpConnection -> Word16
conTcpClientPort TcpConnection
con
  , conTcpDestinationPort :: Word16
conTcpDestinationPort = TcpConnection -> Word16
conTcpServerPort TcpConnection
con
  }



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
showTcpConnectionText :: TcpConnection -> Text
showTcpConnectionText :: TcpConnection -> Text
showTcpConnectionText TcpConnection
con =
  IP -> Text
showIp (TcpConnection -> IP
conTcpClientIp TcpConnection
con) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word16 -> Text
forall a. Show a => a -> Text
tshow (TcpConnection -> Word16
conTcpClientPort TcpConnection
con) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IP -> Text
showIp (TcpConnection -> IP
conTcpServerIp TcpConnection
con) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word16 -> Text
forall a. Show a => a -> Text
tshow (TcpConnection -> Word16
conTcpServerPort TcpConnection
con)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (tcp.stream: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StreamIdTcp -> Text
forall a. StreamId a -> Text
showStream (TcpConnection -> StreamIdTcp
conTcpStreamId TcpConnection
con) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    showIp :: IP -> Text
showIp = IP -> Text
Net.IP.encode
    showStream :: StreamId a -> Text
showStream (StreamId Word32
a) = Word32 -> Text
forall a. Show a => a -> Text
tshow Word32
a