{-# OPTIONS_GHC -Wno-orphans #-}
module Crypto.WebAuthn.Internal.DateOrphans () where
import Control.Monad.Reader (ReaderT, asks)
import Control.Monad.Time (MonadTime, currentTime)
import Data.Fixed (Fixed (MkFixed), HasResolution, Nano)
import Data.Hourglass (Elapsed (Elapsed), ElapsedP (ElapsedP), NanoSeconds (NanoSeconds), Seconds (Seconds), Time, Timeable, timeConvert, timeFromElapsedP, timeGetElapsedP)
import Data.Time (UTCTime, nominalDiffTimeToSeconds, secondsToNominalDiffTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
instance Timeable UTCTime where
timeGetElapsedP :: UTCTime -> ElapsedP
timeGetElapsedP UTCTime
utcTime =
Pico -> ElapsedP
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP (Pico -> ElapsedP) -> Pico -> ElapsedP
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Pico
nominalDiffTimeToSeconds (NominalDiffTime -> Pico) -> NominalDiffTime -> Pico
forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
utcTime
instance Time UTCTime where
timeFromElapsedP :: ElapsedP -> UTCTime
timeFromElapsedP = NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> (ElapsedP -> NominalDiffTime) -> ElapsedP -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime)
-> (ElapsedP -> Pico) -> ElapsedP -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElapsedP -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance (HasResolution a) => Timeable (Fixed a) where
timeGetElapsedP :: Fixed a -> ElapsedP
timeGetElapsedP Fixed a
value = Elapsed -> NanoSeconds -> ElapsedP
ElapsedP Elapsed
seconds NanoSeconds
nanos
where
ns :: Nano
ns :: Nano
ns = Fixed a -> Nano
forall a b. (Real a, Fractional b) => a -> b
realToFrac Fixed a
value
(Int64
s, MkFixed Integer
n) = Nano -> (Int64, Nano)
forall b. Integral b => Nano -> (b, Nano)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Nano
ns
seconds :: Elapsed
seconds = Seconds -> Elapsed
Elapsed (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds Int64
s
nanos :: NanoSeconds
nanos = Int64 -> NanoSeconds
NanoSeconds (Int64 -> NanoSeconds) -> Int64 -> NanoSeconds
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
n
instance (Timeable t, Monad m) => MonadTime (ReaderT t m) where
currentTime :: ReaderT t m UTCTime
currentTime = (t -> UTCTime) -> ReaderT t m UTCTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks t -> UTCTime
forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
timeConvert