module Ketchup.Utils
( trim
, breakBS
, fallback
, parseBody
, sendReply
, sendBadRequest
, sendNotFound
, statusMsg
) where
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import qualified Data.List as List
import Network
import Network.Socket.ByteString
statusMsg :: Int
-> B.ByteString
statusMsg stat
| stat == 200 = "200 OK"
| stat == 201 = "201 Created"
| stat == 204 = "204 No Content"
| stat == 400 = "400 Bad Request"
| stat == 401 = "401 Unauthorized"
| stat == 402 = "402 Payment Required"
| stat == 403 = "403 Forbidden"
| stat == 404 = "404 Not Found"
| stat == 405 = "405 Method Not Allowed"
| stat == 410 = "410 Gone"
| stat == 500 = "500 Internal Server Error"
| stat == 501 = "501 Not Implemented"
| stat == 502 = "502 Bad Gateway"
| stat == 503 = "503 Service Unavailable"
| otherwise = "500 Internal Server Error"
sendBadRequest :: Socket -> IO ()
sendBadRequest client =
sendReply client 400 [("Content-Type",["text/plain"])] "400 Bad Request!\n"
sendNotFound :: Socket -> IO ()
sendNotFound client =
sendReply client 404 [("Content-Type",["text/plain"])] "404 Not Found!\n"
sendReply :: Socket
-> Int
-> [(B.ByteString, [B.ByteString])]
-> B.ByteString
-> IO ()
sendReply client status headers body =
sendAll client reply
where
reply = B.concat
[ "HTTP/1.1 ", statusMsg status,"\r\n"
, "Content-Length: ", B.pack $ show $ B.length body, "\r\n"
, "Connection: close\r\n", heads, "\r\n", body]
heads = B.concat $ map toHeader headers
toHeader x = B.concat [fst x, ": "
,B.concat $ List.intersperse "," $ snd x
,"\r\n"]
trim :: B.ByteString -> B.ByteString
trim = f . f
where f = B.reverse . B.dropWhile isSpace
breakBS :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)
breakBS delimiter source =
(first, second)
where
first = fst broke
second = B.drop (B.length delimiter) $ snd broke
broke = B.breakSubstring delimiter source
parseBody :: B.ByteString -> [(B.ByteString, B.ByteString)]
parseBody body = map (breakBS "=") $ B.split '&' body
fallback :: Maybe a -> a -> a
fallback (Just value) fallback = value
fallback Nothing fallback = fallback