uniworx/oauth2-mock-server
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

replace '=' in query params

Browse Source
This commit is contained in:
David Mosbach 2024-01-10 02:55:23 +01:00
parent 100e4f8765
commit 123cf76b3b
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/AuthCode.hs
View File

@ -42,7 +42,7 @@ genUnencryptedCode client url expiration state = do
now <- getCurrentTime
let
expiresAt = expiration `addUTCTime` now
simpleCode = replace "=" "" . encodeBase64 . pack . filter (/= ' ') $ client <> url <> show now <> show expiresAt
simpleCode = replace "=" "%3D" . encodeBase64 . pack . filter (/= ' ') $ client <> url <> show now <> show expiresAt
success <- atomically . stateTVar state $ \s ->
let mEntry = M.lookup simpleCode s.activeCodes
in

6
src/Server.hs
View File

@ -85,7 +85,7 @@ type QScope = String
type QClient = String
type QResType = String
type QRedirect = String
type QState = String
type QState = Text
type QParam = QueryParam' [Required, Strict]
@ -130,12 +130,12 @@ authServer = handleAuth
redirect :: Maybe ByteString -> AuthHandler userData
redirect (Just url) = liftIO (print url) >> throwError err303 { errHeaders = [("Location", url)]}
redirect Nothing = throwError err500 { errBody = "Could not generate authorisation code."}
addParams :: String -> Maybe Text -> Maybe String -> Maybe ByteString
addParams :: String -> Maybe Text -> Maybe Text -> Maybe ByteString
addParams url Nothing _ = Nothing
addParams url (Just code) mState =
let qPos = fromMaybe (length url) $ elemIndex '?' url
(pre, post) = splitAt qPos url
rState = case mState of {Just s -> "&state=" ++ s; Nothing -> ""}
rState = case mState of {Just s -> "&state=" ++ (unpack $ replace "=" "%3D" s); Nothing -> ""}
post' = if not (null post) then '&' : tail post else post
in Just . fromString $ pre ++ "?code=" ++ (unpack code) ++ post' ++ rState