http-date-0.0.13: test/DateSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module DateSpec where

import Control.Monad
import Data.Maybe (isJust)
import Model
import Network.HTTP.Date
import System.Posix.Types
import Test.Hspec

----------------------------------------------------------------

-- Every 100000 seconds hits few boundaries of a day, so add a step
-- coprime to 86400 from before 1970 to beyond year 9999.
epochs :: [EpochTime]
epochs =
    [0, 100000 .. 10000000000]
        ++ [-62135596800, -62135596800 + 9999991 .. 253402300799]

hd :: HTTPDate
hd =
    defaultHTTPDate
        { hdYear = 1994
        , hdMonth = 11
        , hdDay = 6
        , hdHour = 8
        , hdMinute = 49
        , hdSecond = 37
        , hdWkday = 7
        }

spec :: Spec
spec = do
    describe "epochTimeToHTTPDate" $ do
        it "behaves like utcToHTTPDate" $
            forM_ (epochs ++ [-1, -86400, 253402300800, 10 ^ (15 :: Int)]) $ \e ->
                epochTimeToHTTPDate e `shouldBe` utcToHTTPDate (epochTimeToUtcTime e)
        it "handles the extremes of EpochTime in constant time" $ do
            hdYear (epochTimeToHTTPDate 9223372036854775807) `shouldBe` 292277026596
            hdYear (epochTimeToHTTPDate (-9223372036854775808)) `shouldBe` -292277022657

    describe "formatHTTPDate" $ do
        it "behaves like the model" $
            forM_ epochs $ \e ->
                formatHTTPDate (epochTimeToHTTPDate e)
                    `shouldBe` utcToDate (epochTimeToUtcTime e)
        it "renders out-of-range fields as underscores" $ do
            formatHTTPDate hd{hdYear = 10000} `shouldBe` "Sun, 06 Nov ____ 08:49:37 GMT"
            formatHTTPDate hd{hdYear = -1} `shouldBe` "Sun, 06 Nov ____ 08:49:37 GMT"
            formatHTTPDate hd{hdDay = 0, hdHour = 24, hdMinute = 60, hdSecond = 61}
                `shouldBe` "Sun, __ Nov 1994 __:__:__ GMT"
            formatHTTPDate hd{hdDay = 123, hdHour = -1}
                `shouldBe` "Sun, __ Nov 1994 __:49:37 GMT"

    describe "parseHTTPDate" $ do
        it "behaves like the model" $
            forM_ epochs $ \e -> do
                let m = epochTimeToHTTPDate e
                parseHTTPDate (formatHTTPDate m) `shouldBe` Just m
        it "accepts the three formats of RFC 9110" $ do
            parseHTTPDate "Sun, 06 Nov 1994 08:49:37 GMT" `shouldBe` Just hd
            parseHTTPDate "Sunday, 06-Nov-94 08:49:37 GMT" `shouldBe` Just hd
            parseHTTPDate "Sun Nov  6 08:49:37 1994" `shouldBe` Just hd
            parseHTTPDate "Sun Nov 06 08:49:37 1994" `shouldBe` Just hd
        it "ignores trailing whitespace" $ do
            parseHTTPDate "Sun, 06 Nov 1994 08:49:37 GMT \t " `shouldBe` Just hd
            parseHTTPDate "Sun Nov  6 08:49:37 1994 " `shouldBe` Just hd
        it "maps a two-digit year to 1970-2069" $ do
            hdYear <$> parseHTTPDate "Thursday, 01-Jan-70 00:00:00 GMT" `shouldBe` Just 1970
            hdYear <$> parseHTTPDate "Tuesday, 31-Dec-69 00:00:00 GMT" `shouldBe` Just 2069
        it "accepts a leap second only at 23:59" $ do
            parseHTTPDate "Sat, 31 Dec 2016 23:59:60 GMT" `shouldSatisfy` isJust
            parseHTTPDate "Sat, 31 Dec 2016 23:58:60 GMT" `shouldBe` Nothing
        it "rejects invalid dates and times"
            $ forM_
                [ "Sun, 06 Nov 1994 08:49:37 GMTgarbage"
                , " Sun, 06 Nov 1994 08:49:37 GMT"
                , "Sun, 00 Nov 1994 08:49:37 GMT"
                , "Sun, 31 Nov 1994 08:49:37 GMT"
                , "Sun, 29 Feb 1900 08:49:37 GMT"
                , "Sun, 06 Nov 1994 24:00:00 GMT"
                , "Sun, 06 Nov 1994 08:60:37 GMT"
                , "Sun, 06 Nov 1994 08:49:61 GMT"
                , "Sun, 06 Nov 1994 08:49:37"
                , "Sun, 6 Nov 1994 08:49:37 GMT"
                , "Sun,06 Nov 1994 08:49:37 GMT"
                , "Sun Nov  6 08:49:37 1994 GMT"
                , "Sunday, 06 Nov 1994 08:49:37 GMT"
                , ""
                ]
            $ \s -> parseHTTPDate s `shouldBe` Nothing

    describe "httpDateToUTC" $ do
        it "behaves like the model" $
            forM_ epochs $ \e ->
                httpDateToUTC (epochTimeToHTTPDate e) `shouldBe` epochTimeToUtcTime e
        it "keeps a leap second at 23:59" $ do
            let ls = hd{hdHour = 23, hdMinute = 59, hdSecond = 60}
            show (httpDateToUTC ls) `shouldBe` "1994-11-06 23:59:60 UTC"
            utcToHTTPDate (httpDateToUTC ls) `shouldBe` ls
        it "clips out-of-range fields" $ do
            show (httpDateToUTC hd{hdMonth = 2, hdDay = 31, hdHour = 25})
                `shouldBe` "1994-02-28 23:49:37 UTC"
            show (httpDateToUTC hd{hdMinute = -5, hdSecond = 60})
                `shouldBe` "1994-11-06 08:00:59 UTC"

    describe "httpDateToUTCValid" $ do
        it "agrees with httpDateToUTC on valid values" $
            forM_ epochs $ \e -> do
                let m = epochTimeToHTTPDate e
                httpDateToUTCValid m `shouldBe` Just (httpDateToUTC m)
        it "rejects invalid values"
            $ forM_
                [ hd{hdMonth = 2, hdDay = 30}
                , hd{hdMonth = 13}
                , hd{hdHour = 24}
                , hd{hdMinute = -1}
                , hd{hdSecond = 60}
                ]
            $ \x -> httpDateToUTCValid x `shouldBe` Nothing

    describe "utcToHTTPDate" $ do
        it "behaves like the model" $
            forM_ epochs $ \e ->
                utcToHTTPDate (epochTimeToUtcTime e) `shouldBe` epochTimeToHTTPDate e