wai-routes 0.8.1 → 0.9.0

raw patch · 7 files changed

+420/−147 lines, 7 filesdep +wai-app-staticdep +wai-extradep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: wai-app-static, wai-extra

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• README.md +30/−4
• src/Network/Wai/Middleware/Routes.hs +22/−2
• src/Network/Wai/Middleware/Routes/DefaultRoute.hs +35/−0
• src/Network/Wai/Middleware/Routes/Handler.hs +228/−68
• src/Network/Wai/Middleware/Routes/Monad.hs +15/−4
• src/Network/Wai/Middleware/Routes/Routes.hs +25/−8
• wai-routes.cabal +65/−61

@@ -1,4 +1,4 @@-[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.8.1-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Coverage Status](https://coveralls.io/repos/ajnsit/wai-routes/badge.svg?branch=master&service=github)](https://coveralls.io/github/ajnsit/wai-routes?branch=master)+[Wai-Routes](https://ajnsit.github.io/wai-routes) [![Hackage](https://img.shields.io/badge/hackage-v0.9.0-brightgreen.svg)](https://hackage.haskell.org/package/wai-routes) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/wai-routes.svg)](http://packdeps.haskellers.com/feed?needle=wai-routes) [![Build Status](https://img.shields.io/travis/ajnsit/wai-routes.svg)](https://travis-ci.org/ajnsit/wai-routes) [![Coverage Status](https://coveralls.io/repos/ajnsit/wai-routes/badge.svg?branch=master&service=github)](https://coveralls.io/github/ajnsit/wai-routes?branch=master) ====================================  Wai-routes is a micro web framework for Haskell that focuses on typesafe URLs.@@ -16,6 +16,7 @@     - Nested Routes     - Subsites     - Route Annotations+  - Seamlessly mix and match "unrouted" request handlers with typesafe routing.   - Sitewide Master data which is passed to all handlers and can be used for persistent data (like DB connections)   - Easy to use Handler Monad which allows direct access to request and master data   - Easy composition of multiple routes and middleware to construct an application@@ -62,7 +63,32 @@  Wai has had the ability to stream content for a long time. Now wai-routes exposes this functionality with the `stream` function. This example shows how to stream content in a handler. Note that most browsers using default settings will not show content as it is being streamed. You can use "curl" to observe the effect of streaming. E.g. - `curl localhost:8080` will dump the data as it is being streamed from the server. +**Example 7. Kitchen sink ** - [Code](examples/kitchen) +*Work in progress*. Demonstrates all major features in wai-routes.+++Deployment+==========++The current recommended route (pun not intended) for deploying wai-routes apps is [keter](http://hackage.haskell.org/package/keter). You need to read the port from the environment variables -++    -- Run the application+    main :: IO ()+    main = do+      port' <- getEnv "PORT"+      let port = read port'+      run port $ waiApp application++Then put something like this in `config/keter.yaml` -++    exec: ../path/to/executable+    host: mydomainname.example.com++Then create a tarball with `config/keter.yaml`, `path/to/executable`, and any other files needed at runtime for your application. Rename the tarball to have a `.keter` extension.++Upload that file to your server's `incoming` folder for keter to pick it up. You obviously need keter already installed and configured properly at the server.+ Planned Features ==================== @@ -71,15 +97,15 @@ - Support for raw network responses (see http://hackage.haskell.org/package/wai-3.0.3.0/docs/Network-Wai.html#v:responseRaw) - Seamless websocket support - Development mode-- Keter and Heroku support - Scaffolding-- Better documentation-- Tests and code coverage+- Better documentation, and a getting started tutorial+- More tests and code coverage   Changelog ========= +* 0.9.0 : Support for "unrouted" handlers. API changes to avoid returning lazy text or bytestring. Methods to fetch post/file params. Removed 'HandlerMM' and made 'Handler' more useful. * 0.8.1 : Bumped dependencies. Added 'HandlerMM' type alias * 0.8.0 : Replaced 'show/renderRoute' with 'show/renderRouteSub' and 'show/renderRouteMaster'. Added functions to access request headers (reqHeader/s), send a part of a file (filepart). Auto infer mime-types when sending files. Added cookie handling functions (get/setCookie/s). Added 'sub' to allow access to subsite datatype. * 0.7.3 : Added 'stream' to stream responses. Added 'asContent', 'css', and 'javascript' functions.

@@ -51,6 +51,9 @@      -- * Route Monad makes it easy to compose routes together     , RouteM+    , DefaultMaster(..)+    , Route(DefaultRoute)+    , handler                -- | Add a wai-routes handler     , catchall               -- | Catch all routes with the supplied application     , defaultAction          -- | A synonym for `catchall`, kept for backwards compatibility     , middleware             -- | Add another middleware to the app@@ -60,9 +63,9 @@      -- * HandlerM Monad makes it easy to build a handler     , HandlerM()-    , HandlerMM()            -- | HandlerM Monad specialised for top level sites (no subsites)     , runHandlerM            -- | Run a HandlerM to get a Handler     , request                -- | Access the request data+    , isWebsocket            -- | Is this a websocket request     , reqHeader              -- | Get a particular request header (case insensitive)     , reqHeaders             -- | Get all request headers (case insensitive)     , maybeRootRoute         -- | Access the current route for root route@@ -79,6 +82,7 @@     , filepart               -- | Send a part of a file as response     , stream                 -- | Stream a response     , raw                    -- | Set the raw response body+    , rawBuilder             -- | Set the raw response body as a ByteString Builder     , json                   -- | Set the json response body     , plain                  -- | Set the plain text response body     , html                   -- | Set the html response body@@ -86,13 +90,29 @@     , javascript             -- | Set the javascript response body     , asContent              -- | Set the contentType and a 'Text' body     , next                   -- | Run the next application in the stack+    , getParams              -- | Get all params (query or post, not file)+    , getParam               -- | Get a particular param (query or post, not file)+    , getQueryParams         -- | Get all query params+    , getQueryParam          -- | Get a particular query param+    , getPostParams          -- | Get all post params+    , getPostParam           -- | Get a particular post param+    , getFileParams          -- | Get all file params+    , getFileParam           -- | Get a particular file param     , setCookie              -- | Add a cookie to the response     , getCookie              -- | Get a cookie from the request     , getCookies             -- | Get all cookies from the request++    , module Network.HTTP.Types.Status+    , module Network.Wai.Middleware.RequestLogger+    , module Network.Wai.Application.Static+    , Text   )   where  import Network.Wai.Middleware.Routes.Routes import Network.Wai.Middleware.Routes.Monad import Network.Wai.Middleware.Routes.Handler-+import Network.HTTP.Types.Status+import Network.Wai.Middleware.RequestLogger+import Network.Wai.Application.Static+import Data.Text (Text)

