{-# 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 =
forall t. Timeable t => t -> ElapsedP
timeGetElapsedP forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Pico
nominalDiffTimeToSeconds forall a b. (a -> b) -> a -> b
$ UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds UTCTime
utcTime
instance Time UTCTime where
timeFromElapsedP :: ElapsedP -> UTCTime
timeFromElapsedP = NominalDiffTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> NominalDiffTime
secondsToNominalDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (Real a, Fractional b) => a -> b
realToFrac Fixed a
value
(Int64
s, MkFixed Integer
n) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Nano
ns
seconds :: Elapsed
seconds = Seconds -> Elapsed
Elapsed forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds Int64
s
nanos :: NanoSeconds
nanos = Int64 -> NanoSeconds
NanoSeconds forall a b. (a -> b) -> a -> b
$ 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 = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall t1 t2. (Timeable t1, Time t2) => t1 -> t2
timeConvert