{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards            #-}

module Network.NTP.Client.Packet
    ( NtpPacket (..)
    , ntpPacketSize
    , mkNtpPacket
    , NtpOffset (..)
    , getCurrentTime
    , clockOffsetPure
    , clockOffset
    , realMcsToNtp
    , ntpToRealMcs
    , Microsecond (..)
    ) where


import           Control.Monad (replicateM_)
import           Data.Binary (Binary (..))
import           Data.Binary.Get (getInt8, getWord32be, getWord8, skip)
import           Data.Binary.Put (putInt8, putWord32be, putWord8)
import           Data.Int (Int8)
import           Data.Time.Clock.POSIX (getPOSIXTime)
import           Data.Word (Word32, Word8)

newtype Microsecond = Microsecond Integer
  deriving (Int -> Microsecond
Microsecond -> Int
Microsecond -> [Microsecond]
Microsecond -> Microsecond
Microsecond -> Microsecond -> [Microsecond]
Microsecond -> Microsecond -> Microsecond -> [Microsecond]
(Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Int -> Microsecond)
-> (Microsecond -> Int)
-> (Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> Microsecond -> [Microsecond])
-> Enum Microsecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Microsecond -> Microsecond -> Microsecond -> [Microsecond]
$cenumFromThenTo :: Microsecond -> Microsecond -> Microsecond -> [Microsecond]
enumFromTo :: Microsecond -> Microsecond -> [Microsecond]
$cenumFromTo :: Microsecond -> Microsecond -> [Microsecond]
enumFromThen :: Microsecond -> Microsecond -> [Microsecond]
$cenumFromThen :: Microsecond -> Microsecond -> [Microsecond]
enumFrom :: Microsecond -> [Microsecond]
$cenumFrom :: Microsecond -> [Microsecond]
fromEnum :: Microsecond -> Int
$cfromEnum :: Microsecond -> Int
toEnum :: Int -> Microsecond
$ctoEnum :: Int -> Microsecond
pred :: Microsecond -> Microsecond
$cpred :: Microsecond -> Microsecond
succ :: Microsecond -> Microsecond
$csucc :: Microsecond -> Microsecond
Enum, Microsecond -> Microsecond -> Bool
(Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool) -> Eq Microsecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Microsecond -> Microsecond -> Bool
$c/= :: Microsecond -> Microsecond -> Bool
== :: Microsecond -> Microsecond -> Bool
$c== :: Microsecond -> Microsecond -> Bool
Eq, Integer -> Microsecond
Microsecond -> Microsecond
Microsecond -> Microsecond -> Microsecond
(Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Integer -> Microsecond)
-> Num Microsecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Microsecond
$cfromInteger :: Integer -> Microsecond
signum :: Microsecond -> Microsecond
$csignum :: Microsecond -> Microsecond
abs :: Microsecond -> Microsecond
$cabs :: Microsecond -> Microsecond
negate :: Microsecond -> Microsecond
$cnegate :: Microsecond -> Microsecond
* :: Microsecond -> Microsecond -> Microsecond
$c* :: Microsecond -> Microsecond -> Microsecond
- :: Microsecond -> Microsecond -> Microsecond
$c- :: Microsecond -> Microsecond -> Microsecond
+ :: Microsecond -> Microsecond -> Microsecond
$c+ :: Microsecond -> Microsecond -> Microsecond
Num, Eq Microsecond
Eq Microsecond
-> (Microsecond -> Microsecond -> Ordering)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> Ord Microsecond
Microsecond -> Microsecond -> Bool
Microsecond -> Microsecond -> Ordering
Microsecond -> Microsecond -> Microsecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Microsecond -> Microsecond -> Microsecond
$cmin :: Microsecond -> Microsecond -> Microsecond
max :: Microsecond -> Microsecond -> Microsecond
$cmax :: Microsecond -> Microsecond -> Microsecond
>= :: Microsecond -> Microsecond -> Bool
$c>= :: Microsecond -> Microsecond -> Bool
> :: Microsecond -> Microsecond -> Bool
$c> :: Microsecond -> Microsecond -> Bool
<= :: Microsecond -> Microsecond -> Bool
$c<= :: Microsecond -> Microsecond -> Bool
< :: Microsecond -> Microsecond -> Bool
$c< :: Microsecond -> Microsecond -> Bool
compare :: Microsecond -> Microsecond -> Ordering
$ccompare :: Microsecond -> Microsecond -> Ordering
$cp1Ord :: Eq Microsecond
Ord, Num Microsecond
Ord Microsecond
Num Microsecond
-> Ord Microsecond -> (Microsecond -> Rational) -> Real Microsecond
Microsecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Microsecond -> Rational
$ctoRational :: Microsecond -> Rational
$cp2Real :: Ord Microsecond
$cp1Real :: Num Microsecond
Real, Int -> Microsecond -> ShowS
[Microsecond] -> ShowS
Microsecond -> String
(Int -> Microsecond -> ShowS)
-> (Microsecond -> String)
-> ([Microsecond] -> ShowS)
-> Show Microsecond
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Microsecond] -> ShowS
$cshowList :: [Microsecond] -> ShowS
show :: Microsecond -> String
$cshow :: Microsecond -> String
showsPrec :: Int -> Microsecond -> ShowS
$cshowsPrec :: Int -> Microsecond -> ShowS
Show)