@@ -0,0 +1,35 @@+{-# LANGUAGE TypeFamilies #-}++{- |+Module      :  Network.Wai.Middleware.Routes.DefaultRoute+Copyright   :  (c) Anupam Jain 2013 - 2015+License     :  MIT (see the file LICENSE)++Maintainer  :  ajnsit@gmail.com+Stability   :  experimental+Portability :  non-portable (uses ghc extensions)++Defines a DefaultMaster datatype and associated route (DefaultRoute) which is used for "unrouted" handlers+-}+module Network.Wai.Middleware.Routes.DefaultRoute+  ( DefaultMaster(..)+  , Route(DefaultRoute)+  )+  where++import Data.Text (Text)+import Data.Set (empty)++import Network.Wai.Middleware.Routes.Routes++-- Default master datatype, which is used for "unrouted" handlers+data DefaultMaster = DefaultMaster+-- This makes it possible to define handlers without routing stuff+instance RenderRoute DefaultMaster where+  -- The associated route simply contains all path information+  data Route DefaultMaster = DefaultRoute ([Text],[(Text, Text)]) deriving Eq+  renderRoute (DefaultRoute r) = r+instance ParseRoute DefaultMaster where+  parseRoute = Just . DefaultRoute+instance RouteAttrs DefaultMaster where+  routeAttrs = const empty

@@ -12,9 +12,9 @@ -} module Network.Wai.Middleware.Routes.Handler     ( HandlerM()             -- | A Monad that makes it easier to build a Handler-    , HandlerMM()            -- | HandlerM Monad specialised for top level sites (no subsites)     , runHandlerM            -- | Run a HandlerM to get a Handler     , request                -- | Access the request data+    , isWebsocket            -- | Is this a websocket request     , reqHeader              -- | Get a particular request header (case insensitive)     , reqHeaders             -- | Get all request headers (case insensitive)     , routeAttrSet           -- | Access the route attribute list@@ -29,7 +29,7 @@     , readRouteSub           -- | Get the route parsing function for the subsite     , master                 -- | Access the master datatype     , sub                    -- | Access the sub datatype-    , rawBody                -- | Consume and return the request body as a lazy bytestring+    , rawBody                -- | Consume and return the request body as a bytestring     , jsonBody               -- | Consume and return the request body as JSON     , header                 -- | Add a header to the response     , status                 -- | Set the response status@@ -37,6 +37,7 @@     , filepart               -- | Send a part of a file as response     , stream                 -- | Stream a response     , raw                    -- | Set the raw response body+    , rawBuilder             -- | Set the raw response body as a ByteString Builder     , json                   -- | Set the json response body     , plain                  -- | Set the plain text response body     , html                   -- | Set the html response body@@ -44,17 +45,25 @@     , javascript             -- | Set the javascript response body     , asContent              -- | Set the contentType and a 'Text' body     , next                   -- | Run the next application in the stack+    , getParams              -- | Get all params (query or post, not file)+    , getParam               -- | Get a particular param (query or post, not file)+    , getQueryParams         -- | Get all query params+    , getQueryParam          -- | Get a particular query param+    , getPostParams          -- | Get all post params+    , getPostParam           -- | Get a particular post param+    , getFileParams          -- | Get all file params+    , getFileParam           -- | Get a particular file param     , setCookie              -- | Add a cookie to the response     , getCookie              -- | Get a cookie from the request     , getCookies             -- | Get all cookies from the request     )     where -import Network.Wai (Request, Response, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody, requestHeaders, FilePart)+import Network.Wai (Request, Response, responseRaw, responseFile, responseBuilder, responseStream, pathInfo, queryString, requestBody, StreamingBody, requestHeaders, FilePart) #if MIN_VERSION_wai(3,0,1) import Network.Wai (strictRequestBody) #endif-import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler, showRoute, showRouteQuery, readRoute)+import Network.Wai.Middleware.Routes.Routes (Env(..), RequestData, HandlerS, waiReq, currentRoute, runNext, ResponseHandler, showRoute, showRouteQuery, readRoute, readQueryString) import Network.Wai.Middleware.Routes.Class (Route, RenderRoute, ParseRoute, RouteAttrs(..)) import Network.Wai.Middleware.Routes.ContentTypes (contentType, contentTypeFromFile, typeHtml, typeJson, typePlain, typeCss, typeJavascript) @@ -62,33 +71,34 @@ import Control.Monad.Loops (unfoldWhileM) import Control.Monad.State (StateT, get, put, modify, runStateT, MonadState, MonadIO, lift, liftIO, MonadTrans) -import Control.Applicative (Applicative, (<$>))+import Control.Applicative (Applicative, (<$>), (<*>))  import Data.Maybe (maybe) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import Blaze.ByteString.Builder (Builder, toByteString, fromLazyByteString)+import Blaze.ByteString.Builder (Builder, toByteString, fromByteString) import Network.HTTP.Types.Header (HeaderName(), RequestHeaders) import Network.HTTP.Types.Status (Status(), status200) -import Data.Aeson (ToJSON, FromJSON, eitherDecode)+import Data.Aeson (ToJSON, FromJSON, eitherDecodeStrict)+ import qualified Data.Aeson as A+import qualified Data.Aeson.Encode as AE  import Data.Set (Set) import qualified Data.Set as S (empty, map) -import Data.Text.Lazy (Text)-import qualified Data.Text as TS (Text)-import qualified Data.Text.Lazy as T-import Data.Text.Lazy.Encoding (encodeUtf8)-import Data.Text.Encoding (decodeUtf8)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8, decodeUtf8)  import Data.CaseInsensitive (CI, mk) -import Web.Cookie (Cookies, parseCookies, renderCookies, renderSetCookie, SetCookie(..))+import Web.Cookie (CookiesText, parseCookiesText, renderSetCookie, SetCookie(..)) import Data.Default.Class (def) +import qualified Network.Wai.Parse as P+ -- | The internal implementation of the HandlerM monad -- TODO: Should change this to StateT over ReaderT (but performance may suffer) newtype HandlerMI sub master m a = H { extractH :: StateT (HandlerState sub master) m a }@@ -97,33 +107,81 @@ -- | The HandlerM Monad type HandlerM sub master a = HandlerMI sub master IO a --- | A HandlerMM is a HandlerM Monad for use with a top level site (where the sub and master datatypes are the same)-type HandlerMM master a = HandlerM master master a+-- | Modeled after Network.Wai.Parse.FileInfo, but uses Text for names, and lazy ByteString for content+data FileInfo = FileInfo+  { fileName        :: Text+  , fileContentType :: Text+  , fileContent     :: BL.ByteString+  } +-- Post Params+-- Files are read into memory+-- TODO: Check for security issues. Allow automatic storing of files on disk.+type PostParams = ([(Text, Text)], [(Text, FileInfo)])++-- Private+-- Convert from Network.Wai.Parse ([Param], [File y])  to PostParams+_toPostParams :: ([P.Param], [P.File BL.ByteString])  -> PostParams+_toPostParams (params, files) = (params', files')+  where+    params' = map (\(k,v) -> (decodeUtf8 k, decodeUtf8 v))     params+    files'  = map (\(k,v) -> (decodeUtf8 k, decodeFileInfo v)) files+    decodeFileInfo fi = FileInfo+      { fileName = decodeUtf8 $ P.fileName fi+      , fileContentType = decodeUtf8 $ P.fileContentType fi+      , fileContent = P.fileContent fi+      }++-- A Raw Response handler :: source -> sink -> IO+type RespRawHandler = IO B.ByteString -> (B.ByteString -> IO ()) -> IO ()+ -- | The state kept in a HandlerM Monad data HandlerState sub master = HandlerState-                { getMaster      :: master-                , getRequestData :: RequestData sub-                -- TODO: Experimental-                -- Streaming request body, consumed, and stored as a ByteString-                , reqBody        :: Maybe BL.ByteString-                , respHeaders    :: [(HeaderName, ByteString)]-                , respStatus     :: Status-                , respResp       :: MkResponse-                , respCookies    :: [SetCookie]-                , getSub         :: sub-                , toMasterRoute  :: Route sub -> Route master-                }+  { getMaster      :: master+  , getRequestData :: RequestData sub+  -- TODO: Experimental+  -- Streaming request body, consumed, and stored as a ByteString+  , reqBody        :: Maybe ByteString+  , respHeaders    :: [(HeaderName, ByteString)]+  , respStatus     :: Status+  , respResp       :: MkResponse+  , respRaw        :: Maybe RespRawHandler+  , respCookies    :: [SetCookie]+  , getSub         :: sub+  , toMasterRoute  :: Route sub -> Route master+  -- TODO: Experimental+  -- Parsed POST request body, in the same format as Network.Wai.Parse+  , postParams     :: Maybe PostParams+  } +-- Initial Handler State+defaultHandlerState :: Env sub master -> RequestData sub -> HandlerState sub master+defaultHandlerState env req = HandlerState+  { getMaster = envMaster env+  , getRequestData = req+  , reqBody = Nothing+  , respHeaders = []+  , respStatus = status200+  , respResp = defaultResponse+  , respRaw = Nothing+  , respCookies = []+  , getSub = envSub env+  , toMasterRoute = envToMaster env+  , postParams = Nothing+  }+ -- Internal: Type of response -- Similar to Wai's Response type data MkResponse     = ResponseFile FilePath (Maybe FilePart)     | ResponseBuilder Builder     | ResponseStream StreamingBody-    -- Experimental: ResponseNext is the default, so if you don't respond in one handler, move to next automatically     | ResponseNext +-- Default response in case none is set by the handler+defaultResponse :: MkResponse+defaultResponse = ResponseBuilder ""+ -- The header name for request cookies cookieHeaderName :: CI ByteString cookieHeaderName = mk "Cookie"@@ -135,34 +193,45 @@ -- | "Run" HandlerM, resulting in a Handler runHandlerM :: HandlerM sub master () -> HandlerS sub master runHandlerM h env req hh = do-  (_, st) <- runStateT (extractH h) (HandlerState (envMaster env) req Nothing [] status200 ResponseNext [] (envSub env) (envToMaster env))+  (_, st) <- runStateT (extractH h) (defaultHandlerState env req)   -- Handle cookies (add them to headers)   let cookieHeaders = map mkSetCookie (respCookies st)-  let st' = st {respHeaders = cookieHeaders ++ (respHeaders st)}-  -- Construct response-  mkResponse st' (respResp st')+  st <- return $ st {respHeaders = cookieHeaders ++ (respHeaders st)}+  case respResp st of+    -- Abort handling current response and move to next handler+    ResponseNext -> runNext (getRequestData st) hh+    -- Normal handling+    normalResponse -> do+      -- Construct the normal response+      let resp = mkResponse st normalResponse+      -- Check if we are trying to send a raw response+      case respRaw st of+        Nothing -> hh resp+        Just rawHandler ->+          -- TODO: Ensure the body has not been read before using raw response+          hh $ responseRaw rawHandler resp   where     mkSetCookie s = (cookieSetHeaderName, toByteString $ renderSetCookie s)-    mkResponse st (ResponseFile path part) = hh $ responseFile (respStatus st) (respHeaders st) path part-    mkResponse st (ResponseBuilder builder) = hh $ responseBuilder (respStatus st) (respHeaders st) builder-    mkResponse st (ResponseStream streaming) = hh $ responseStream (respStatus st) (respHeaders st) streaming-    mkResponse st ResponseNext = runNext (getRequestData st) hh+    mkResponse st (ResponseFile path part) = responseFile (respStatus st) (respHeaders st) path part+    mkResponse st (ResponseBuilder builder) = responseBuilder (respStatus st) (respHeaders st) builder+    mkResponse st (ResponseStream streaming) = responseStream (respStatus st) (respHeaders st) streaming --- | Get the request body as a lazy bytestring. However consumes the entire body at once.+-- | Get the request body as a bytestring. Consumes the entire body into memory at once. -- TODO: Implement streaming. Prevent clash with direct use of `Network.Wai.requestBody`-rawBody :: HandlerM master master BL.ByteString+rawBody :: HandlerM sub master ByteString rawBody = do   s <- get   case reqBody s of     Just consumedBody -> return consumedBody     Nothing -> do       req <- request-      rbody <- liftIO $ readStrictRequestBody req+      rbody <- liftIO $ BL.toStrict <$> _readStrictRequestBody req       put s {reqBody = Just rbody}       return rbody -readStrictRequestBody :: Request -> IO BL.ByteString-readStrictRequestBody =+-- PRIVATE+_readStrictRequestBody :: Request -> IO BL.ByteString+_readStrictRequestBody = #if MIN_VERSION_wai(3,0,1)         -- Use the `strictRequestBody` function available in wai > 3.0.1         strictRequestBody@@ -172,8 +241,8 @@ #endif  -- | Parse the body as a JSON object-jsonBody :: FromJSON a => HandlerM master master (Either String a)-jsonBody = liftM eitherDecode rawBody+jsonBody :: FromJSON a => HandlerM sub master (Either String a)+jsonBody = liftM eitherDecodeStrict rawBody  -- | Get the master master :: HandlerM sub master master@@ -187,11 +256,21 @@ request :: HandlerM sub master Request request = liftM (waiReq . getRequestData) get +-- | Is this a websocket request+isWebsocket :: HandlerM sub master Bool+isWebsocket = liftM (maybe False (== "websocket")) (reqHeader "upgrade")+ -- | Get a particular request header (Case insensitive)-reqHeader :: ByteString -> HandlerM sub master (Maybe ByteString)-reqHeader name = liftM (lookup $ mk name) reqHeaders+reqHeader :: Text -> HandlerM sub master (Maybe Text)+reqHeader name = liftM (fmap decodeUtf8) (_reqHeaderBS nameText)+  where+    nameText = mk $ encodeUtf8 name --- | Get all request headers (Case insensitive)+-- PRIVATE+_reqHeaderBS :: CI ByteString -> HandlerM sub master (Maybe ByteString)+_reqHeaderBS name = liftM (lookup name) reqHeaders++-- | Get all request headers as raw case-insensitive bytestrings reqHeaders :: HandlerM sub master RequestHeaders reqHeaders = liftM requestHeaders request @@ -203,47 +282,47 @@ maybeRootRoute :: HandlerM sub master (Maybe (Route master)) maybeRootRoute = do   s <- get-  return $ fmap (toMasterRoute s) $ currentRoute $ getRequestData s+  return $ toMasterRoute s <$> currentRoute (getRequestData s)  -- | Get the route rendering function for the master site-showRouteMaster :: RenderRoute master => HandlerM sub master (Route master -> TS.Text)+showRouteMaster :: RenderRoute master => HandlerM sub master (Route master -> Text) showRouteMaster = return showRoute  -- | Get the route rendering function for the subsite-showRouteSub :: RenderRoute master => HandlerM sub master (Route sub -> TS.Text)+showRouteSub :: RenderRoute master => HandlerM sub master (Route sub -> Text) showRouteSub = do   s <- get   return $ showRoute . toMasterRoute s  -- | Get the route rendering function for the master site-showRouteQueryMaster :: RenderRoute master => HandlerM sub master (Route master -> [(TS.Text,TS.Text)] -> TS.Text)+showRouteQueryMaster :: RenderRoute master => HandlerM sub master (Route master -> [(Text,Text)] -> Text) showRouteQueryMaster = return showRouteQuery  -- | Get the route rendering function for the subsite-showRouteQuerySub :: RenderRoute master => HandlerM sub master (Route sub -> [(TS.Text,TS.Text)] -> TS.Text)+showRouteQuerySub :: RenderRoute master => HandlerM sub master (Route sub -> [(Text,Text)] -> Text) showRouteQuerySub = do   s <- get   return $ showRouteQuery . toMasterRoute s  -- | Get the route parsing function for the master site-readRouteMaster :: ParseRoute master => HandlerM sub master (TS.Text -> Maybe (Route master))+readRouteMaster :: ParseRoute master => HandlerM sub master (Text -> Maybe (Route master)) readRouteMaster = return readRoute  -- | Get the route parsing function for the subsite-readRouteSub :: ParseRoute sub => HandlerM sub master (TS.Text -> Maybe (Route master))+readRouteSub :: ParseRoute sub => HandlerM sub master (Text -> Maybe (Route master)) readRouteSub = do   s <- get-  return $ fmap (toMasterRoute s) . readRoute+  return $ (toMasterRoute s <$>) . readRoute  -- | Get the current route attributes routeAttrSet :: RouteAttrs sub => HandlerM sub master (Set Text)-routeAttrSet = liftM (S.map T.fromStrict . maybe S.empty routeAttrs . currentRoute . getRequestData) get+routeAttrSet = liftM (maybe S.empty routeAttrs . currentRoute . getRequestData) get  -- | Get the attributes for the current root route rootRouteAttrSet :: RouteAttrs master => HandlerM sub master (Set Text) rootRouteAttrSet = do   s <- get-  return $ S.map T.fromStrict $ maybe S.empty (routeAttrs . toMasterRoute s) $ currentRoute $ getRequestData s+  return $ maybe S.empty (routeAttrs . toMasterRoute s) $ currentRoute $ getRequestData s  -- | Add a header to the application response -- TODO: Differentiate between setting and adding headers@@ -283,10 +362,14 @@     addStream st = _setResp st $ ResponseStream s  -- | Set the response body-raw :: BL.ByteString -> HandlerM sub master ()-raw bs = modify addBody+raw :: ByteString -> HandlerM sub master ()+raw = rawBuilder . fromByteString++-- | Set the response body as a builder+rawBuilder :: Builder -> HandlerM sub master ()+rawBuilder b = modify addBody   where-    addBody st = _setResp st $ ResponseBuilder (fromLazyByteString bs)+    addBody st = _setResp st $ ResponseBuilder b  -- | Run the next application next :: HandlerM sub master ()@@ -296,12 +379,10 @@  -- Util -- Set the response handler--- Experimental: Don't overwrite previous response handler _setResp :: HandlerState sub master -> MkResponse -> HandlerState sub master-_setResp st r = case respResp st of-  ResponseNext -> st{respResp=r}-  _ -> st+_setResp st r = st{respResp=r} + -- Standard response bodies  -- | Set the body of the response to the JSON encoding of the given value. Also sets \"Content-Type\"@@ -309,7 +390,13 @@ json :: ToJSON a => a -> HandlerM sub master () json a = do   header contentType typeJson-  raw $ A.encode a+  rawBuilder $ _encode $ A.toJSON a+  where+#if MIN_VERSION_aeson(0,9,0)+    _encode = AE.encodeToBuilder+#else+    _encode = AE.encodeToByteStringBuilder+#endif  -- | Set the body of the response to the given 'Text' value. Also sets \"Content-Type\" -- header to \"text/plain\".@@ -346,17 +433,90 @@     setCookie st = st {respCookies = s : respCookies st}  -- | Get all cookies-getCookies :: HandlerM sub master Cookies+getCookies :: HandlerM sub master CookiesText getCookies = do   -- Note: We don't cache the parsedCookies for all requests to avoid overhead   -- However it is pretty easy to cache cookies in the app itself-  cookies <- reqHeader "Cookie"+  cookies <- _reqHeaderBS cookieHeaderName   return $ case cookies of     Nothing -> []-    Just cookies' -> parseCookies cookies'+    Just cookies' -> parseCookiesText cookies'  -- | Get a particular cookie-getCookie :: ByteString -> HandlerM sub master (Maybe ByteString)+getCookie :: Text -> HandlerM sub master (Maybe Text) getCookie name = do   cookies <- getCookies   return $ lookup name cookies++-- PRIVATE+-- Get the cached post params (if any)+_getCachedPostParams :: HandlerM sub master (Maybe PostParams)+_getCachedPostParams = postParams <$> get++-- PRIVATE+-- Util: Parse and cache post params+_populatePostParams :: HandlerM sub master PostParams+_populatePostParams = do+  st <- get+  case postParams st of+    Just params -> return params+    Nothing -> do+      req <- request+      params <- case P.getRequestBodyType req of+        Nothing -> return ([],[])+        Just _ -> do+          -- TODO: Use cached request body instead of reading it from wai request+          params <- liftIO $ P.parseRequestBody P.lbsBackEnd req+          return $ _toPostParams params+      put $ st{postParams=Just params}+      return params++-- PRIVATE+-- Get a list of post parameters+_getAllFileOrPostParams :: HandlerM sub master PostParams+_getAllFileOrPostParams = do+  cachedPostParams <- _getCachedPostParams+  case cachedPostParams of+    Nothing -> _populatePostParams+    Just params -> return params++-- | Get all Query params+getQueryParams :: HandlerM sub master [(Text,Text)]+getQueryParams = readQueryString . queryString <$> request++-- | Get a particular Query param+getQueryParam :: Text -> HandlerM sub master (Maybe Text)+getQueryParam name = lookup name <$> getQueryParams++-- | Get all Post params+getPostParams :: HandlerM sub master [(Text,Text)]+getPostParams = do+  (params,_) <- _getAllFileOrPostParams+  return params++-- | Get a particular Post param+getPostParam :: Text -> HandlerM sub master (Maybe Text)+getPostParam name = lookup name <$> getPostParams++-- | Get all File params+getFileParams :: HandlerM sub master [(Text,FileInfo)]+getFileParams = do+  (_,files) <- _getAllFileOrPostParams+  return files++-- | Get a particular File param+getFileParam :: Text -> HandlerM sub master (Maybe FileInfo)+getFileParam name = lookup name <$> getFileParams++-- | Get all params (query or post, NOT file)+-- Duplicate parameters are preserved+getParams :: HandlerM sub master [(Text, Text)]+getParams = (++) <$> getQueryParams <*> getPostParams++-- | Get a param (query or post, NOT file)+getParam :: Text -> HandlerM sub master (Maybe Text)+getParam name = do+  getLookup <- getQueryParam name+  case getLookup of+    Nothing -> getPostParam name+    Just _ -> return $ getLookup

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, TypeFamilies, RankNTypes, DeriveFunctor #-}+{-# LANGUAGE OverloadedStrings, TypeFamilies, RankNTypes, DeriveFunctor #-}  {- | Module      :  Network.Wai.Middleware.Routes.Monad@@ -15,6 +15,9 @@     ( -- * Route Monad       RouteM       -- * Compose Routes+    , DefaultMaster(..)+    , Route(DefaultRoute)+    , handler     , middleware     , route     , catchall@@ -27,7 +30,8 @@  import Network.Wai import Network.Wai.Middleware.Routes.Routes-import Network.HTTP.Types+import Network.Wai.Middleware.Routes.DefaultRoute+import Network.HTTP.Types (status404)  import Util.Free (F(..), liftF) @@ -47,10 +51,17 @@ defaultAction = catchall  -- | Add a middleware to the application--- Middleware are ordered so the one declared earlier is wraps the remaining application.+-- Middleware are ordered so the one declared earlier wraps the ones later middleware :: Middleware -> RouteM () middleware m = liftF $ M m () +-- | Add a wai-routes handler+handler :: Handler DefaultMaster -> RouteM ()+handler h = middleware $ customRouteDispatch dispatcher' DefaultMaster+  where+    dispatcher' env req = runHandler h env (Just $ DefaultRoute $ getRoute req) req+    getRoute req = (pathInfo $ waiReq req, readQueryString $ queryString $ waiReq req)+ -- | Add a route to the application. -- Routes are ordered so the one declared earlier is matched first. route :: (Routable master master) => master -> RouteM ()@@ -66,7 +77,7 @@ waiApp :: RouteM () -> Application waiApp (F r) = r (const defaultApplication) f   where-    f (M m r) = m r+    f (M m r') = m r'     f (D a) = a  -- | Similar to waiApp but returns the app in an arbitrary monad

