Add formData for parsing forms into records

Also add some tests for formData

Web/Scotty.hs

@@ -25,7 +25,7 @@ module Web.Scotty
     , capture, regex, function, literal
       -- ** Accessing the Request and its fields
     , request, header, headers, body, bodyReader
-    , jsonData
+    , jsonData, formData
       -- ** Accessing Path, Form and Query Parameters
     , param, params
     , pathParam, captureParam, formParam, queryParam
@@ -69,6 +69,7 @@ import Network.Wai (Application, Middleware, Request, StreamingBody)
 import Network.Wai.Handler.Warp (Port)
 import qualified Network.Wai.Parse as W (defaultParseRequestBodyOptions)
 
+import Web.FormUrlEncoded (FromForm)
 import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..))
 import UnliftIO.Exception (Handler(..), catch)
 
@@ -273,6 +274,12 @@ bodyReader = Trans.bodyReader
 jsonData :: FromJSON a => ActionM a
 jsonData = Trans.jsonData
 
+-- | Parse the request body as @x-www-form-urlencoded@ form data and return it. Raises an exception if parse is unsuccessful.
+--
+-- NB: uses 'body' internally
+formData :: FromForm a => ActionM a
+formData = Trans.formData
+
 -- | Get a parameter. First looks in captures, then form data, then query parameters.
 --
 -- * Raises an exception which can be caught by 'catch' if parameter is not found.

Web/Scotty/Action.hs

@@ -23,6 +23,7 @@ module Web.Scotty.Action
     , liftAndCatchIO
     , json
     , jsonData
+    , formData
     , next
     , param
     , pathParam
@@ -101,6 +102,7 @@ import qualified Network.Wai.Parse as W (FileInfo(..), ParseRequestBodyOptions,
 
 import           Numeric.Natural
 
+import           Web.FormUrlEncoded (FromForm, urlDecodeAsForm)
 import           Web.Scotty.Internal.Types
 import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
 import           UnliftIO.Exception (Handler(..), catch, catches, throwIO)
@@ -168,6 +170,13 @@ scottyExceptionHandler = Handler $ \case
       , "Body: " <> bs
       , "Error: " <> BL.fromStrict (encodeUtf8 err)
       ]
+  MalformedForm bs err -> do
+    status status400
+    raw $ BL.unlines
+      [ "formData: malformed"
+      , "Body: " <> bs
+      , "Error: " <> BL.fromStrict (encodeUtf8 err)
+      ]
   PathParameterNotFound k -> do
     status status500
     text $ T.unwords [ "Path parameter", k, "not found"]
@@ -354,6 +363,19 @@ jsonData = do
         A.Error err -> throwIO $ FailedToParseJSON b $ T.pack err
         A.Success a -> return a
 
+-- | Parse the request body as @x-www-form-urlencoded@ form data and return it.
+--
+--   The form is parsed using 'urlDecodeAsForm'. If that returns 'Left', the
+--   status is set to 400 and an exception is thrown.
+--
+-- NB : Internally this uses 'body'.
+formData :: (FromForm a, MonadIO m) => ActionT m a
+formData = do
+  b <- body
+  case urlDecodeAsForm b of
+    Left err -> throwIO $ MalformedForm b err
+    Right value -> return value
+
 -- | Get a parameter. First looks in captures, then form data, then query parameters.
 --
 -- * Raises an exception which can be caught by 'catch' if parameter is not found.

Web/Scotty/Internal/Types.hs

@@ -147,6 +147,7 @@ data ScottyException
   = RequestTooLarge
   | MalformedJSON LBS8.ByteString T.Text
   | FailedToParseJSON LBS8.ByteString T.Text
+  | MalformedForm LBS8.ByteString T.Text
   | PathParameterNotFound T.Text
   | QueryParameterNotFound T.Text
   | FormFieldNotFound T.Text

Web/Scotty/Trans.hs

@@ -30,7 +30,7 @@ module Web.Scotty.Trans
     , capture, regex, function, literal
       -- ** Accessing the Request and its fields
     , request, Lazy.header, Lazy.headers, body, bodyReader
-    , jsonData
+    , jsonData, formData
 
       -- ** Accessing Path, Form and Query Parameters
     , param, params

scotty.cabal

@@ -77,6 +77,7 @@ Library
                        case-insensitive      >= 1.0.0.1  && < 1.3,
                        cookie                >= 0.4,
                        exceptions            >= 0.7      && < 0.11,
+                       http-api-data         >= 0.5.1,
                        http-types            >= 0.9.1    && < 0.13,
                        monad-control         >= 1.0.0.3  && < 1.1,
                        mtl                   >= 2.1.2    && < 2.4,
@@ -114,6 +115,7 @@ test-suite spec
                        directory,
                        hspec == 2.*,
                        hspec-wai >= 0.6.3,
+                       http-api-data,
                        http-types,
                        lifted-base,
                        network,

test/Web/ScottySpec.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, CPP, ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings, CPP, ScopedTypeVariables, DeriveGeneric #-}
 module Web.ScottySpec (main, spec) where
 
 import           Test.Hspec
@@ -9,18 +9,22 @@ import           Control.Applicative
 import           Control.Monad
 import           Data.Char
 import           Data.String
+import           Data.Text.Lazy (Text)
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import Data.Time (UTCTime(..))
 import Data.Time.Calendar (fromGregorian)
 import Data.Time.Clock (secondsToDiffTime)
 
+import GHC.Generics (Generic)
+
 import           Network.HTTP.Types
 import           Network.Wai (Application, Request(queryString), responseLBS)
 import           Network.Wai.Parse (defaultParseRequestBodyOptions)
 import qualified Control.Exception.Lifted as EL
 import qualified Control.Exception as E
 
+import           Web.FormUrlEncoded (FromForm)
 import           Web.Scotty as Scotty hiding (get, post, put, patch, delete, request, options)
 import qualified Web.Scotty as Scotty
 import qualified Web.Scotty.Cookie as SC (getCookie, setSimpleCookie, deleteCookie)
@@ -41,6 +45,13 @@ main = hspec spec
 availableMethods :: [StdMethod]
 availableMethods = [GET, POST, HEAD, PUT, PATCH, DELETE, OPTIONS]
 
+data SearchForm = SearchForm
+  { sfQuery :: Text
+  , sfYear :: Int
+  } deriving (Generic)
+
+instance FromForm SearchForm where
+
 spec :: Spec
 spec = do
   let withApp = with . scottyApp
@@ -270,6 +281,14 @@ spec = do
                 ) $ do
           it "catches a ScottyException" $ do
             get "/search?query=potato" `shouldRespondWith` 200 { matchBody = "z"}
+
+    describe "formData" $ do
+      withApp (Scotty.post "/search" $ formData >>= (text . sfQuery)) $ do
+        it "decodes the form" $ do
+          postHtmlForm "/search" [("sfQuery", "Haskell"), ("sfYear", "2024")] `shouldRespondWith` "Haskell"
+
+        it "returns 400 when the form can't is malformed" $ do
+          postHtmlForm "/search" [("sfQuery", "Haskell")] `shouldRespondWith` 400
 
     describe "formParam" $ do
       let