module Http (runServer) where

import qualified Cache as C
import Common (maybeAt, splitOn)
import qualified Html as H
import Intro
import qualified Mail as M
import Network.Socket (HostName, ServiceName, Socket, socketToHandle)
import qualified Queue as Q
import System.IO (Handle, IOMode (ReadWriteMode), hClose, hGetLine, hPutStrLn)
import qualified Tcp
import qualified Template as T
import Text.Read (readMaybe)

runServer :: Maybe HostName -> ServiceName -> C.CacheM -> Q.QueueM M.Mail -> IO ()
runServer host port cache queue = Tcp.runServer host port (sockHandler cache queue)

sockHandler :: C.CacheM -> Q.QueueM M.Mail -> Socket -> IO ()
sockHandler cache queue s = do
  handle <- socketToHandle s ReadWriteMode
  requestHandler handle cache queue

requestHandler :: Handle -> C.CacheM -> Q.QueueM M.Mail -> IO ()
requestHandler h cache queue = do
  line <- hGetLine h
  case route line of
    ("GET", []) -> showInbox h cache
    ("GET", ["poll", s]) -> showPolled h queue s
    ("GET", ["mail", n]) -> case (readMaybe n :: Maybe Int) of
      Just n' -> showMail h cache n'
      Nothing -> showNotFound h
    _ -> showNotFound h
  hClose h

showNotFound :: Handle -> IO ()
showNotFound h = do
  replyHtml h 404 [H.p ["Page not found"]]

showInbox :: Handle -> C.CacheM -> IO ()
showInbox h cache = do
  inbox <- C.getInbox cache
  replyHtml h 200 (T.inbox inbox)

showMail :: Handle -> C.CacheM -> Int -> IO ()
showMail h cache idx = do
  mail <- maybeAt idx <$> C.getInbox cache
  case mail of
    Just mail' -> replyHtml h 200 (T.mail mail')
    Nothing -> showNotFound h

showPolled :: Handle -> Q.QueueM M.Mail -> String -> IO ()
showPolled h queue s = do
  mail <- Q.pullWith (\m -> m.to == [s]) queue
  replyHtml h 200 (T.mail mail)

route :: String -> (String, [String])
route x = case words x of
  [m, p, "HTTP/1.1"] -> (m, splitOn (== '/') p)
  _ -> ("GET", [])

replyHtml :: Handle -> Int -> [String] -> IO ()
replyHtml h s body = do
  let page = H.html body
  hPutStrLn h $ "HTTP/1.1 " ++ status s
  hPutStrLn h "content-type: text/html"
  hPutStrLn h $ "content-length: " ++ show (length page)
  hPutStrLn h ""
  hPutStrLn h page
  hPutStrLn h ""

status :: Int -> String
status s = case s of
  200 -> "200 OK"
  404 -> "404 NOT FOUND"
  _ -> "500 INTERNAL SERVER ERROR"