{-# LANGUAGE OverloadedStrings #-}

module Inf.Web
  ( run
  , Routes

  , ok
  , raise404
  , raise500
  , redirect
  , redirectWithCookies
  , atomFeed

  , formData
  , module Web
  ) where

import qualified Control.Exception as Exn
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as TS
import qualified Data.Text.Encoding as EncodingS
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as Encoding
import qualified Network.HTTP.Types as HTTP
import qualified Network.HTTP.Types.Header as HTTP
import qualified Network.Wai as W
import qualified Network.Wai.Handler.Warp as W
import qualified System.Environment as Env
import qualified Text.Read as Read

import qualified Inf.DB.Monad as DB
import qualified Inf.Log as Log
import qualified Inf.Templates as Template
import           Inf.Web.Cookies as Web

type Routes = DB.Connection -> W.Request -> IO W.Response

formData :: W.Request -> IO HTTP.Query
formData =
  fmap (HTTP.parseQuery . LBS.toStrict) . W.lazyRequestBody

run :: Routes -> IO ()
run routes = do
  portVar <- Env.lookupEnv "PORT"
  let port = case portVar of
        Just x
          | Just p <- Read.readMaybe x -> p
        _ -> 8080
  dbVar <- Env.lookupEnv "DB"
  let dbLocation = case dbVar of
                     Nothing  -> "test.db"
                     Just loc -> loc
  Log.info [ "opening database", show dbLocation ]
  conn <- DB.open dbLocation
  Log.info [ "running on port", show port ]
  W.run port $ \ r k -> do
    Log.debug [ show (W.remoteHost r)
              , ":"
              , BS8.unpack (W.requestMethod r)
              , BS8.unpack (W.rawPathInfo r)
              ]
    resp <- routes conn r
              `Exn.catch` (\ (e :: DB.DBException) -> raise500 r e)
              `Exn.catch` (\ (e :: Exn.SomeException) -> raise500 r e)
    k resp

ok :: Maybe TS.Text -> T.Text -> T.Text -> TS.Text -> IO W.Response
ok user title stuff url = do
  pg <- Template.main Template.Main
    { Template.mainUser = user
    , Template.mainTitle = title
    , Template.mainContents = stuff
    , Template.mainUrl = url
    }
  let headers = [(HTTP.hContentType, "text/html")]
  pure (W.responseLBS HTTP.status200 headers (Encoding.encodeUtf8 pg))

raise404 :: W.Request -> [TS.Text] -> IO W.Response
raise404 req msgs = do
  Log.warn [ "  raised 404 for URL"
           , BS8.unpack (W.rawPathInfo req)
           ]
  contents <- Template.page $ TS.unwords
       [ "No handler found for page "
       , "`/" <> TS.intercalate "/" msgs <> "`"
       ]
  pg <- Template.main Template.Main
    { Template.mainUser = Nothing
    , Template.mainTitle ="404"
    , Template.mainContents = contents
    , Template.mainUrl = "/"
    }
  pure (W.responseLBS HTTP.status404 [] (Encoding.encodeUtf8 pg))

raise500 :: Template.InternalError e => W.Request -> e -> IO W.Response
raise500 req err = do
  Log.error [ "  raised 500 for URL"
            , BS8.unpack (W.rawPathInfo req)
            , ":"
            , Template.loggedError err
            ]
  body <- Encoding.encodeUtf8 `fmap` Template.renderedError err
  pure (W.responseLBS HTTP.status500 [] body)

redirect :: TS.Text -> IO W.Response
redirect url =
  let headers = [(HTTP.hLocation, EncodingS.encodeUtf8 url)]
  in pure (W.responseLBS HTTP.status303 headers "redirecting...")

redirectWithCookies :: TS.Text -> Web.Cookies -> IO W.Response
redirectWithCookies url cookies =
  let headers = [ (HTTP.hLocation, EncodingS.encodeUtf8 url)
                , (HTTP.hSetCookie, Web.dumpCookies cookies)
                ]
  in pure (W.responseLBS HTTP.status303 headers "redirecting...")

atomFeed :: LBS.ByteString -> IO W.Response
atomFeed feed =
  let headers = [(HTTP.hContentType, "application/atom+xml")]
  in pure (W.responseLBS HTTP.status200 headers feed)