-- The derived instance is using `toInteger :: Integer -> Integer` which gives
-- a warning (`-Widentities`)
instance Integral Microsecond where
  toInteger :: Microsecond -> Integer
toInteger (Microsecond Integer
a) = Integer
a
  (Microsecond Integer
a) quotRem :: Microsecond -> Microsecond -> (Microsecond, Microsecond)
`quotRem` (Microsecond Integer
b) =
    case Integer
a Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
b of
      (Integer
x, Integer
r) -> (Integer -> Microsecond
Microsecond Integer
x, Integer -> Microsecond
Microsecond Integer
r)

data NtpPacket = NtpPacket
    { NtpPacket -> Word8
ntpParams       :: Word8        -- ^ some magic parameters
    , NtpPacket -> Int8
ntpPoll         :: Int8         -- ^ poll delay between requests
    , NtpPacket -> Microsecond
ntpOriginTime   :: Microsecond  -- ^ when server sent reply
    , NtpPacket -> Microsecond
ntpReceivedTime :: Microsecond  -- ^ when server got request
    , NtpPacket -> Microsecond
ntpTransmitTime :: Microsecond  -- ^ when client sent request
    } deriving (Int -> NtpPacket -> ShowS
[NtpPacket] -> ShowS
NtpPacket -> String
(Int -> NtpPacket -> ShowS)
-> (NtpPacket -> String)
-> ([NtpPacket] -> ShowS)
-> Show NtpPacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NtpPacket] -> ShowS
$cshowList :: [NtpPacket] -> ShowS
show :: NtpPacket -> String
$cshow :: NtpPacket -> String
showsPrec :: Int -> NtpPacket -> ShowS
$cshowsPrec :: Int -> NtpPacket -> ShowS
Show, NtpPacket -> NtpPacket -> Bool
(NtpPacket -> NtpPacket -> Bool)
-> (NtpPacket -> NtpPacket -> Bool) -> Eq NtpPacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NtpPacket -> NtpPacket -> Bool
$c/= :: NtpPacket -> NtpPacket -> Bool
== :: NtpPacket -> NtpPacket -> Bool
$c== :: NtpPacket -> NtpPacket -> Bool
Eq)

instance Binary NtpPacket where
    put :: NtpPacket -> Put
put NtpPacket{Int8
Word8
Microsecond
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
ntpTransmitTime :: NtpPacket -> Microsecond
ntpReceivedTime :: NtpPacket -> Microsecond
ntpOriginTime :: NtpPacket -> Microsecond
ntpPoll :: NtpPacket -> Int8
ntpParams :: NtpPacket -> Word8
..} = do
        Word8 -> Put
putWord8 Word8
ntpParams
        Word8 -> Put
putWord8 Word8
0
        Int8 -> Put
putInt8 Int8
ntpPoll
        Word8 -> Put
