# WAI Request Spec WAI Request Spec is a declarative validation layer for HTTP requests. It aims to make error-handling for malformed requests as easy as taking the happy path. A brief summary of the core features: * Can specify headers and query params as input sources * Support for parsing ints, floats, text, bytes (with encodings), and bools * A parser combinator interface for chaining together request requirements * Support for Alternatives * Support for optional parameters * Convenient and informative default error messages that let service consumers know what went wrong It is built on WAI, so it is compatible with several Haskell web frameworks. All you need is the ability to access the Request object, and WAI Request Spec takes care of the rest! # Contributing Contributions are welcome! Documentation, examples, code, and feedback - they all help. Be sure to review the included code of conduct. This project adheres to the [Contributor's Covenant](http://contributor-covenant.org/). By participating in this project you agree to abide by its terms. # How to Do Here's some code: ```haskell {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Control.Applicative import Data.Text import Data.Text.Lazy (fromStrict) import Network.Wai.RequestSpec import Network.HTTP.Types (badRequest400) import Web.Scotty hiding (param, header) import Network.Wai.RequestSpec.Examples.Types ------------------------------------------------------------ -- Your Data Model ------------------------------------------------------------ data Query = Query ClientId Count Offset UserName Accepts deriving Show ------------------------------------------------------------ -- Request Spec: The Part You Write ------------------------------------------------------------ -- if offset is given, return that value; else, offset is 0 offset :: Maybe Int -> Offset offset (Just n) = Offset n offset Nothing = Offset 0 -- if Accept is given, parse it; otherwise, default to plain text accept :: Maybe Text -> Accepts accept (Just "text/plain") = PlainText accept (Just "application/json") = JSON accept _ = PlainText instance FromEnv Query where fromEnv e = Query <$> (ClientId <$> textQ "client_id" e) <*> (Count <$> intQ "count" e) <*> (offset <$> intQM "offset" e) <*> (UserName <$> textH "X-User-Name" e) <*> (accept <$> textHM "Accept" e) ------------------------------------------------------------ -- Application: Making Use of Request Spec ------------------------------------------------------------ main :: IO () main = scotty 3000 $ get "/query" $ do -- Request spec in action: parse what you want, and ... req <- request let query = parse fromEnv (toEnv req) :: Result Query -- figure out what to do next based on whether the request was valid! case query of -- show user what's missing Failure e -> status badRequest400 >> (text . fromStrict . pack . show $ e) -- show user what Query they made Success v -> text . fromStrict . pack . show $ v ``` Here's the API responses: ```http $ http get localhost:3000/query HTTP/1.1 400 Bad Request Content-Type: text/plain; charset=utf-8 Date: Thu, 09 Apr 2015 21:30:43 GMT Server: Warp/3.0.10 Transfer-Encoding: chunked missing Header "X-User-Name" missing Param "count" missing Param "client_id" ``` --- ```http $ http get 'localhost:3000/query?client_id&offset&count' x-user-name:taco HTTP/1.1 400 Bad Request Content-Type: text/plain; charset=utf-8 Date: Thu, 09 Apr 2015 21:31:22 GMT Server: Warp/3.0.10 Transfer-Encoding: chunked missing Param "count" missing Param "client_id" ``` --- ```http $ http get 'localhost:3000/query?client_id=usually&offset=cat&count=not-a-typical-number' x-user-name:taco HTTP/1.1 400 Bad Request Content-Type: text/plain; charset=utf-8 Date: Wed, 08 Apr 2015 19:33:47 GMT Server: Warp/3.0.10 Transfer-Encoding: chunked could not parse "cat": "Could not parse integer" could not parse "not-a-typical-number": "Could not parse integer" ``` --- ```http $ http get 'localhost:3000/query?client_id=usually&offset=5&count=10' x-user-name:taco HTTP/1.1 200 OK Content-Type: text/plain; charset=utf-8 Date: Thu, 09 Apr 2015 21:37:29 GMT Server: Warp/3.0.10 Transfer-Encoding: chunked Query (ClientId "usually") (Count 10) (Offset 5) (UserName "taco") PlainText ``` --- ```http $ http get 'localhost:3000/query?client_id=usually&count=10' x-user-name:taco accept:application/json HTTP/1.1 200 OK Content-Type: text/plain; charset=utf-8 Date: Thu, 09 Apr 2015 21:38:24 GMT Server: Warp/3.0.10 Transfer-Encoding: chunked Query (ClientId "usually") (Count 10) (Offset 0) (UserName "taco") JSON ``` # Developer Setup Here's a few handy steps in order to get the project set up locally: 1. Install [Haskell](https://github.com/bitemyapp/learnhaskell#getting-set-up) 2. Build the project ``` $ git clone https://gitlab.com/queertypes/wai-request-spec.git $ cd wai-request-spec $ cabal sandbox init $ cabal install --dependencies-only $ cd examples $ cabal sandbox init $ cabal sandbox add-source .. # Until this is published on Hackage $ cabal install --dependencies-only ``` 3. Play with the project! I give examples below using the lovely [httpie](https://github.com/jakubroztocil/httpie) HTTP CLI client. ``` $ cabal run scotty-request-spec # new terminal $ http get 'localhost:3000/auth?client_id=cats'\ Authorization:"Basic eW91J3JlOmF3ZXNvbWU=" ``` 4. (Coming soon) Run tests: ``` # From project root, not examples/ $ cabal configure --enable-tests $ cabal install --dependencies-only $ cabal test ``` 5. (Coming soon) Run benchmarks: ``` # From project root, not examples/ $ cabal configure --enable-benchmarks $ cabal install --dependencies-only $ cabal benchmark ``` ## Todo ### Benchmarking What's slow? What's fast? It'd be nice to track regressions and improvements in performance over time. ### Documentation/Examples There's examples available for a few web frameworks already. It'd be great to see more types of examples. ### Testing A combination of spec-style and property tests are needed. There's a lot of churn right now, but capturing expected core behavior would be awesome. # Licensing This project is distrubted under a BSD3 license. See the included LICENSE file for more details.