{-# LANGUAGE OverloadedStrings #-}

module Application
  ( signInAction
  , validateSignInAction
  , getUserName
  , getPaymentsAction
  , createPaymentAction
  , signOutAction

  , getIndexAction
  , getUsersAction
  , addUserAction
  , deleteUserAction
  ) 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.Lazy as TL
import qualified Data.Text.Encoding as TE
import Data.String (fromString)
import Data.Time.Clock (getCurrentTime, diffUTCTime)

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)

import Mail

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]
          let mail = Mail [login] "Sign in" url url
          maybeSentMail <- liftIO . sendMail $ mail
          case maybeSentMail of
            Right _ ->
              status ok200
            Left _ ->
              errorResponse "Sorry, we failed to send you the sign up email."
        _ ->
          errorResponse "You are not authorized to sign in."
    else
      errorResponse "Please enter a valid email address."

validateSignInAction :: Text -> ActionM ()
validateSignInAction token = do
  maybeSignIn <- liftIO . runDb $ getSignInToken token
  now <- liftIO getCurrentTime
  case maybeSignIn of
    Just signIn ->
      if signInIsUsed . entityVal $ signIn
        then
          redirectError "The token has already been used."
        else
          let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn)
          in  if diffTime > 2 * 60 -- 2 minutes
                then
                  redirectError "The token has expired."
                else do
                  LoginSession.put (signInEmail . entityVal $ signIn)
                  liftIO . runDb . signInTokenToUsed . entityKey $ signIn
                  redirect "/"
    Nothing ->
      redirectError "The token is invalid."

redirectError :: Text -> ActionM ()
redirectError msg =
  redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]

getUserName :: ActionM ()
getUserName =
  Secure.loggedAction (\user -> do
    json . Message . userName . entityVal $ user
  )

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

createPaymentAction :: Text -> Int -> ActionM ()
createPaymentAction name cost =
  Secure.loggedAction (\user -> do
    _ <- liftIO . runDb $ createPayment (entityKey user) name cost
    return ()
  )

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

errorResponse :: Text -> ActionM ()
errorResponse msg = do
  status badRequest400
  json (Message msg)





getIndexAction :: ActionM ()
getIndexAction = html page

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

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