Time.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Network.QUIC.Types.Time (
    Milliseconds (..),
    Microseconds (..),
    milliToMicro,
    microToMilli,
    TimeMicrosecond,
    timeMicrosecond0,
    getTimeMicrosecond,
    getElapsedTimeMicrosecond,
    elapsedTimeMicrosecond,
    getTimeoutInMicrosecond,
    getPastTimeMicrosecond,
    getFutureTimeMicrosecond,
    addMicroseconds,
) where

import Data.UnixTime
import Foreign.C.Types (CTime (..))

import Network.QUIC.Imports

----------------------------------------------------------------

newtype Milliseconds = Milliseconds Int64 deriving (Eq, Ord, Num, Bits)
newtype Microseconds = Microseconds Int deriving (Eq, Ord, Num, Bits)

instance Show Milliseconds where
    show (Milliseconds n) = show n

instance Show Microseconds where
    show (Microseconds n) = show n

{-# INLINE milliToMicro #-}
milliToMicro :: Milliseconds -> Microseconds
milliToMicro (Milliseconds n) = Microseconds (fromIntegral n * 1000)

microToMilli :: Microseconds -> Milliseconds
microToMilli (Microseconds n) = Milliseconds (fromIntegral n `div` 1000)

----------------------------------------------------------------

type TimeMicrosecond = UnixTime

timeMicrosecond0 :: UnixTime
timeMicrosecond0 = UnixTime 0 0

----------------------------------------------------------------

getTimeMicrosecond :: IO TimeMicrosecond
getTimeMicrosecond = getUnixTime

----------------------------------------------------------------

getElapsedTimeMicrosecond :: TimeMicrosecond -> IO Microseconds
getElapsedTimeMicrosecond base = do
    c <- getTimeMicrosecond
    return $ elapsedTimeMicrosecond c base

elapsedTimeMicrosecond :: UnixTime -> UnixTime -> Microseconds
elapsedTimeMicrosecond c base = Microseconds elapsed
  where
    UnixDiffTime (CTime s) u = c `diffUnixTime` base
    elapsed = fromIntegral (s * 1000000 + fromIntegral u)

getTimeoutInMicrosecond :: TimeMicrosecond -> IO Microseconds
getTimeoutInMicrosecond tmout = do
    c <- getTimeMicrosecond
    let UnixDiffTime (CTime s) u = tmout `diffUnixTime` c
        timeout = fromIntegral s * 1000000 + fromIntegral u
    return $ Microseconds timeout

----------------------------------------------------------------

getPastTimeMicrosecond :: Microseconds -> IO TimeMicrosecond
getPastTimeMicrosecond (Microseconds us) = do
    let diff = microSecondsToUnixDiffTime $ negate us
    c <- getTimeMicrosecond
    let past = c `addUnixDiffTime` diff
    return past

getFutureTimeMicrosecond :: Microseconds -> IO TimeMicrosecond
getFutureTimeMicrosecond (Microseconds us) = do
    let diff = microSecondsToUnixDiffTime us
    c <- getTimeMicrosecond
    let future = c `addUnixDiffTime` diff
    return future

addMicroseconds :: TimeMicrosecond -> Microseconds -> TimeMicrosecond
addMicroseconds t (Microseconds n) = t `addUnixDiffTime` microSecondsToUnixDiffTime n