added logout endpoint
This commit is contained in:
parent
ba9bc7f784
commit
26d2255c25
@ -5,7 +5,12 @@
|
|||||||
|
|
||||||
{-# Language OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, QuasiQuotes #-}
|
{-# Language OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, QuasiQuotes #-}
|
||||||
|
|
||||||
module LoginForm (HTML(..), Html, loginPage) where
|
module LoginForm
|
||||||
|
( HTML(..)
|
||||||
|
, Html
|
||||||
|
, loginPage
|
||||||
|
, logoutPage
|
||||||
|
) where
|
||||||
|
|
||||||
import Prelude hiding (head)
|
import Prelude hiding (head)
|
||||||
|
|
||||||
@ -66,4 +71,16 @@ loginPage headers = docTypeHtml $ head' >> body'
|
|||||||
.then(url => window.location.replace(url.substring(1, url.length - 1)));
|
.then(url => window.location.replace(url.substring(1, url.length - 1)));
|
||||||
// Response.redirect(url);
|
// Response.redirect(url);
|
||||||
};
|
};
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
|
||||||
|
logoutPage :: Html
|
||||||
|
logoutPage = docTypeHtml $ head' >> body'
|
||||||
|
where
|
||||||
|
head' = head $ do
|
||||||
|
meta ! A.charset "UTF-8"
|
||||||
|
meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0"
|
||||||
|
title "UniWorX Oauth2 Mock Server"
|
||||||
|
body' = body $ do
|
||||||
|
h1 "UniWorX Oauth2 Mock Server"
|
||||||
|
p "Logout successful."
|
||||||
@ -171,7 +171,7 @@ loginServer = decideLogin
|
|||||||
|
|
||||||
|
|
||||||
codeServer :: forall user userData . UserData user userData => AuthServer user AuthCode
|
codeServer :: forall user userData . UserData user userData => AuthServer user AuthCode
|
||||||
codeServer creds scopes client url mState = addHeader ("oa2_auth_cookie=" <> creds) <$>
|
codeServer creds scopes client url mState = addHeader ("oa2_auth_cookie=\"" <> creds <> "\"") <$>
|
||||||
handleCreds @user @userData creds scopes client url mState Nothing
|
handleCreds @user @userData creds scopes client url mState Nothing
|
||||||
|
|
||||||
handleCreds :: forall user userData . UserData user userData
|
handleCreds :: forall user userData . UserData user userData
|
||||||
@ -341,6 +341,29 @@ userListEndpoint = handleUserData
|
|||||||
Nothing -> return . QLeft $ QError "UserDoesNotExist"
|
Nothing -> return . QLeft $ QError "UserDoesNotExist"
|
||||||
|
|
||||||
|
|
||||||
|
--------------
|
||||||
|
---- Logout ----
|
||||||
|
--------------
|
||||||
|
|
||||||
|
type Logout = "logout"
|
||||||
|
:> QueryParam "post_logout_redirect_uri" QRedirect
|
||||||
|
:> HeaderR "Cookie" QCookie
|
||||||
|
:> Get '[HTML] (Headers '[Header "Set-Cookie" Text] Html)
|
||||||
|
|
||||||
|
logoutEndpoint :: forall user userData . UserData user userData => AuthServer user Logout
|
||||||
|
logoutEndpoint = logout
|
||||||
|
where
|
||||||
|
logout :: Maybe QRedirect
|
||||||
|
-> QCookie
|
||||||
|
-> AuthHandler user (Headers '[Header "Set-Cookie" Text] Html)
|
||||||
|
logout mUri cookie = do
|
||||||
|
let mCreds = lookup "oa2_auth_cookie" . parseCookiesText $ encodeUtf8 cookie
|
||||||
|
unless (isJust mCreds) $ throwError err401 { errBody = "Missing auth cookie" }
|
||||||
|
addHeader "oa2_auth_cookie=\"\"" <$> case mUri of
|
||||||
|
Just uri -> throwError err303 { errHeaders = [("Location", encodeUtf8 uri)]}
|
||||||
|
Nothing -> return logoutPage
|
||||||
|
|
||||||
|
|
||||||
-------------------
|
-------------------
|
||||||
---- Server Main ----
|
---- Server Main ----
|
||||||
-------------------
|
-------------------
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user