{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE DeriveGeneric        #-}

{-|
This module contains the web application
and API implementation of Breve.
-}
module Application where

-- Breve modules
import Breve.Generator
import Breve.UrlTable
import Views

-- Misc
import Control.Monad.IO.Class  (liftIO)
import qualified Data.Text.IO  as T

-- JSON conversion
import Data.Text                (Text)
import Data.Aeson               (ToJSON)
import GHC.Generics             (Generic)

-- HTML replies
import Text.Blaze.Html5              (Html)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

-- API definition
import Servant
import Servant.HTML.Blaze       (HTML)
import Web.FormUrlEncoded       (FromForm(..), parseUnique)


-- * Types

-- | API successful reply
--
-- This is the reply returned by the JSON API
-- handler when the url has been shortned
-- successfully.
data ApiReply = ApiReply
  { link     :: Url  -- ^ shortened url
  , name     :: Name -- ^ just the name
  , original :: Url  -- ^ original url
  } deriving Generic

instance ToJSON ApiReply

-- | This type is just a wrapper around a 'Text'
-- value. It's used to create a 'FromForm' instance
-- for a 'Url'.
newtype UrlForm = UrlForm Text

instance FromForm UrlForm where
  fromForm f = UrlForm <$> parseUnique "url" f


-- * Breve API

-- | API spec
--
-- Breve has two main components:
--
-- 1. the web app
-- 2. the JSON API itself
type Breve = API :<|> App

-- | Web app spec
--
-- +----------+------+----------------------+
-- | path     | type | description          |
-- +==========+======+======================+
-- | /        | GET  | homepage             |
-- +----------+------+----------------------+
-- | /        | POST | upload a new url     |
-- +----------+------+----------------------+
-- | /static  | GET  | static assets        |
-- +----------+------+----------------------+
-- | /:name   | GET  | resolves a short url |
-- +----------+------+----------------------+
type App =
       Get '[HTML] Html
  :<|> "static" :> Raw
  :<|> Capture "name" Name :> Redirect
  :<|> ReqBody '[FormUrlEncoded] UrlForm :> Post '[HTML] Html

-- | JSON API spec
--
-- +----------+------+----------------------+
-- | path     | type | description          |
-- +==========+======+======================+
-- | /api     | POST | upload a new url     |
-- +----------+------+----------------------+
type API =
  "api" :> ReqBody '[FormUrlEncoded] UrlForm :> Post '[JSON] ApiReply

-- | Breve application
breve :: FilePath    -- ^ static assets path
      -> Url         -- ^ bind url
      -> UrlTable    -- ^ url hashtable
      -> Application
breve static url table = serve (Proxy :: Proxy Breve) (breveServer static url table)

-- | Empty application
--
-- This app does *nothing* but it's useful nonetheless:
-- it will be used as a basis to run the 'forceSSL'
-- middleware.
emptyApp :: Application
emptyApp = serve (Proxy :: Proxy EmptyAPI) emptyServer

-- * Handlers

-- | Breve server
--
-- This is just an ordered collection of handlers
-- following the 'Breve' API spec.
breveServer :: FilePath -> Url -> UrlTable -> Server Breve
breveServer static url table =
  api url table :<|> app
    where app = homepage                    :<|>
                serveDirectoryWebApp static :<|>
                resolver table              :<|>
                uploader url table

-- | Serves the homepage
homepage :: Handler Html
homepage = pure index

-- | Resolves a 'Name' to the full 'Url'
resolver :: UrlTable -> Name -> Handler Redirection
resolver table name = do
  url <- liftIO (extract table name)
  case url of
    Nothing  ->
      throwError $ err404 { errBody = renderHtml (message "404: not found") }
    Just url -> do
      logStr ("Resolved " <> name <> " -> " <> url)
      pure (addHeader url NoContent)


-- | Takes a 'UrlForm' via POST
-- and prints the shortned one
uploader :: Url -> UrlTable -> UrlForm -> Handler Html
uploader bindUrl table (UrlForm url) = do
  name <- liftIO (insert table url)
  logStr ("Registered " <> url <> " -> " <> name)
  pure (done $ bindUrl <> name)

-- | Takes a 'Url' via POST and returns
-- the shortned one in an 'ApiReply' as JSON.
api :: Url -> UrlTable -> UrlForm -> Handler ApiReply
api bindUrl table (UrlForm url) = do
  name <- liftIO (insert table url)
  logStr ("Registered " <> url <> " -> " <> name)
  pure $ ApiReply { link     = (bindUrl <> name)
                  , name     = name
                  , original = url
                  }

-- * Misc

-- | Handy function to log to stdout
logStr :: Text -> Handler ()
logStr = liftIO . T.putStrLn . ("[breve] " <>)

-- | Verb that encodes an HTTP 302 redirection
type Redirect =
  Verb 'GET 302 '[PlainText] Redirection

-- | Reply with Location redirect header
type Redirection =
  Headers '[Header "Location" Text] NoContent