{-# LANGUAGE FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables #-}-- | Functions and classes related to generating a 'Response' and setting the response code. For detailed instruction see the Happstack Crash Course: <http://happstack.com/docs/crashcourse/HelloWorld.html#response_code>moduleHappstack.Server.Response(-- * Converting values to a 'Response'ToMessage(..),flatten,toResponseBS-- * Setting the Response Code,ok,noContent,internalServerError,badGateway,badRequest,unauthorized,forbidden,notFound,requestEntityTooLarge,seeOther,found,movedPermanently,tempRedirect,setResponseCode,resp-- * Handling if-modified-since,ifModifiedSince)whereimportqualifiedData.ByteString.Char8asBimportqualifiedData.ByteString.Lazy.Char8asLimportqualifiedData.ByteString.Lazy.UTF8asLU(fromString)importqualifiedData.MapasMimportqualifiedData.TextasTimportqualifiedData.Text.EncodingasTimportqualifiedData.Text.LazyasLTimportqualifiedData.Text.Lazy.EncodingasLTimportHappstack.Server.Internal.Monads(FilterMonad(composeFilter))importHappstack.Server.Types(Response(..),Request(..),nullRsFlags,getHeader,noContentLength,redirect,result,setHeader,setHeaderBS)importHappstack.Server.SURI(ToSURI)importSystem.Locale(defaultTimeLocale)importSystem.Time(CalendarTime,formatCalendarTime)importqualifiedText.BlazeasBlazeimportqualifiedText.Blaze.Renderer.Utf8asBlazeimportText.Html(Html,renderHtml)importqualifiedText.XHtmlasXHtml(Html,renderHtml)-- | A low-level function to build a 'Response' from a content-type-- and a 'ByteString'.---- Creates a 'Response' in a manner similar to the 'ToMessage' class,-- but without requiring an instance declaration.-- -- example:-- -- > import Data.ByteString.Char8 as C-- > import Data.ByteString.Lazy.Char8 as L-- > import Happstack.Server-- >-- > main = simpleHTTP nullConf $ ok $ toResponseBS (C.pack "text/plain") (L.pack "hello, world")---- (note: 'C.pack' and 'L.pack' only work for ascii. For unicode strings you would need to use @utf8-string@, @text@, or something similar to create a valid 'ByteString').toResponseBS::B.ByteString-- ^ content-type->L.ByteString-- ^ response body->ResponsetoResponseBScontentTypemessage=letres=Response200M.emptynullRsFlagsmessageNothinginsetHeaderBS(B.pack"Content-Type")contentTyperes-- | 'toResponse' will convert a value into a 'Response' body,-- set the @content-type@, and set the default response code for that type.---- Example:---- > main = simpleHTTP nullConf $ toResponse "hello, world!"---- will generate a 'Response' with the content-type @text/plain@,-- the response code @200 OK@, and the body: @hello, world!@.---- 'simpleHTTP' will call 'toResponse' automatically, so the above can be shortened to:---- > main = simpleHTTP nullConf $ "hello, world!"---- Minimal definition: 'toMessage' (and usually 'toContentType'). classToMessageawheretoContentType::a->B.ByteStringtoContentType_=B.pack"text/plain"toMessage::a->L.ByteStringtoMessage=error"Happstack.Server.SimpleHTTP.ToMessage.toMessage: Not defined"toResponse::a->ResponsetoResponseval=letbs=toMessagevalres=Response200M.emptynullRsFlagsbsNothinginsetHeaderBS(B.pack"Content-Type")(toContentTypeval)res{-
instance ToMessage [Element] where
toContentType _ = B.pack "application/xml; charset=UTF-8"
toMessage [el] = LU.fromString $ H.simpleDoc H.NoStyle $ toHaXmlEl el -- !! OPTIMIZE
toMessage x = error ("Happstack.Server.SimpleHTTP 'instance ToMessage [Element]' Can't handle " ++ show x)
-}instanceToMessage()wheretoContentType_=B.pack"text/plain"toMessage()=L.emptyinstanceToMessageStringwheretoContentType_=B.pack"text/plain; charset=UTF-8"toMessage=LU.fromStringinstanceToMessageT.TextwheretoContentType_=B.pack"text/plain; charset=UTF-8"toMessaget=L.fromChunks[T.encodeUtf8t]instanceToMessageLT.TextwheretoContentType_=B.pack"text/plain; charset=UTF-8"toMessage=LT.encodeUtf8instanceToMessageIntegerwheretoMessage=toMessage.showinstanceToMessagea=>ToMessage(Maybea)wheretoContentType_=toContentType(undefined::a)toMessageNothing=toMessage"nothing"toMessage(Justx)=toMessagexinstanceToMessageHtmlwheretoContentType_=B.pack"text/html; charset=UTF-8"toMessage=LU.fromString.renderHtmlinstanceToMessageXHtml.HtmlwheretoContentType_=B.pack"text/html; charset=UTF-8"toMessage=LU.fromString.XHtml.renderHtmlinstanceToMessageBlaze.HtmlwheretoContentType_=B.pack"text/html; charset=UTF-8"toMessage=Blaze.renderHtmlinstanceToMessageResponsewheretoResponse=id{-
-- This instances causes awful error messages. I am removing it and
-- seeing if anyone complains. I doubt they will.
instance (Xml a)=>ToMessage a where
toContentType = toContentType . toXml
toMessage = toMessage . toPublicXml
-}-- toMessageM = toMessageM . toPublicXml-- | alias for: @fmap toResponse@---- turns @m a@ into @m 'Response'@ using 'toResponse'.---- > main = simpleHTTP nullConf $ flatten $ do return "flatten me."flatten::(ToMessagea,Functorf)=>fa->fResponseflatten=fmaptoResponse-- |Honor an @if-modified-since@ header in a 'Request'.-- If the 'Request' includes the @if-modified-since@ header and the-- 'Response' has not been modified, then return 304 (Not Modified),-- otherwise return the 'Response'.ifModifiedSince::CalendarTime-- ^ mod-time for the 'Response' (MUST NOT be later than server's time of message origination)->Request-- ^ incoming request (used to check for if-modified-since)->Response-- ^ Response to send if there are modifications->ResponseifModifiedSincemodTimerequestresponse=letrepr=formatCalendarTimedefaultTimeLocale"%a, %d %b %Y %X GMT"modTimenotmodified=getHeader"if-modified-since"request==Just(B.pack$repr)inifnotmodifiedthennoContentLength$result304""-- Not ModifiedelsesetHeader"Last-modified"reprresponse-- | Deprecated: use 'composeFilter'.modifyResponse::(FilterMonadam)=>(a->a)->m()modifyResponse=composeFilter{-# DEPRECATED modifyResponse "Use composeFilter" #-}-- | Set an arbitrary return code in your response.---- A filter for setting the response code. Generally you will use a-- helper function like 'ok' or 'seeOther'.-- -- > main = simpleHTTP nullConf $ do setResponseCode 200-- > return "Everything is OK"-- -- see also: 'resp'setResponseCode::FilterMonadResponsem=>Int-- ^ response code->m()setResponseCodecode=composeFilter$\r->r{rsCode=code}-- | Same as @'setResponseCode' status >> return val@.-- -- Use this if you want to set a response code that does not already-- have a helper function. -- -- > main = simpleHTTP nullConf $ resp 200 "Everything is OK"resp::(FilterMonadResponsem)=>Int-- ^ response code->b-- ^ value to return->mbrespstatusval=setResponseCodestatus>>returnval-- | Respond with @200 OK@.-- -- > main = simpleHTTP nullConf $ ok "Everything is OK"ok::(FilterMonadResponsem)=>a->maok=resp200-- | Respond with @204 No Content@---- A @204 No Content@ response may not contain a message-body. If you try to supply one, it will be dutifully ignored.---- > main = simpleHTTP nullConf $ noContent "This will be ignored."noContent::(FilterMonadResponsem)=>a->manoContentval=composeFilter(\r->noContentLength(r{rsCode=204,rsBody=L.empty}))>>returnval-- | Respond with @500 Internal Server Error@.---- > main = simpleHTTP nullConf $ internalServerError "Sorry, there was an internal server error."internalServerError::(FilterMonadResponsem)=>a->mainternalServerError=resp500-- | Responds with @502 Bad Gateway@.---- > main = simpleHTTP nullConf $ badGateway "Bad Gateway."badGateway::(FilterMonadResponsem)=>a->mabadGateway=resp502-- | Respond with @400 Bad Request@.---- > main = simpleHTTP nullConf $ badRequest "Bad Request."badRequest::(FilterMonadResponsem)=>a->mabadRequest=resp400-- | Respond with @401 Unauthorized@.---- > main = simpleHTTP nullConf $ unauthorized "You are not authorized."unauthorized::(FilterMonadResponsem)=>a->maunauthorized=resp401-- | Respond with @403 Forbidden@.---- > main = simpleHTTP nullConf $ forbidden "Sorry, it is forbidden."forbidden::(FilterMonadResponsem)=>a->maforbidden=resp403-- | Respond with @404 Not Found@.-- -- > main = simpleHTTP nullConf $ notFound "What you are looking for has not been found."notFound::(FilterMonadResponsem)=>a->manotFound=resp404-- | Respond with @413 Request Entity Too Large@.---- > main = simpleHTTP nullConf $ requestEntityTooLarge "That's too big for me to handle."requestEntityTooLarge::(FilterMonadResponsem)=>a->marequestEntityTooLarge=resp413-- | Respond with @303 See Other@.---- > main = simpleHTTP nullConf $ seeOther "http://example.org/" "What you are looking for is now at http://example.org/"---- NOTE: The second argument of 'seeOther' is the message body which will sent to the browser. According to the HTTP 1.1 spec,---- @the entity of the response SHOULD contain a short hypertext note with a hyperlink to the new URI(s).@---- This is because pre-HTTP\/1.1 user agents do not support 303. However, in practice you can probably just use @\"\"@ as the second argument.seeOther::(FilterMonadResponsem,ToSURIuri)=>uri->res->mresseeOtherurires=domodifyResponse$redirect303urireturnres-- | Respond with @302 Found@.-- -- You probably want 'seeOther'. This method is not in popular use anymore, and is generally treated like 303 by most user-agents anyway.found::(FilterMonadResponsem,ToSURIuri)=>uri->res->mresfoundurires=domodifyResponse$redirect302urireturnres-- | Respond with @301 Moved Permanently@.---- > main = simpleHTTP nullConf $ movedPermanently "http://example.org/" "What you are looking for is now at http://example.org/"movedPermanently::(FilterMonadResponsem,ToSURIa)=>a->res->mresmovedPermanentlyurires=domodifyResponse$redirect301urireturnres-- | Respond with @307 Temporary Redirect@.---- > main = simpleHTTP nullConf $ tempRedirect "http://example.org/" "What you are looking for is temporarily at http://example.org/"tempRedirect::(FilterMonadResponsem,ToSURIa)=>a->res->mrestempRedirectvalres=domodifyResponse$redirect307valreturnres