User_id support (via user_vars)

src/PostgREST/App.hs

@@ -120,9 +120,9 @@ app conf reqBody req =
               login <- signInRole (cs $ userId u)
                               (cs $ userPass u)
               case login of
-                LoginSuccess role ->
+                LoginSuccess role uid ->
                   return $ responseLBS status201 [ jsonH ] $
-                    encode . object $ [("token", String $ tokenJWT jwtSecret (cs $ userId u) role)]
+                    encode . object $ [("token", String $ tokenJWT jwtSecret uid role)]
                 _  -> return $ responseLBS status401 [jsonH] $
                   encode . object $ [("message", String "Failed authentication.")]
 

src/PostgREST/Auth.hs

@@ -40,12 +40,13 @@ instance ToJSON AuthUser where
     , "role" .= userRole u ]
 
 type DbRole = Text
+type UserId = Text
 
 data LoginAttempt =
     NoCredentials
   | MalformedAuth
   | LoginFailed
-  | LoginSuccess DbRole
+  | LoginSuccess DbRole UserId
   deriving (Eq, Show)
 
 checkPass :: Text -> Text -> Bool
@@ -57,6 +58,15 @@ setRole role = H.unitEx $ B.Stmt ("set role " <> cs (pgFmtLit role)) V.empty Tru
 resetRole :: H.Tx P.Postgres s ()
 resetRole = H.unitEx [H.stmt|reset role|]
 
+setUserId :: Text -> H.Tx P.Postgres s ()
+setUserId uid = if uid /= "" then
+  H.unitEx $ B.Stmt ("set user_vars.user_id = " <> cs (pgFmtLit uid)) V.empty True
+else
+  resetUserId
+
+resetUserId :: H.Tx P.Postgres s ()
+resetUserId = H.unitEx [H.stmt|reset user_vars.user_id|]
+
 addUser :: Text -> Text -> Text -> H.Tx P.Postgres s ()
 addUser identity pass role = do
   let Just hashed = unsafePerformIO $ hashPasswordUsingPolicy fastBcryptHashingPolicy (cs pass)
@@ -66,20 +76,23 @@ addUser identity pass role = do
 
 signInRole :: Text -> Text -> H.Tx P.Postgres s LoginAttempt
 signInRole user pass = do
-  u <- H.maybeEx $ [H.stmt|select pass, rolname from postgrest.auth where id = ?|] user
+  u <- H.maybeEx $ [H.stmt|select id, pass, rolname from postgrest.auth where id = ?|] user
   return $ maybe LoginFailed (\r ->
-      let (hashed, role) = r in
+      let (uid, hashed, role) = r in
       if checkPass hashed pass
-         then LoginSuccess role
+         then LoginSuccess role uid
          else LoginFailed
     ) u
 
 signInWithJWT :: Text -> Text -> LoginAttempt
 signInWithJWT secret input = case maybeRole of
-    Just (Just (String role)) -> LoginSuccess $ cs role
+    Just (Just (String role)) -> case maybeUserId of
+      Just (Just (String uid)) -> LoginSuccess (cs role) (cs uid)
+      _   -> LoginFailed
     _   -> LoginFailed
   where 
     maybeRole = (Data.Map.lookup "role" <$> claims) ::Maybe (Maybe Value)
+    maybeUserId = (Data.Map.lookup "id" <$> claims) ::Maybe (Maybe Value)
     claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
     decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
     

src/PostgREST/Middleware.hs

@@ -20,7 +20,7 @@ import Network.Wai (Application, requestHeaders, responseLBS, rawPathInfo,
 import Network.URI (URI(..), parseURI)
 
 import PostgREST.Config (AppConfig(..))
-import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole)
+import PostgREST.Auth (LoginAttempt(..), signInRole, signInWithJWT, setRole, resetRole, setUserId, resetUserId)
 import Codec.Binary.Base64.String (decode)
 
 import Prelude
@@ -35,8 +35,8 @@ authenticated conf app req = do
       return $ responseLBS status400 [] "Malformed basic auth header"
     LoginFailed ->
       return $ responseLBS status401 [] "Invalid username or password"
-    LoginSuccess role -> if role /= currentRole then runInRole role else app req
-    NoCredentials ->     if anon /= currentRole then runInRole anon else app req
+    LoginSuccess role uid -> if role /= currentRole then runInRole role uid else app req
+    NoCredentials         -> if anon /= currentRole then runInRole anon "" else app req
 
  where
    jwtSecret = cs $ configJwtSecret conf
@@ -54,11 +54,13 @@ authenticated conf app req = do
         return $ signInWithJWT jwtSecret jwt
       _ -> return NoCredentials
 
-   runInRole :: Text -> H.Tx P.Postgres s Response
-   runInRole r = do
+   runInRole :: Text -> Text -> H.Tx P.Postgres s Response
+   runInRole r uid = do
+     setUserId uid
      setRole r
      res <- app req
      resetRole
+     resetUserId
      return res