{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.Me where

import Import
import UtilEmail (randomKey, sendVerifyEmail)

import Prelude (head)
import Control.Monad (join)
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Data.Time.Clock (getCurrentTime)

getMeR :: Handler RepHtml
getMeR = do
    Entity uid u <- requireAuth
    (fformWidget, fformEnctype) <- generateFormPost (efwdForm uid u)
    (eformWidget, eformEnctype) <- generateFormPost emailForm
    let submission = Nothing :: Maybe User
        destination = T.empty
    defaultLayout $ do
        aDomId <- lift newIdent
        setTitle "PFIF contractor page"
        $(widgetFile "mepage")

postMeR :: Handler RepHtml
postMeR = do
    Entity uid u <- requireAuth
    ((fresult, fformWidget), fformEnctype) <- runFormPost (efwdForm uid u)
    (eformWidget, eformEnctype) <- generateFormPost emailForm
    let submission = case fresult of
            FormSuccess res -> Just res
            _ -> Nothing
    maybe (return ()) (runDB . replace uid) submission
    destination <- runDB $ maybe (return "<None>") (fmap emailEmail . get404) (userPrimaryemail =<< submission)

    defaultLayout $ do
        aDomId <- lift newIdent
        setTitle "PFIF contractor page"
        $(widgetFile "mepage")

postNewdestR :: Handler RepHtml
postNewdestR = do
    Entity uid u <- requireAuth
    ((eresult, eformWidget), eformEnctype) <- runFormPost emailForm
    submission <- case eresult of
                    FormSuccess res -> do
                              lid <- runDB $ insert res
                              render <- getUrlRender
                              tm <- getRouteToMaster
                              let verKey = fromJust $ emailVerkey res
                              let verUrl = render $ tm $ verify lid [verKey]
                              sendVerifyEmail (emailEmail res) verKey verUrl
			      return (Just res)
                    _ -> return Nothing
    defaultLayout $ do
        aDomId <- lift newIdent
        setTitle "Email addition page"
        $(widgetFile "newdestpage")
    where
        verify :: EmailId -> Texts -> Route App
        verify eid verkey = VerifyEmailR eid verkey

efwdForm :: UserId -> User -> Form User
efwdForm uid u = renderDivs $ User
    <$> pure (userIdent u)
    <*> pure (userPassword u)
    <*> pure (userSalt u)
    <*> aopt (radioField (emails uid u)) "Verified addresses" (Just (userPrimaryemail u))
    where
        emails :: UserId -> User -> GHandler App App (OptionList EmailId)
        emails uid u = do -- optionsPersist [EmailUser ==. Just uid, EmailVerkey ==. Nothing] [Desc EmailLastverified] emailEmail
            es <- runDB $ selectList [EmailUser ==. Just uid, EmailVerkey ==. Nothing] [Desc EmailLastverified]
            optionsPairs $ map (\e -> (emailEmail . entityVal $ e, entityKey e)) es

emailForm :: Form Email
emailForm = renderDivs $ Email
    <$> areq (check noPFIF emailField) "Target" Nothing
    <*> pure Nothing
    <*> aformM (liftIO (fmap Just randomKey))
    <*> pure Nothing
    where
        noPFIF :: Text -> Either Text Text
        noPFIF e = if T.isSuffixOf "protocolfreedom.org" e then Left "You may not forward to a protocolfreedom.org address." else Right e

getVerifyEmailR :: EmailId -> Texts -> Handler RepHtml
getVerifyEmailR eid ts = do
    let key = head ts
    Entity uid u <- requireAuth
    e <- runDB $ get404 eid
    case (emailVerkey e == Just key,T.length key == 10, emailUser e == Nothing) of
        (True, True, True) -> liftIO getCurrentTime >>= \now -> runDB $ update eid [EmailVerkey =. Nothing, EmailUser =. Just uid, EmailLastverified =. Just now]
        _ -> fail "Oops"
    redirect MeR