Reinjections.hs

{-|

Module      : MptcpAnalyzer.Commands.Reinjections
Description : Command to analyze reinjections
Maintainer  : matt


-}
{-# LANGUAGE PackageImports #-}
module MptcpAnalyzer.Commands.Reinjections (

  piListReinjections
  , piQualifyReinjections
  , qualifyReinjections
  , cmdListReinjections
  , cmdQualifyReinjections
)
where

import MptcpAnalyzer.ArtificialFields
import MptcpAnalyzer.Cache
import MptcpAnalyzer.Commands.Definitions as CMD
import MptcpAnalyzer.Commands.List as CMD
import MptcpAnalyzer.Loader
import MptcpAnalyzer.Merge
import MptcpAnalyzer.Pcap
import MptcpAnalyzer.Stream
import MptcpAnalyzer.Types
import Net.Mptcp

import Control.Lens ((^.))
import Control.Lens hiding (argument)
import Data.Either (lefts, rights)
import Data.Foldable (toList)
import qualified Data.Foldable as F
import Data.Function (on)
import Data.List (intercalate, intersperse, sortBy, sortOn)
import Data.Maybe
import Frames
import Frames.CSV
import Frames.Rec
import Options.Applicative
import qualified Pipes
import qualified Pipes.Prelude as Pipes
import Polysemy (Embed, Member, Members, Sem)
import qualified Polysemy as P
import Polysemy.Log (Log)
import qualified Polysemy.Log as Log
import Polysemy.State as P
import Polysemy.Trace as P
import Prelude hiding (log)

import Control.Monad
import qualified Debug.Trace as D
import Tshark.Main (defaultTsharkPrefs)

piListReinjections :: ParserInfo CommandArgs
piListReinjections = info (
    parserListReinjections
    <**> helper)
  ( progDesc "List MPTCP reinjections"
  )
  where
    -- parserListReinjections :: Parser CommandArgs
    parserListReinjections =
          ArgsListReinjections <$>
          -- strArgument (
          --     metavar "PCAP1"
          --     <> help "File to analyze"
          -- )
          -- <*>
          argument readStreamId (
              metavar "TCP_STREAM"
              <> help "stream id to analyze"
          )

piQualifyReinjections :: ParserInfo CommandArgs
piQualifyReinjections = info (
    parserQualifyReinjections <**> helper)
  ( progDesc "Qualifies MPTCP reinjections"
  <> footer "analyze examples/client_2_redundant.pcapng 0 examples/server_2_redundant.pcapng 0"
  )


parserQualifyReinjections :: Parser CommandArgs
parserQualifyReinjections =
      ArgsQualifyReinjections
      <$> parserPcapMapping False
      <*> switch (
          long "verbose"
          <> help "Verbose or not"
      )

cmdListReinjections :: (Members '[Log, P.Trace, P.State MyState, Cache, Embed IO] r)
    => StreamId Mptcp
    -> Sem r RetCode
cmdListReinjections streamId = do
  state <- P.get
  let loadedPcap = view loadedFile state
  case loadedPcap of
    Nothing -> do
      trace "please load a pcap first"
      return CMD.Continue
    Just (frame :: FrameRec HostCols) -> do
      let
        reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. reinjectionOf) frame
      -- log $ "Number of rows " ++ show (frameLength frame)
        outputs = fmap showReinjections reinjectedPacketsFrame
      -- P.embed $ putStrLn $ "Number of MPTCP connections " ++ show (length mptcpStreams)
      -- P.embed $ putStrLn $ show mptcpStreams
      P.trace $ intercalate "\n" (toList outputs)
      return CMD.Continue
      where
        -- packetid=757 (tcp.stream 1) is a reinjection of 1 packet(s):
        -- - packet 256 (tcp.stream 7)
        showReinjections row = "packetid=" ++ show (row ^. packetId) ++ " (tcp.stream " ++ show (row ^. tcpStream) ++ ")\n"
            -- TODO map over the list
            ++ intercalate "\n" ( map showReinjection (fromJust $ row ^. reinjectionOf))

        showReinjection reinjection = case toList $ filterFrame (\x -> x ^. packetId == reinjection) (frame) of
          [] -> error "did not find original packet"
          rows -> "- Reinjection of " ++ show reinjection ++ "(tcp.stream " ++ show ( (head rows)  ^. tcpStream) ++ ")"

-- Analyzes row of reinject packets
-- Compares arrival time of the first send of a segment with the
analyzeReinjection :: FrameRec SenderReceiverCols -> Record SenderReceiverCols -> Double
analyzeReinjection mergedFrame row =
  let
    -- a list of packetIds
    reinjectOf = fromJust (rgetField @SndReinjectionOf row)
    initialPktId = D.traceShowId $ head reinjectOf

    -- it is a frame

    originalPkt :: Record SenderReceiverCols
    originalPkt = let
          originalFrame = filterFrame (\x -> x ^. sndPacketId == initialPktId) mergedFrame
      in case frameLength originalFrame of
      0 -> error "empty frame"
      _ -> frameRow originalFrame 0

    origArrival, reinjArrival :: Double
    origArrival = rgetField @RcvRelTime originalPkt
    reinjArrival = rgetField @RcvRelTime originalPkt
    reinjPktId = row ^. sndPacketId

    delta = reinjArrival - origArrival
  in
    delta


{- Tries to distinguish between useful and useless reinjections
  Also tries to evalute the usefulness by providing a delta showing how much time
  the reinjection made the connection win or lose
-}
cmdQualifyReinjections ::
  Members '[
    Log
    , P.State MyState
    , Cache
    , P.Trace
    , Embed IO
    ] r
  => PcapMapping Mptcp
  -> [ConnectionRole]
  -> Bool
  -> Sem r RetCode
