From c68bf943f3a193c9cdcb5f3ed1b1abff7adaeae1 Mon Sep 17 00:00:00 2001
From: David Mosbach <david.mosbach@live.de>
Date: Wed, 10 Jan 2024 17:07:22 +0100
Subject: [PATCH] changed header type for user endpoint

---
 src/Server.hs | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

diff --git a/src/Server.hs b/src/Server.hs
index 0bbb5b1..855b1de 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -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