putWord8 Word8
0

        Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
5 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
putWord32be Word32
0

        let (Word32
osec, Word32
ofrac) = Microsecond -> (Word32, Word32)
realMcsToNtp Microsecond
ntpOriginTime
        Word32 -> Put
putWord32be Word32
osec
        Word32 -> Put
putWord32be Word32
ofrac

        let (Word32
rsec, Word32
rfrac) = Microsecond -> (Word32, Word32)
realMcsToNtp Microsecond
ntpReceivedTime
        Word32 -> Put
putWord32be Word32
rsec
        Word32 -> Put
putWord32be Word32
rfrac

        let (Word32
tsec, Word32
tfrac) = Microsecond -> (Word32, Word32)
realMcsToNtp Microsecond
ntpTransmitTime
        Word32 -> Put
putWord32be Word32
tsec
        Word32 -> Put
putWord32be Word32
tfrac

    get :: Get NtpPacket
get = do
        Word8
ntpParams <- Get Word8
getWord8
        Word8
_         <- Get Word8
getWord8
        Int8
ntpPoll   <- Get Int8
getInt8
        Word8
_         <- Get Word8
getWord8

        -- skip 5 @'Word32'@ words
        Int -> Get ()
skip Int
20

        Microsecond
ntpOriginTime   <- Get Microsecond
getTimestamp
        Microsecond
ntpReceivedTime <- Get Microsecond
getTimestamp
        Microsecond
ntpTransmitTime <- Get Microsecond
getTimestamp
        NtpPacket -> Get NtpPacket
forall (m :: * -> *) a. Monad m => a -> m a
return NtpPacket :: Word8
-> Int8 -> Microsecond -> Microsecond -> Microsecond -> NtpPacket
NtpPacket{Int8
Word8
Microsecond
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
..}
      where
        getTimestamp :: Get Microsecond
getTimestamp = Word32 -> Word32 -> Microsecond
ntpToRealMcs (Word32 -> Word32 -> Microsecond)
-> Get Word32 -> Get (Word32 -> Microsecond)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get (Word32 -> Microsecond) -> Get Word32 -> Get Microsecond
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be

-- |
-- NTP timestamp start in 1.1.1900, i.e. 70 years before UNIX epoch.
-- references:
--  * https://tools.ietf.org/html/rfc5905#section-6
--  * https://tools.ietf.org/html/rfc5905#appendix-A.4
ntpTimestampDelta :: Integer
ntpTimestampDelta :: Integer
ntpTimestampDelta = Integer
2208988800

-- |
-- We only need first 48 bytes of a packet:
-- reference: https://tools.ietf.org/html/rfc5905#section-7.3
ntpPacketSize :: Int
ntpPacketSize :: Int
ntpPacketSize = Int
48

