diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 0.2.0.0 - 2026-05-21 + +- Fix parsers to reject years with more than 15 digits + # 0.1.1 - Support GHC-8.6.5...9.10.1 diff --git a/src/Data/Time/FromText.hs b/src/Data/Time/FromText.hs --- a/src/Data/Time/FromText.hs +++ b/src/Data/Time/FromText.hs @@ -272,19 +272,24 @@ start :: Int -> Int -> Either String r start !off !len = unconsAscii_ arr off len (unexpectedEOF "-, +, or a digit") $ \c off' len' -> case c of - '-' -> loop negate off' off' len' - '+' -> loop id off' off' len' + -- year is capped to 15 digits and we try consuming one more before raising an error, hence max 16 digits + '-' -> loop negate off' off' (min len' 16) + '+' -> loop id off' off' (min len' 16) _ - | '0' <= c, c <= '9' -> loop id off off' len' + | '0' <= c, c <= '9' -> loop id off off' (min len' 15) -- already consumed first digit, 15 left | otherwise -> Left $ "Unexpected '" ++ show c ++ ", expecting -, +, or a digit" + -- The caller must make sure not to consume too many digits, to avoid complexity blow up in conversion to Integer! loop :: (Integer -> Integer) -> Int -> Int -> Int -> Either String r loop !posNeg !off0 !off !len = unconsAscii_ arr off len (finishEOF posNeg off0 off) $ \c off' len' -> if | '0' <= c, c <= '9' -> loop posNeg off0 off' len' - | otherwise -> finishC posNeg c off0 off off' len' + | otherwise -> finishC posNeg c off0 off off' (lenS - (off' - offS)) -- restore the full remaining length finishEOF :: (Integer -> Integer) -> Int -> Int -> Either String r finishEOF !posNeg !off0 !off + | len0 >= 16 + = Left "expected year with at most 15 digits" + | len0 >= 4 = year `seq` kontEOF year @@ -415,6 +420,8 @@ makeTimeOfDay h m s kont = if h < 24 && m < 60 && s < 61 then inline kont (Local.TimeOfDay h m s) + else if h == 24 && m == 0 && s == 0 + then inline kont (Local.TimeOfDay 24 0 0) else Left $ "Invalid time of day:" ++ show (h,m,s) -- Parse seconds: @SS.SSS@. diff --git a/tests/text-iso8601-tests.hs b/tests/text-iso8601-tests.hs --- a/tests/text-iso8601-tests.hs +++ b/tests/text-iso8601-tests.hs @@ -12,7 +12,7 @@ property) import Test.QuickCheck.Instances () import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.HUnit (assertFailure, testCase) +import Test.Tasty.HUnit (assertEqual, assertFailure, testCase) import Test.Tasty.QuickCheck (testProperty) import qualified Data.Text as T @@ -61,23 +61,34 @@ -- accepts +23:59 , accepts T.parseUTCTime "1937-01-01T12:00:00+23:59" , accepts T.parseUTCTime "1937-01-01T12:00:00-23:59" + + -- accepts 24:00:00 + , accepts T.parseUTCTime "1990-12-31T24:00:00Z" ] , testGroup "rejected" -- https://github.com/haskell/aeson/issues/1033 - [ rejects T.parseUTCTime "2023-06-09T02:35:33 Z" + [ rejects T.parseUTCTime "2023-06-09T02:35:33 Z" "Unexpected ' ', expecting timezone: Z, +HH:MM or -HH:MM" -- Y2K years - , rejects T.parseDay "99-12-12" + , rejects T.parseDay "99-12-12" "expected year with at least 4 digits" -- we don't accept lowercase T or Z -- RFC3339 says we MAY limit, i.e. requiring they should be uppercase. - , rejects T.parseUTCTime "2023-06-09T02:35:33z" - , rejects T.parseUTCTime "2023-06-09t02:35:33Z" + , rejects T.parseUTCTime "2023-06-09T02:35:33z" "Unexpected 'z', expecting timezone: Z, +HH:MM or -HH:MM" + , rejects T.parseUTCTime "2023-06-09t02:35:33Z" "Unexpected 't', expecting a day separator, T or space" -- accepts +23:59, but not 24 or 60 - , rejects T.parseUTCTime "1937-01-01T12:00:00+24:59" - , rejects T.parseUTCTime "1937-01-01T12:00:00-23:60" + , rejects T.parseUTCTime "1937-01-01T12:00:00+24:59" "Invalid TimeZone:(24,59)" + , rejects T.parseUTCTime "1937-01-01T12:00:00-23:60" "Invalid TimeZone:(23,60)" + + -- rejects 24:xx:xx except 24:00:00 + , rejects T.parseUTCTime "1990-12-31T24:00:01Z" "Invalid time of day:(24,0,1.000000000000)" + , rejects T.parseUTCTime "1990-12-31T24:00:60Z" "Invalid time of day:(24,0,60.000000000000)" + , rejects T.parseUTCTime "1990-12-31T24:01:00Z" "Invalid time of day:(24,1,0.000000000000)" + + -- Reject long years + , rejects T.parseUTCTime "1234567890123456-01-01T01:01Z" "expected year with at most 15 digits" ] ] @@ -98,10 +109,10 @@ counterexample (show y) $ property (liftEq eq y (Right x)) -rejects :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree -rejects parse inp = testCase (show (typeRep (Proxy :: Proxy a)) ++ " rejects " ++ show inp) $ do +rejects :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> String -> TestTree +rejects parse inp expected = testCase (show (typeRep (Proxy :: Proxy a)) ++ " rejects " ++ show inp) $ do case parse (T.pack inp) of - Left _ -> return () + Left actual -> assertEqual "Error message mismatch" actual expected Right a -> assertFailure $ "Unexpectedly accepted: " ++ show a accepts :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree diff --git a/text-iso8601.cabal b/text-iso8601.cabal --- a/text-iso8601.cabal +++ b/text-iso8601.cabal @@ -1,9 +1,9 @@ cabal-version: 1.12 name: text-iso8601 -version: 0.1.1.1 +version: 0.2.0.0 synopsis: Converting time to and from ISO 8601 text. description: - Converting time to and from IS0 8601 text. + Converting time to and from ISO 8601 text. Specifically the [RFC3339](https://datatracker.ietf.org/doc/html/rfc3339) profile. license: BSD3 @@ -26,7 +26,7 @@ || ==9.4.8 || ==9.6.6 || ==9.8.4 - || ==9.10.1 + || ==9.10.3 || ==9.12.4 || ==9.14.1