diff options
| author | Andrew <saintruler@gmail.com> | 2020-11-27 20:51:21 +0400 |
|---|---|---|
| committer | Andrew <saintruler@gmail.com> | 2020-11-27 20:51:21 +0400 |
| commit | 46d7f5d2d88a62ed2c77514c33d97e25d737881c (patch) | |
| tree | c79a0c9ab4a1094b04716320d1c686bbe2a73eb7 /Web | |
| parent | 0093cbc556c735d148b571011a45ad32c567d62d (diff) | |
Added networking
Diffstat (limited to 'Web')
| -rw-r--r-- | Web/Response.hs | 4 | ||||
| -rw-r--r-- | Web/Utils.hs | 12 | ||||
| -rw-r--r-- | Web/Views.hs | 25 |
3 files changed, 9 insertions, 32 deletions
diff --git a/Web/Response.hs b/Web/Response.hs index 9bc2179..3c393ad 100644 --- a/Web/Response.hs +++ b/Web/Response.hs @@ -23,8 +23,8 @@ getContent (TextResponse _ _ content) = content formResponse :: Response -> Text formResponse (HtmlResponse code html) = - T.unlines + T.strip $ T.unlines $ map T.pack [ "HTTP/1.1 " ++ getStatus code , "Content-Type: text/html; charset=utf-8" - , "Connection: keep-alive" + , "Connection: close" , "" ] ++ [html] diff --git a/Web/Utils.hs b/Web/Utils.hs index 4e9082b..97bc512 100644 --- a/Web/Utils.hs +++ b/Web/Utils.hs @@ -9,6 +9,7 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Text (Text) import Web.Http +import Web.Request -- Query string parser @@ -44,14 +45,14 @@ parseQs url = rev :: [a] -> [a] rev = foldl (flip (:)) [] -getMethod :: Text -> Method -getMethod s +parseMethod :: Text -> Method +parseMethod s | s == (T.pack "POST") = POST | s == (T.pack "PUT") = PUT | otherwise = GET parseFirstLine :: Text -> (Method, Text) -parseFirstLine l = (getMethod methodT, url) +parseFirstLine l = (parseMethod methodT, url) where [methodT, url, _] = T.words l parseHeader :: Text -> Header @@ -63,7 +64,8 @@ parseHeader line = parseHeaders :: [Text] -> [Header] parseHeaders = map parseHeader -parseHttp :: Text -> ((Method, Text, [QueryPair]), [Header], [Text]) +-- parseHttp :: Text -> ((Method, Text, [QueryPair]), [Header], [Text]) +parseHttp :: Text -> (Request, [Header], [Text]) parseHttp text = let lines = T.splitOn (T.pack "\r\n") text @@ -80,7 +82,7 @@ parseHttp text = (method, url) = parseFirstLine fl (path, query) = parseQs url in - ((method, path, query), parseHeaders headers, rest2) + ((Request query path method), parseHeaders headers, rest2) -- HTTP Status Codes statusCodes = diff --git a/Web/Views.hs b/Web/Views.hs deleted file mode 100644 index 6619d09..0000000 --- a/Web/Views.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Web.Views where - -import System.IO -import qualified Data.Text as T -import Data.Text (Text) - -import Web.Request -import Web.Response - -indexGet (Request query url method) = - return $ HtmlResponse 200 (T.pack "<strong>index</strong>") - -helloGet req = - return $ HtmlResponse 200 (T.pack "<i>hello</i>") - -renderTemplate :: String -> IO Response -renderTemplate name = do - template <- readTemplate name - return $ HtmlResponse 200 template - -readTemplate :: String -> IO Text -readTemplate name = do - handle <- openFile ("templates/" ++ name) ReadMode - contents <- hGetContents handle - return $ T.pack contents |