Trans.hs

{-# LANGUAGE OverloadedStrings #-}
{- |
  This module defines better resource routing for Scotty.

  Scotty is defined in terms of "routes", whereas HTTP is defined in
  terms of "resources".  This package adds a "resource" abstraction to
  the scotty ecosystem.

  (note: All examples probably require -XOverloadedStrings)

  Scotty comes out of the box with a way to model "routes". The problem
  is that "routes" is not the abstraction used by the HTTP standard and
  it can sometimes be tricky to write a perfectly correct HTTP service
  using the routes model (where "correct" is judged against rfc-2616).
  The most blatant, (and who knows, maybe the only) example of this problem
  is shown by the scotty code:

  > import Web.Scotty.Trans (get, scottyT, text)
  >
  > ...
  >
  > scottyT 8080 id $ do
  >   get "/hello" $ do
  >     text "world"

  If a client requests something like @DELETE /hello@, this scotty application
  will return @404 Not Found@, which conflicts with section 5.1.1 of rfc-2616.
  A better response would be @405 Method Not Allowed@, and it would include an
  automatically generated @Allow@ response header.

  This library gives users a way to model "resources" which is closer to the
  abstractions used in the HTTP standard.

  We can re-write the above example like this:

  > import Web.Scotty.Trans (scottyT, text)
  > import Web.Scotty.Resource.Trans (resource, get)
  >
  > ...
  >
  > scottyT 8080 id $ do
  >   resource "/hello" $ do
  >     get $ do
  >       text "world"

  Given a request:

  > DELETE /hello HTTP/1.1
  > Host: localhost:8080

  The resource-based scotty application will produce something like:

  > HTTP/1.1 405 Method Not Allowed
  > Allow: GET

  Each resource is described by a `WebResource` value, which happens to
  be a `Monad`. The only reason `WebResource` implements `Monad` to fit
  in with the do-notation coding style of `ScottyT`. This is an abuse of
  `Monad`, but, you know, whatever. The `Monoid` typeclass more correctly
  represents what a `WebResource` really is. The `Monad` and `Monoid`
  typeclasses are used to compose instances of `WebResource`.

  Here is another more complex example, with multiple resources.

  > import Data.Aeson (decode)
  > import Network.HTTP.Types (notFound404, badRequest400, noContent204)
  > import Web.Scotty.Resource.Trans (resource, get, post)
  > import Web.Scotty.Trans (scottyT, text, body, raw, status, param)
  >
  > import MyApplication (lookupPerson, storePerson)
  > 
  > ...
  > 
  > scottyT 8080 id $ do
  >
  >   -- an "echo" resource
  >   resource "/echo" $ do
  >     get $ do
  >       text "hello world"
  >     post $ do
  >       -- echo the request body back to the user
  >       raw =<< body
  >
  >   -- A resource that represents a kind of a RESTful database of people.
  >   -- This resource supports GET and PUT.
  >   resource "/people/:personId" $ do
  >     get $ do
  >       personId <- param "personId"
  >       maybePerson <- lookupPerson personId
  >       case maybePerson of
  >         Nothing ->
  >           status notFound404
  >         Just person ->
  >           json person
  >     put $ do
  >       personId <- param "personId"
  >       maybePerson <- decode <$> body
  >       case maybePerson of
  >         Nothing -> do
  >           status badRequest400
  >           text "Invalid person JSON"
  >         Just person ->
  >           storePerson personId person
  >           status noContent204
-}
module Web.Scotty.Resource.Trans (
  resource,
  WebResource,
  options,
  get,
  head,
  post,
  put,
  delete,
  patch,
  method
) where

import Prelude hiding (head)

import Control.Monad (liftM, ap)
import Control.Monad.IO.Class (MonadIO)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Set (fromList, toList)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Lazy (fromStrict)
import Network.HTTP.Types (Method, methodNotAllowed405)
import Network.Wai (requestMethod)
import Web.Scotty.Trans (ActionT, RoutePattern, ScottyT, matchAny,
  request, ScottyError, setHeader, status)

{- |
  Add a resource whose uri matches the route pattern.
-}
resource :: (MonadIO m, ScottyError e)
  => RoutePattern
  -> WebResource e m ()
  -> ScottyT e m ()
resource uri (W methods ()) = matchAny uri $
    getMethod `liftM` request >>= fromMaybe notAllowed
  where
    getMethod = (`lookup` methods) . requestMethod
    notAllowed = do
      setHeader "Allow" allowed
      status methodNotAllowed405

    {-
      Build a list of allowed methods.
    -}
    allowed =
      (
        fromStrict
        . decodeUtf8
        . mconcat
        . intersperse ", "
        . dedupe
        . fmap fst
      ) methods


{- |
  An opaque representation of an http resource. Use `get`, `post`, etc. to
  create one of these. Use the `Monad` or `Monoid` instances to compose them.
-}
data WebResource e m a = W [(Method, ActionT e m ())] a
instance Functor (WebResource e m) where
  fmap = liftM
instance Applicative (WebResource e m) where
  pure = return
  (<*>) = ap
instance Monad (WebResource e m) where
  return = W []
  W methods a >>= f =
    let W newMethods b = f a
    in W (methods <> newMethods) b
instance Monoid (WebResource e m a) where
  mempty = W mempty undefined
  mappend (W a _) (W b _) = W (a <> b) undefined


{- |
  Create a `WebResource` that handles OPTIONS requests using the given
  scotty action.
-}
options :: ActionT e m () -> WebResource e m ()
options action = W [("OPTIONS", action)] ()


{- |
  Create a `WebResource` that handles GET requests using the given
  scotty action.
-}
get :: ActionT e m () -> WebResource e m ()
get action = W [("GET", action)] ()


{- |
  Create a `WebResource` that handles HEAD requests using the given
  scotty action.
-}
head :: ActionT e m () -> WebResource e m ()
head action = W [("HEAD", action)] ()


{- |
  Create a `WebResource` that handles POST requests using the given
  scotty action.
-}
post :: ActionT e m () -> WebResource e m ()
post action = W [("POST", action)] ()


{- |
  Create a `WebResource` that handles PUT requests using the given
  scotty action.
-}
put :: ActionT e m () -> WebResource e m ()
put action = W [("PUT", action)] ()


{- |
  Create a `WebResource` that handles DELETE requests using the given
  scotty action.
-}
delete :: ActionT e m () -> WebResource e m ()
delete action = W [("DELETE", action)] ()


{- |
  Create a `WebResource` that handles PATCH requests using the given
  scotty action.
-}
patch :: ActionT e m () -> WebResource e m ()
patch action = W [("PATCH", action)] ()


{- |
  Create a `WebResource` that handles the specific method using the given
  scotty action.
-}
method :: Method -> ActionT e m () -> WebResource e m ()
method m action = W [(m, action)] ()


{- |
  A helper function that removes duplicates from a list.
-}
dedupe :: (Ord a) => [a] -> [a]
dedupe = toList . fromList