Stats.hs

{-|
Module      : Net.Mptcp.Stats
Description : Compute basic MPTCP statistics
Maintainer  : matt
License     : GPL-3
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
module Net.Mptcp.Stats (
    TcpSubflowUnidirectionalStats(..)
  , MptcpUnidirectionalStats(..)
  , getMptcpStats
  , getMptcpGoodput
  , getMptcpStatsDuration
  , getSubflowStats
  , showMptcpUnidirectionalStats
)
where

import MptcpAnalyzer.ArtificialFields
import MptcpAnalyzer.Pcap
import MptcpAnalyzer.Stream
import MptcpAnalyzer.Units

import qualified Data.Map as Map
import Net.Mptcp.Connection
import Net.Tcp
import Net.Tcp.Stats

import Data.Either (fromRight)
import Data.Text (Text)
import qualified Data.Text as T

import Control.Lens
import Control.Lens hiding (argument)
import Data.List (sort, sortBy, sortOn)
import Data.Map (Map, fromList, mapKeys)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromJust)
import Data.Set (toList)
import Data.Vinyl
import Data.Word (Word32, Word64)
import qualified Data.Foldable as F
import qualified Frames as F
import qualified Frames.InCore as F
import MptcpAnalyzer.Types
import MptcpAnalyzer.Utils.Text
import Control.Exception (assert)
-- import MptcpAnalyzer.Pcap (addTcpDestinationsToAFrame)

-- | Useful to show DSN
data TcpSubflowUnidirectionalStats = TcpSubflowUnidirectionalStats {
  -- tssStats :: TcpUnidirectionalStats
    tssStats  :: TcpUnidirectionalStats
  , tssMinDsn :: Word64
  , tssMaxDsn :: Word64
  } deriving Show
-- newtype TcpSubflowUnidirectionalStats = TcpSubflowUnidirectionalStats

instance Semigroup TcpSubflowUnidirectionalStats where
   -- (<>) :: a -> a -> a
   -- TODO this does nothing
   (<>) a b = a

instance Monoid TcpSubflowUnidirectionalStats where
  mempty = TcpSubflowUnidirectionalStats {
      tssStats = mempty 
    , tssMinDsn = 0
    , tssMaxDsn = 0
    }


-- | Holds MPTCP application level statistics for one direction
data MptcpUnidirectionalStats = MptcpUnidirectionalStats {
    musDirection        :: ConnectionRole
  , musApplicativeBytes :: Word64
  , musMaxDsn           :: Word64
  , musMinDsn           :: Word64
  , musSubflowStats     :: Map MptcpSubflow TcpSubflowUnidirectionalStats
  } deriving Show

instance Monoid MptcpUnidirectionalStats where
  mempty = MptcpUnidirectionalStats RoleServer 0 0 0 mempty

instance Semigroup MptcpUnidirectionalStats where
  -- TODO fix
  (<>) s1 s2 = assert (musDirection s1 == musDirection s2)
      s1 {
            musMaxDsn = max (musMaxDsn s1) (musMaxDsn s2)
          , musMinDsn = min (musMinDsn s1) (musMinDsn s2)
          -- , musApplicativeBytes = musApplicativeBytes s1 ++ musApplicativeBytes s2
        }


    -- ''' application data = goodput = useful bytes '''
    -- ''' max(dsn)- min(dsn) - 1'''
    -- mptcp_application_bytes: Byte

    -- '''Total duration of the mptcp connection'''
    -- mptcp_duration: datetime.timedelta
    -- subflow_stats: List[TcpUnidirectionalStats]

    -- @property
    -- def mptcp_throughput_bytes(self) -> Byte:
    --     ''' sum of total bytes transferred '''
    --     return Byte(sum(map(lambda x: x.throughput_bytes, self.subflow_stats)))

-- |Goodput is defined as the amount of effective data exchanged over time
-- I.e., (maxDsn - minDsn) / (Mptcp communication Duration)
getMptcpGoodput :: MptcpUnidirectionalStats -> Throughput
getMptcpGoodput s = Throughput (Bytes $ musApplicativeBytes s) ((getMptcpStatsDuration s) ^. _1)

-- fromIntegral

