module Session.Timing.Time
  ( Time (..)
  ) where

import Internal.Prelude

-- | Creation and access times, used to determine session expiration
data Time a = Time
  { forall a. Time a -> a
created :: a
  -- ^ When the session was created
  --
  -- This is used to apply the absolute timeout.
  , forall a. Time a -> a
accessed :: a
  -- ^ When the session was last accessed
  --
  -- This is used to apply the idle timeout.
  }
  deriving stock (Time a -> Time a -> Bool
(Time a -> Time a -> Bool)
-> (Time a -> Time a -> Bool) -> Eq (Time a)
forall a. Eq a => Time a -> Time a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Time a -> Time a -> Bool
== :: Time a -> Time a -> Bool
$c/= :: forall a. Eq a => Time a -> Time a -> Bool
/= :: Time a -> Time a -> Bool
Eq, Int -> Time a -> ShowS
[Time a] -> ShowS
Time a -> String
(Int -> Time a -> ShowS)
-> (Time a -> String) -> ([Time a] -> ShowS) -> Show (Time a)
forall a. Show a => Int -> Time a -> ShowS
forall a. Show a => [Time a] -> ShowS
forall a. Show a => Time a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Time a -> ShowS
showsPrec :: Int -> Time a -> ShowS
$cshow :: forall a. Show a => Time a -> String
show :: Time a -> String
$cshowList :: forall a. Show a => [Time a] -> ShowS
showList :: [Time a] -> ShowS
Show)