@@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-} {- | Module      :  Network.Wai.Middleware.Routes.Routes Copyright   :  (c) Anupam Jain 2013@@ -29,6 +30,7 @@      -- * Dispatch     , routeDispatch+    , customRouteDispatch      -- * URL rendering and parsing     , showRoute@@ -57,12 +59,15 @@     , currentRoute           -- | Extract the current `Route` from `RequestData`     , runNext                -- | Run the next application in the stack +    -- * Not exported outside wai-routes+    , runHandler+    , readQueryString     )     where  -- Wai import Network.Wai (ResponseReceived, Middleware, Application, pathInfo, requestMethod, requestMethod, Response, Request(..))-import Network.HTTP.Types (decodePath, encodePath, queryTextToQuery, queryToQueryText)+import Network.HTTP.Types (Query, decodePath, encodePath, queryTextToQuery, queryToQueryText)  -- Network.Wai.Middleware.Routes import Network.Wai.Middleware.Routes.Class (Route, RenderRoute(..), ParseRoute(..), RouteAttrs(..))@@ -107,14 +112,14 @@ runNext req = nextApp req $ waiReq req  -- | A `Handler` generates an App from the master datatype-type Handler master = HandlerS master master+type Handler sub = forall master. RenderRoute master => HandlerS sub master type HandlerS sub master = Env sub master -> App sub  -- | Generates everything except `Routable` instance and dispatch function mkRouteData :: String -> [ResourceTree String] -> Q [Dec] mkRouteData typName routes = do   let typ = parseType typName-  let rname = mkName $ "resources" ++ typName+  let rname = mkName $ "_resources" ++ typName   let resourceTrees = map (fmap parseType) routes   eres <- lift routes   let resourcesDec =@@ -159,7 +164,7 @@   let typ = parseType typName   disp <- mkDispatchClause MkDispatchSettings         { mdsRunHandler    = [| runHandler    |]-        , mdsSubDispatcher = [| subDispatcher  |]+        , mdsSubDispatcher = [| subDispatcher |]         , mdsGetPathInfo   = [| getPathInfo   |]         , mdsMethod        = [| getReqMethod  |]         , mdsSetPathInfo   = [| setPathInfo   |]@@ -189,9 +194,15 @@  -- | Generates the application middleware from a `Routable` master datatype routeDispatch :: Routable master master => master -> Middleware+routeDispatch = customRouteDispatch dispatcher++-- | Like routeDispatch but generates the application middleware from a custom dispatcher+customRouteDispatch :: HandlerS master master -> master -> Middleware+-- TODO: Should this have master master instead of sub master?+-- TODO: Verify that this plays well with subsites -- Env master master is converted to Env sub master by subDispatcher -- Route information is filled in by runHandler-routeDispatch master def req = dispatcher (_masterToEnv master) RequestData{waiReq=req, nextApp=def, currentRoute=Nothing}+customRouteDispatch customDispatcher master def req = customDispatcher (_masterToEnv master) RequestData{waiReq=req, nextApp=def, currentRoute=Nothing}  -- | Render a `Route` and Query parameters to Text showRouteQuery :: RenderRoute master => Route master -> [(Text,Text)] -> Text@@ -209,8 +220,12 @@ -- | Read a route from Text -- Returns Nothing if Route reading failed. Just route otherwise readRoute :: ParseRoute master => Text -> Maybe (Route master)-readRoute = parseRoute . second (map (second (fromMaybe "")) . queryToQueryText) . decodePath . encodeUtf8+readRoute = parseRoute . second readQueryString . decodePath . encodeUtf8 +-- | Convert a Query to the format expected by parseRoute+readQueryString :: Query -> [(Text, Text)]+readQueryString = map (second (fromMaybe "")) . queryToQueryText+ -- PRIVATE  -- Get the request method from a RequestData@@ -236,6 +251,8 @@ app405 _master = runNext  -- Run a route handler function+-- Currently all this does is populate the route into RequestData+-- But it may do more in the future runHandler     :: HandlerS sub master     -> Env sub master@@ -255,8 +272,8 @@   where     env' = _envToSub getSub toMasterRoute env     reqData' = reqData{currentRoute=Nothing}-    qq (k,mv) = (decodeUtf8 k, maybe "" decodeUtf8 mv)-    req = waiReq reqData+    -- qq (k,mv) = (decodeUtf8 k, maybe "" decodeUtf8 mv)+    -- req = waiReq reqData  _masterToEnv :: master -> Env master master _masterToEnv master = Env master master id

@@ -1,14 +1,14 @@-name          : wai-routes-version       : 0.8.1-cabal-version : >=1.18-build-type    : Simple-license       : MIT-license-file  : LICENSE-maintainer    : ajnsit@gmail.com-stability     : Experimental-homepage      : https://ajnsit.github.io/wai-routes/-synopsis      : Typesafe URLs for Wai applications.-description   : Provides easy to use typesafe URLs for Wai Applications. See README for more information. Also see examples/ directory for usage examples.+name               : wai-routes+version            : 0.9.0+cabal-version      : >=1.18+build-type         : Simple+license            : MIT+license-file       : LICENSE+maintainer         : ajnsit@gmail.com+stability          : Experimental+homepage           : https://ajnsit.github.io/wai-routes/+synopsis           : Typesafe URLs for Wai applications.+description        : Provides easy to use typesafe URLs for Wai Applications. See README for more information. Also see examples/ directory for usage examples. category           : Network author             : Anupam Jain data-dir           : ""@@ -20,59 +20,63 @@  source-repository this     type     : git-    location : http://github.com/ajnsit/wai-routes/tree/v0.8.1-    tag      : v0.8.1+    location : http://github.com/ajnsit/wai-routes/tree/v0.9.0+    tag      : v0.9.0  library-    build-depends: base               >= 4.7  && < 4.9-                 , wai                >= 3.0  && < 3.1-                 , text               >= 1.2  && < 1.3-                 , template-haskell   >= 2.9  && < 2.11-                 , mtl                >= 2.1  && < 2.3-                 , aeson              >= 0.8  && < 0.10-                 , containers         >= 0.5  && < 0.6-                 , random             >= 1.1  && < 1.2-                 , path-pieces        >= 0.2  && < 0.3-                 , bytestring         >= 0.10 && < 0.11-                 , http-types         >= 0.8  && < 0.9-                 , blaze-builder      >= 0.4  && < 0.5-                 , monad-loops        >= 0.4  && < 0.5-                 , case-insensitive   >= 1.2  && < 1.3-                 , mime-types         >= 0.1  && < 0.2-                 , filepath           >= 1.3  && < 1.5-                 , cookie             >= 0.4  && < 0.5-                 , data-default-class >= 0.0  && < 0.1-    exposed-modules: Network.Wai.Middleware.Routes-                     Network.Wai.Middleware.Routes.Parse-                     Network.Wai.Middleware.Routes.Overlap-                     Network.Wai.Middleware.Routes.Class-                     Network.Wai.Middleware.Routes.Routes-                     Network.Wai.Middleware.Routes.Monad-                     Network.Wai.Middleware.Routes.Handler-                     Network.Wai.Middleware.Routes.ContentTypes-                     Network.Wai.Middleware.Routes.TH-                     Network.Wai.Middleware.Routes.TH.Types-                     Network.Wai.Middleware.Routes.TH.Dispatch-                     Network.Wai.Middleware.Routes.TH.ParseRoute-                     Network.Wai.Middleware.Routes.TH.RenderRoute-                     Network.Wai.Middleware.Routes.TH.RouteAttrs-                     Util.Free-    exposed        : True-    buildable      : True-    hs-source-dirs : src+    build-depends      : base               >= 4.7  && < 4.9+                       , wai                >= 3.0  && < 3.1+                       , wai-extra          >= 3.0  && < 3.1+                       , wai-app-static     >= 3.0  && < 3.2+                       , text               >= 1.2  && < 1.3+                       , template-haskell   >= 2.9  && < 2.11+                       , mtl                >= 2.1  && < 2.3+                       , aeson              >= 0.8  && < 0.11+                       , containers         >= 0.5  && < 0.6+                       , random             >= 1.1  && < 1.2+                       , path-pieces        >= 0.2  && < 0.3+                       , bytestring         >= 0.10 && < 0.11+                       , http-types         >= 0.8  && < 0.9+                       , blaze-builder      >= 0.4  && < 0.5+                       , monad-loops        >= 0.4  && < 0.5+                       , case-insensitive   >= 1.2  && < 1.3+                       , mime-types         >= 0.1  && < 0.2+                       , filepath           >= 1.3  && < 1.5+                       , cookie             >= 0.4  && < 0.5+                       , data-default-class >= 0.0  && < 0.1+    exposed-modules    : Network.Wai.Middleware.Routes+    other-modules      : Network.Wai.Middleware.Routes.Parse+                         Network.Wai.Middleware.Routes.Overlap+                         Network.Wai.Middleware.Routes.Class+                         Network.Wai.Middleware.Routes.Routes+                         Network.Wai.Middleware.Routes.Monad+                         Network.Wai.Middleware.Routes.Handler+                         Network.Wai.Middleware.Routes.ContentTypes+                         Network.Wai.Middleware.Routes.DefaultRoute+                         Network.Wai.Middleware.Routes.TH+                         Network.Wai.Middleware.Routes.TH.Types+                         Network.Wai.Middleware.Routes.TH.Dispatch+                         Network.Wai.Middleware.Routes.TH.ParseRoute+                         Network.Wai.Middleware.Routes.TH.RenderRoute+                         Network.Wai.Middleware.Routes.TH.RouteAttrs+                         Util.Free+    exposed            : True+    buildable          : True+    hs-source-dirs     : src     default-language   : Haskell2010  test-suite test-  main-is:             Spec.hs-  type:                exitcode-stdio-1.0-  default-language:    Haskell2010-  hs-source-dirs:      test-  GHC-options:         -Wall -threaded -fno-warn-orphans+  main-is          : Spec.hs+  type             : exitcode-stdio-1.0+  default-language : Haskell2010+  hs-source-dirs   : test+  GHC-options      : -Wall -threaded -fno-warn-orphans -  build-depends: base           >= 4.7 && < 4.9-               , wai            >= 3.0 && < 3.1-               , aeson          >= 0.8 && < 0.10-               , hspec          >= 2.1 && < 2.3-               , hspec-wai      >= 0.6 && < 0.7-               , hspec-wai-json >= 0.6 && < 0.7-               , wai-routes+  build-depends    : base           >= 4.7 && < 4.9+                   , wai            >= 3.0 && < 3.1+                   , aeson          >= 0.8 && < 0.11+                   , hspec          >= 2.1 && < 2.3+                   , hspec-wai      >= 0.6 && < 0.7+                   , hspec-wai-json >= 0.6 && < 0.7+                   , wai-app-static >= 3.0 && < 3.2+                   , wai-routes