cmdQualifyReinjections (PcapMapping pcap1 streamId1 pcap2 streamId2) destinations verbose = do
  eframe1 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap1 streamId1
  eframe2 <- buildAFrameFromStreamIdMptcp defaultTsharkPrefs pcap2 streamId2
  res <- case (eframe1, eframe2 ) of
    (Right aframe1, Right aframe2) -> do

          mergedRes <- mergeMptcpConnectionsFromKnownStreams aframe1 aframe2
          let
            -- mergedRes = mergeMptcpConnectionsFromKnownStreams' aframe1 aframe2
            reinjectedPacketsHost1 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe1)
            reinjectedPacketsHost2 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe2)

            -- mbRecs = map recMaybe mergedRes
            -- packets that could be mapped in both pcaps
            -- justRecs = catMaybes mbRecs
            myFrame = convertToSenderReceiver mergedRes

            reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. sndReinjectionOf) myFrame

            -- loop over these reinjectpackets
            -- assume both were mapped

          -- Log.info $ "Result of the analysis; reinjections:"
            -- <> tshow (showReinjects justRecs)
          -- Log.debug $ "reinjectionsOf in host1 frame " <> tshow $ showFrame myFrame
          -- Log.debug $ "showing merged res" <> tshow (showMergedRes $ take 3 mergedRes)
          -- P.embed $ writeMergedPcap ("mergedRes-"  ++ ".csv") mergedRes
          trace $ "Size after conversion to sender/receiver " ++ show (frameLength myFrame)
                  ++ "( " ++ show (length mergedRes) ++ ")"
          -- trace $ "Number of reinjected packets: " ++ show (frameLength reinjectedPacketsFrame)

          -- trace $ "Merged mptcp connection\nFrame size: " ++ show (frameLength reinjectedPacketsFrame)
                  -- ++ "\n" ++ showFrame "," reinjectedPacketsFrame
          forM_ destinations $ \x -> do
            qualifyReinjections myFrame (assignRoles aframe1 aframe2) x

          -- qualifyReinjections tempPath handle (getDests dest) (ffCon aframe1) mergedRes
          return CMD.Continue
    (Left err, _) -> return $ CMD.Error err
    (_, Left err) -> return $ CMD.Error err


  return CMD.Continue
    -- mergedPcap
    -- reinjectedPackets = filterFrame (sndReinjectionOf) (toFrame justRecs)

-- buildTcpConnectionFromSndRecord :: (
--   SndIpSource ∈ rs, SndIpDest ∈ rs, SndTcpSrcPort ∈ rs, SndTcpDestPort ∈ rs, SndTcpStream ∈ rs
--     -- rs ⊆ HostCols
--   )
--   => Record rs -> TcpConnection
-- buildTcpConnectionFromRecord r =
--   TcpConnection {
--     conTcpClientIp = r ^. sndIpSource
--     , conTcpServerIp = r ^. sndIpDest
--     , conTcpClientPort = r ^. sndTcpSrcPort
--     , conTcpServerPort = r ^. sndTcpDestPort
--     , conTcpStreamId = r ^. sndTcpStream
--   }


-- buildConnectionFromSndPacket :: Record SenderReceiverCols -> TcpConnection
-- buildConnectionFromSndPacket row ->


-- | Returns (Client,Server)
-- kinbda hackish
assignRoles :: FrameFiltered MptcpConnection Packet -> FrameFiltered MptcpConnection Packet
  -> (FrameFiltered MptcpConnection Packet , FrameFiltered MptcpConnection Packet)
