Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Snap.Internal.Http.Types
Description
An internal Snap module containing HTTP types.
N.B. this is an internal interface, please don't write user code that depends on it. Most of these declarations (except for the unsafe/encapsulation-breaking ones) are re-exported from Snap.Core.
Synopsis
- set_c_locale :: IO ()
- c_parse_http_time :: CString -> IO CTime
- c_format_http_time :: CTime -> CString -> IO ()
- c_format_log_time :: CTime -> CString -> IO ()
- class HasHeaders a where
- updateHeaders :: (Headers -> Headers) -> a -> a
- headers :: a -> Headers
- addHeader :: HasHeaders a => CI ByteString -> ByteString -> a -> a
- setHeader :: HasHeaders a => CI ByteString -> ByteString -> a -> a
- getHeader :: HasHeaders a => CI ByteString -> a -> Maybe ByteString
- listHeaders :: HasHeaders a => a -> [(CI ByteString, ByteString)]
- deleteHeader :: HasHeaders a => CI ByteString -> a -> a
- data Method
- normalizeMethod :: Method -> Method
- type HttpVersion = (Int, Int)
- data Cookie = Cookie {
- cookieName :: !ByteString
- cookieValue :: !ByteString
- cookieExpires :: !(Maybe UTCTime)
- cookieDomain :: !(Maybe ByteString)
- cookiePath :: !(Maybe ByteString)
- cookieSecure :: !Bool
- cookieHttpOnly :: !Bool
- type Params = Map ByteString [ByteString]
- data Request = Request {
- rqHostName :: ByteString
- rqClientAddr :: ByteString
- rqClientPort :: !Int
- rqServerAddr :: ByteString
- rqServerPort :: !Int
- rqLocalHostname :: ByteString
- rqIsSecure :: !Bool
- rqHeaders :: Headers
- rqBody :: InputStream ByteString
- rqContentLength :: !(Maybe Word64)
- rqMethod :: !Method
- rqVersion :: !HttpVersion
- rqCookies :: [Cookie]
- rqPathInfo :: ByteString
- rqContextPath :: ByteString
- rqURI :: ByteString
- rqQueryString :: ByteString
- rqParams :: Params
- rqQueryParams :: Params
- rqPostParams :: Params
- type StreamProc = OutputStream Builder -> IO (OutputStream Builder)
- data ResponseBody
- rspBodyMap :: (StreamProc -> StreamProc) -> ResponseBody -> ResponseBody
- rspBodyToEnum :: ResponseBody -> StreamProc
- data Response = Response {}
- rqParam :: ByteString -> Request -> Maybe [ByteString]
- rqPostParam :: ByteString -> Request -> Maybe [ByteString]
- rqQueryParam :: ByteString -> Request -> Maybe [ByteString]
- rqModifyParams :: (Params -> Params) -> Request -> Request
- rqSetParam :: ByteString -> [ByteString] -> Request -> Request
- emptyResponse :: Response
- setResponseBody :: (OutputStream Builder -> IO (OutputStream Builder)) -> Response -> Response
- setResponseStatus :: Int -> ByteString -> Response -> Response
- setResponseCode :: Int -> Response -> Response
- modifyResponseBody :: ((OutputStream Builder -> IO (OutputStream Builder)) -> OutputStream Builder -> IO (OutputStream Builder)) -> Response -> Response
- setContentType :: ByteString -> Response -> Response
- cookieToBS :: Cookie -> ByteString
- renderCookies :: Response -> Headers -> Headers
- addResponseCookie :: Cookie -> Response -> Response
- getResponseCookie :: ByteString -> Response -> Maybe Cookie
- getResponseCookies :: Response -> [Cookie]
- deleteResponseCookie :: ByteString -> Response -> Response
- modifyResponseCookie :: ByteString -> (Cookie -> Cookie) -> Response -> Response
- setContentLength :: Word64 -> Response -> Response
- clearContentLength :: Response -> Response
- formatHttpTime :: CTime -> IO ByteString
- formatLogTime :: CTime -> IO ByteString
- parseHttpTime :: ByteString -> IO CTime
- statusReasonMap :: IntMap ByteString
- rqRemoteAddr :: Request -> ByteString
- rqRemotePort :: Request -> Int
Documentation
set_c_locale :: IO () Source #
class HasHeaders a where Source #
A typeclass for datatypes which contain HTTP headers.
Methods
updateHeaders :: (Headers -> Headers) -> a -> a Source #
Modify the datatype's headers.
headers :: a -> Headers Source #
Retrieve the headers from a datatype that has headers.
Instances
addHeader :: HasHeaders a => CI ByteString -> ByteString -> a -> a Source #
Adds a header key-value-pair to the HasHeaders
datatype. If a header
with the same name already exists, the new value is appended to the headers
list.
Example:
ghci> import qualified Snap.Types.Headers as H ghci>addHeader
"Host" "localhost" H.empty
H {unH = [("host","localhost")]} ghci>addHeader
"Host" "127.0.0.1" it H {unH = [("host","localhost,127.0.0.1")]}
setHeader :: HasHeaders a => CI ByteString -> ByteString -> a -> a Source #
Sets a header key-value-pair in a HasHeaders
datatype. If a header with
the same name already exists, it is overwritten with the new value.
Example:
ghci> import qualified Snap.Types.Headers as H ghci>setHeader
"Host" "localhost" H.empty
H {unH = [("host","localhost")]} ghci> setHeader "Host" "127.0.0.1" it H {unH = [("host","127.0.0.1")]}
getHeader :: HasHeaders a => CI ByteString -> a -> Maybe ByteString Source #
Gets a header value out of a HasHeaders
datatype.
Example:
ghci> import qualified Snap.Types.Headers as H ghci>getHeader
"Host" $setHeader
"Host" "localhost" H.empty
Just "localhost"
listHeaders :: HasHeaders a => a -> [(CI ByteString, ByteString)] Source #
Lists all the headers out of a HasHeaders
datatype. If many
headers came in with the same name, they will be catenated together.
Example:
ghci> import qualified Snap.Types.Headers as H ghci>listHeaders
$setHeader
"Host" "localhost" H.empty
[("host","localhost")]
deleteHeader :: HasHeaders a => CI ByteString -> a -> a Source #
Clears a header value from a HasHeaders
datatype.
Example:
ghci> import qualified Snap.Types.Headers as H ghci>deleteHeader
"Host" $setHeader
"Host" "localhost" H.empty
H {unH = []}
Enumerates the HTTP method values (see http://tools.ietf.org/html/rfc2068.html#section-5.1.1).
normalizeMethod :: Method -> Method Source #
Equate the special case constructors with their corresponding
Method name
variant.
type HttpVersion = (Int, Int) Source #
Represents a (major, minor) version of the HTTP protocol.
A datatype representing an HTTP cookie.
Constructors
Cookie | |
Fields
|
type Params = Map ByteString [ByteString] Source #
A type alias for the HTTP parameters mapping. Each parameter
key maps to a list of ByteString
values; if a parameter is specified
multiple times (e.g.: "GET /foo?param=bar1¶m=bar2
"), looking up
"param
" in the mapping will give you ["bar1", "bar2"]
.
Contains all of the information about an incoming HTTP request.
Constructors
Request | |
Fields
|
Instances
Show Request Source # | |
HasHeaders Request Source # | |
Monad m => MonadState Request (RequestBuilder m) Source # | |
Defined in Snap.Internal.Test.RequestBuilder Methods get :: RequestBuilder m Request # put :: Request -> RequestBuilder m () # state :: (Request -> (a, Request)) -> RequestBuilder m a # |
type StreamProc = OutputStream Builder -> IO (OutputStream Builder) Source #
data ResponseBody Source #
rspBodyMap :: (StreamProc -> StreamProc) -> ResponseBody -> ResponseBody Source #
Represents an HTTP response.
Constructors
Response | |
Fields
|
Arguments
:: ByteString | parameter name to look up |
-> Request | HTTP request |
-> Maybe [ByteString] |
Looks up the value(s) for the given named parameter. Parameters initially
come from the request's query string and any decoded POST body (if the
request's Content-Type
is application/x-www-form-urlencoded
).
Parameter values can be modified within handlers using "rqModifyParams".
Example:
ghci> :set -XOverloadedStrings
ghci> import qualified Snap.Test as T
ghci> import qualified Data.Map as M
ghci> :{
ghci| rq <- T.buildRequest $ do
ghci| T.postUrlEncoded "/foo/bar" $ M.fromList [("baz", ["qux"])]
ghci| T.setQueryStringRaw "baz=quux"
ghci| :}
ghci> rqParam
"baz" rq
Just ["qux","quux"]
Arguments
:: ByteString | parameter name to look up |
-> Request | HTTP request |
-> Maybe [ByteString] |
Looks up the value(s) for the given named parameter in the POST parameters mapping.
Example:
ghci> :set -XOverloadedStrings
ghci> import qualified Snap.Test as T
ghci> import qualified Data.Map as M
ghci> :{
ghci| rq <- T.buildRequest $ do
ghci| T.postUrlEncoded "/foo/bar" $ M.fromList [("baz", ["qux"])]
ghci| T.setQueryStringRaw "baz=quux"
ghci| :}
ghci> rqPostParam
"baz" rq
Just ["qux"]
Arguments
:: ByteString | parameter name to look up |
-> Request | HTTP request |
-> Maybe [ByteString] |
Looks up the value(s) for the given named parameter in the query parameters mapping.
Example:
ghci> :set -XOverloadedStrings
ghci> import qualified Snap.Test as T
ghci> import qualified Data.Map as M
ghci> :{
ghci| rq <- T.buildRequest $ do
ghci| T.postUrlEncoded "/foo/bar" $ M.fromList [("baz", ["qux"])]
ghci| T.setQueryStringRaw "baz=quux"
ghci| :}
ghci> rqQueryParam
"baz" rq
Just ["quux"]
rqModifyParams :: (Params -> Params) -> Request -> Request Source #
Modifies the parameters mapping (which is a Map ByteString ByteString
)
in a Request
using the given function.
Example:
ghci> :set -XOverloadedStrings ghci> import qualified Snap.Test as T ghci> import qualified Data.Map as M ghci> :{ ghci| rq <- T.buildRequest $ do ghci| T.postUrlEncoded "/foo/bar" $ M.fromList [("baz", ["qux"])] ghci| T.setQueryStringRaw "baz=quux" ghci| :} ghci>rqParams
rq fromList [("baz",["qux","quux"])] ghci>rqParams
$rqModifyParams
(M.delete "baz") rq fromList []
Arguments
:: ByteString | parameter name |
-> [ByteString] | parameter values |
-> Request | request |
-> Request |
Writes a key-value pair to the parameters mapping within the given request.
Example:
ghci> :set -XOverloadedStrings ghci> import qualified Snap.Test as T ghci> import qualified Data.Map as M ghci> :{ ghci| rq <- T.buildRequest $ do ghci| T.postUrlEncoded "/foo/bar" $ M.fromList [("baz", ["qux"])] ghci| T.setQueryStringRaw "baz=quux" ghci| :} ghci>rqParams
rq fromList [("baz",["qux","quux"])] ghci>rqParams
$rqSetParam
"baz" ["corge"] rq fromList [("baz", ["corge"])]
Arguments
:: (OutputStream Builder -> IO (OutputStream Builder)) | new response body |
-> Response | response to modify |
-> Response |
Sets an HTTP response body to the given stream procedure.
Example:
ghci> :set -XOverloadedStrings ghci> import qualified System.IO.Streams as Streams ghci> import qualified Data.ByteString.Builder as Builder ghci> :{ ghci| let r =setResponseBody
ghci| (out -> do ghci| Streams.write (Just $ Builder.byteString
"Hello, world!") out ghci| return out) ghci|emptyResponse
ghci| :} ghci> r HTTP/1.1 200 OK Hello, world!
Arguments
:: Int | HTTP response integer code |
-> ByteString | HTTP response explanation |
-> Response | Response to be modified |
-> Response |
Sets the HTTP response status. Note: normally you would use
setResponseCode
unless you needed a custom response explanation.
Example:
ghci> :set -XOverloadedStrings
ghci> setResponseStatus 500 "Internal Server Error" emptyResponse
HTTP/1.1 500 Internal Server Error
modifyResponseBody :: ((OutputStream Builder -> IO (OutputStream Builder)) -> OutputStream Builder -> IO (OutputStream Builder)) -> Response -> Response Source #
Modifies a response body.
Example:
ghci> :set -XOverloadedStrings ghci> import qualified System.IO.Streams as Streams ghci> import qualified Data.ByteString.Builder as Builder ghci> :{ ghci| let r =setResponseBody
ghci| (out -> do ghci| Streams.write (Just $ Builder.byteString
"Hello, world!") out ghci| return out) ghci|emptyResponse
ghci| :} ghci> r HTTP/1.1 200 OK Hello, world! ghci> :{ ghci| let r' =modifyResponseBody
ghci| (f out -> do ghci| out' <- f out ghci| Streams.write (Just $ Builder.byteString
"\nBye, world!") out' ghci| return out') r ghci| :} ghci> r' HTTP/1.1 200 OK Hello, world! Bye, world!
setContentType :: ByteString -> Response -> Response Source #
Sets the Content-Type
in the Response
headers.
Example:
ghci> :set -XOverloadedStrings
ghci> setContentType "text/html" emptyResponse
HTTP/1.1 200 OK
content-type: text/html
cookieToBS :: Cookie -> ByteString Source #
Convert Cookie
into ByteString
for output.
TODO: Remove duplication. This function is copied from snap-server/Snap.Internal.Http.Server.Session.
Adds an HTTP Cookie
to Response
headers.
Example:
ghci> :set -XOverloadedStrings ghci> let cookie =Cookie
"name" "value" Nothing Nothing Nothing False False ghci>getResponseCookie
"name" $addResponseCookie
cookieemptyResponse
Just (Cookie {cookieName = "name", cookieValue = "value", ...})
Arguments
:: ByteString | cookie name |
-> Response | response to query |
-> Maybe Cookie |
Gets an HTTP Cookie
with the given name from Response
headers.
Example:
ghci> :set -XOverloadedStrings ghci>getResponseCookie
"cookie-name"emptyResponse
Nothing
Arguments
:: ByteString | cookie name |
-> Response | response to modify |
-> Response |
Deletes an HTTP Cookie
from the Response
headers. Please note
this does not necessarily erase the cookie from the client browser.
Example:
ghci> :set -XOverloadedStrings ghci> let cookie =Cookie
"name" "value" Nothing Nothing Nothing False False ghci> let rsp =addResponseCookie
cookieemptyResponse
ghci>getResponseCookie
"name" rsp Just (Cookie {cookieName = "name", cookieValue = "value", ...}) ghci>getResponseCookie
"name" $deleteResponseCookie
"name" rsp Nothing
Arguments
:: ByteString | cookie name |
-> (Cookie -> Cookie) | modifier function |
-> Response | response to modify |
-> Response |
Modifies an HTTP Cookie
with given name in Response
headers.
Nothing will happen if a matching Cookie
can not be found in Response
.
Example:
ghci> :set -XOverloadedStrings ghci> import Data.Monoid ghci> let cookie =Cookie
"name" "value" Nothing Nothing Nothing False False ghci> let rsp =addResponseCookie
cookieemptyResponse
ghci>getResponseCookie
"name" rsp Just (Cookie {cookieName = "name", cookieValue = "value", ...}) ghci> let f ck@(Cookie
{ cookieName = name }) = ck { cookieName = name <> "'"} ghci> let rsp' =modifyResponseCookie
"name" f rsp ghci>getResponseCookie
"name'" rsp' Just (Cookie {cookieName = "name'", ...}) ghci>getResponseCookie
"name" rsp' Just (Cookie {cookieName = "name", ...})
setContentLength :: Word64 -> Response -> Response Source #
A note here: if you want to set the Content-Length
for the response,
Snap forces you to do it with this function rather than by setting it in
the headers; the Content-Length
in the headers will be ignored.
The reason for this is that Snap needs to look up the value of
Content-Length
for each request, and looking the string value up in the
headers and parsing the number out of the text will be too expensive.
If you don't set a content length in your response, HTTP keep-alive will be
disabled for HTTP/1.0 clients, forcing a Connection: close
. For
HTTP/1.1 clients, Snap will switch to the chunked transfer encoding if
Content-Length
is not specified.
Example:
ghci> setContentLength 400 emptyResponse
HTTP/1.1 200 OK
Content-Length: 400
clearContentLength :: Response -> Response Source #
Removes any Content-Length
set in the Response
.
Example:
ghci> clearContentLength $setContentLength
400emptyResponse
HTTP/1.1 200 OK
formatHttpTime :: CTime -> IO ByteString Source #
Convert a CTime
into an HTTP timestamp.
Example:
ghci>formatHttpTime
.fromIntegral
$ 10 "Thu, 01 Jan 1970 00:00:10 GMT"
formatLogTime :: CTime -> IO ByteString Source #
Convert a CTime
into common log entry format.
parseHttpTime :: ByteString -> IO CTime Source #
Converts an HTTP timestamp into a CTime
.
If the given time string is unparseable, this function will return 0.
Example:
ghci> :set -XOverloadedStrings
ghci> parseHttpTime
"Thu, 01 Jan 1970 00:00:10 GMT"
10
rqRemoteAddr :: Request -> ByteString Source #
Deprecated: (snap-core >= 1.0.0.0) please use rqClientAddr
, this will be removed in 1.1.*
See rqClientAddr
.
rqRemotePort :: Request -> Int Source #
Deprecated: (snap-core >= 1.0.0.0) please use rqClientPort
, this will be removed in 1.1.*
See rqClientPort
.