{-# 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 GHC.IO.Exception (IOException(..), IOErrorType(..))
import Network.Socket
import Network.Socket.ByteString
import System.IO.Error (catchIOError)

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)) = do
  -- lazy IO is fine here because the whole thing is traversed before the end of this function in sendMany
  elazyContents <-
    catchIOError (Right <$> BSL.readFile path)
      (\e -> case ioe_type e of
               NoSuchThing -> return (Left (status404, "File not found"))
               _ -> return (Left (status500, "Something went wrong")))
  case elazyContents of
    Right lazyContents -> sendResponseChunks conn status hdrs lazyContents
    Left (status', text) -> sendResponseChunks conn status' [] text

sendResponseChunks :: Socket -> Status -> [(Header, ByteString)] -> BSL.ByteString -> IO ()
sendResponseChunks conn (Status code reason) hdrs body =
  catchIOError
    (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)
    (\_ ->
      -- If an IO error occurs during sending, that ought to be sendMany, in
      -- which case we just exit: if we can't write, we won't be able to write
      -- in the future, and we might as well give up on this connection.
      return ())

wrapHdrVal :: ByteString -> ByteString
wrapHdrVal bs = BS.intercalate (BS.singleton 32) (BS.split 10 bs)