{-# OPTIONS_GHC -Wno-orphans #-}

-- | Stability: internal
--
-- This module contains orphan instances connecting different date libraries together:
--
-- * [time](https://hackage.haskell.org/package/time), a commonly used library
--   containing the 'UTCTime' type, which is a bit slow and inconvenient to use
-- * [monad-time](https://hackage.haskell.org/package/monad-time) which defines
--   the 'MonadTime' class which uses 'UTCTime'. monad-time is used by the
--   [jose](https://hackage.haskell.org/package/jose) library to get the time
-- * [hourglass](https://hackage.haskell.org/package/hourglass), an alternative
--   to the time library which is nicer to use. It is used by the
--   [x509-validation](https://hackage.haskell.org/package/x509-validation) library
-- * [Data.Fixed](https://hackage.haskell.org/package/base/docs/Data-Fixed.html)
--   in @base@, which is used as the underlying representation of 'Data.Time.NominalDiffTime'
--   in the @time@ library.
--
-- This module contains a 'Timeable' and 'Time' implementation for 'UTCTime',
-- and a 'MonadTime' implementation for any 'ReaderT' of a 'Timeable'
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