-- |
-- Module      : Amazonka.Data.Time
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Time
  ( -- * Time
    Format (..),
    Time (..),
    _Time,

    -- ** Formats
    UTCTime,
    RFC822,
    ISO8601,
    BasicTime,
    AWSTime,
    POSIX,
  )
where

import Amazonka.Core.Lens.Internal (iso)
import Amazonka.Data.ByteString
import Amazonka.Data.JSON
import Amazonka.Data.Query
import Amazonka.Data.Text
import Amazonka.Data.XML
import Amazonka.Prelude
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Attoparsec.Text as A
import qualified Data.Attoparsec.Text as AText
import qualified Data.ByteString.Char8 as BS
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Data.Time as Time
import Data.Time.Clock.POSIX
import Data.Time.Format (defaultTimeLocale, formatTime)

data Format
  = RFC822Format
  | ISO8601Format
  | BasicFormat
  | AWSFormat
  | POSIXFormat
  deriving stock (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, ReadPrec [Format]
ReadPrec Format
Int -> ReadS Format
ReadS [Format]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Format]
$creadListPrec :: ReadPrec [Format]
readPrec :: ReadPrec Format
$creadPrec :: ReadPrec Format
readList :: ReadS [Format]
$creadList :: ReadS [Format]
readsPrec :: Int -> ReadS Format
$creadsPrec :: Int -> ReadS Format
Read, Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic)

newtype Time (a :: Format) = Time {forall (a :: Format). Time a -> UTCTime
fromTime :: UTCTime}
  deriving stock (Int -> Time a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: Format). Int -> Time a -> ShowS
forall (a :: Format). [Time a] -> ShowS
forall (a :: Format). Time a -> String
showList :: [Time a] -> ShowS
$cshowList :: forall (a :: Format). [Time a] -> ShowS
show :: Time a -> String
$cshow :: forall (a :: Format). Time a -> String
showsPrec :: Int -> Time a -> ShowS
$cshowsPrec :: forall (a :: Format). Int -> Time a -> ShowS
Show, ReadPrec [Time a]
ReadPrec (Time a)
ReadS [Time a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (a :: Format). ReadPrec [Time a]
forall (a :: Format). ReadPrec (Time a)
forall (a :: Format). Int -> ReadS (Time a)
forall (a :: Format). ReadS [Time a]
readListPrec :: ReadPrec [Time a]
$creadListPrec :: forall (a :: Format). ReadPrec [Time a]
readPrec :: ReadPrec (Time a)
$creadPrec :: forall (a :: Format). ReadPrec (Time a)
readList :: ReadS [Time a]
$creadList :: forall (a :: Format). ReadS [Time a]
readsPrec :: Int -> ReadS (Time a)
$creadsPrec :: forall (a :: Format). Int -> ReadS (Time a)
Read, Time a -> Time a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Format). Time a -> Time a -> Bool
/= :: Time a -> Time a -> Bool
$c/= :: forall (a :: Format). Time a -> Time a -> Bool
== :: Time a -> Time a -> Bool
$c== :: forall (a :: Format). Time a -> Time a -> Bool
Eq, Time a -> Time a -> Bool
Time a -> Time a -> Ordering
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
forall (a :: Format). Eq (Time a)
forall (a :: Format). Time a -> Time a -> Bool
forall (a :: Format). Time a -> Time a -> Ordering
forall (a :: Format). Time a -> Time a -> Time a
min :: Time a -> Time a -> Time a
$cmin :: forall (a :: Format). Time a -> Time a -> Time a
max :: Time a -> Time a -> Time a
$cmax :: forall (a :: Format). Time a -> Time a -> Time a
>= :: Time a -> Time a -> Bool
$c>= :: forall (a :: Format). Time a -> Time a -> Bool
> :: Time a -> Time a -> Bool
$c> :: forall (a :: Format). Time a -> Time a -> Bool
<= :: Time a -> Time a -> Bool
$c<= :: forall (a :: Format). Time a -> Time a -> Bool
< :: Time a -> Time a -> Bool
$c< :: forall (a :: Format). Time a -> Time a -> Bool
compare :: Time a -> Time a -> Ordering
$ccompare :: forall (a :: Format). Time a -> Time a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: Format) x. Rep (Time a) x -> Time a
forall (a :: Format) x. Time a -> Rep (Time a) x
$cto :: forall (a :: Format) x. Rep (Time a) x -> Time a
$cfrom :: forall (a :: Format) x. Time a -> Rep (Time a) x
Generic)
  deriving newtype (Time a -> ()
forall a. (a -> ()) -> NFData a
forall (a :: Format). Time a -> ()
rnf :: Time a -> ()
$crnf :: forall (a :: Format). Time a -> ()
NFData)

