1 {-# LANGUAGE CPP, OverloadedStrings #-}
    2 module Controller.Token
    3   ( lookupPasswordResetAccount
    4   , viewLoginToken
    5   , postPasswordToken
    6   ) where
    7 
    8 #if !defined(DEVEL) && !defined(SANDBOX)
    9 import Control.Monad (mfilter)
   10 #endif
   11 import Control.Monad (when, unless)
   12 import qualified Data.ByteString as BS
   13 import Data.Maybe (isNothing, isJust)
   14 
   15 import Ops
   16 import Has
   17 import qualified JSON
   18 import Model.Id
   19 import Model.Token
   20 import Model.Party
   21 #if !defined(DEVEL) && !defined(SANDBOX)
   22 import Model.Permission
   23 #endif
   24 import Model.Notification.Types
   25 import HTTP.Path.Parser
   26 import Action.Run
   27 import Action
   28 import Controller.Paths
   29 import Controller.Form
   30 import Controller.Login
   31 import Controller.Angular
   32 import Controller.Notification
   33 import View.Token
   34 
   35 lookupPasswordResetAccount :: BS.ByteString -> Handler (Maybe SiteAuth)
   36 lookupPasswordResetAccount email =
   37 #if !defined(DEVEL) && !defined(SANDBOX)
   38   mfilter ((PermissionADMIN >) . accessMember) <$>
   39 #endif
   40   lookupSiteAuthByEmail True email
   41 
   42 viewLoginToken :: ActionRoute (API, Id LoginToken)
   43 viewLoginToken = action GET (pathAPI </> pathId) $ \(api, ti) -> withoutAuth $ do
   44   when (api == HTML) angular
   45   tok <- maybeAction =<< lookupLoginToken ti
   46   if loginPasswordToken tok
   47     then case api of
   48       JSON -> return $ okResponse [] $ JSON.recordEncoding $ JSON.Record ti $
   49         "reset" JSON..= isJust (accountPasswd (view tok))
   50       HTML -> peeks $ blankForm . htmlPasswordToken ti
   51     else do
   52       _ <- removeLoginToken tok
   53       loginAccount api (view tok) False
   54 
   55 postPasswordToken :: ActionRoute (API, Id LoginToken)
   56 postPasswordToken = action POST (pathAPI </> pathId) $ \(api, ti) -> withoutAuth $ do
   57   tok <- maybeAction =<< lookupLoginToken ti
   58   unless (loginPasswordToken tok) $ result =<< peeks notFoundResponse
   59   let auth :: SiteAuth
   60       auth = view tok
   61   pw <- runForm ((api == HTML) `thenUse` htmlPasswordToken ti) $
   62     passwordForm (siteAccount auth)
   63   changeAccount auth{ accountPasswd = Just pw } -- or should this be withAuth?
   64   _ <- removeLoginToken tok
   65   unless (isNothing $ accountPasswd auth) $
   66     createNotification (blankNotification (siteAccount auth) NoticeAccountChange)
   67       { notificationParty = Just $ partyRow $ accountParty $ siteAccount auth }
   68   loginAccount api (view tok) False