aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Sproxy/Application.hs10
1 files changed, 5 insertions, 5 deletions
diff --git a/src/Sproxy/Application.hs b/src/Sproxy/Application.hs
index 3d6598f..791e59c 100644
--- a/src/Sproxy/Application.hs
+++ b/src/Sproxy/Application.hs
@@ -124,12 +124,12 @@ oauth2callback key db (provider, oa2c) be req resp =
Just state ->
case State.decode key state of
Left msg -> badRequest ("invalid state: " ++ msg) req resp
- Right path -> do
+ Right url -> do
au <- oauth2Authenticate oa2c code (redirectURL req provider)
let email = getEmail au
Log.info $ "login " ++ show email ++ " by " ++ show provider
exists <- userExists db email
- if exists then authenticate key be au path req resp
+ if exists then authenticate key be au url req resp
else userNotFound au req resp
where
param p = do
@@ -153,7 +153,7 @@ extractCookie key now name req = do
authenticate :: ByteString -> BackendConf -> AuthUser -> ByteString -> W.Application
-authenticate key be user path req resp = do
+authenticate key be user url _req resp = do
now <- epochTime
let domain = pack <$> beCookieDomain be
expiry = now + CTime (beCookieMaxAge be)
@@ -169,7 +169,7 @@ authenticate key be user path req resp = do
, WC.setCookieExpires = Just . posixSecondsToUTCTime . realToFrac $ expiry
}
resp $ W.responseLBS seeOther303 [
- (hLocation, "https://" <> fromJust (W.requestHeaderHost req) <> path)
+ (hLocation, url)
, ("Set-Cookie", toByteString $ WC.renderSetCookie cookie)
] ""
@@ -280,7 +280,7 @@ authenticationRequired key oa2 req resp = do
path = if W.requestMethod req == methodGet
then W.rawPathInfo req <> W.rawQueryString req
else "/"
- state = State.encode key path
+ state = State.encode key $ "https://" <> fromJust (W.requestHeaderHost req) <> path
authLink :: Text -> OAuth2Client -> ByteString -> ByteString
authLink provider oa2c html =
let u = oauth2AuthorizeURL oa2c state (redirectURL req provider)