instance Hashable (Time a) where
  hashWithSalt :: Int -> Time a -> Int
hashWithSalt Int
salt (Time (Time.UTCTime (Time.ModifiedJulianDay Integer
d) DiffTime
t)) =
    Int
salt
      forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Integer
d
      forall a. Hashable a => Int -> a -> Int
`hashWithSalt` forall a. Real a => a -> Rational
toRational DiffTime
t

_Time :: Iso' (Time a) UTCTime
_Time :: forall (a :: Format). Iso' (Time a) UTCTime
_Time = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (a :: Format). Time a -> UTCTime
fromTime forall (a :: Format). UTCTime -> Time a
Time

convert :: Time a -> Time b
convert :: forall (a :: Format) (b :: Format). Time a -> Time b
convert = coerce :: forall a b. Coercible a b => a -> b
coerce

type RFC822 = Time 'RFC822Format

type ISO8601 = Time 'ISO8601Format

type BasicTime = Time 'BasicFormat

type AWSTime = Time 'AWSFormat

type POSIX = Time 'POSIXFormat

class TimeFormat a where
  format :: proxy a -> String

instance TimeFormat RFC822 where
  format :: forall (proxy :: * -> *). proxy RFC822 -> String
format proxy RFC822
_ = String
"%a, %d %b %Y %H:%M:%S %Z"

instance TimeFormat ISO8601 where
  format :: forall (proxy :: * -> *). proxy ISO8601 -> String
format proxy ISO8601
_ = String
"%FT%XZ"

instance TimeFormat BasicTime where
  format :: forall (proxy :: * -> *). proxy BasicTime -> String
format proxy BasicTime
_ = String
"%Y%m%d"

instance TimeFormat AWSTime where
  format :: forall (proxy :: * -> *). proxy AWSTime -> String
format proxy AWSTime
_ = String
"%Y%m%dT%H%M%SZ"

instance FromText (Time fmt) where
  fromText :: Text -> Either String (Time fmt)
fromText = forall a. Parser a -> Text -> Either String a
A.parseOnly ((forall (a :: Format). Parser (Time a)
parseUnixTimestamp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Format). Parser (Time a)
parseFormattedTime) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
A.endOfInput)

parseFormattedTime :: A.Parser (Time a)
parseFormattedTime :: forall (a :: Format). Parser (Time a)
parseFormattedTime = do
  String
s <- Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
AText.takeText

  let parse :: String -> A.Parser (Time a)
      parse :: forall (a :: Format). String -> Parser (Time a)
parse String
fmt =
        case forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
Time.parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt String
s of
          Just UTCTime
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (a :: Format). UTCTime -> Time a
Time UTCTime
x)
          Maybe UTCTime
Nothing ->
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail
              ( String
"Unable to parse Time format "
                  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
fmt
                  forall a. [a] -> [a] -> [a]
++ String
" from "
                  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s
              )

  forall (a :: Format). String -> Parser (Time a)
parse (forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (forall {k} (t :: k). Proxy t
Proxy @RFC822))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Format). String -> Parser (Time a)
parse (forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (forall {k} (t :: k). Proxy t
Proxy @ISO8601))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Format). String -> Parser (Time a)
parse (forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (forall {k} (t :: k). Proxy t
Proxy @BasicTime))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Format). String -> Parser (Time a)
parse (forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (forall {k} (t :: k). Proxy t
Proxy @AWSTime))
    -- Deprecated ISO8601 format exhibited in the AWS-supplied examples.
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (a :: Format). String -> Parser (Time a)
parse String
"%FT%X%Q%Z"
    -- Exhaustive Failure
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Failure parsing Time from value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s)

parseUnixTimestamp :: A.Parser (Time a)
parseUnixTimestamp :: forall (a :: Format). Parser (Time a)
parseUnixTimestamp =
  forall (a :: Format). UTCTime -> Time a
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Double
AText.double
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
AText.endOfInput
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failure parsing Unix Timestamp"

instance ToText RFC822 where
  toText :: RFC822 -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText ISO8601 where
  toText :: ISO8601 -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText BasicTime where
  toText :: BasicTime -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText AWSTime where
  toText :: AWSTime -> Text
toText = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToText POSIX where
  toText :: POSIX -> Text
toText (Time UTCTime
t) = forall a. ToText a => a -> Text
toText (forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer)

renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String
renderFormattedTime :: forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime (Time UTCTime
t) =
  forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime
    TimeLocale
defaultTimeLocale
    (forall a (proxy :: * -> *). TimeFormat a => proxy a -> String
format (forall {k} (t :: k). Proxy t
Proxy @(Time a)))
    -- Convert `t` to a GMT `ZonedTime`, because otherwise the
    -- `FormatTime` instance for `UTCTime` converts to UTC `ZonedTime`
    -- for us. While they are the same offset, a UTC `ZonedTime` emits
    -- `UTC` instead of `GMT` when formatted by `RFC822`'s
    -- `TimeFormat`, which is not a valid `zone` in RFC 822's grammar.
    (TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime (forall a. Read a => String -> a
read String
"GMT") UTCTime
t)

