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

View file

@ -7,6 +7,7 @@ module Control.Auth where
import Servant import Servant
import Servant.Client import Servant.Client
import Servant.Client.Core.Auth (mkAuthenticatedRequest)
import qualified Data.Text as T import qualified Data.Text as T
@ -30,6 +31,7 @@ import Types
import View import View
import Util import Util
import Client import Client
import ClientAuth
import API import API
import Hash import Hash
@ -174,3 +176,20 @@ authPostControl (Just cookies) mDestination (AuthReturn pass method) = do
authPostControl Nothing _ _ = throwError $ err400 authPostControl Nothing _ _ = throwError $ err400
{ errBody = "No ticket cookie present." { 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 :<|> userManageAuthDeleteControl mcookie
:<|> authControl mcookie :<|> authControl mcookie
:<|> authPostControl mcookie :<|> authPostControl mcookie
:<|> authLogoutControl mcookie
) )
userApi :: Proxy UserAPI userApi :: Proxy UserAPI

View file

@ -66,6 +66,15 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
": " <> ": " <>
(formatMoney $ MT.userDetailsBalance ud) (formatMoney $ MT.userDetailsBalance ud)
-- TODO: Add currency symbol -- 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 case method of
MT.PrimaryPass -> MT.PrimaryPass ->
userSettingsPointer userSettingsPointer