module Network.TLS.Measurement (
    Measurement (..),
    newMeasurement,
    addBytesReceived,
    addBytesSent,
    resetBytesCounters,
    incrementNbHandshakes,
) where

import Network.TLS.Imports

-- | record some data about this connection.
data Measurement = Measurement
    { Measurement -> Word32
nbHandshakes :: Word32
    -- ^ number of handshakes on this context
    , Measurement -> Word32
bytesReceived :: Word32
    -- ^ bytes received since last handshake
    , Measurement -> Word32
bytesSent :: Word32
    -- ^ bytes sent since last handshake
    }
    deriving (Int -> Measurement -> ShowS
[Measurement] -> ShowS
Measurement -> String
(Int -> Measurement -> ShowS)
-> (Measurement -> String)
-> ([Measurement] -> ShowS)
-> Show Measurement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Measurement -> ShowS
showsPrec :: Int -> Measurement -> ShowS
$cshow :: Measurement -> String
show :: Measurement -> String
$cshowList :: [Measurement] -> ShowS
showList :: [Measurement] -> ShowS
Show, Measurement -> Measurement -> Bool
(Measurement -> Measurement -> Bool)
-> (Measurement -> Measurement -> Bool) -> Eq Measurement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Measurement -> Measurement -> Bool
== :: Measurement -> Measurement -> Bool
$c/= :: Measurement -> Measurement -> Bool
/= :: Measurement -> Measurement -> Bool
Eq)

newMeasurement :: Measurement
newMeasurement :: Measurement
newMeasurement =
    Measurement
        { nbHandshakes :: Word32
nbHandshakes = Word32
0
        , bytesReceived :: Word32
bytesReceived = Word32
0
        , bytesSent :: Word32
bytesSent = Word32
0
        }

addBytesReceived :: Int -> Measurement -> Measurement
addBytesReceived :: Int -> Measurement -> Measurement
addBytesReceived Int
sz Measurement
measure =
    Measurement
measure{bytesReceived = bytesReceived measure + fromIntegral sz}

addBytesSent :: Int -> Measurement -> Measurement
addBytesSent :: Int -> Measurement -> Measurement
addBytesSent Int
sz Measurement
measure =
    Measurement
measure{bytesSent = bytesSent measure + fromIntegral sz}

resetBytesCounters :: Measurement -> Measurement
resetBytesCounters :: Measurement -> Measurement
resetBytesCounters Measurement
measure = Measurement
measure{bytesReceived = 0, bytesSent = 0}

incrementNbHandshakes :: Measurement -> Measurement
incrementNbHandshakes :: Measurement -> Measurement
incrementNbHandshakes Measurement
measure =
    Measurement
measure{nbHandshakes = nbHandshakes measure + 1}