-- |
-- For pairs @(x, y) :: (Word32, Word32)@ with @y \`mod\` 4294 == 0@ it is
-- be right inverse of @'realMsgToNtp'@.   In general it is not injective (for that
-- we'd need to use @'Picosecond'@ instead of @'Microsecond'@).
ntpToRealMcs :: Word32 -> Word32 -> Microsecond
ntpToRealMcs :: Word32 -> Word32 -> Microsecond
ntpToRealMcs Word32
sec Word32
frac =
    let -- microseconds
        secMicro :: Integer
        secMicro :: Integer
secMicro = (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ntpTimestampDelta) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000
        -- We divide 1 second into 2 ^ 32 parts, giving 2.3283064365386963e-10
        -- as the quantum. A picosecond is 10e-12 of a second, so this is 232
        -- picoseconds or `1/4294` of a millisecond.
        -- ref: https://tools.ietf.org/html/rfc5905#section-6
        fracMicro :: Integer
        fracMicro :: Integer
fracMicro = (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
frac) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
4294
    in Integer -> Microsecond
Microsecond (Integer -> Microsecond) -> Integer -> Microsecond
forall a b. (a -> b) -> a -> b
$ Integer
secMicro Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
fracMicro

-- |
-- It is a partial function, since @Microsecond ~ Integer@; it is well defined
-- for:
-- @
--  x < 2085978496 = (maxBound @Word32 * 1000000) - ntpTimestampDelta + 1`
-- @
-- (in microseconds; this is roughly 66 years, so we're fine untill 2036).
realMcsToNtp :: Microsecond -> (Word32, Word32)
realMcsToNtp :: Microsecond -> (Word32, Word32)
realMcsToNtp (Microsecond Integer
mcs) =
    let (Integer
sec, Integer
frac) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
mcs Integer
1000000
    in  ( Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Integer
sec Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ntpTimestampDelta
        , Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Integer
frac Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
4294)

-- |
-- Smart constructor for @'NtpPacket'@.
mkNtpPacket :: IO NtpPacket
mkNtpPacket :: IO NtpPacket
mkNtpPacket = do
    let ntpParams :: Word8
ntpParams       = Word8
0x1b
        ntpPoll :: Int8
ntpPoll         = Int8
0
        ntpOriginTime :: Microsecond
ntpOriginTime   = Microsecond
0
        ntpReceivedTime :: Microsecond
ntpReceivedTime = Microsecond
0
    Microsecond
ntpTransmitTime <- IO Microsecond
getCurrentTime
    NtpPacket -> IO NtpPacket
forall (m :: * -> *) a. Monad m => a -> m a
return NtpPacket :: Word8
-> Int8 -> Microsecond -> Microsecond -> Microsecond -> NtpPacket
NtpPacket{Int8
Word8
Microsecond
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
..}

-- |
-- @'NtpOffset'@ is the difference between NTP time and local time.
newtype NtpOffset = NtpOffset { NtpOffset -> Microsecond
getNtpOffset :: Microsecond }
    deriving (Int -> NtpOffset
NtpOffset -> Int
NtpOffset -> [NtpOffset]
NtpOffset -> NtpOffset
NtpOffset -> NtpOffset -> [NtpOffset]
NtpOffset -> NtpOffset -> NtpOffset -> [NtpOffset]
(NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset)
-> (Int -> NtpOffset)
-> (NtpOffset -> Int)
-> (NtpOffset -> [NtpOffset])
-> (NtpOffset -> NtpOffset -> [NtpOffset])
-> (NtpOffset -> NtpOffset -> [NtpOffset])
-> (NtpOffset -> NtpOffset -> NtpOffset -> [NtpOffset])
-> Enum NtpOffset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NtpOffset -> NtpOffset -> NtpOffset -> [NtpOffset]
$cenumFromThenTo :: NtpOffset -> NtpOffset -> NtpOffset -> [NtpOffset]
enumFromTo :: NtpOffset -> NtpOffset -> [NtpOffset]
$cenumFromTo :: NtpOffset -> NtpOffset -> [NtpOffset]
enumFromThen :: NtpOffset -> NtpOffset -> [NtpOffset]
$cenumFromThen :: NtpOffset -> NtpOffset -> [NtpOffset]
enumFrom :: NtpOffset -> [NtpOffset]
$cenumFrom :: NtpOffset -> [NtpOffset]
fromEnum :: NtpOffset -> Int
$cfromEnum :: NtpOffset -> Int
toEnum :: Int -> NtpOffset
$ctoEnum :: Int -> NtpOffset
pred :: NtpOffset -> NtpOffset
$cpred :: NtpOffset -> NtpOffset
succ :: NtpOffset -> NtpOffset
$csucc :: NtpOffset -> NtpOffset
Enum, NtpOffset -> NtpOffset -> Bool
(NtpOffset -> NtpOffset -> Bool)
-> (NtpOffset -> NtpOffset -> Bool) -> Eq NtpOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NtpOffset -> NtpOffset -> Bool
$c/= :: NtpOffset -> NtpOffset -> Bool
== :: NtpOffset -> NtpOffset -> Bool
$c== :: NtpOffset -> NtpOffset -> Bool
Eq, Enum NtpOffset
Real NtpOffset
Real NtpOffset
-> Enum NtpOffset
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset))
-> (NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset))
-> (NtpOffset -> Integer)
-> Integral NtpOffset
NtpOffset -> Integer
NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset)
NtpOffset -> NtpOffset -> NtpOffset
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: NtpOffset -> Integer
$ctoInteger :: NtpOffset -> Integer
divMod :: NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset)
$cdivMod :: NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset)
quotRem :: NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset)
$cquotRem :: NtpOffset -> NtpOffset -> (NtpOffset, NtpOffset)
mod :: NtpOffset -> NtpOffset -> NtpOffset
$cmod :: NtpOffset -> NtpOffset -> NtpOffset
div :: NtpOffset -> NtpOffset -> NtpOffset
$cdiv :: NtpOffset -> NtpOffset -> NtpOffset
rem :: NtpOffset -> NtpOffset -> NtpOffset
$crem :: NtpOffset -> NtpOffset -> NtpOffset
quot :: NtpOffset -> NtpOffset -> NtpOffset
$cquot :: NtpOffset -> NtpOffset -> NtpOffset
$cp2Integral :: Enum NtpOffset
$cp1Integral :: Real NtpOffset
Integral, Integer -> NtpOffset
NtpOffset -> NtpOffset
NtpOffset -> NtpOffset -> NtpOffset
(NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset)
-> (Integer -> NtpOffset)
-> Num NtpOffset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NtpOffset
$cfromInteger :: Integer -> NtpOffset
signum :: NtpOffset -> NtpOffset
$csignum :: NtpOffset -> NtpOffset
abs :: NtpOffset -> NtpOffset
$cabs :: NtpOffset -> NtpOffset
negate :: NtpOffset -> NtpOffset
$cnegate :: NtpOffset -> NtpOffset
* :: NtpOffset -> NtpOffset -> NtpOffset
$c* :: NtpOffset -> NtpOffset -> NtpOffset
- :: NtpOffset -> NtpOffset -> NtpOffset
$c- :: NtpOffset -> NtpOffset -> NtpOffset
+ :: NtpOffset -> NtpOffset -> NtpOffset
$c+ :: NtpOffset -> NtpOffset -> NtpOffset
Num, Eq NtpOffset
Eq NtpOffset
-> (NtpOffset -> NtpOffset -> Ordering)
-> (NtpOffset -> NtpOffset -> Bool)
-> (NtpOffset -> NtpOffset -> Bool)
-> (NtpOffset -> NtpOffset -> Bool)
-> (NtpOffset -> NtpOffset -> Bool)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> (NtpOffset -> NtpOffset -> NtpOffset)
-> Ord NtpOffset
NtpOffset -> NtpOffset -> Bool
NtpOffset -> NtpOffset -> Ordering
NtpOffset -> NtpOffset -> NtpOffset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NtpOffset -> NtpOffset -> NtpOffset
$cmin :: NtpOffset -> NtpOffset -> NtpOffset
max :: NtpOffset -> NtpOffset -> NtpOffset
$cmax :: NtpOffset -> NtpOffset -> NtpOffset
>= :: NtpOffset -> NtpOffset -> Bool
$c>= :: NtpOffset -> NtpOffset -> Bool
> :: NtpOffset -> NtpOffset -> Bool
$c> :: NtpOffset -> NtpOffset -> Bool
<= :: NtpOffset -> NtpOffset -> Bool
$c<= :: NtpOffset -> NtpOffset -> Bool
< :: NtpOffset -> NtpOffset -> Bool
$c< :: NtpOffset -> NtpOffset -> Bool
compare :: NtpOffset -> NtpOffset -> Ordering
$ccompare :: NtpOffset -> NtpOffset -> Ordering
$cp1Ord :: Eq NtpOffset
Ord, Num NtpOffset
Ord NtpOffset
Num NtpOffset
-> Ord NtpOffset -> (NtpOffset -> Rational) -> Real NtpOffset
NtpOffset -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NtpOffset -> Rational
$ctoRational :: NtpOffset -> Rational
$cp2Real :: Ord NtpOffset
$cp1Real :: Num NtpOffset
Real, Int -> NtpOffset -> ShowS
[NtpOffset] -> ShowS
NtpOffset -> String
(Int -> NtpOffset -> ShowS)
-> (NtpOffset -> String)
-> ([NtpOffset] -> ShowS)
-> Show NtpOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NtpOffset] -> ShowS
$cshowList :: [NtpOffset] -> ShowS
show :: NtpOffset -> String
$cshow :: NtpOffset -> String
showsPrec :: Int -> NtpOffset -> ShowS
$cshowsPrec :: Int -> NtpOffset -> ShowS
Show)

