From 34a12ec226d7150615fed4169edfd9782297c2ad Mon Sep 17 00:00:00 2001 From: David Mosbach Date: Sat, 23 Dec 2023 05:49:16 +0100 Subject: [PATCH] redefined token endpoint --- src/Server.hs | 47 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 42 insertions(+), 5 deletions(-) diff --git a/src/Server.hs b/src/Server.hs index f3990ee..8daf341 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -23,6 +23,7 @@ import Data.Maybe (fromMaybe) import Data.String (IsString (..)) import Data.Text hiding (elem, find, head, length, map, null, splitAt, tail, words) import Data.Text.Encoding (decodeUtf8) +import Data.Time.Clock (NominalDiffTime (..), nominalDay) import qualified Data.Map.Strict as Map @@ -71,7 +72,6 @@ type Auth user userData = BasicAuth "login" user :> QParam "redirect_uri" QRedirect :> Get '[JSON] userData -type Token = "token" :> Post '[JSON] Text -- TODO post jwt token -- type Insert = "insert" :> Post '[JSON] User @@ -103,7 +103,7 @@ authServer = handleAuth -- return uData redirect $ url `withCode` mAuthCode redirect :: Maybe ByteString -> AuthHandler userData - redirect (Just url) = throwError err302 { errHeaders = [("Location", url)]} + redirect (Just url) = throwError err303 { errHeaders = [("Location", url)]} redirect Nothing = throwError err500 { errBody = "Could not generate authorisation code."} withCode :: String -> Maybe String -> Maybe ByteString withCode url Nothing = Nothing @@ -152,8 +152,45 @@ runMockServer' port = do bracket (forkIO . run port $ insecureOAuthMock' testUsers state) killThread $ \_ -> runClientM (frontend $ BasicAuthData "foo@bar.com" "0000") (mkClientEnv mgr (BaseUrl Http "localhost" port "")) >>= print - -tokenEndpoint :: Server Token -tokenEndpoint = undefined + +------ +------ Token +------ + + +data ClientData = ClientData + { grantType :: Text + , grant :: Text + , clientID :: Text + , clientSecret :: Text + , redirect :: Text + } deriving Show + +instance FromJSON ClientData where + parseJSON (Object o) = ClientData + <$> o .: "grant_type" + <*> o .: "authorization_code" --TODO add alternatives + <*> o .: "client_id" + <*> o .: "client_secret" + <*> o .: "redirect_url" + +data JWT = JWT + { token :: Text -- TODO should be JWT + , tokenType :: Text -- TODO enum + , expiration :: NominalDiffTime + } + +type Token = "token" + :> ReqBody '[JSON] ClientData + :> Post '[JSON] JWT + +tokenEndpoint :: AuthServer Token +tokenEndpoint = provideToken + where + provideToken :: ClientData -> AuthHandler JWT + provideToken client = do + --TODO validate everything + return JWT {token = "", tokenType = "JWT", expiration = 0.25 * nominalDay} + \ No newline at end of file