6 files changed, 0 insertions, 399 deletions
diff --git a/mini-http/Network/HTTP/Server/Mini.hs b/mini-http/Network/HTTP/Server/Mini.hs
deleted file mode 100644
index 3c5c3f6..0000000
--- a/mini-http/Network/HTTP/Server/Mini.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE TypeApplications #-}
-module Network.HTTP.Server.Mini (
-  run,
-  module Network.HTTP.Server.Mini.Types,
-) where
-
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception
-import Control.Monad
-import Data.List.NonEmpty qualified as NE
-import Network.Socket
-import Network.Socket.ByteString
-
-import Network.HTTP.Server.Mini.Parser
-import Network.HTTP.Server.Mini.Printer
-import Network.HTTP.Server.Mini.Types
-
-
--- | The request handler will run in a forkIO thread.
-run :: Settings -> (Request -> IO Response) -> IO ()
-run settings handler = do
-  let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV, AI_PASSIVE]
-                           , addrSocketType = Stream }
-  addrs <- getAddrInfo @NE.NonEmpty (Just hints) Nothing (Just (show (setPort settings)))
-
-  semaphore <- newTVarIO (setMaxParallelRequests settings)
-  finishVar <- newEmptyMVar
-
-  threads <- forM addrs $ \addr ->
-    forkIO $
-      bracket
-        (openSocket addr)
-        (\sock -> close sock `finally` putMVar finishVar ())
-        (\sock -> do
-          setSocketOption sock ReusePort 1
-          bind sock (addrAddress addr)
-          listen sock (setListenQueue settings)
-          acceptLoop sock semaphore)
-
-  takeMVar finishVar
-  forM_ threads killThread
-  where
-    -- Put the forever _outside_ the mask_ to unmask briefly between iterations
-    -- (when it's safe because we have nothing ongoing).
-    acceptLoop sock semaphore = forever $ mask_ $ do
-      -- Because we're masked, if atomically exits with an async exception, it
-      -- was while blocking so the transaction failed, so nothing happened, so
-      -- no cleanup necessary.
-      atomically $ do
-        n <- readTVar semaphore
-        when (n == 0) retry
-        writeTVar semaphore $! n - 1
-      let increment = atomically (modifyTVar' semaphore (+1))
-
-      (conn, _peer) <- accept sock `onException` increment
-      let cleanup = close conn `finally` increment
-
-      onException
-        (do allowInterrupt  -- we're masked but we just blocked (in `accept` in FFI), so let exceptions through
-            -- Now either the forkIO succeeds (and the responsibility for
-            -- closing and incrementing is passed to the thread) or it fails
-            -- (and we retain both responsibilities).
-            void $ forkIO $
-              handleConnection settings conn handler `finally` cleanup)
-        cleanup
-
--- | Will not close the connection, instead will just return, expecting the
--- caller to close the connection then.
-handleConnection :: Settings -> Socket -> (Request -> IO Response) -> IO ()
-handleConnection settings conn handler =
-  readRequest (setMaxRequestSize settings) (recv conn) >>= \case
-    Nothing -> return ()
-    Just req -> do
-      resp <- handler req
-      sendResponse conn resp
diff --git a/mini-http/Network/HTTP/Server/Mini/Parser.hs b/mini-http/Network/HTTP/Server/Mini/Parser.hs
deleted file mode 100644
index 1e968cb..0000000
--- a/mini-http/Network/HTTP/Server/Mini/Parser.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-module Network.HTTP.Server.Mini.Parser where
-
-import Control.Monad (guard)
-import Control.Monad.Trans.Maybe
-import Data.ByteString (ByteString)
-import Data.ByteString qualified as BS
-import Data.ByteString.Short (ShortByteString)
-import Data.ByteString.Short qualified as SBS
-import Data.Char
-import Data.Word
-import FlatParse.Basic qualified as P
-
-import Network.HTTP.Server.Mini.Types
-import Network.HTTP.Server.Mini.URI
-import Network.HTTP.Server.Mini.Util
-
-
-readRequest :: Monad m => Int -> (Int -> m ByteString) -> m (Maybe Request)
-readRequest maxsize recv = runMaybeT $ do
-  bs <- MaybeT $ readUntilTerminator maxsize recv []
-  hoistMaybe (parseRequest bs)
-
-parseRequest :: ByteString -> Maybe Request
-parseRequest bs =
-  case P.runParser pRequest bs of
-    P.OK req rest | BS.null rest -> Just req
-    _ -> Nothing
-
-pRequest :: P.Parser e Request
-pRequest = do
-  (method, uri) <- pFirstLine
-  headers <- P.many pHeader
-  let (path, query) = parseURI uri
-  return Request { reqMethod = method
-                 , reqURI = uri
-                 , reqHeaders = headers
-                 , reqPath = path
-                 , reqQuery = query }
-
-pFirstLine :: P.Parser e (ShortByteString, ByteString)
-pFirstLine = do
-  method <- pTakeUntil (ord8 ' ')
-  guard (BS.length method <= 32)  -- will put it in an SBS later
-  P.word8 32
-  uri <- pTakeUntil (ord8 ' ')
-  P.word8 32
-  $(P.bytes (map (fromIntegral @Int @Word . ord) "HTTP/1."))
-  version <- P.anyWord8
-  guard (version == ord8 '0' || version == ord8 '1')
-  pNewline
-  return (SBS.pack (map toAsciiUpperCase (BS.unpack method)), uri)
-
-pHeader :: P.Parser e (Header, ByteString)
-pHeader = do
-  key <- pTakeUntil (ord8 ':')
-  guard (BS.length key <= 128)  -- will put it in an SBS later
-  P.word8 (ord8 ':')
-  P.skipMany (P.satisfy isLinearSpace)
-  value <- pValue []
-  return (SBS.pack (map toAsciiLowerCase (BS.unpack key)), value)
-  where
-    pValue revlines = do
-      line <- trimCR <$> pTakeUntil 10
-      P.word8 10
-      P.withOption (P.lookahead (P.skipSatisfyAscii isLinearSpace))
-        (\_ -> pValue (line : revlines))
-        (return (BS.concat (reverse (line : revlines))))
-
-    trimCR bs
-      | len >= 1, bs `BS.index` (len - 1) == 13 = BS.take (len - 1) bs
-      | otherwise = bs
-      where len = BS.length bs
-
-isLinearSpace :: Char -> Bool
-isLinearSpace c = c == ' ' || c == '\t'
-
-pTakeUntil :: Word8 -> P.Parser e ByteString
-pTakeUntil term = do
-  midx <- P.lookahead (BS.elemIndex term <$> P.takeRest)
-  case midx of
-    Just idx -> P.take idx
-    Nothing -> P.failed
-
-pNewline :: P.Parser e ()
-pNewline = P.withAnyWord8 $ \case
-  10 -> return ()
-  13 -> P.word8 10
-  _ -> P.failed
-
-readUntilTerminator :: Monad m => Int -> (Int -> m ByteString) -> [ByteString] -> m (Maybe ByteString)
-readUntilTerminator 0 _ _ = return Nothing
-readUntilTerminator maxsize recv toprevprefix = do
-  text <- recv maxsize
-  if BS.length text == 0
-    then return Nothing
-    else goFind toprevprefix text
-  where
-    goFind revprefix text =
-      case findTerminator text of
-        NoTerm -> readUntilTerminator (maxsize - BS.length text) recv (text : revprefix)
-        IncompleteTerm haveCR
-          | maxsize == BS.length text -> return Nothing
-          | otherwise -> do
-              text2 <- recv (maxsize - BS.length text)
-              text2' <- case BS.length text2 of
-                1 -> (text2 <>) <$> recv (maxsize - BS.length text - 1)  -- premature concat but rare
-                _ -> return text2  -- also for length 0 (i.e. EOF)!
-              -- now text2' has length at least 2 if available before EOF
-              case (haveCR, BS.length text2') of
-                (_, 0) -> return Nothing
-                (False, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.concat (reverse (text : revprefix))))
-                (False, n) | n >= 2, text2' `BS.index` 0 == 13, text2' `BS.index` 1 == 10 ->
-                  return (Just (BS.concat (reverse (text : revprefix))))
-                (True, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.init (BS.concat (reverse (text : revprefix)))))
-                (_, 1) -> return Nothing  -- second recv returned EOF and no terminator found before that
-                _ -> goFind (text : revprefix) text2'
-        FoundTerm i -> return (Just (BS.concat (reverse (BS.take i text : revprefix))))
-
-data FoundTerminator
-  = NoTerm
-  | IncompleteTerm {-# UNPACK #-} !Bool
-      -- ^ Bool indicates "have CR".
-      -- If False, then LF at end of segment, requires LF or CRLF at start of next.
-      -- If True, then LF CR at end of segment, requires LF at start of next.
-  | FoundTerm Int  -- ^ Index right after the first [CR]LF sequence in the terminator
-  deriving (Show)
-
-findTerminator :: ByteString -> FoundTerminator
-findTerminator bs =
-  -- We're looking for [CR] LF [CR] LF. Look for the first LF, and see if it's
-  -- followed by CRLF or LF.
-  go (BS.elemIndices 10 bs)
-  where
-    len = BS.length bs
-
-    go [] = NoTerm
-    go (i:is)
-      | i == len - 1 = IncompleteTerm False
-      | i == len - 2 =
-          case bs `BS.index` (i+1) of
-            10 -> FoundTerm (i+1)
-            13 -> IncompleteTerm True
-            _ -> NoTerm
-      -- now certainly two bytes after this LF
-      | otherwise =
-          case bs `BS.index` (i+1) of
-            10 -> FoundTerm (i+1)
-            -- [i+2] is read twice if this check fails, but LF CR (!=LF) will be very rare so it's fine
-            13 | bs `BS.index` (i+2) == 10 -> FoundTerm (i+1)
-            _ -> go is
-
-toAsciiUpperCase :: Word8 -> Word8
-toAsciiUpperCase c
-  | ord8 'a' <= c, c <= ord8 'z' = c - 32
-  | otherwise = c
-
-toAsciiLowerCase :: Word8 -> Word8
-toAsciiLowerCase c
-  | ord8 'A' <= c, c <= ord8 'Z' = c + 32
-  | otherwise = c
diff --git a/mini-http/Network/HTTP/Server/Mini/Printer.hs b/mini-http/Network/HTTP/Server/Mini/Printer.hs
deleted file mode 100644
index ab6c1f6..0000000
--- a/mini-http/Network/HTTP/Server/Mini/Printer.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Network.HTTP.Server.Mini.Printer where
-
-import Data.ByteString (ByteString)
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as BSL
-import Data.ByteString.Builder qualified as BSB
-import Network.Socket
-import Network.Socket.ByteString
-
-import Network.HTTP.Server.Mini.Types
-
-
-sendResponse :: Socket -> Response -> IO ()
-sendResponse conn (Response status hdrs (BodyLBS body)) =
-  sendResponseChunks conn status hdrs body
-sendResponse conn (Response status hdrs (BodyFile path)) =
-  -- lazy IO is fine here because the whole thing is traversed before the end of this function in sendMany
-  sendResponseChunks conn status hdrs =<< BSL.readFile path
-
-sendResponseChunks :: Socket -> Status -> [(Header, ByteString)] -> BSL.ByteString -> IO ()
-sendResponseChunks conn (Status code reason) hdrs body =
-  sendMany conn $
-    BSL.toStrict (BSB.toLazyByteString
-      (BSB.shortByteString "HTTP/1.1 "
-       <> BSB.intDec code
-       <> BSB.char8 ' '
-       <> BSB.shortByteString reason
-       <> BSB.shortByteString "\r\n"
-       <> foldMap (\(key, val) ->
-                    BSB.shortByteString key <> BSB.shortByteString ": "
-                    <> BSB.byteString (wrapHdrVal val) <> BSB.shortByteString "\r\n")
-                  hdrs
-       <> BSB.shortByteString "Content-Length: " <> BSB.int64Dec (BSL.length body)
-       <> BSB.shortByteString "\r\nConnection: close\r\n\r\n"))
-    : BSL.toChunks body
-
-wrapHdrVal :: ByteString -> ByteString
-wrapHdrVal bs = BS.intercalate (BS.singleton 32) (BS.split 10 bs)
diff --git a/mini-http/Network/HTTP/Server/Mini/Types.hs b/mini-http/Network/HTTP/Server/Mini/Types.hs
deleted file mode 100644
index c764182..0000000
--- a/mini-http/Network/HTTP/Server/Mini/Types.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Network.HTTP.Server.Mini.Types where
-
-import Data.ByteString (ByteString)
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy (LazyByteString)
-import Data.ByteString.Builder (Builder)
-import Data.ByteString.Builder qualified as BSB
-import Data.ByteString.Short (ShortByteString)
-
-
-data Settings = Settings
-  { setPort :: !Int
-  , setListenQueue :: !Int
-  , setMaxParallelRequests :: !Int
-  , setMaxRequestSize :: !Int
-  }
-  deriving (Show)
-
-defaultSettings :: Settings
-defaultSettings = Settings
-  { setPort = 80
-  , setListenQueue = 32
-  , setMaxParallelRequests = 4
-  , setMaxRequestSize = 8192
-  }
-
-type Header = ShortByteString
-
-data Request = Request
-  { reqMethod :: !ShortByteString  -- | All-uppercase
-  , reqURI :: !ByteString
-  , reqHeaders :: ![(Header, ByteString)]  -- | Header name in all-lowercase
-  , reqPath :: [ByteString]  -- | Lazy field
-  , reqQuery :: [(ByteString, ByteString)]  -- | Lazy field
-  }
-  deriving (Show)
-
-data Status = Status !Int !ShortByteString
-  deriving (Show)
-
-data Response = Response
-  { resStatus :: !Status
-  , resHeaders :: ![(Header, ByteString)]
-  , resBody :: !ResponseBody }
-  deriving (Show)
-
-data ResponseBody
-  = BodyLBS !LazyByteString
-  | BodyFile !FilePath
-  deriving (Show)
-
-status200 :: Status
-status200 = Status 200 "OK"
-
-status404 :: Status
-status404 = Status 404 "Not Found"
-
-responseLBS :: Status -> [(Header, ByteString)] -> LazyByteString -> Response
-responseLBS status hdrs = Response status hdrs . BodyLBS
-
-responseBS :: Status -> [(Header, ByteString)] -> ByteString -> Response
-responseBS status hdrs = responseLBS status hdrs . BS.fromStrict
-
-responseBuilder :: Status -> [(Header, ByteString)] -> Builder -> Response
-responseBuilder status hdrs = responseLBS status hdrs . BSB.toLazyByteString
-
-responseFile :: Status -> [(Header, ByteString)] -> FilePath -> Response
-responseFile status hdrs = Response status hdrs . BodyFile
diff --git a/mini-http/Network/HTTP/Server/Mini/URI.hs b/mini-http/Network/HTTP/Server/Mini/URI.hs
deleted file mode 100644
index 13d7c35..0000000
--- a/mini-http/Network/HTTP/Server/Mini/URI.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE ViewPatterns #-}
-module Network.HTTP.Server.Mini.URI where
-
-import Data.ByteString (ByteString)
-import Data.ByteString qualified as BS
-
-import Network.HTTP.Server.Mini.Util
-
-
--- | (path components, query string)
---
--- TODO: percent-decode
-parseURI :: ByteString -> ([ByteString], [(ByteString, ByteString)])
-parseURI = \bs ->
-  case BS.uncons bs of
-    Just ((== ord8 '/') -> True, bs1) -> goPath id bs1
-    _ -> ([], [])
-  where
-    goPath f bs
-      | BS.null bs = (f [], [])
-      | otherwise =
-          let (comp, bs1) = BS.span (\c -> c /= ord8 '/' && c /= ord8 '?') bs
-          in case BS.uncons bs1 of
-               Just ((== ord8 '/') -> True, bs2) ->
-                 goPath (f . (comp:)) bs2
-               Just ((== ord8 '?') -> True, bs2) ->
-                 (f [comp], goQuery bs2)
-               _ -> (f [comp], [])
-
-    goQuery bs
-      | BS.null bs = []
-      | Just ((== ord8 '&') -> True, bs1) <- BS.uncons bs = goQuery bs1
-      | otherwise =
-          let (key, bs1) = BS.span (\c -> c /= ord8 '=' && c /= ord8 '&') bs
-          in case BS.uncons bs1 of
-               Just ((== ord8 '=') -> True, bs2) ->
-                 let (val, bs3) = BS.span (\c -> c /= ord8 '&') bs2
-                 in case BS.uncons bs3 of
-                      Just (_, bs4) -> (key, val) : goQuery bs4
-                      Nothing -> [(key, val)]
-               Just ((== ord8 '&') -> True, bs2) ->
-                 (key, BS.empty) : goQuery bs2
-               _ ->
-                 [(key, BS.empty)]
diff --git a/mini-http/Network/HTTP/Server/Mini/Util.hs b/mini-http/Network/HTTP/Server/Mini/Util.hs
deleted file mode 100644
index c29a8e6..0000000
--- a/mini-http/Network/HTTP/Server/Mini/Util.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Network.HTTP.Server.Mini.Util where
-
-import Data.Char
-import Data.Word
-
-
-{-# INLINE ord8 #-}
-ord8 :: Char -> Word8
-ord8 = fromIntegral . ord