Prototype compressed event listing

2 files changed, 18 insertions, 1 deletions

diff --git a/mini-http-server/Network/HTTP/Server/Mini/Internal/Parser.hs b/mini-http-server/Network/HTTP/Server/Mini/Internal/Parser.hs
index 6278326..ee989af 100644
--- a/mini-http-server/Network/HTTP/Server/Mini/Internal/Parser.hs
+++ b/mini-http-server/Network/HTTP/Server/Mini/Internal/Parser.hs
@@ -9,6 +9,7 @@ import Data.ByteString qualified as BS
 import Data.ByteString.Short (ShortByteString)
 import Data.ByteString.Short qualified as SBS
 import Data.Char
+import Data.Maybe (catMaybes)
 import Data.Word
 import FlatParse.Basic qualified as P
 
@@ -33,11 +34,13 @@ pRequest = do
   (method, uri) <- pFirstLine
   headers <- P.many pHeader
   let (path, query) = parseURI uri
+      cookies = maybe [] parseCookie (lookup (packSBS "cookie") headers)
   return Request { reqMethod = method
                  , reqURI = uri
                  , reqHeaders = headers
                  , reqPath = path
-                 , reqQuery = query }
+                 , reqQuery = query
+                 , reqCookies = cookies }
 
 pFirstLine :: P.Parser e (ShortByteString, ByteString)
 pFirstLine = do
@@ -151,6 +154,16 @@ findTerminator bs =
             13 | bs `BS.index` (i+2) == 10 -> FoundTerm (i+1)
             _ -> go is
 
+parseCookie :: ByteString -> [(ByteString, ByteString)]
+parseCookie hdr = catMaybes (map parseSingle (BS.split (ord8 ';') hdr))
+  where
+    parseSingle str =
+      let str1 = BS.dropWhile (== ord8 ' ') str
+          (name, str2) = BS.span (/= ord8 '=') str1
+      in if not (BS.null str2) && BS.head str2 == ord8 '='
+           then Just (name, BS.tail str2)
+           else Nothing
+
 toAsciiUpperCase :: Word8 -> Word8
 toAsciiUpperCase c
   | ord8 'a' <= c, c <= ord8 'z' = c - 32
@@ -160,3 +173,6 @@ toAsciiLowerCase :: Word8 -> Word8
 toAsciiLowerCase c
   | ord8 'A' <= c, c <= ord8 'Z' = c + 32
   | otherwise = c
+
+packSBS :: String -> ShortByteString
+packSBS = SBS.pack . map ord8
diff --git a/mini-http-server/Network/HTTP/Server/Mini/Types.hs b/mini-http-server/Network/HTTP/Server/Mini/Types.hs
index d657a13..94e113f 100644
--- a/mini-http-server/Network/HTTP/Server/Mini/Types.hs
+++ b/mini-http-server/Network/HTTP/Server/Mini/Types.hs
@@ -33,6 +33,7 @@ data Request = Request
   , reqHeaders :: ![(Header, ByteString)]  -- | Header name in all-lowercase
   , reqPath :: [ByteString]  -- | Lazy field
   , reqQuery :: [(ByteString, ByteString)]  -- | Lazy field
+  , reqCookies :: [(ByteString, ByteString)]  -- | Lazy field
   }
   deriving (Show, Eq)