instance FromXML RFC822 where
  parseXML :: [Node] -> Either String RFC822
parseXML = forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"RFC822"

instance FromXML ISO8601 where
  parseXML :: [Node] -> Either String ISO8601
parseXML = forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"ISO8601"

instance FromXML AWSTime where
  parseXML :: [Node] -> Either String AWSTime
parseXML = forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"AWSTime"

instance FromXML BasicTime where
  parseXML :: [Node] -> Either String BasicTime
parseXML = forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"BasicTime"

instance FromJSON RFC822 where
  parseJSON :: Value -> Parser RFC822
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"RFC822"

instance FromJSON ISO8601 where
  parseJSON :: Value -> Parser ISO8601
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"ISO8601"

instance FromJSON AWSTime where
  parseJSON :: Value -> Parser AWSTime
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"AWSTime"

instance FromJSON BasicTime where
  parseJSON :: Value -> Parser BasicTime
parseJSON = forall a. FromText a => String -> Value -> Parser a
parseJSONText String
"BasicTime"

-- This is a somewhat unfortunate hack to support the bizzare apigateway
-- occurence of returning ISO8601 or POSIX timestamps in unknown scenarios.
--
-- See: https://github.com/brendanhay/amazonka/issues/291
instance FromJSON POSIX where
  parseJSON :: Value -> Parser POSIX
parseJSON Value
o = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: Format) (b :: Format). Time a -> Time b
convert (Value -> Parser ISO8601
str Value
o) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser POSIX
num Value
o
    where
      str :: Value -> Aeson.Parser ISO8601
      str :: Value -> Parser ISO8601
str = forall a. FromJSON a => Value -> Parser a
parseJSON

      num :: Value -> Aeson.Parser POSIX
      num :: Value -> Parser POSIX
num =
        forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific
          String
"POSIX"
          ( forall (f :: * -> *) a. Applicative f => a -> f a
pure
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). UTCTime -> Time a
Time
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
          )

instance ToByteString RFC822 where
  toBS :: RFC822 -> ByteString
toBS = String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString ISO8601 where
  toBS :: ISO8601 -> ByteString
toBS = String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString BasicTime where
  toBS :: BasicTime -> ByteString
toBS = String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToByteString AWSTime where
  toBS :: AWSTime -> ByteString
toBS = String -> ByteString
BS.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: Format). TimeFormat (Time a) => Time a -> String
renderFormattedTime

instance ToQuery RFC822 where
  toQuery :: RFC822 -> QueryString
toQuery = forall a. ToQuery a => a -> QueryString
toQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery ISO8601 where
  toQuery :: ISO8601 -> QueryString
toQuery = forall a. ToQuery a => a -> QueryString
toQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery BasicTime where
  toQuery :: BasicTime -> QueryString
toQuery = forall a. ToQuery a => a -> QueryString
toQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery AWSTime where
  toQuery :: AWSTime -> QueryString
toQuery = forall a. ToQuery a => a -> QueryString
toQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToByteString a => a -> ByteString
toBS

instance ToQuery POSIX where
  toQuery :: POSIX -> QueryString
toQuery (Time UTCTime
t) = forall a. ToQuery a => a -> QueryString
toQuery (forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer)

instance ToXML RFC822 where
  toXML :: RFC822 -> XML
toXML = forall a. ToText a => a -> XML
toXMLText

instance ToXML ISO8601 where
  toXML :: ISO8601 -> XML
toXML = forall a. ToText a => a -> XML
toXMLText

instance ToXML AWSTime where
  toXML :: AWSTime -> XML
toXML = forall a. ToText a => a -> XML
toXMLText

instance ToXML BasicTime where
  toXML :: BasicTime -> XML
toXML = forall a. ToText a => a -> XML
toXMLText

instance ToJSON RFC822 where
  toJSON :: RFC822 -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance ToJSON ISO8601 where
  toJSON :: ISO8601 -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance ToJSON AWSTime where
  toJSON :: AWSTime -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance ToJSON BasicTime where
  toJSON :: BasicTime -> Value
toJSON = forall a. ToText a => a -> Value
toJSONText

instance ToJSON POSIX where
  toJSON :: POSIX -> Value
toJSON (Time UTCTime
t) =
    Scientific -> Value
Aeson.Number forall a b. (a -> b) -> a -> b
$
      Integer -> Int -> Scientific
Scientific.scientific (forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t) :: Integer) Int
0