changed token endpoint to accept post requests
This commit is contained in:
parent
d75ba4f762
commit
83dacacf56
@ -128,7 +128,7 @@ authServer = handleAuth
|
|||||||
-- liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes')
|
-- liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes')
|
||||||
redirect $ addParams url mAuthCode mState
|
redirect $ addParams url mAuthCode mState
|
||||||
redirect :: Maybe ByteString -> AuthHandler userData
|
redirect :: Maybe ByteString -> AuthHandler userData
|
||||||
redirect (Just url) = throwError err303 { errHeaders = [("Location", url)]}
|
redirect (Just url) = liftIO (print url) >> throwError err303 { errHeaders = [("Location", url)]}
|
||||||
redirect Nothing = throwError err500 { errBody = "Could not generate authorisation code."}
|
redirect Nothing = throwError err500 { errBody = "Could not generate authorisation code."}
|
||||||
addParams :: String -> Maybe String -> Maybe String -> Maybe ByteString
|
addParams :: String -> Maybe String -> Maybe String -> Maybe ByteString
|
||||||
addParams url Nothing _ = Nothing
|
addParams url Nothing _ = Nothing
|
||||||
@ -207,7 +207,7 @@ instance FromHttpApiData JWTWrapper where
|
|||||||
|
|
||||||
type Token = "token"
|
type Token = "token"
|
||||||
:> ReqBody '[JSON] ClientData
|
:> ReqBody '[JSON] ClientData
|
||||||
:> Get '[JSON] JWTWrapper
|
:> Post '[JSON] JWTWrapper
|
||||||
|
|
||||||
tokenEndpoint :: AuthServer Token
|
tokenEndpoint :: AuthServer Token
|
||||||
tokenEndpoint = provideToken
|
tokenEndpoint = provideToken
|
||||||
@ -221,6 +221,7 @@ tokenEndpoint = provideToken
|
|||||||
unless valid . throwError $ err500 { errBody = "Invalid authorisation code" }
|
unless valid . throwError $ err500 { errBody = "Invalid authorisation code" }
|
||||||
-- return JWT {token = "", tokenType = "JWT", expiration = 0.25 * nominalDay}
|
-- return JWT {token = "", tokenType = "JWT", expiration = 0.25 * nominalDay}
|
||||||
token <- asks mkToken >>= liftIO
|
token <- asks mkToken >>= liftIO
|
||||||
|
liftIO . putStrLn $ "token: " ++ show token
|
||||||
return token
|
return token
|
||||||
x -> error $ show x ++ " not supported yet"
|
x -> error $ show x ++ " not supported yet"
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user