-- | return max - min across subflows
getMptcpStatsDuration :: MptcpUnidirectionalStats -> (Duration, Timestamp, Timestamp)
getMptcpStatsDuration s = (diffTime end start, start, end)
  where
    start = Timestamp $ head $ sort starts
    end = Timestamp $ last $ sort ends
    -- min of
    -- TODO get min
    starts = map (tusStartTime . tssStats) (Map.elems $ musSubflowStats s)
    -- take the maximum
    ends = map (tusEndTime . tssStats) (Map.elems $ musSubflowStats s)


-- | TcpSubflowUnidirectionalStats
getSubflowStats ::
  (TcpSeq F.∈ rs, F.RecVec rs, RelTime F.∈ rs, TcpLen F.∈ rs
  , PacketId F.∈ rs
    , IpSource ∈ rs, IpDest ∈ rs, TcpSrcPort ∈ rs, TcpDestPort ∈ rs, TcpStream ∈ rs
  -- , TcpDest F.∈ rs
  )
  => FrameFiltered MptcpSubflow (F.Record rs) -> ConnectionRole -> TcpSubflowUnidirectionalStats
getSubflowStats aframe role = TcpSubflowUnidirectionalStats {
      tssStats = getTcpStatsFromAFrame (addTcpDestinationsToAFrame aframe') role
      , tssMinDsn = 0
      , tssMaxDsn = 0
    }
    where
      aframe' = FrameTcp (sfConn $ ffCon aframe) (ffFrame aframe)


-- mptcp_compute_throughput est bourrin il calcule tout d'un coup, je veux avoir une version qui marche iterativement
-- | Generates Stats for one direction only
getMptcpStats ::
  (
   -- TcpDest F.∈ rs
  MptcpDsn F.∈ rs, TcpSeq F.∈ rs, IpDest F.∈ rs, IpSource F.∈ rs
  , TcpLen F.∈ rs
  , PacketId F.∈ rs
  , TcpDestPort F.∈ rs, MptcpRecvToken F.∈ rs
  , TcpFlags F.∈ rs, TcpSrcPort F.∈ rs, TcpStream F.∈ rs, RelTime F.∈ rs
  , rs F.⊆ HostCols
  , F.RecVec rs
  )
  => FrameFiltered MptcpConnection (F.Record rs)
  -> ConnectionRole
  -> MptcpUnidirectionalStats
getMptcpStats (FrameTcp mptcpConn frame) dest =
  MptcpUnidirectionalStats {
      musDirection = dest
    , musApplicativeBytes = getSeqRange maxDsn minDsn
    , musMaxDsn = maxDsn
    , musMinDsn = minDsn
    -- we need the stream id / FrameFiltered MptcpSubflow (Record rs)
    , musSubflowStats = Map.fromList $ map (\sf -> (sf, getStats dest sf))  (toList $ _mpconSubflows mptcpConn)
  }
  where
    -- buildTcpConnectionFromStreamId :: SomeFrame -> StreamId Tcp -> Either String (FrameFiltered TcpConnection Packet)
    -- traverse a set
    getStats role sf = let
        sfFrame = fromRight (error "could not build sfFrame") (buildSubflowFromTcpStreamId frame (conTcpStreamId $ sfConn sf))
        -- sfFrame' = addTcpDestinationsToAFrame sfFrame
      in
        getSubflowStats sfFrame role

    -- frame = addTcpDestToFrame $ ffFrame aframe
    -- these return Maybes
    -- minSeq = minimum (F.toList $ view tcpSeq <$> frame)
    -- maxSeq = maximum $ F.toList $ view tcpSeq <$> frame

    maxTime = maximum $ F.toList $ view relTime <$> frame
    minTime = minimum $ F.toList $ view relTime <$> frame

    -- dsn_range, dsn_max, dsn_min = transmitted_seq_range(df, "dsn")
    -- mbRecs = map recMaybe mergedRes
    -- justRecs = catMaybes mbRecs
  -- in
    -- (toFrame justRecs, [])

    dsns = catMaybes $ F.toList $ view mptcpDsn <$> frame

    -- mergedPcapToFrame
    maxDsn, minDsn :: Word64
    maxDsn = maximum dsns

    minDsn = minimum dsns

showMptcpUnidirectionalStats :: MptcpUnidirectionalStats -> Text
showMptcpUnidirectionalStats stats = T.unlines [
  "Max/min dsn: " <> tshow (musMinDsn stats) <> "/" <> tshow (musMaxDsn stats) <> " towards " <> tshow (musDirection stats)
  ]