List.hs

{-|

Module      : MptcpAnalyzer.Commands.List
Description : List (MP)TCP connections in a pcap
Maintainer  : matt

-}
{-# LANGUAGE PackageImports #-}

module MptcpAnalyzer.Commands.List (
    piListTcpOpts
  , piTcpSummaryOpts
  , piMptcpSummaryOpts
  , cmdListTcpConnections
  , cmdTcpSummary
  , cmdTcpSummarySharkd
  , cmdMptcpSummary
)
where

import MptcpAnalyzer.ArtificialFields
import MptcpAnalyzer.Cache
import MptcpAnalyzer.Commands.Definitions as CMD
import MptcpAnalyzer.Pcap
import MptcpAnalyzer.Stats
import MptcpAnalyzer.Stream
import MptcpAnalyzer.Types
import MptcpAnalyzer.Utils.Text
import Net.Mptcp
import Net.Mptcp.Stats
import Net.Tcp
import Net.Tcp.Stats
import Net.Tcp.Constants (TcpFlag(..))
import Tshark.Sharkd

import Control.Lens hiding (argument)
import Data.Either (fromRight)
import Data.List (intercalate)
import qualified Data.Map as Map
import Frames
import qualified Frames as F
import Frames.CSV
import qualified Frames.InCore as F
import Options.Applicative
import Polysemy (Embed, Member, Members, Sem)
import qualified Polysemy as P
import qualified Polysemy.Embed as P
import Polysemy.Log (Log)
import qualified Polysemy.Log as Log
import qualified Polysemy.State as P
import Polysemy.Trace as P
import Prelude hiding (log)

piListTcpOpts ::  ParserInfo CommandArgs
piListTcpOpts = info (
   ArgsListTcpConnections <$> parserList <**> helper)
  ( progDesc "List subflows of an MPTCP connection"
  )
  where
    parserList = switch (long "detailed" <> help "detail connections")

piTcpSummaryOpts :: ParserInfo CommandArgs
piTcpSummaryOpts = info (
   piTcpSummary <**> helper)
  ( progDesc "Detail a specific TCP connection"
    <> footer "Example: summary 0"
  )
  where
    piTcpSummary :: Parser CommandArgs
    piTcpSummary = ArgsTcpSummary <$> switch
              ( long "full"
            <> help "Print details for each subflow" )
          <*> argument readStreamId (
              metavar "STREAM_ID"
              <> help "Stream Id (tcp.stream)"
              -- TODO pass a default
              )



piMptcpSummaryOpts :: ParserInfo CommandArgs
piMptcpSummaryOpts = info (
   piMptcpSummary <**> helper)
  ( progDesc "Detail a specific TCP connection"
  <> footer "mptcp-summary 0"
  )
  where
    piMptcpSummary :: Parser CommandArgs
    piMptcpSummary = ArgsMptcpSummary <$> switch
              ( long "full"
            <> help "Print details for each subflow" )
          <*> argument readStreamId (
              metavar "STREAM_ID"
              <> help "Stream Id (mptcp.stream)"
              -- TODO pass a default
              )

{-| Show a list of all connections

@
8 tcp connection(s)
  tcp.stream 0: 10.0.0.1:33782 -> 10.0.0.2:05201
  tcp.stream 1: 10.0.0.1:33784 -> 10.0.0.2:05201
  tcp.stream 2: 10.0.0.1:54595 -> 11.0.0.2:05201
  tcp.stream 3: 10.0.0.1:57491 -> 11.0.0.2:05201
  tcp.stream 4: 11.0.0.1:59555 -> 11.0.0.2:05201
  tcp.stream 5: 11.0.0.1:50077 -> 11.0.0.2:05201
  tcp.stream 6: 11.0.0.1:35589 -> 10.0.0.2:05201
  tcp.stream 7: 11.0.0.1:50007 -> 10.0.0.2:05201
@
-}
cmdListTcpConnections ::
  (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
  => Bool -- ^ detailed
  -> Sem r RetCode
cmdListTcpConnections listDetailed = do
    -- TODO this part should be extracted so that
    state <- P.get
    let loadedPcap = view loadedFile state
    case loadedPcap of
      Nothing -> do
        trace "please load a pcap first"
        return CMD.Continue
      Just frame -> do
        let tcpStreams = getTcpStreams frame
        let streamIdList = if listDetailed then [] else tcpStreams
        -- log $ "Number of rows " ++ show (frameLength frame)
        P.trace $ "Number of TCP connections " ++ show (length tcpStreams)
        -- TODO use a trace there
        mapM_ (P.trace . describeConnection) streamIdList
        return CMD.Continue
        where
          describeConnection streamId =
            case buildTcpConnectionFromStreamId frame streamId of
              Left msg -> msg
              Right aframe -> showConnection (ffCon aframe)


{-| Display statistics for the connection:
throughput/goodput

detailed
-}
cmdTcpSummary :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
  => StreamId Tcp
  -> Bool
  -> Sem r RetCode
cmdTcpSummary streamId detailed = do
    state <- P.get
    let loadedPcap = view loadedFile state
    case loadedPcap of
      Nothing -> return $ CMD.Error "please load a pcap first"
      Just frame -> case buildTcpConnectionFromStreamId frame streamId of
        Left msg -> return $ CMD.Error msg
        Right aframe -> do
          -- let _tcpstreams = getTcpStreams frame
          P.trace $ showConnection (ffCon aframe)
          Log.info $ "Number of rows "  <> tshow (frameLength $ ffFrame aframe)
          if detailed
          then do
            res <- showStats aframe RoleServer
            P.trace res
            res2 <- showStats aframe RoleClient
            P.trace res2
          else
            pure ()
          return CMD.Continue

{-| Display statistics for the connection:
throughput/goodput

detailed
-}
cmdTcpSummarySharkd :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
  => FilePath
  -> StreamId Tcp
  -> Bool
  -> Sem r RetCode
cmdTcpSummarySharkd pcapPath streamId detailed = do
    P.embed $ loadFile pcapPath defaultSocketPath >> return CMD.Continue
    -- TODO then ask for the stats about that TCP flow
    --
    -- state <- P.get
    -- let loadedPcap = view loadedFile state
    -- case loadedPcap of
    --   Nothing -> return $ CMD.Error "please load a pcap first"
    --   Just frame -> case buildTcpConnectionFromStreamId frame streamId of
    --     Left msg -> return $ CMD.Error msg
    --     Right aframe -> do
    --       -- let _tcpstreams = getTcpStreams frame
    --       P.trace $ showConnection (ffCon aframe)
    --       Log.info $ "Number of rows "  <> tshow (frameLength $ ffFrame aframe)
    --       if detailed
    --       then do
    --         res <- showStats aframe RoleServer
    --         P.trace res
    --         res2 <- showStats aframe RoleClient
    --         P.trace res2
    --       else
    --         pure ()
    --       return CMD.Continue


-- | Show stats in both directions
showStats :: ( Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
  => FrameFiltered TcpConnection Packet
  -> ConnectionRole
  -> Sem r String
showStats aframe dest = let
    aframeWithDest = addTcpDestinationsToAFrame aframe
    tcpStats = getTcpStatsFromAFrame aframeWithDest dest

    destFrame = F.filterFrame (\x -> x ^. tcpDest == dest) (ffFrame aframeWithDest)

  in do
    P.embed $ writeDSV defaultParserOptions ("debug-" ++ show dest ++ ".csv") destFrame
    return $ showTcpStats tcpStats ++ "   (" ++ show (frameLength destFrame) ++ " packets)"


-- | summarize a few key characteristics like goodput/throughput
showTcpStats :: TcpUnidirectionalStats -> String
showTcpStats s =
                  "- transferred " ++ show (tusSndNext s - tusMinSeq s + 1 + tusReinjectedBytes s)  ++ " bytes "
                  ++ " over " ++ show (tusEndTime s - tusStartTime s) ++ "s: "
                  ++ " Throughput " ++ show (getTcpThroughput s) ++ "b/s"


{-
Returns something
mptcp stream 0 transferred 469.0 Bytes over 45.831181 sec(456.0 Bytes per second) towards Server.
tcpstream 0 transferred 460.0 Bytes out of 469.0 Bytes, accounting for 98.08%
tcpstream 2 transferred 9.0 Bytes out of 469.0 Bytes, accounting for 1.92%
tcpstream 4 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%
tcpstream 6 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%
-}
showMptcpStats :: MptcpUnidirectionalStats -> String
showMptcpStats s = unlines [
    " Mptcp stats towards " ++ show (musDirection s) ++ " :"
    , "- Duration " ++ show (getMptcpStatsDuration s)
    , "- Goodput " ++ show (getMptcpGoodput s)
    , "<TODO>\n"
    , "Applicative Bytes : " ++ show (musApplicativeBytes s)
    , "Subflow stats:"
    , intercalate "\n" (map showSubflowStats (Map.toList $ musSubflowStats s))
    ]
    where
      -- ++ show (tusStreamId)
      showSubflowStats (sf, sfStats) = let
          tcpStats = tssStats sfStats
          seqRange = getTcpSeqRange tcpStats
          totalApplicationBytes = musApplicativeBytes s
        in "stream " ++ show (conTcpStreamId (sfConn sf))
          ++ ": transferred " ++ show seqRange ++ " out of " ++ show totalApplicationBytes
          ++ " between "
          ++ show (tusStartTime tcpStats) ++ " end time: " ++ show (tusEndTime $ tssStats sfStats)
          ++ " , accouting for " ++ show (seqRange / fromIntegral totalApplicationBytes) ++ " %"

{-
Returns:
mptcp stream 0 transferred 308.0 Bytes over 45.658558 sec(308.0 Bytes per second) towards Client.
tcpstream 0 transferred 308.0 Bytes out of 308.0 Bytes, accounting for 100.00%
tcpstream 2 transferred 0.0 Bytes out of 308.0 Bytes, accounting for 0.00%
tcpstream 6 transferred 0.0 Bytes out of 308.0 Bytes, accounting for 0.00%
mptcp stream 0 transferred 469.0 Bytes over 45.831181 sec(456.0 Bytes per second) towards Server.
tcpstream 0 transferred 460.0 Bytes out of 469.0 Bytes, accounting for 98.08%
tcpstream 2 transferred 9.0 Bytes out of 469.0 Bytes, accounting for 1.92%
tcpstream 4 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%
tcpstream 6 transferred 0.0 Bytes out of 469.0 Bytes, accounting for 0.00%
-}
cmdMptcpSummary :: (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
  => StreamId Mptcp
  -> Bool
  -> Sem r RetCode
cmdMptcpSummary streamId detailed = do
  state <- P.get
  case view loadedFile state of
    Nothing -> trace ("please load a pcap first" :: String) >> return CMD.Continue
    Just frame -> case buildMptcpConnectionFromStreamId frame streamId of
      Left msg -> return $ CMD.Error msg
      Right aframe -> do

        let mptcpStatsClient = getMptcpStats aframe RoleClient
        let mptcpStatsServer = getMptcpStats aframe RoleServer

        P.trace $ showConnection (ffCon aframe)
        Log.debug $ "Number of rows " <> tshow (frameLength frame)
        if detailed
        then
          -- RoleServer
          P.trace $ showMptcpStats mptcpStatsClient
          -- trace $ showMptcpStats mptcpStatsServer
        else
          pure ()
        return CMD.Continue