clockOffsetPure :: NtpPacket -> Microsecond -> NtpOffset
clockOffsetPure :: NtpPacket -> Microsecond -> NtpOffset
clockOffsetPure NtpPacket{Int8
Word8
Microsecond
ntpTransmitTime :: Microsecond
ntpReceivedTime :: Microsecond
ntpOriginTime :: Microsecond
ntpPoll :: Int8
ntpParams :: Word8
ntpTransmitTime :: NtpPacket -> Microsecond
ntpReceivedTime :: NtpPacket -> Microsecond
ntpOriginTime :: NtpPacket -> Microsecond
ntpPoll :: NtpPacket -> Int8
ntpParams :: NtpPacket -> Word8
..} Microsecond
localTime = Microsecond -> NtpOffset
NtpOffset
    (Microsecond -> NtpOffset) -> Microsecond -> NtpOffset
forall a b. (a -> b) -> a -> b
$ (Microsecond
ntpReceivedTime Microsecond -> Microsecond -> Microsecond
forall a. Num a => a -> a -> a
- Microsecond
ntpOriginTime Microsecond -> Microsecond -> Microsecond
forall a. Num a => a -> a -> a
+ Microsecond
ntpTransmitTime Microsecond -> Microsecond -> Microsecond
forall a. Num a => a -> a -> a
- Microsecond
localTime)
      Microsecond -> Microsecond -> Microsecond
