{-# LANGUAGE OverloadedStrings #-}

module Application
  ( signInAction
  , validateSignInAction
  , signOutAction
  , getIndexAction
  , getUsersAction
  , getPaymentsAction
  , addUserAction
  , deleteUserAction
  , createPaymentAction
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (ok200, badRequest400)
import Network.Wai (requestHeaderHost)

import Database.Persist

import Control.Monad.IO.Class (liftIO)

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE
import Data.String (fromString)

import Text.Email.Validate (isValid)

import qualified LoginSession

import qualified Secure

import Model.Database
import Model.User
import Model.Payment
import Model.SignIn
import Model.Message

import View.Page (page)

getIndexAction :: ActionM ()
getIndexAction = html page

getUsersAction :: ActionM ()
getUsersAction = do
  users <- liftIO $ runDb getUsers
  html . fromString . show $ users

getPaymentsAction :: ActionM ()
getPaymentsAction =
  Secure.loggedAction (\_ -> do
    payments <- liftIO $ runDb getPayments
    json payments
  )

addUserAction :: Text -> Text -> ActionM ()
addUserAction email name = do
  _ <- liftIO . runDb $ createUser email name
  status ok200

deleteUserAction :: Text -> ActionM ()
deleteUserAction email = do
  _ <- liftIO . runDb $ deleteUser email
  status ok200

createPaymentAction :: Text -> Text -> Int -> ActionM ()
createPaymentAction email name cost = do
  maybeUser <- liftIO . runDb $ getUser email
  case maybeUser of
    Just user -> do
      _ <- liftIO . runDb $ createPayment (entityKey user) name cost
      return ()
    Nothing -> do
      status badRequest400
      status ok200

signInAction :: Text -> ActionM ()
signInAction login =
  if isValid (TE.encodeUtf8 login)
    then do
      maybeUser <- liftIO . runDb $ getUser login
      maybeHost <- fmap TE.decodeUtf8 . requestHeaderHost <$> request
      case (maybeUser, maybeHost) of
        (Just _, Just host) -> do
          token <- liftIO . runDb $ createSignInToken login
          let url = T.concat ["http://", host ,"/validateSignIn?token=", token]
          liftIO . TIO.putStrLn $ url
          status ok200
        _ -> do
          status badRequest400
          json (Message "You are not authorized to sign in.")
    else do
      status badRequest400
      json (Message "Please enter a valid email address.")

validateSignInAction :: Text -> ActionM ()
validateSignInAction token = do
  maybeSignIn <- liftIO . runDb $ getSignInToken token
  case maybeSignIn of
    Just signIn -> do
      LoginSession.put (signInEmail . entityVal $ signIn)
      liftIO . runDb . signInTokenIsUsed . entityKey $ signIn
      redirect "/"
    Nothing ->
      status badRequest400

signOutAction :: ActionM ()
signOutAction = do
  LoginSession.delete
  status ok200