PlotOWD.hs

{-
Module      : MptcpAnalyzer.Commands.PlotOwd
Description : Plot One way delays
Maintainer  : matt
-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module MptcpAnalyzer.Commands.PlotOWD (
  cmdPlotTcpOwd
  , cmdPlotMptcpOwd
  , plotParserOwd
  , piPlotTcpOwd
)
where

import MptcpAnalyzer.ArtificialFields
import MptcpAnalyzer.Cache
import MptcpAnalyzer.Commands.Definitions
import MptcpAnalyzer.Commands.Definitions as CMD
import MptcpAnalyzer.Debug
import MptcpAnalyzer.Loader
import MptcpAnalyzer.Merge
import MptcpAnalyzer.Pcap
import MptcpAnalyzer.Plots.Types
import MptcpAnalyzer.Stream
import MptcpAnalyzer.Types
import MptcpAnalyzer.Utils.Text
-- for retypeColumn
-- import MptcpAnalyzer.Frames.Utils
-- for fields
import Net.Mptcp
import Net.Tcp

import Frames
import qualified Frames as F
import Frames.CSV
import Options.Applicative
import Polysemy
import qualified Polysemy.Trace as P
import Prelude hiding (filter, log, lookup, repeat)

-- import Graphics.Rendering.Chart.Backend.Diagrams (defaultEnv, runBackendR)
-- import Graphics.Rendering.Chart.Easy

import Data.Word (Word16, Word32, Word64, Word8)
import Graphics.Rendering.Chart.Backend.Cairo
import Graphics.Rendering.Chart.Easy hiding (argument)

import Data.Vinyl.TypeLevel as V

import Data.Text (Text)
import qualified Data.Text as T
import qualified Pipes as P hiding (embed)
import qualified Pipes.Prelude as P
import Polysemy (Embed, Member, Members, Sem)
import qualified Polysemy as P
import Polysemy.State as P
import System.Exit
import System.Process hiding (runCommand)
-- import Data.Time.LocalTime
import Data.Foldable (toList)
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Set as Set
import Debug.Trace
import Distribution.Simple.Utils (TempFileOptions(..), withTempFileEx)
import Frames.ShowCSV (showCSV)
import GHC.TypeLits (Symbol)
import Polysemy.Log (Log)
import qualified Polysemy.Log as Log
import System.Directory (renameFile)
import System.IO (Handle)
import Tshark.Main (defaultTsharkPrefs)

-- data PlotTypes = PlotTcpAttribute {
--     pltAttrField :: Text
--     -- syndrop => drop syn packets
--     -- Drops first 3 packets of the dataframe assuming they are syn
--   }

-- Plot MPTCP subflow attributes over time

-- piPlotParserTcpAttr :: Parser PlotTypes
-- piPlotParserTcpAttr = PlotTcpAttribute <$> argument str
--       ( help "Choose an mptcp attribute to plot"
--       <> metavar "FIELD" )

-- |
-- @param
piPlotTcpOwd ::  ParserInfo ArgsPlots
piPlotTcpOwd = info (plotParserOwd False) (progDesc "Plot TCP owd")



-- TODO pass the list of accepted attributes (so that it works for TCP/MPTCP)
plotParserOwd ::
    -- [String]
    Bool -- ^ for mptcp yes or no
    ->
    Parser ArgsPlots
plotParserOwd _mptcpPlot = ArgsPlotOwdTcp <$>
      parserPcapMapping False
      -- this ends up being not optional !
      -- strArgument (
      --     metavar "PCAP1"
      --     <> help "File to analyze"
      -- )
      -- <*> strArgument (
      --     metavar "PCAP2"
      --     <> help "File to analyze"
      -- )
      -- -- auto readStreamId
      -- <*> argument auto (
      --     metavar "STREAM_ID1"
      --     <> help "Stream Id (tcp.stream)"
      -- )
      -- <*> argument auto (
      --     metavar "STREAM_ID2"
      --     <> help "Stream Id (tcp.stream)"
      -- )
      -- TODO validate as presented in https://github.com/pcapriotti/optparse-applicative/issues/75
      --validate :: (a -> Either String a) -> ReadM a -> ReadM a
      -- TODO ? if nothing prints both directions
      <*> optional (argument readConnectionRole (
          metavar "Destination"
        -- <> Options.Applicative.value RoleServer
        <> help ""
      ))
      -- <**> help
      -- <*> option auto (
      --     metavar "MPTCP"
      --   -- internal is stronger than --belive, hides from all descriptions
      --   <> internal
      --   <> Options.Applicative.value mptcpPlot
      --   <> help ""
      -- )

-- called PlotTcpAttribute in mptcpanalyzer
-- todo pass --filterSyn Args fields
-- TODO filter according to destination

-- destinations is an array of destination
-- cmdPlotTcpAttribute :: Members [Log String,  P.State MyState, Cache, Embed IO] m =>
--           FilePath -- ^ temporary file to save plot to
--           -> Handle
--           -> [ConnectionRole]
--           -> FrameFiltered Packet
--           -> Sem m RetCode
-- cmdPlotTcpAttribute tempPath _ destinations aFrame = do

-- -- inCore converts into a producer
--   -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)
--   -- embed $ writeCSV "debug.csv" frame2
--   embed $ toFile def tempPath $ do
--       layout_title .= "TCP Sequence number"
--       -- TODO generate for mptcp plot
--       flip mapM_ destinations plotAttr