forall a. Integral a => a -> a -> a
`div` Microsecond
2

-- |
-- Compute clock offset unless the NTP packet was requested more than the given
-- timeout.
clockOffset
    :: Microsecond
    -- ^ @'ntpResponseTimeout'@, ignore responses which come after it passed.
    -> NtpPacket
    -> IO (Maybe NtpOffset)
clockOffset :: Microsecond -> NtpPacket -> IO (Maybe NtpOffset)
clockOffset Microsecond
respTimeout NtpPacket
packet = do
    Microsecond
time <- IO Microsecond
getCurrentTime
    let isLate :: Bool
isLate = Microsecond
time Microsecond -> Microsecond -> Microsecond
forall a. Num a => a -> a -> a
- NtpPacket -> Microsecond
ntpOriginTime NtpPacket
packet Microsecond -> Microsecond -> Bool
forall a. Ord a => a -> a -> Bool
>= Microsecond
respTimeout
    if Bool
isLate
        then Maybe NtpOffset -> IO (Maybe NtpOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NtpOffset
forall a. Maybe a
Nothing
        else Maybe NtpOffset -> IO (Maybe NtpOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NtpOffset -> IO (Maybe NtpOffset))
-> Maybe NtpOffset -> IO (Maybe NtpOffset)
forall a b. (a -> b) -> a -> b
$ NtpOffset -> Maybe NtpOffset
forall a. a -> Maybe a
Just (NtpOffset -> Maybe NtpOffset) -> NtpOffset -> Maybe NtpOffset
forall a b. (a -> b) -> a -> b
$ NtpPacket -> Microsecond -> NtpOffset
clockOffsetPure NtpPacket
packet Microsecond
time

-- |
-- Helper function to get current time in @Microsecond@.
getCurrentTime :: IO Microsecond
getCurrentTime :: IO Microsecond
getCurrentTime = Integer -> Microsecond
Microsecond (Integer -> Microsecond)
-> (POSIXTime -> Integer) -> POSIXTime -> Microsecond
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Integer)
-> (POSIXTime -> POSIXTime) -> POSIXTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000000) (POSIXTime -> Microsecond) -> IO POSIXTime -> IO Microsecond
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime