From 787b02e8b5d7bfd5835da1030cd3da697f6ab17d Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 14 Oct 2019 20:10:30 +0200 Subject: [PATCH] add logout capability --- src/API.hs | 6 +++++- src/Control/Auth.hs | 19 +++++++++++++++++++ src/Main.hs | 1 + src/View/User.hs | 9 +++++++++ 4 files changed, 34 insertions(+), 1 deletion(-) diff --git a/src/API.hs b/src/API.hs index 2954767..12abf26 100644 --- a/src/API.hs +++ b/src/API.hs @@ -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) diff --git a/src/Control/Auth.hs b/src/Control/Auth.hs index 6231768..382be4f 100644 --- a/src/Control/Auth.hs +++ b/src/Control/Auth.hs @@ -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) + } diff --git a/src/Main.hs b/src/Main.hs index 0a5b48e..9379815 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -53,6 +53,7 @@ userApp initState = serveWithContext userApi (EmptyContext) $ :<|> userManageAuthDeleteControl mcookie :<|> authControl mcookie :<|> authPostControl mcookie + :<|> authLogoutControl mcookie ) userApi :: Proxy UserAPI diff --git a/src/View/User.hs b/src/View/User.hs index d0a7748..be8f33e 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -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