module Bein.Web.Pages.Login where import Bein.Web.Commands import Bein.Web.Pages.Common import Bein.Web.Types import Bein.Web.Elements import Bein.Web.Authentication import Happstack.Server hiding (method) loginTitle :: String loginTitle = "Bein - Login" login :: BeinServerPart Response login = page (Just loginTitle) HideNone loginBody (noHtml,noHtml) loginBody :: (Html,Html) -> BeinFormPart (Html,Html) Html loginBody (headerMsg,loginMsg) = do mconcatM [ paragraphM << headerMsg, paragraphM =<<: [ html "Bein is a web-based shell for exploratory data analysis. ", html "Its source and documentation is available at ", anchorM [value "", size "25"], brM, alignedLabelM "Password:", passwordM "password" [value "", size "25"], brM, submitM "signin" "Sign in" [thestyle "text-align: right"], html loginMsg ]]] tryLogin :: BeinServerPart (FormResponse (Html,Html)) tryLogin = withDataFn loginFields tryLogin' where tryLogin' :: (String,String) -> BeinServerPart (FormResponse (Html,Html)) tryLogin' = ensureSession loginFailed loginSucceeded loginFailed :: BeinServerPart (FormResponse (Html,Html)) loginFailed = return $ ContinuePage (noHtml,redParagraph "Invalid username or password.") loginSucceeded :: BeinServerPart (FormResponse (Html,Html)) loginSucceeded = fullUrl "/" >>= \u -> return $ RedirectTo u loginFields :: RqData (String,String) loginFields = do u <- look "username" p <- look "password" return (u,p) authenticated :: BeinServerPart Response -> BeinServerPart Response authenticated act = getRequestUser >>= \u -> case u of Just user -> act `withUser` user Nothing -> fullUrl "/login" >>= \url -> seeOther url (toResponse "Redirecting...")