salvia-0.0.4: src/Network/Salvia/Handlers/Head.hs

module Network.Salvia.Handlers.Head (hHead) where

import Control.Applicative
import Control.Monad.State

import Network.Salvia.Httpd
import Network.Protocol.Http

{- |
The 'hHead' handler makes sure no response body is sent to the client when the
request is an HTTP 'HEAD' request. In the case of a 'HEAD' request the
specified sub handler will be executed under the assumption that the request
was a 'GET' request, otherwise this handler will act as the identify function.
-}

hHead :: Handler a -> Handler a
hHead handler = do
  m <- gets (method . request)
  case m of
    HEAD -> withRequest (setMethod GET) handler
         <* emptyQueue
    _    -> handler