fix numeric parsers accepting overflowing bounded values (#302)

changelog.md

@@ -7,6 +7,7 @@
 - fix case-insensitive parsing for AM/PM markers, UTC, and known timezone names
 - fix Unix timezone fallback offset sign and DST abbreviation
 - fix JavaScript getTimeZone offsets and summer flag around DST transitions
+- fix numeric parsers accepting overflowing bounded values
 
 ## [1.16] - 2026-05-03
 

lib/Data/Format.hs

@@ -29,6 +29,7 @@ import Control.Monad.Fail
 import Data.Char
 import Data.Void
 import Text.ParserCombinators.ReadP
+import Text.Read (readMaybe)
 import Prelude hiding (fail)
 
 class IsoVariant f where
@@ -213,13 +214,40 @@ readSign NoSign = return id
 readSign NegSign = option id $ char '-' >> return negate
 readSign PosNegSign = (char '+' >> return id) +++ (char '-' >> return negate)
 
+readDigits :: Maybe Int -> ReadP String
+readDigits mdigitcount =
+    case mdigitcount of
+        Just digitcount -> count digitcount $ satisfy isDigit
+        Nothing -> munch1 isDigit
+
+readMaybeP :: Read t => String -> ReadP t
+readMaybeP str =
+    case readMaybe str of
+        Just t -> return t
+        Nothing -> pfail
+
+fromIntegerExact :: Integral t => Integer -> Maybe t
+fromIntegerExact i =
+    let
+        t = fromInteger i
+    in
+        if toInteger t == i
+            then Just t
+            else Nothing
+
+readIntegerNumber :: Integral t => SignOption -> Maybe Int -> ReadP t
+readIntegerNumber signOpt mdigitcount = do
+    sign <- readSign signOpt
+    digits <- readDigits mdigitcount
+    i <- readMaybeP digits
+    case fromIntegerExact $ sign i of
+        Just t -> return t
+        Nothing -> pfail
+
 readNumber :: (Num t, Read t) => SignOption -> Maybe Int -> Bool -> ReadP t
 readNumber signOpt mdigitcount allowDecimal = do
     sign <- readSign signOpt
-    digits <-
-        case mdigitcount of
-            Just digitcount -> count digitcount $ satisfy isDigit
-            Nothing -> munch1 isDigit
+    digits <- readDigits mdigitcount
     moredigits <-
         case allowDecimal of
             False -> return ""
@@ -228,7 +256,8 @@ readNumber signOpt mdigitcount allowDecimal = do
                     _ <- char '.' +++ char ','
                     dd <- munch1 isDigit
                     return $ '.' : dd
-    return $ sign $ read $ digits ++ moredigits
+    a <- readMaybeP $ digits ++ moredigits
+    return $ sign a
 
 zeroPad :: Maybe Int -> String -> Maybe String
 zeroPad Nothing s = Just s
@@ -269,8 +298,8 @@ showNumber signOpt mdigitcount t =
                     PosNegSign -> '+' : s
                     _ -> s
 
-integerFormat :: (Show t, Read t, Num t) => SignOption -> Maybe Int -> Format t
-integerFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readNumber signOpt mdigitcount False)
+integerFormat :: (Show t, Integral t) => SignOption -> Maybe Int -> Format t
+integerFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readIntegerNumber signOpt mdigitcount)
 
 decimalFormat :: (Show t, Read t, Num t) => SignOption -> Maybe Int -> Format t
 decimalFormat signOpt mdigitcount = MkFormat (showNumber signOpt mdigitcount) (readNumber signOpt mdigitcount True)

lib/Data/Time/Format/ISO8601.hs

@@ -328,7 +328,7 @@ dayAndTimeFormat fday ftod = fday <**> withTimeDesignator ftod
 timeAndOffsetFormat :: Format t -> FormatExtension -> Format (t, TimeZone)
 timeAndOffsetFormat ft fe = ft <**> timeOffsetFormat fe
 
-intDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t
+intDesignator :: (Show t, Integral t) => Char -> Format t
 intDesignator c = optionalFormat 0 $ integerFormat NegSign Nothing <** literalFormat [c]
 
 decDesignator :: (Eq t, Show t, Read t, Num t) => Char -> Format t

lib/Data/Time/Format/Parse/Instances.hs

@@ -129,11 +129,20 @@ readSpec_Z _ _ = Nothing
 eqCI :: String -> String -> Bool
 eqCI x y = map toUpper x == map toUpper y
 
+readIntegralMaybe :: Integral a => String -> Maybe a
+readIntegralMaybe str = do
+    i <- readMaybe str
+    let
+        a = fromInteger i
+    if toInteger a == i
+        then Just a
+        else Nothing
+
 makeDayFact :: TimeLocale -> Char -> String -> Maybe [DayFact]
 makeDayFact l c x =
     let
-        ra :: Read a => Maybe a
-        ra = readMaybe x
+        ra :: Integral a => Maybe a
+        ra = readIntegralMaybe x
         zeroBasedListIndex :: [String] -> Maybe Int
         zeroBasedListIndex ss = elemIndex (map toUpper x) $ fmap (map toUpper) ss
         oneBasedListIndex :: [String] -> Maybe Int
@@ -411,8 +420,8 @@ timeFactGetZone = lastMatch $ \case
 makeTimeFact :: TimeLocale -> Char -> String -> Maybe [TimeFact]
 makeTimeFact l c x =
     let
-        ra :: Read a => Maybe a
-        ra = readMaybe x
+        ra :: Integral a => Maybe a
+        ra = readIntegralMaybe x
         getAmPm =
             let
                 (amStr, pmStr) = amPm l

test/main/Test/Format/ISO8601.hs

@@ -160,6 +160,9 @@ testShowReadFormat name fmt str val =
 testReadFormat :: (Show t, Eq t) => String -> Format t -> String -> t -> TestTree
 testReadFormat name fmt str val = nameTest (name ++ ": " ++ str) $ assertEqual "" (Just val) $ formatParseM fmt str
 
+testReadFormatFails :: (Show t, Eq t) => String -> Format t -> String -> TestTree
+testReadFormatFails name fmt str = nameTest (name ++ ": " ++ str) $ assertEqual "" Nothing $ formatParseM fmt str
+
 testShowFormats :: TestTree
 testShowFormats =
     nameTest
@@ -240,6 +243,10 @@ testShowFormats =
             (recurringIntervalFormat (calendarFormat ExtendedFormat) durationDaysFormat)
             "R74/2015-06-13/P1Y2M7D"
             (74, fromGregorian 2015 6 13, CalendarDiffDays 14 7)
+        , testReadFormatFails
+            "recurringIntervalFormat etc."
+            (recurringIntervalFormat (calendarFormat ExtendedFormat) (calendarFormat ExtendedFormat))
+            "R18446744073709551616/2024-01-01/2024-01-02"
         , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:30" (minutesToTimeZone (-390))
         , testShowReadFormat "timeOffsetFormat" iso8601Format "-06:00" (minutesToTimeZone (-360))
         , testReadFormat "timeOffsetFormat" iso8601Format "-06" (minutesToTimeZone (-360))

test/main/Test/Format/ParseTime.hs

@@ -293,7 +293,12 @@ particularParseTests =
     lowerKnownZoneLocale = defaultTimeLocale{knownTimeZones = [lowerKnownZone]}
 
 badParseTests :: TestTree
-badParseTests = testGroup "bad" [parseTest False (Nothing :: Maybe Day) "%Y" ""]
+badParseTests =
+    testGroup
+        "bad"
+        [ parseTest False (Nothing :: Maybe Day) "%Y" ""
+        , parseTest False (Nothing :: Maybe TimeOfDay) "%-H" "18446744073709551616"
+        ]
 
 {-
 parseYMD :: Day -> TestTree