1 {-# LANGUAGE CPP, OverloadedStrings #-}
    2 module Databrary.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 Databrary.Ops
   16 import Databrary.Has
   17 import qualified Databrary.JSON as JSON
   18 import Databrary.Model.Id
   19 import Databrary.Model.Token
   20 import Databrary.Model.Party
   21 #if !defined(DEVEL) && !defined(SANDBOX)
   22 import Databrary.Model.Permission
   23 #endif
   24 import Databrary.Model.Notification.Types
   25 import Databrary.HTTP.Path.Parser
   26 import Databrary.Action.Run
   27 import Databrary.Action
   28 import Databrary.Controller.Paths
   29 import Databrary.Controller.Form
   30 import Databrary.Controller.Login
   31 import Databrary.Controller.Angular
   32 import Databrary.Controller.Notification
   33 import Databrary.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