add logout capability

This commit is contained in:
nek0 2019-10-14 20:10:30 +02:00
parent c3cda9a253
commit 787b02e8b5
4 changed files with 34 additions and 1 deletions

View File

@ -55,6 +55,9 @@ type UserAPI =
:<|> "auth" :> QueryParam "destination" T.Text
:> ReqBody '[FormUrlEncoded] AuthReturn
:> Post '[HTML] UserSelectPage
:<|> "auth" :> "logout"
-- :> ReqBody '[FormUrlEncoded] ()
:> Post '[HTML] UserOverviewPage
)
( userSelectLink :<|>
@ -66,5 +69,6 @@ type UserAPI =
userManageAuthCreateLink :<|>
userManageAuthDeleteLink :<|>
authLink :<|>
authPostLink
authPostLink :<|>
authLogoutLink
) = allLinks (Proxy :: Proxy UserAPI)

View File

@ -7,6 +7,7 @@ module Control.Auth where
import Servant
import Servant.Client
import Servant.Client.Core.Auth (mkAuthenticatedRequest)
import qualified Data.Text as T
@ -30,6 +31,7 @@ import Types
import View
import Util
import Client
import ClientAuth
import API
import Hash
@ -174,3 +176,20 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
authPostControl Nothing _ _ = throwError $ err400
{ errBody = "No ticket cookie present."
}
authLogoutControl
:: Maybe T.Text
-> UserHandler UserOverviewPage
authLogoutControl mcookie = do
(ReadState _ backend _) <- ask
let mParsedCookie = fmap parseCookieText mcookie
token = T.unpack $ fromMaybe "secret" $
((lookup "x-token") =<< mParsedCookie)
eReturn <- liftIO $ runClientM
(authLogout (mkAuthenticatedRequest token authenticateReq))
backend
case eReturn of
Right _ -> throwError $ redirect303 userSelectLink
Left err -> throwError $ err500
{ errBody = fromString (show err)
}

View File

@ -53,6 +53,7 @@ userApp initState = serveWithContext userApi (EmptyContext) $
:<|> userManageAuthDeleteControl mcookie
:<|> authControl mcookie
:<|> authPostControl mcookie
:<|> authLogoutControl mcookie
)
userApi :: Proxy UserAPI

View File

@ -66,6 +66,15 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
": " <>
(formatMoney $ MT.userDetailsBalance ud)
-- TODO: Add currency symbol
H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $ authLogoutLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group optional" $ do
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Logout"
case method of
MT.PrimaryPass ->
userSettingsPointer