--   return Continue
--   where
--     -- filter by dest
--     frame2 = addTcpDestinationsToAFrame aFrame
--     plotAttr dest =
--         plot (line ("TCP seq (" ++ show dest ++ ")") [ [ (d,v) | (d,v) <- zip timeData seqData ] ])
--         where
--           -- frameDest = ffTcpFrame tcpFrame
--           frameDest = frame2
--           -- frameDest = frame2
--           unidirectionalFrame = filterFrame (\x -> x ^. tcpDest == dest) (ffFrame frameDest)

--           seqData :: [Double]
--           seqData = map fromIntegral (toList $ view tcpSeq <$> unidirectionalFrame)
--           timeData = toList $ view relTime <$> unidirectionalFrame

-- AbsTime2
-- type AbsTime2 = "absTime2" :-> Text  -- :: (Symbol, *)

-- absTime2 is problematic
-- declareColumn "absTime2" ''Text
-- declareColumn "absTimeSnd" ''Double
-- type AbsTime2 = "absTime2" :-> Text  -- :: (Symbol, *)
-- expects (Symbol, Symbol, Type)
-- type AbsTimeRenameTest =   ("absTime" :: Symbol, "absTime2", Text)

-- type RetypeMatt = [
--   ("absTime", "absTime2", Text)
--   ]

cmdPlotTcpOwd :: (Members [Log, P.Trace, P.State MyState, Cache, Embed IO] m)
  => FilePath -- ^ temporary file to save plot to
  -> Handle
  -> [ConnectionRole]
  -- -> TcpConnection
  -> (PcapMapping Tcp)
  -- -> MergedFrame
  -- -> FrameFiltered Packet
  -- -> FrameFiltered (Record HostColsPrefixed)
  -> Sem m RetCode
