{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Monad (join)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as TS
import qualified Data.Text.Encoding as EncodingS
import qualified Data.Text.Lazy as T
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as W
import           System.FilePath ((</>))

import qualified Inf.DB.Monad as DB
import qualified Inf.DB as DB
import qualified Inf.Feed as Feed
import qualified Inf.Templates as Template
import qualified Inf.Log as Log
import           Inf.Types
import qualified Inf.Web as Web

main :: IO ()
main = Web.run route

route :: Web.Routes
route c req = do
  user <- Web.getUser c (lookup HTTP.hCookie (W.requestHeaders req))
  case (W.requestMethod req, W.pathInfo req) of
    ("GET", []) -> do
      post <- DB.runDB c DB.newestPostRef
      Web.redirect (postRefURL post)

    ("POST", []) ->
      case user of
        Nothing -> do
          Log.error [ "non-logged-in user attempted to post something" ]
          Web.redirect "/"
        Just u -> do
          formData <- Web.formData req
          let rpMb = do
                title <- join (lookup "title" formData)
                contents <- join (lookup "contents" formData)
                pure RawPost
                  { rpId       = Nothing
                  , rpTitle    = EncodingS.decodeUtf8 title
                  , rpAuthor   = User u
                  , rpContents = EncodingS.decodeUtf8 contents
                  }
          case rpMb of
            Nothing -> do
              Log.error [ "bad input data somehow" ]
              Web.redirect "/"
            Just rp -> do
              DB.runDB c (DB.submitPost (User u) rp)
              Web.redirect "/newest"

    ("GET", ["auth"]) -> do
      password <- Template.login
      Web.ok user "login" password "/"

    ("GET", ["archive"]) -> do
      posts <- DB.runDB c DB.allPostRefs
      contents <- Template.list posts
      Web.ok user "Past Entries" contents "/archive"

    ("GET", ["create"]) ->
      case user of
        Nothing -> Web.redirect "/"
        Just _  -> do
          contents <- Template.edit "/" emptyRawPost
          Web.ok user "New Post" contents "/"

    ("GET", [y, m, s]) -> do
      (post, cached) <- DB.runDB c $ do
        ps <- DB.postByDateAndSlug y m s
        ch <- DB.cachedMarkup (postId ps)
        pure (ps, ch)
      case cached of
        Just cache -> do
          Web.ok user (T.fromStrict (postTitle post)) cache (postURL post)
        Nothing -> do
          contents <- Template.post user post
          DB.runDB c (DB.storeCachedMarkup (postId post) contents)
          Web.ok user (T.fromStrict (postTitle post)) contents (postURL post)

    ("POST", [y, m, s]) ->
      case user of
        Nothing -> do
          Log.error [ "non-logged-in user attempted to edit post" ]
          Web.redirect "/"
        Just u -> do
          formData <- Web.formData req
          oldPost <- DB.runDB c (DB.postByDateAndSlug y m s)
          let rpMb = do
                title <- join (lookup "title" formData)
                contents <- join (lookup "contents" formData)
                pure RawPost
                  { rpId       = Just (postId oldPost)
                  , rpTitle    = EncodingS.decodeUtf8 title
                  , rpAuthor   = User u
                  , rpContents = EncodingS.decodeUtf8 contents
                  }
          case rpMb of
            Nothing -> do
              Log.error [ "bad input data somehow" ]
              Web.redirect "/"
            Just rp -> do
              DB.runDB c (DB.submitPost (User u) rp)
              Web.redirect (postURL oldPost)

    ("GET", [y, m, s, "edit"]) ->
      case user of
        Nothing -> do
          Log.error [ "non-logged-in user attempted to edit post" ]
          Web.redirect "/"
        Just {} -> do
          oldPost <- DB.runDB c (DB.postByDateAndSlug y m s)
          contents <- Template.edit (postURL oldPost) (postToRawPost oldPost)
          Web.ok user (T.fromStrict (postTitle oldPost)) contents "/"

    ("POST", [y, m, s, "delete"]) ->
      case user of
        Nothing -> Web.redirect "/"
        Just _ -> do
          Log.warn [ "deleting post:", show (y, m, s) ]
          DB.runDB c $ do
            post <- DB.postByDateAndSlug y m s
            DB.deletePost (postToRawPost post)
          Web.redirect "/"

    ("GET", [y, m, s, "delete"]) ->
      case user of
        Nothing -> Web.redirect "/"
        Just _ -> do
          post <- DB.runDB c (DB.postByDateAndSlug y m s)
          contents <- Template.delete post
          Web.ok user "Delete Post?" contents "/"

    ("POST", ["login"]) -> do
      formData <- Web.formData req
      Log.warn [ "attempting login"
               , case lookup "user" formData of
                   Just (Just u) -> "of user " ++ show u
                   _ -> "without a specified user"
               ]
      case (lookup "user" formData, lookup "passwd" formData) of
        (Just (Just u), Just (Just p)) -> do
          userMb <- Web.verifyUser c u p
          case userMb of
            Just _  ->
              let cookies = Web.authCookie u p
              in Web.redirectWithCookies "/" cookies
            Nothing -> Web.raise500 req (Unimplemented "Bad Password")
        _ -> Web.raise500 req (Unimplemented "Bad Login")

    ("GET", ["logout"]) ->
      Web.redirectWithCookies "/" [("USERDATA", "")]

    ("GET", ["newest"]) -> do
      post <- DB.runDB c DB.newestPostRef
      Web.redirect (postRefURL post)

    ("GET", ["oldest"]) -> do
      post <- DB.runDB c DB.oldestPostRef
      Web.redirect (postRefURL post)

    ("GET", ["static", fp]) ->
      let path = "static" </> TS.unpack fp
      in pure (W.responseFile HTTP.status200 [] path Nothing)

    ("GET", ["rss"]) -> do
      cached <- DB.runDB c DB.cachedRSS
      case cached of
        Just t -> Web.atomFeed (BSL.fromStrict t)
        Nothing -> do
          posts <- DB.runDB c DB.allPosts
          feed <- Feed.renderFeed posts
          DB.runDB c (DB.storeCachedRSS (BSL.toStrict feed))
          Web.atomFeed feed

    ("GET", [pagename]) -> do
      pg <- DB.runDB c (DB.staticPage pagename)
      contents <- Template.page (pageText pg)
      Web.ok user (T.fromStrict pagename) contents ("/" <> pagename)

    ("GET", [_page, "edit"]) ->
      case user of
        Nothing -> Web.redirect "/"
        Just _  -> do
          contents <- Template.edit "/" emptyRawPost
          Web.ok user "New Post" contents "/"

    (_, path) -> Web.raise404 req path