{-# 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 =
    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