module Web.Utils.HTTP where
import Web.Types
import Data.Maybe
import Text.JSON
data Request
= Request
{ reqMethod :: String
, reqURL :: URLString
, reqHeaders :: [(String,String)]
, reqVars :: [(String,String)]
, reqBody :: String
}
data Response
= Response
{ respStatus :: Integer
, respHeaders :: [(String,String)]
, respBody :: String
} deriving ( Show, Read )
jsonRequest :: String -> Maybe Request
jsonRequest s =
case decode s of
Ok v -> Just v
_ -> Nothing
jsonResponse :: Response -> String
jsonResponse r = encode r
instance JSON Request where
readJSON r = readRequest r
showJSON r = showRequest r
instance JSON Response where
readJSON r = readResponse r
showJSON r = showResponse r
readRequest :: JSValue -> Result Request
readRequest (JSObject o) = do
m <- valFromObj "method" o
u <- valFromObj "url" o
hs <- valFromObj "headers" o
vs <- valFromObj "vars" o
bo <- valFromObj "body" o
return Request{ reqMethod = m
, reqURL = u
, reqHeaders = hs
, reqVars = vs
, reqBody = bo
}
readRequest _ = Error ("unable to decode Request object")
showRequest :: Request -> JSValue
showRequest r = makeObj
[ ("method", showJSON (reqMethod r))
, ("url", showJSON (reqURL r))
, ("headers", showJSON (reqHeaders r))
, ("vars", showJSON (reqVars r))
, ("body", showJSON (reqBody r))
]
readResponse :: JSValue -> Result Response
readResponse (JSObject o) = do
s <- valFromObj "status" o
hs <- valFromObj "headers" o
bo <- valFromObj "body" o
return Response{ respStatus = s
, respHeaders = hs
, respBody = bo
}
readResponse _ = Error ("unable to decode response object")
showResponse :: Response -> JSValue
showResponse r = makeObj
[ ("status", showJSON (respStatus r))
, ("headers", showJSON (respHeaders r))
, ("body", showJSON (respBody r))
]
toStatusString :: Integer -> String
toStatusString x = fromMaybe "" (lookup x statusMap)
statusMap :: [(Integer, String)]
statusMap =
[ 100 -=> "Continue"
, 101 -=> "Switching Protocols"
, 200 -=> "OK"
, 201 -=> "Created"
, 202 -=> "Accepted"
, 203 -=> "Non-Authoritative Information"
, 204 -=> "No Content"
, 205 -=> "Reset Content"
, 206 -=> "Partial Content"
, 300 -=> "Multiple Choices"
, 301 -=> "Moved Permanently"
, 302 -=> "Found"
, 303 -=> "See Other"
, 304 -=> "Not Modified"
, 305 -=> "Use Proxy"
, 307 -=> "Temporary Redirect"
, 400 -=> "Bad Request"
, 401 -=> "Unauthorized"
, 402 -=> "Payment Required"
, 403 -=> "Forbidden"
, 404 -=> "Not Found"
, 405 -=> "Method Not Allowed"
, 406 -=> "Not Acceptable"
, 407 -=> "Proxy Authentication Required"
, 408 -=> "Request Time-out"
, 409 -=> "Conflict"
, 410 -=> "Gone"
, 411 -=> "Length Required"
, 412 -=> "Precondition Failed"
, 413 -=> "Request Entity Too Large"
, 414 -=> "Request-URI Too Large"
, 415 -=> "Unsupported Media Type"
, 416 -=> "Requested range not satisfiable"
, 417 -=> "Expectation Failed"
, 500 -=> "Internal Server Error"
, 501 -=> "Not Implemented"
, 502 -=> "Bad Gateway"
, 503 -=> "Service Unavailable"
, 504 -=> "Gateway Time-out"
, 505 -=> "HTTP Version not supported"
]
where
(-=>) a b = (a,b)