assignRoles aframe1 aframe2 =
  if delta > 0 then
    (aframe1, aframe2)
  else
    (aframe2, aframe1)
  where
    -- assume non empty
    firstRow1 = frameRow (ffFrame aframe1) 0
    firstRow2 = frameRow (ffFrame aframe2) 0

    delta :: Double
    delta = (firstRow2 ^. absTime) - (firstRow1 ^. absTime)

    -- selectDest :: ConnectionRole -> FrameRec MergedHostCols
    -- selectDest dest = (filterFrame (\x -> x ^. senderDest == dest) jframe)


-- TODO there should be a classification on a per mptcp basis
-- Here we should be able to tell who is the sender
qualifyReinjections :: Members '[
    Log, P.State MyState
    , Cache
    , P.Trace
    , Embed IO
    ] r
    => FrameRec SenderReceiverCols
    -- (Client, server) pcaps
    -> (FrameFiltered MptcpConnection Packet,FrameFiltered MptcpConnection Packet)
    -> ConnectionRole
    -> Sem r ()
qualifyReinjections frame (aframeH1, aframeH2) dest = do
    let
      -- "dest"frame
      dstFrame = filterFrame (\x -> x ^. senderDest == dest) frame
      -- mergedRes = mergeMptcpConnectionsFromKnownStreams' aframe1 aframe2
      -- reinjectedPacketsHost1 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe1)
      -- reinjectedPacketsHost2 = filterFrame (\x -> isJust $ x ^. reinjectionOf) (ffFrame aframe2)
      reinjectedPacketsFrame = filterFrame (\x -> isJust $ x ^. sndReinjectionOf) dstFrame
      reinjects = fmap (analyzeReinjection frame) reinjectedPacketsFrame

    trace $ "Qualify reinjections for dests " ++ show dest
    P.embed $ writeDSV defaultParserOptions ("sndrcv-merged-" ++ show dest  ++ ".csv") dstFrame
    trace $ "Number of reinjected packets: " ++ show (frameLength reinjectedPacketsFrame)
    -- trace $ "Result of the analysis; reinjections:" ++ showReinjects reinjects
    forM_ reinjectedPacketsFrame $ \row -> do
      let
        reinjectOf = fromJust (rgetField @SndReinjectionOf row)
        hostType = rgetField @SenderHost row
        senderDestVal = rgetField @SenderDest row

        -- originalFrame = if senderDest == RoleClient then (ffFrame aframeH2) else (ffFrame aframeH1)
        originalFrame = frame

        -- should be only one
        originalPackets = filterFrame (\x -> x ^. sndPacketId == initialPktId) originalFrame

        -- ((frameRow originalPacket 0) ^. senderHost)
        hostBool = if frameLength originalPackets > 0 then show hostType else "unknown"

        -- TODO we want to find
        -- buildTcpConnectionFromSndRecord

        initialPktId = D.traceShowId $ head reinjectOf
        -- initialPktId = D.traceShowId $ head reinjectOf
      -- of packet id " ++ show initialPktId
      -- from host" ++ show hostType
      trace $ show (row ^. sndPacketId) ++ " is a reinjection of packet id " ++ show initialPktId
      trace $ "number of original packets " ++ show (frameLength originalPackets) ++ " Host " ++ show senderDestVal
      trace $ describeReinjection row originalPackets
      -- TODO check if pktId is available

    where
        showReinjects frame2 =
          -- unlines (intercalate sep (columnHeaders (Proxy :: Proxy (Record rs))) : rows)
          intercalate "," rows
          where
            rows = Pipes.toList (F.mapM_ (Pipes.yield . show ) frame2)

        describeReinjection reinjectedPacket originalPackets = case frameLength originalPackets of
          0 -> "No original packets found FISHY ?!"
          _otherwise -> let
                originalPacket = frameRow originalPackets 0
                reinjArrivalTime = reinjectedPacket ^. rcvAbsTime
                originalArrivalTime = originalPacket ^. rcvAbsTime
                reinj_delta = reinjArrivalTime - originalArrivalTime

            in
            if reinj_delta < 0 then
                "Efficient reinjection: latency gain: " ++ show reinj_delta

            else
              "Redundant reinjection" ++ show reinj_delta
              --

            --     # print("GOT A failed reinjection")
            --     df_all.loc[df_all[_sender("packetid")] == reinjection.packetid, "redundant"] = True
            --     #TODO set reinj_delta for reinjection.packetid
            -- else:
            --     # print("GOT a successful reinjection")
            --     pass