From abbf64f5a5453fcb6bfe9b90df9e8f6fa002b66a Mon Sep 17 00:00:00 2001
From: Andrew Guschin <guschin.drew@gmail.com>
Date: Sun, 5 Mar 2023 14:28:47 +0400
Subject: Fixed warnings

---
 app/Web/Request.hs  |  5 ++++-
 app/Web/Response.hs |  8 +++++++-
 app/Web/Utils.hs    | 46 ++++++++++++++++++++++++++--------------------
 3 files changed, 37 insertions(+), 22 deletions(-)

(limited to 'app/Web')

diff --git a/app/Web/Request.hs b/app/Web/Request.hs
index 71dc421..96144b8 100644
--- a/app/Web/Request.hs
+++ b/app/Web/Request.hs
@@ -8,8 +8,11 @@ import Web.Http
 data Request = Request [QueryPair] Text Method
   deriving Show
 
+getQuery :: Request -> [QueryPair]
 getQuery (Request query _ _) = query
 
+getUrl :: Request -> Text
 getUrl (Request _ url _) = url
 
-getMethod (Request _ _ method) = method
\ No newline at end of file
+getMethod :: Request -> Method
+getMethod (Request _ _ method) = method
diff --git a/app/Web/Response.hs b/app/Web/Response.hs
index 3c393ad..11ab5f2 100644
--- a/app/Web/Response.hs
+++ b/app/Web/Response.hs
@@ -10,21 +10,27 @@ data Response
   | TextResponse Int Text Text -- Код возврата, Content-Type, содержимое HTML
   deriving Show
 
+notFoundResponse :: Response
 notFoundResponse = HtmlResponse 404 (T.pack "<strong>404 Not Found</strong>")
 
+getStatusCode :: Response -> Int
 getStatusCode (HtmlResponse code _) = code
 getStatusCode (TextResponse code _ _) = code
 
+getContentType :: Response -> Text
 getContentType (HtmlResponse _ _) = (T.pack "text/html")
 getContentType (TextResponse _ contentType _) = contentType
 
+getContent :: Response -> Text
 getContent (HtmlResponse _ content) = content
 getContent (TextResponse _ _ content) = content
 
 formResponse :: Response -> Text
-formResponse (HtmlResponse code html) = 
+formResponse (HtmlResponse code html) =
   T.strip $ T.unlines
   $ map T.pack [ "HTTP/1.1 " ++ getStatus code
                , "Content-Type: text/html; charset=utf-8"
                , "Connection: close"
                , "" ] ++ [html]
+-- TODO: Добавить обработчик
+formResponse _ = undefined
diff --git a/app/Web/Utils.hs b/app/Web/Utils.hs
index 97bc512..e77754f 100644
--- a/app/Web/Utils.hs
+++ b/app/Web/Utils.hs
@@ -1,12 +1,11 @@
 module Web.Utils (parseQs, parseHttp, getStatus) where
 
 import Network.HTTP.Types.URI as URI
-import qualified Data.ByteString as S
-import Data.ByteString (ByteString)
 
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Data.Text (Text)
+import Data.Maybe (catMaybes)
 
 import Web.Http
 import Web.Request
@@ -25,18 +24,17 @@ parseQs url =
 
     parsePair :: Text -> Maybe QueryPair
     parsePair s
-      | T.any ((==) '=') s = Just (QueryPair a b)
+      | T.any ((==) '=') s =
+          case T.splitOn (T.pack "=") s of
+            []            -> Nothing
+            [_]           -> Nothing
+            key : val : _ -> Just (QueryPair key val)
       | otherwise = Nothing
-      where a : b : _ = T.splitOn (T.pack "=") s
-    
-    get (Just p : rest) = p : get rest
-    get (Nothing : rest) = get rest
-    get [] = []
 
-    pairs = 
+    pairs =
       if T.null rest
       then []
-      else get $ map parsePair $ T.splitOn (T.pack "&") $ T.tail rest
+      else catMaybes $ map parsePair $ T.splitOn (T.pack "&") $ T.tail rest
 
   in (path, pairs)
 
@@ -51,12 +49,16 @@ parseMethod s
   | s == (T.pack "PUT")  = PUT
   | otherwise            = GET
 
+-- TODO: добавить нормальную обработку ошибочных ситуаций
 parseFirstLine :: Text -> (Method, Text)
-parseFirstLine l = (parseMethod methodT, url)
-  where [methodT, url, _] = T.words l
+parseFirstLine l =
+  case T.words l of
+    []                -> undefined
+    [_]               -> undefined
+    methodT : url : _ -> (parseMethod methodT, url)
 
 parseHeader :: Text -> Header
-parseHeader line = 
+parseHeader line =
   Header (T.takeWhile p line)
          (T.strip $ T.tail $ T.dropWhile p line)
     where p = (\c -> c /= ':')
@@ -64,28 +66,32 @@ parseHeader line =
 parseHeaders :: [Text] -> [Header]
 parseHeaders = map parseHeader
 
--- parseHttp :: Text -> ((Method, Text, [QueryPair]), [Header], [Text])
 parseHttp :: Text -> (Request, [Header], [Text])
-parseHttp text = 
+parseHttp text =
   let
-    lines = T.splitOn (T.pack "\r\n") text
+    textLines = T.splitOn (T.pack "\r\n") text
 
     getFirstLine (l : rest) = (l, rest)
+    -- TODO: добавить нормальную обработку ошибочных ситуаций
+    getFirstLine [] = undefined
 
     getHeaders (l : rest) acc
       | T.null l  = (rev acc, rest)
       | otherwise = getHeaders rest (l : acc)
-    
-    (fl, rest1) = getFirstLine lines
+    -- TODO: добавить нормальную обработку ошибочных ситуаций
+    getHeaders [] _ = undefined
+
+    (fl, rest1) = getFirstLine textLines
     (headers, rest2) = getHeaders rest1 []
 
     (method, url) = parseFirstLine fl
     (path, query) = parseQs url
-  in 
+  in
     ((Request query path method), parseHeaders headers, rest2)
 
 -- HTTP Status Codes
-statusCodes = 
+statusCodes :: [(Int, String)]
+statusCodes =
   [ (100, "Continue"),
     (101, "Switching Protocols"),
     (102, "Processing"),
-- 
cgit v1.2.3