-
Notifications
You must be signed in to change notification settings - Fork 0
/
HTTPRequest.hs
65 lines (49 loc) · 1.91 KB
/
HTTPRequest.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# LANGUAGE OverloadedStrings #-}
module HTTPRequest
(
HTTPRequest(..)
, HTTPResponse(..)
, request
, sendResponse
, readResponse
) where
import Control.Applicative
import Data.Attoparsec.ByteString as P
import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
import Data.ByteString (ByteString, append)
import Data.Word (Word8)
import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)
import Data.Binary (encode)
data Header = Header {
name :: ByteString,
value :: ByteString
} deriving (Eq, Ord, Show)
data HTTPRequest = HTTPRequest {
method :: ByteString,
uri :: ByteString,
version :: ByteString,
headers :: [Header]
} deriving (Eq, Ord, Show)
data HTTPResponse = HTTPResponse {
status :: ByteString,
message :: ByteString,
body :: ByteString
} deriving (Eq, Ord, Show)
skipSpaces :: Parser ()
skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace
isToken :: Word8 -> Bool
isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w
httpVersion :: Parser ByteString
httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)
header :: Parser Header
header = Header
<$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
<*> (takeTill isEndOfLine <* endOfLine)
request = HTTPRequest <$> (takeWhile1 isToken <* char8 ' ')
<*> (takeWhile1 (/=32) <* char8 ' ')
<*> (httpVersion <* endOfLine)
<*> (many header <* many endOfLine <* endOfInput)
sendResponse :: ByteString -> ByteString -> ByteString -> HTTPResponse
sendResponse s m b = HTTPResponse s m b
readResponse :: HTTPResponse -> ByteString
readResponse res = "HTTP/1.1 " `append` (status res) `append` " " `append` (message res) `append` "\n\n" `append` (body res)