Fixed paramOrDefault failing on empty parameters

This regression has been introduced with the last IHP release. paramOrDefault should not fail when an empty parameter is given.

Added tests to make sure this won't happen again in the future

IHP/Controller/Param.hs

@@ -26,6 +26,7 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.HashSet as HashSet
 import qualified Data.Scientific as Scientific
 import qualified Data.Vector as Vector
+import qualified Control.DeepSeq as DeepSeq
 
 -- | Returns a query or body parameter from the current request. The raw string
 -- value is parsed before returning it. So the return value type depends on what
@@ -110,13 +111,14 @@ param !name = case paramOrError name of
 -- When a value cannot be parsed, this function will fail similiar to 'param'.
 --
 -- Related: https://stackoverflow.com/questions/63875081/how-can-i-pass-list-params-in-ihp-forms/63879113
-paramList :: forall valueType. (?context :: ControllerContext) => (ParamReader valueType) => ByteString -> [valueType]
+paramList :: forall valueType. (?context :: ControllerContext, DeepSeq.NFData valueType, ParamReader valueType) => ByteString -> [valueType]
 paramList name =
     allParams
     |> filter (\(paramName, paramValue) -> paramName == name)
     |> mapMaybe (\(paramName, paramValue) -> paramValue)
     |> map (readParameter @valueType)
     |> map (Either.fromRight (error (paramParserErrorMessage name)))
