changed header type for user endpoint

This commit is contained in:
David Mosbach 2024-01-10 17:07:22 +01:00
parent 3e2d07518c
commit c68bf943f3

View File

@ -24,7 +24,7 @@ import Data.List (find, elemIndex)
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing)
import Data.String (IsString (..))
import Data.Text hiding (elem, find, head, length, map, null, splitAt, tail, words)
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time.Clock (NominalDiffTime (..), nominalDay, UTCTime(..), getCurrentTime, addUTCTime)
import qualified Data.ByteString.Char8 as BS
@ -234,23 +234,28 @@ mkToken state = do
type Users = "users"
type HeaderR = Header' [Strict, Required]
type Me userData = Users
:> "me"
:> Header "Authorization" JWTWrapper
:> HeaderR "Authorization" Text
:> Get '[JSON] userData
type UserList userData = Users
:> "query"
:> Header "Authorization" JWTWrapper
:> HeaderR "Authorization" Text
:> Get '[JSON] [userData] -- TODO support query params
userEndpoint :: forall user userData . UserData user userData => AuthServer (Me userData)
userEndpoint = handleUserData
where
handleUserData :: Maybe JWTWrapper -> AuthHandler userData
handleUserData :: Text -> AuthHandler userData
handleUserData jwtw = do
let mToken = stripPrefix "Bearer " jwtw
unless (isJust mToken) . throwError $ err500 { errBody = "Invalid token format"}
token <- asks (decodeToken (fromJust mToken)) >>= liftIO
liftIO $ putStrLn "decoded token:" >> print token
undefined
-- let
-- scopes' = map (readScope @user @userData) $ words scopes
@ -258,10 +263,15 @@ userEndpoint = handleUserData
-- liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes')
-- return uData
decodeToken :: Text -> AuthState -> IO (Either JwtError JwtContent)
decodeToken token state = do
pubKey <- atomically $ readTVar state >>= return . publicKey
jwkDecode pubKey $ encodeUtf8 token
userListEndpoint :: forall user userData . UserData user userData => AuthServer (UserList userData)
userListEndpoint = handleUserData
where
handleUserData :: Maybe JWTWrapper -> AuthHandler [userData]
handleUserData :: Text -> AuthHandler [userData]
handleUserData jwtw = do
undefined