--   This Source Code Form is subject to the terms of the Mozilla Public
--   License, v. 2.0. If a copy of the MPL was not distributed with this
--   file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE DerivingStrategies #-}

-- | POSIX seconds
module Libjwt.NumericDate
  ( NumericDate(..)
  , fromUTC
  , fromPOSIX
  , toPOSIX
  , now
  , plusSeconds
  , minusSeconds
  , diffSeconds
  )
where

import           Control.Monad.Time

import           Data.Int

import           Data.Time.Clock                ( NominalDiffTime
                                                , UTCTime
                                                )
import           Data.Time.Clock.POSIX          ( POSIXTime
                                                , utcTimeToPOSIXSeconds
                                                )
-- | Represents the number of seconds elapsed since 1970-01-01
--
--   Used in accordance with the RFC in 'Libjwt.RegisteredClaims.Exp', 'Libjwt.RegisteredClaims.Nbf' and 'Libjwt.RegisteredClaims.Iat' claims
newtype NumericDate = NumericDate { NumericDate -> Int64
secondsSinceEpoch :: Int64 }
  deriving stock (Int -> NumericDate -> ShowS
[NumericDate] -> ShowS
NumericDate -> String
(Int -> NumericDate -> ShowS)
-> (NumericDate -> String)
-> ([NumericDate] -> ShowS)
-> Show NumericDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumericDate] -> ShowS
$cshowList :: [NumericDate] -> ShowS
show :: NumericDate -> String
$cshow :: NumericDate -> String
showsPrec :: Int -> NumericDate -> ShowS
$cshowsPrec :: Int -> NumericDate -> ShowS
Show, NumericDate -> NumericDate -> Bool
(NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool) -> Eq NumericDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumericDate -> NumericDate -> Bool
$c/= :: NumericDate -> NumericDate -> Bool
== :: NumericDate -> NumericDate -> Bool
$c== :: NumericDate -> NumericDate -> Bool
Eq, Eq NumericDate
Eq NumericDate
-> (NumericDate -> NumericDate -> Ordering)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> Bool)
-> (NumericDate -> NumericDate -> NumericDate)
-> (NumericDate -> NumericDate -> NumericDate)
-> Ord NumericDate
NumericDate -> NumericDate -> Bool
NumericDate -> NumericDate -> Ordering
NumericDate -> NumericDate -> NumericDate
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 :: NumericDate -> NumericDate -> NumericDate
$cmin :: NumericDate -> NumericDate -> NumericDate
max :: NumericDate -> NumericDate -> NumericDate
$cmax :: NumericDate -> NumericDate -> NumericDate
>= :: NumericDate -> NumericDate -> Bool
$c>= :: NumericDate -> NumericDate -> Bool
> :: NumericDate -> NumericDate -> Bool
$c> :: NumericDate -> NumericDate -> Bool
<= :: NumericDate -> NumericDate -> Bool
$c<= :: NumericDate -> NumericDate -> Bool
< :: NumericDate -> NumericDate -> Bool
$c< :: NumericDate -> NumericDate -> Bool
compare :: NumericDate -> NumericDate -> Ordering
$ccompare :: NumericDate -> NumericDate -> Ordering
$cp1Ord :: Eq NumericDate
Ord, NumericDate
NumericDate -> NumericDate -> Bounded NumericDate
forall a. a -> a -> Bounded a
maxBound :: NumericDate
$cmaxBound :: NumericDate
minBound :: NumericDate
$cminBound :: NumericDate
Bounded)

fromPOSIX :: POSIXTime -> NumericDate
fromPOSIX :: POSIXTime -> NumericDate
fromPOSIX = Int64 -> NumericDate
NumericDate (Int64 -> NumericDate)
-> (POSIXTime -> Int64) -> POSIXTime -> NumericDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate

fromUTC :: UTCTime -> NumericDate
fromUTC :: UTCTime -> NumericDate
fromUTC = POSIXTime -> NumericDate
fromPOSIX (POSIXTime -> NumericDate)
-> (UTCTime -> POSIXTime) -> UTCTime -> NumericDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds

toPOSIX :: NumericDate -> POSIXTime
toPOSIX :: NumericDate -> POSIXTime
toPOSIX (NumericDate Int64
s) = Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s

-- | Convert 'currentTime' to a number of seconds since 1970-01-01
now :: (MonadTime m) => m NumericDate
now :: m NumericDate
now = UTCTime -> NumericDate
fromUTC (UTCTime -> NumericDate) -> m UTCTime -> m NumericDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
currentTime

-- | Add some seconds to the date
plusSeconds :: NumericDate -> NominalDiffTime -> NumericDate
plusSeconds :: NumericDate -> POSIXTime -> NumericDate
plusSeconds NumericDate
d POSIXTime
s = Int64 -> NumericDate
NumericDate (Int64 -> NumericDate) -> Int64 -> NumericDate
forall a b. (a -> b) -> a -> b
$ NumericDate -> Int64
secondsSinceEpoch NumericDate
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
s

-- | Subtract some seconds from the date
minusSeconds :: NumericDate -> NominalDiffTime -> NumericDate
minusSeconds :: NumericDate -> POSIXTime -> NumericDate
minusSeconds NumericDate
d POSIXTime
s = NumericDate -> POSIXTime -> NumericDate
plusSeconds NumericDate
d (-POSIXTime
s)

-- | The number of seconds between two dates
diffSeconds :: NumericDate -> NumericDate -> NominalDiffTime
diffSeconds :: NumericDate -> NumericDate -> POSIXTime
diffSeconds NumericDate
a NumericDate
b = NumericDate -> POSIXTime
toPOSIX NumericDate
a POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- NumericDate -> POSIXTime
toPOSIX NumericDate
b