转授权

chusql-web/src/ChuSQL/Web/API.hs

@@ -1212,6 +1212,7 @@ grantJson grant =
     object
         [ "privilege" .= grantPrivilege grant
         , "object" .= grantObject grant
+        , "grantable" .= grantable grant
         ]
 
 -- | 建角色
@@ -1236,7 +1237,8 @@ grantRoleH env = do
     role <- pathParam "name"
     withJsonObject env $ \o -> case grantFields o of
         Left err -> reply400 "bad_request" err
-        Right (privileges, objectName) -> runPrivilegeSql ws (grantPrivilegesSql privileges objectName role)
+        Right (privileges, objectName, withOption) ->
+            runPrivilegeSql ws (grantPrivilegesSql privileges objectName role withOption)
 
 -- | 收角色的权限
 revokeRoleH :: AppEnv -> ActionM ()
@@ -1245,7 +1247,7 @@ revokeRoleH env = do
     role <- pathParam "name"
     withJsonObject env $ \o -> case grantFields o of
         Left err -> reply400 "bad_request" err
-        Right (privileges, objectName) -> runPrivilegeSql ws (revokePrivilegesSql privileges objectName role)
+        Right (privileges, objectName, _) -> runPrivilegeSql ws (revokePrivilegesSql privileges objectName role)
 
 -- | 把用户加进角色
 addRoleMemberH :: AppEnv -> ActionM ()
@@ -1264,14 +1266,18 @@ removeRoleMemberH env = do
     user <- pathParam "user"
     runPrivilegeSql ws (revokeRoleSql role [user])
 
--- | 权限（一条或一串）与对象
-grantFields :: A.Object -> Either Text ([Text], Text)
+-- | 权限（一条或一串）、对象与是否带转授权
+grantFields :: A.Object -> Either Text ([Text], Text, Bool)
 grantFields o = do
     objectName <- textField "object" o
     privileges <- case KM.lookup "privileges" o of
         Just (A.Array xs) -> mapM stringValue (V.toList xs)
         _ -> Left "missing or non-array field: privileges"
-    if null privileges then Left "at least one privilege is required" else pure (privileges, objectName)
+    withOption <- case KM.lookup "grantOption" o of
+        Nothing -> Right False
+        Just (A.Bool flag) -> Right flag
+        _ -> Left "grantOption must be a boolean"
+    if null privileges then Left "at least one privilege is required" else pure (privileges, objectName, withOption)
 
 -- | 成员（一条或一串）
 memberFields :: A.Object -> Either Text [Text]

chusql-web/test/Spec.hs

@@ -262,6 +262,11 @@ asInt :: A.Value -> Int
 asInt (A.Number n) = round n
 asInt _ = -1
 
+-- | 当布尔看
+asBool :: A.Value -> Bool
+asBool (A.Bool b) = b
+asBool _ = False
+
 -- | 第 i 个元素，越界给 Nothing
 nth :: Int -> [a] -> Maybe a
 nth i xs = case drop i xs of
@@ -852,6 +857,28 @@ roleSpec env = describe "roles and grants" $ do
             dropped <- deleteAs hs "/api/roles/analyst"
             expectStatusWith "drop role" dropped 200
 
+        it "carries the grant option through the API" $ do
+            hs <- adminHeaders
+            ensureDatabase hs testDatabaseName
+            created <- postAs hs "/api/roles" (encode (object ["name" .= ("passer" :: Text)]))
+            expectStatusWith "create passer" created 200
+            granted <-
+                postAs
+                    (withDb testDatabaseName hs)
+                    "/api/roles/passer/grants"
+                    (encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text]), "grantOption" .= True]))
+            expectStatusWith "grant with option" granted 200
+            listed <- getAs hs "/api/roles"
+            expectStatusWith "list roles" listed 200
+            let matching = [view | view <- items (jsonBody listed), asText (at "name" view) == "passer"]
+            check ((concatMap (map (asBool . at "grantable") . items . at "grants") matching) `shouldBe` [True])
+            refused <-
+                postAs
+                    hs
+                    "/api/roles/passer/grants"
+                    (encode (object ["object" .= testDatabaseName, "privileges" .= (["select"] :: [Text]), "grantOption" .= ("yes" :: Text)]))
+            expectStatusWith "non-boolean grant option" refused 400
+
 -- SQL 控制台 -----------------------------------------------------------------
 
 -- | SQL 控制台用例