+    |> DeepSeq.force
 {-# INLINE paramList #-}
 
 paramParserErrorMessage name = "param: Parameter '" <> cs name <> "' is invalid"
@@ -125,7 +127,7 @@ paramParserErrorMessage name = "param: Parameter '" <> cs name <> "' is invalid"
 data ParamException
     = ParamNotFoundException { name :: ByteString }
     | ParamCouldNotBeParsedException { name :: ByteString, parserError :: ByteString }
-    deriving (Show)
+    deriving (Show, Eq)
 
 instance Exception ParamException where
     displayException (ParamNotFoundException { name }) = "param: Parameter '" <> cs name <> "' not found"
@@ -203,12 +205,12 @@ paramOrDefault !defaultValue = fromMaybe defaultValue . paramOrNothing
 -- >     let page :: Maybe Int = paramOrNothing "page"
 --
 -- When calling @GET /Users?page=1@ the variable @page@ will be set to @Just 1@.
-paramOrNothing :: forall paramType. (?context :: ControllerContext) => ParamReader paramType => ByteString -> Maybe paramType
+paramOrNothing :: forall paramType. (?context :: ControllerContext) => ParamReader (Maybe paramType) => ByteString -> Maybe paramType
 paramOrNothing !name =
     case paramOrError name of
         Left ParamNotFoundException {} -> Nothing
         Left otherException -> Exception.throw otherException
-        Right value -> Just value
+        Right value -> value
 {-# INLINE paramOrNothing #-}
 
 -- | Like 'param', but returns @Left "Some error message"@ if the parameter is missing or invalid

Test/Controller/ParamSpec.hs

@@ -8,11 +8,94 @@ import IHP.Prelude
 import IHP.HaskellSupport
 import Test.Hspec
 import IHP.Controller.Param
+import IHP.Controller.Context
+import IHP.Controller.RequestContext
 import qualified Data.Aeson as Aeson
 import qualified Data.UUID as UUID
+import qualified Data.TMap as TypeMap
+import qualified Network.Wai as Wai
+import qualified GHC.IO as IO
 
 tests = do
     describe "IHP.Controller.Param" do
+        describe "param" do
+            it "should parse valid input" do
+                let ?context = createControllerContextWithParams [("page", "1")]
+                (param @Int "page") `shouldBe` 1
+
+            it "should fail on empty input" do
+                let ?context = createControllerContextWithParams [("page", "")]
+                (IO.evaluate (param @Int "page")) `shouldThrow` (== ParamCouldNotBeParsedException { name = "page", parserError = "ParamReader Int: not enough input" })
+
+            it "should fail if param not provided" do
+                let ?context = createControllerContextWithParams []
+                (IO.evaluate (param @Int "page")) `shouldThrow` (== ParamNotFoundException { name = "page" })
+
+            it "should fail with a parser error on invalid input" do
+                let ?context = createControllerContextWithParams [("page", "NaN")]
+                (IO.evaluate (param @Int "page")) `shouldThrow` (== ParamCouldNotBeParsedException { name = "page", parserError = "ParamReader Int: Failed reading: takeWhile1" })
+
+        describe "paramOrNothing" do
+            it "should parse valid input" do
+                let ?context = createControllerContextWithParams [("referredBy", "776ab71d-327f-41b3-90a8-7b5a251c4b88")]
+                (paramOrNothing @UUID "referredBy") `shouldBe` (Just "776ab71d-327f-41b3-90a8-7b5a251c4b88")
+
+            it "should return Nothing on empty input" do
+                let ?context = createControllerContextWithParams [("referredBy", "")]
+                (paramOrNothing @UUID "referredBy") `shouldBe` Nothing
+
+            it "should return Nothing if param not provided" do
+                let ?context = createControllerContextWithParams []
+                (paramOrNothing @UUID "referredBy") `shouldBe` Nothing
+
+            it "should fail with a parser error on invalid input" do
+                let ?context = createControllerContextWithParams [("referredBy", "not a uuid")]
+                (IO.evaluate (paramOrNothing @UUID "referredBy")) `shouldThrow` (== ParamCouldNotBeParsedException { name = "referredBy", parserError = "FromParameter UUID: Parse error" })
+
+        describe "paramOrDefault" do
+            it "should parse valid input" do
+                let ?context = createControllerContextWithParams [("page", "1")]
+                (paramOrDefault @Int 0 "page") `shouldBe` 1
+
+            it "should return default value on empty input" do
+                let ?context = createControllerContextWithParams [("page", "")]
+                (paramOrDefault @Int 10 "page") `shouldBe` 10
+
+            it "should return default value if param not provided" do
+                let ?context = createControllerContextWithParams []
+                (paramOrDefault @Int 10 "page") `shouldBe` 10
+
+            it "should fail with a parser error on invalid input" do
+                let ?context = createControllerContextWithParams [("page", "NaN")]
+                (IO.evaluate (paramOrDefault @Int 10 "page")) `shouldThrow` (== ParamCouldNotBeParsedException { name = "page", parserError = "ParamReader Int: Failed reading: takeWhile1" })
+
+
+        describe "paramList" do
+            it "should parse valid input" do
+                let ?context = createControllerContextWithParams [("ingredients", "milk"), ("ingredients", "egg")]
+                (paramList @Text "ingredients") `shouldBe` ["milk", "egg"]
+
+            it "should fail on invalid input" do
+                let ?context = createControllerContextWithParams [("numbers", "1"), ("numbers", "NaN")]
+                (IO.evaluate (paramList @Int "numbers")) `shouldThrow` (errorCall "param: Parameter 'numbers' is invalid")
+
+            it "should deal with empty input" do
+                let ?context = createControllerContextWithParams []
+                (paramList @Int "numbers") `shouldBe` []
+
+        describe "hasParam" do
+            it "returns True if param given" do
+                let ?context = createControllerContextWithParams [("a", "test")]
+                hasParam "a" `shouldBe` True
+
+            it "returns True if param given but empty" do
+                let ?context = createControllerContextWithParams [("a", "")]
+                hasParam "a" `shouldBe` True
+
+            it "returns False if param missing" do
+                let ?context = createControllerContextWithParams []
+                hasParam "a" `shouldBe` False
+
         describe "ParamReader" do
             describe "ByteString" do
                 it "should handle text input" do
@@ -186,6 +269,13 @@ tests = do
                 it "should deal with parser errors" do
                     (readParameter @(Maybe Int) "not a number") `shouldBe` (Left "ParamReader Int: Failed reading: takeWhile1")
 
+createControllerContextWithParams params =
+        let
+            requestBody = FormBody { params, files = [] }
+            request = Wai.defaultRequest
+            requestContext = RequestContext { request, respond = error "respond", requestBody, vault = error "vault", frameworkConfig = error "frameworkConfig" }
+        in FrozenControllerContext { requestContext, customFields = TypeMap.empty }
+
 json :: Text -> Aeson.Value
 json string =
     let (Just value) :: Maybe Aeson.Value = Aeson.decode (cs string)