cmdPlotTcpOwd tempPath _ destinations (PcapMapping pcap1 streamId1 pcap2 streamId2) = do
  Log.info "plotting TCP OWDs "
  -- look at https://hackage.haskell.org/package/vinyl-0.13.0/docs/Data-Vinyl-Functor.html#t::.
  -- could use showRow as well
  -- P.embed $ dumpRec $ head justRecs
  -- P.trace $ "There are " ++ show (length justRecs) ++ " valid merged rows (out of " ++ show (length mergedRes) ++ " merged rows)"
  -- P.trace $ (concat . showFields) (head justRecs)
  -- P.embed $ putStrLn $ "retyped column" ++ (concat . showFields) (newCol)
  Log.info $ "plotting owd for tcp.stream " <> tshow streamId1 <> " and " <> tshow streamId2
  eframe1 <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcap1 streamId1
  eframe2 <- buildAFrameFromStreamIdTcp defaultTsharkPrefs pcap2 streamId2

  res <- case (eframe1, eframe2 ) of
    (Left err, _) -> return $ CMD.Error err
    (_, Left err) -> return $ CMD.Error err
    (Right (FrameTcp con frame1), Right aframe2) -> do
        -- TODO addTcpDest -> convert then
        let
          dest = genTcpDestFrame frame1 con

          convertCols' :: Record '[TcpDest] -> Record '[SenderDest]
          convertCols' = F.withNames . F.stripNames
          sendFrame = fmap convertCols' dest

        mergedRes <- mergeTcpConnectionsFromKnownStreams (FrameTcp con (F.zipFrames sendFrame frame1)) aframe2
        -- let mbRecs = map recMaybe mergedRes
        -- let justRecs = catMaybes mbRecs
        let sndRcvFrame = convertToSenderReceiver mergedRes

        embed $ toFile def tempPath $ do
            layout_title .= "TCP One-way delays"
            -- TODO generate for mptcp plot
            -- for each subflow, plot the MptcpDest
            mapM_ (plotAttr sndRcvFrame)  [ x | x <- destinations]


        -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)
        -- embed $ writeDSV defaultParserOptions "tcp-owd-debug.csv" (toFrame justRecs)
        embed $ writeDSV defaultParserOptions "tcp-owd-converted.csv" sndRcvFrame
        -- P.embed $ putStrLn $ "OWDs:" ++ show owd
        -- so for now we assume an innerJoin (but fix it later)
        return Continue
        where
          -- mbRecs = map recMaybe mergedRes
          -- justRecs = catMaybes mbRecs
          dumpRec x = print x
          -- add dest to the whole frame
          -- frameDest = addMptcpDest (ffFrame aFrame) (ffCon aFrame)
          plotAttr sndRcvFrame dest =
            plot (line lineLabel [ [ (d,v) | (d,v) <- zip timeData owd ] ])

              where
                lineLabel = "TCP seq " ++ showConnection con ++ " (towards " ++ showConnectionRole dest ++ ")"
                unidirectionalFrame = filterFrame (\x -> x ^. senderDest == dest) sndRcvFrame

                timeData = traceShow ("timedata length=" ++ show (frameLength unidirectionalFrame)) toList $ view sndAbsTime <$> unidirectionalFrame

                getOwd x = (x ^. rcvAbsTime) - (x ^. sndAbsTime)

                owd :: [Double]
                owd = let res = map getOwd (toList unidirectionalFrame) in traceShow res res
  return res




cmdPlotMptcpOwd :: (
  Members [Log, P.Trace, P.State MyState, Cache, Embed IO] m)
  => FilePath -- ^ temporary file to save plot to
  -> Handle
  -> [ConnectionRole]
  -> TcpConnection
  -> MergedFrame
  -> Sem m RetCode
cmdPlotMptcpOwd tempPath _ destinations con mergedRes = do
  Log.info "plotting MPTCP OWDs "
  -- look at https://hackage.haskell.org/package/vinyl-0.13.0/docs/Data-Vinyl-Functor.html#t::.
  -- could use showRow as well
  -- P.embed $ dumpRec $ head justRecs
  -- P.trace $ "There are " ++ show (length justRecs) ++ " valid merged rows (out of " ++ show (length mergedRes) ++ " merged rows)"
  -- P.trace $ (concat . showFields) (head justRecs)
  -- P.embed $ putStrLn $ "retyped column" ++ (concat . showFields) (newCol)
  embed $ toFile def tempPath $ do
      layout_title .= "MPTCP One-way delays"
      -- TODO generate for mptcp plot
      -- for each subflow, plot the MptcpDest
      mapM_ plotAttr  [ x | x <- destinations]


  -- embed $ putStrLn $ showConnection (ffTcpCon tcpFrame)
  -- embed $ writeDSV defaultParserOptions "mptcp-owd-debug.csv" (toFrame justRecs)
  embed $ writeDSV defaultParserOptions "mptcp-owd-converted.csv" sndRcvFrame
  -- P.embed $ putStrLn $ "OWDs:" ++ show owd
  -- so for now we assume an innerJoin (but fix it later)

  return Continue
  where
    -- mbRecs = map recMaybe mergedRes
    -- justRecs = catMaybes mbRecs
    sndRcvFrame = convertToSenderReceiver mergedRes
    dumpRec x = print x
    -- add dest to the whole frame
    -- frameDest = addMptcpDest (ffFrame aFrame) (ffCon aFrame)
    plotAttr dest =
      plot (line lineLabel [ [ (d,v) | (d,v) <- zip timeData owd ] ])

        where
          lineLabel = "Subflow DSNs " ++ showConnection con ++ " (towards " ++ showConnectionRole dest ++ ")"
          unidirectionalFrame = filterFrame (\x -> x ^. senderDest == dest) sndRcvFrame

          timeData = traceShow ("timedata length=" ++ show (frameLength unidirectionalFrame)) toList $ view sndAbsTime <$> unidirectionalFrame

          getOwd x = (x ^. rcvAbsTime) - (x ^. sndAbsTime)

          owd :: [Double]
          owd = let res = map getOwd (toList unidirectionalFrame) in traceShow res res