转授权

chusql-server/src/ChuSQL/Server/Backend.hs

@@ -11,6 +11,7 @@ module ChuSQL.Server.Backend (
     ipcBackend,
     memoryBackend,
     membersTable,
+    optionsTable,
     rolesTable,
     statementNeedsDatabase,
     statementTables,
@@ -359,11 +360,15 @@ rolesTable = "__system_roles"
 grantsTable :: String
 grantsTable = "__system_grants"
 
+-- | 带 grant option 的授权单独一张表
+optionsTable :: String
+optionsTable = "__system_grant_options"
+
 membersTable :: String
 membersTable = "__system_members"
 
 internalNames :: [String]
-internalNames = [rolesTable, grantsTable, membersTable]
+internalNames = [rolesTable, grantsTable, optionsTable, membersTable]
 
 -- | 名字是否带内部表前缀
 reserved :: String -> Bool

chusql-server/src/ChuSQL/Server/Catalog.hs

@@ -14,6 +14,9 @@ module ChuSQL.Server.Catalog
     , readGrants
     , addGrant
     , removeGrant
+    , readGrantOptions
+    , addGrantOption
+    , removeGrantOption
     , readMembers
     , addMember
     , removeMember
@@ -22,7 +25,7 @@ module ChuSQL.Server.Catalog
 import ChuSQL.Core.Model (Row, Value (..))
 import ChuSQL.Interface.Actions (sqlLiteral)
 import ChuSQL.Interface.Protocol (Grant (..))
-import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, rolesTable)
+import ChuSQL.Server.Backend (Backend (..), StatementResult (..), grantsTable, membersTable, optionsTable, rolesTable)
 import Control.Concurrent.MVar (MVar, newMVar, withMVar)
 import Data.List (intercalate, isInfixOf)
 import Data.Text (Text)
@@ -75,6 +78,7 @@ ensureCatalog catalog = eachAction tableDefs (createTable catalog)
     tableDefs =
         [ (rolesTable, "(name VARCHAR(64))")
         , (grantsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
+        , (optionsTable, "(role VARCHAR(64), privilege VARCHAR(16), object VARCHAR(128))")
         , (membersTable, "(role VARCHAR(64), member VARCHAR(64))")
         ]
 
@@ -111,9 +115,10 @@ dropRole catalog role = do
     second <- exec catalog ("DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role)
     third <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE role = " ++ roleLiteral role)
     fourth <- exec catalog ("DELETE FROM " ++ membersTable ++ " WHERE member = " ++ roleLiteral role)
-    pure (sequence_ [first, second, third, fourth])
+    fifth <- exec catalog ("DELETE FROM " ++ optionsTable ++ " WHERE role = " ++ roleLiteral role)
+    pure (sequence_ [first, second, third, fourth, fifth])
 
--- | 全部授权
+-- | 全部授权，都不带 grant option
 readGrants :: Catalog -> IO (Either String [Grant])
 readGrants catalog = fmap (fmap (map grantOf)) (readRows catalog grantsTable)
 
@@ -127,7 +132,23 @@ addGrant catalog role privilege object = do
 
 -- | 取消一条授权
 removeGrant :: Catalog -> Text -> Text -> Text -> IO (Either String ())
-removeGrant catalog role privilege object = exec catalog (deleteGrantSql role privilege object)
+removeGrant catalog role privilege object = exec catalog (deleteGrantSql grantsTable role privilege object)
+
+-- | 全部带 grant option 的授权
+readGrantOptions :: Catalog -> IO (Either String [Grant])
+readGrantOptions catalog = fmap (fmap (map optionOf)) (readRows catalog optionsTable)
+
+-- | 记一条带 grant option 的授权，同名的先清掉
+addGrantOption :: Catalog -> Text -> Text -> Text -> IO (Either String ())
+addGrantOption catalog role privilege object = do
+    cleared <- removeGrantOption catalog role privilege object
+    case cleared of
+        Left err -> pure (Left err)
+        Right () -> exec catalog (insertSql optionsTable ["role", "privilege", "object"] [normalizeRole role, privilege, object])
+
+-- | 取消一条带 grant option 的授权
+removeGrantOption :: Catalog -> Text -> Text -> Text -> IO (Either String ())
+removeGrantOption catalog role privilege object = exec catalog (deleteGrantSql optionsTable role privilege object)
 
 -- | 全部成员关系
 readMembers :: Catalog -> IO (Either String [(Text, Text)])
@@ -164,16 +185,21 @@ grantOf row =
         { grantRole = normalizeRole (cell "role" row)
         , grantPrivilege = T.toLower (T.strip (cell "privilege" row))
         , grantObject = T.toLower (T.strip (cell "object" row))
+        , grantable = False
         }
 
+-- | 一行带 grant option 的授权记录
+optionOf :: Row -> Grant
+optionOf row = (grantOf row) {grantable = True}
+
 -- | 一行成员关系
 memberOf :: Row -> (Text, Text)
 memberOf row = (normalizeRole (cell "role" row), normalizeUser (cell "member" row))
 
 -- | 拼一条删授权的语句
-deleteGrantSql :: Text -> Text -> Text -> String
-deleteGrantSql role privilege object =
-    "DELETE FROM " ++ grantsTable ++ " WHERE role = " ++ roleLiteral role
+deleteGrantSql :: String -> Text -> Text -> Text -> String
+deleteGrantSql table role privilege object =
+    "DELETE FROM " ++ table ++ " WHERE role = " ++ roleLiteral role
         ++ " AND privilege = " ++ literal privilege ++ " AND object = " ++ literal object
 
 -- | 拼一条插入语句

chusql-server/src/ChuSQL/Server/Privileges.hs

@@ -29,6 +29,7 @@ import ChuSQL.Server.Backend (
 import ChuSQL.Server.Catalog (
     Catalog,
     addGrant,
+    addGrantOption,
     addMember,
     dropRole,
     eachAction,
@@ -37,10 +38,12 @@ import ChuSQL.Server.Catalog (
     normalizeObject,
     normalizeRole,
     normalizeUser,
+    readGrantOptions,
     readGrants,
     readMembers,
     readRoleNames,
     removeGrant,
+    removeGrantOption,
     removeMember,
     withCatalogLock,
     ensureCatalog,
@@ -68,7 +71,7 @@ data Membership = Membership
 data PrivilegeCommand
     = CreateRoleCommand Text
     | DropRoleCommand Text
-    | GrantPrivilegesCommand [Text] Text Text
+    | GrantPrivilegesCommand [Text] Text Text Bool
     | RevokePrivilegesCommand [Text] Text Text
     | GrantRoleCommand Text [Text]
     | RevokeRoleCommand Text [Text]
@@ -87,24 +90,24 @@ privilegeCommand :: Statement -> Maybe PrivilegeCommand
 privilegeCommand stmt = case stmt of
     CreateRole name -> Just (CreateRoleCommand (T.pack name))
     DropRole name -> Just (DropRoleCommand (T.pack name))
-    GrantPrivileges privs obj role ->
-        Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
+    GrantPrivileges privs obj role withOption ->
+        Just (GrantPrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role) withOption)
     RevokePrivileges privs obj role ->
         Just (RevokePrivilegesCommand (map T.toLower (map T.pack privs)) (T.pack obj) (T.pack role))
     GrantRole role members -> Just (GrantRoleCommand (T.pack role) (map T.pack members))
     RevokeRole role members -> Just (RevokeRoleCommand (T.pack role) (map T.pack members))
     _ -> Nothing
 
--- | 执行管理命令：只有管理员能跑，命令提到的角色必须已经存在
+-- | 执行管理命令：管理员全通，普通身份只能转授自己拿到的权限
 runPrivilegeCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
 runPrivilegeCommand service principal database command
-    | not (principalIsRoot principal) = pure (Left forbidden)
     | needsDatabase = pure (Left (PrivilegeError "no_database" "no database selected"))
-    | otherwise = withTables service (applyCommand service database command)
+    | principalIsRoot principal = withTables service (applyCommand service database command)
+    | otherwise = withTables service (delegateCommand service principal database command)
   where
     -- | 授权到具体对象时需要先选库
     needsDatabase = T.null database && case command of
-        GrantPrivilegesCommand _ object _ -> T.strip object /= "*"
+        GrantPrivilegesCommand _ object _ _ -> T.strip object /= "*"
         RevokePrivilegesCommand _ object _ -> T.strip object /= "*"
         _ -> False
 
@@ -164,10 +167,18 @@ requiredActions stmt = case stmt of
 
 -- | 每项 (表, 权限) 都要被某条授权覆盖
 checkAll :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
-checkAll database grants needed = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of
+checkAll database grants needed = checkCovered database grants needed "permission denied: "
+
+-- | 转授权要查 grant option，报错口径与普通鉴权分开
+checkOptions :: Text -> [Grant] -> [(Text, Text)] -> Either PrivilegeError ()
+checkOptions database grants needed = checkCovered database grants needed "grant option required: "
+
+-- | 覆盖检查的公共实现
+checkCovered :: Text -> [Grant] -> [(Text, Text)] -> Text -> Either PrivilegeError ()
+checkCovered database grants needed prefix = case [pair | pair@(table, privilege) <- needed, not (covered table privilege)] of
     [] -> Right ()
     ((table, privilege) : _) ->
-        Left (PrivilegeError "forbidden" ("permission denied: " <> T.toUpper privilege <> " ON " <> table))
+        Left (PrivilegeError "forbidden" (prefix <> T.toUpper privilege <> " ON " <> table))
   where
     -- | 某一项是否被授权覆盖
     covered table privilege =
@@ -176,19 +187,25 @@ checkAll database grants needed = case [pair | pair@(table, privilege) <- needed
                 (\grant -> (grantObject grant == "*" || grantObject grant == target) && grantPrivilege grant == privilege)
                 grants
 
--- | 一个用户实际能用的授权：所属角色加上继承来的
+-- | 一个用户实际能用的授权：含角色继承
 grantsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
 grantsOfUser service user = do
     members <- catalog (readMembers (pvCatalog service))
     grants <- catalog (readGrants (pvCatalog service))
+    options <- catalog (readGrantOptions (pvCatalog service))
     roles <- roleNames service
     pure $ do
         memberRows <- members
         grantRows <- grants
+        optionRows <- options
         known <- roles
         let edges = roleEdges memberRows known
             mine = closureUp edges [role | (role, member) <- memberRows, member == normalizeUser user]
-        pure [grant | grant <- grantRows, grantRole grant `elem` mine]
+        pure [grant | grant <- grantRows ++ optionRows, grantRole grant `elem` mine]
+
+-- | 一个用户手里的 grant option，只有这些能再转授
+optionsOfUser :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
+optionsOfUser service user = fmap (fmap (filter grantable)) (grantsOfUser service user)
 
 -- | 角色到角色的成员边：父角色在前
 roleEdges :: [(Text, Text)] -> [Text] -> [(Text, Text)]
@@ -203,11 +220,28 @@ closureUp edges = go
         let more = [parent | (parent, child) <- edges, child `elem` known, parent `notElem` known]
          in if null more then known else go (known ++ more)
 
--- | 一个角色挂着的授权
+-- | 一个角色挂着的授权，带 grant option 的会标出来
 roleGrantsOf :: Privileges -> Text -> IO (Either PrivilegeError [Grant])
 roleGrantsOf service role = do
     grants <- catalog (readGrants (pvCatalog service))
-    pure (filter (\grant -> grantRole grant == normalizeRole role) <$> grants)
+    options <- catalog (readGrantOptions (pvCatalog service))
+    pure (do
+        rows <- grants
+        optionRows <- options
+        let mine = filter (\grant -> grantRole grant == normalizeRole role) rows
+        pure (markOptions mine optionRows))
+
+-- | 给授权标上有没有对应的 grant option
+markOptions :: [Grant] -> [Grant] -> [Grant]
+markOptions grants options = [grant {grantable = hasOption grant} | grant <- grants]
+  where
+    -- | 有没有一条同角色同权限同对象的 option
+    hasOption grant = any (same grant) options
+    -- | 两条授权指向同一处
+    same one other =
+        grantRole one == grantRole other
+            && grantPrivilege one == grantPrivilege other
+            && grantObject one == grantObject other
 
 -- | 角色名清单（统一小写）
 roleNames :: Privileges -> IO (Either PrivilegeError [Text])
@@ -244,20 +278,20 @@ applyCommand service database command = case command of
         case allowed of
             Left err -> pure (Left err)
             Right () -> catalog (dropRole (pvCatalog service) role)
-    GrantPrivilegesCommand privileges object role -> do
+    GrantPrivilegesCommand privileges object role withOption -> do
         allowed <- requireRole service role
         case allowed of
             Left err -> pure (Left err)
             Right () ->
                 eachAction (expandPrivileges privileges) $ \privilege ->
-                    catalog (addGrant (pvCatalog service) role privilege (normalizeObject database object))
+                    grantOne service withOption role privilege (normalizeObject database object)
     RevokePrivilegesCommand privileges object role -> do
         allowed <- requireRole service role
         case allowed of
             Left err -> pure (Left err)
             Right () ->
                 eachAction (expandPrivileges privileges) $ \privilege ->
-                    catalog (removeGrant (pvCatalog service) role privilege (normalizeObject database object))
+                    revokeOne service role privilege (normalizeObject database object)
     GrantRoleCommand role members -> do
         allowed <- requireRole service role
         case allowed of
@@ -273,6 +307,43 @@ applyCommand service database command = case command of
             Left err -> pure (Left err)
             Right () -> eachAction users $ \user -> catalog (removeMember (pvCatalog service) role user)
 
+-- | 落一条授权，带 grant option 的再落一条转授权
+grantOne :: Privileges -> Bool -> Text -> Text -> Text -> IO (Either PrivilegeError ())
+grantOne service withOption role privilege object = do
+    written <- catalog (addGrant (pvCatalog service) role privilege object)
+    case written of
+        Left err -> pure (Left err)
+        Right ()
+            | withOption -> catalog (addGrantOption (pvCatalog service) role privilege object)
+            | otherwise -> pure (Right ())
+
+-- | 收一条授权，连同它的 grant option
+revokeOne :: Privileges -> Text -> Text -> Text -> IO (Either PrivilegeError ())
+revokeOne service role privilege object = do
+    dropped <- catalog (removeGrant (pvCatalog service) role privilege object)
+    case dropped of
+        Left err -> pure (Left err)
+        Right () -> catalog (removeGrantOption (pvCatalog service) role privilege object)
+
+-- | 普通身份转授权：只放行 GRANT
+delegateCommand :: Privileges -> Principal -> Text -> PrivilegeCommand -> IO (Either PrivilegeError ())
+delegateCommand service principal database command = case command of
+    GrantPrivilegesCommand privileges object role _ -> do
+        allowed <- requireRole service role
+        case allowed of
+            Left err -> pure (Left err)
+            Right () -> do
+                owned <- optionsOfUser service (principalName principal)
+                case owned >>= \found -> checkOptions database found needed of
+                    Left err -> pure (Left err)
+                    Right () -> applyCommand service database command
+    _ -> pure (Left forbidden)
+  where
+    -- | 命令里每个 (对象, 权限) 都要对得上
+    needed = case command of
+        GrantPrivilegesCommand privileges object _ _ -> [(object, privilege) | privilege <- expandPrivileges privileges]
+        _ -> []
+
 -- | 加一条成员边：名字是角色就查环，否则当用户加
 grantMember :: Privileges -> [Text] -> Text -> Text -> IO (Either PrivilegeError ())
 grantMember service roles role member = do

chusql-server/test/Spec.hs

@@ -507,14 +507,14 @@ privilegeSpec = describe "server privileges" $ do
 
     it "grants a privilege on a table and shows it in the role view" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
-        granted <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        granted <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         granted `shouldBe` Right ()
         views <- listRoleViews service
-        fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users"]]
+        fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" False]]
 
     it "expands ALL and keeps a star object as is" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
-        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "*" "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["all"] "*" "reader" False)
         views <- listRoleViews service
         fmap (concatMap (map grantPrivilege) . map roleGrants) views
             `shouldBe` Right ["select", "insert", "update", "delete"]
@@ -522,11 +522,47 @@ privilegeSpec = describe "server privileges" $ do
 
     it "revokes a privilege again" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
-        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader")
         views <- listRoleViews service
         fmap (map roleGrants) views `shouldBe` Right [[]]
 
+    it "marks a grant that carries the grant option" $ withPrivileges $ \service root -> do
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True)
+        views <- listRoleViews service
+        fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True]]
+
+    it "refuses a non-administrator without the grant option" $ withPrivileges $ \service root -> do
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
+        _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
+        refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False)
+        refused `shouldBe` Left (PrivilegeError "forbidden" "grant option required: SELECT ON users")
+
+    it "lets a grant option holder pass the privilege on" $ withPrivileges $ \service root -> do
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True)
+        _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
+        passed <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False)
+        passed `shouldBe` Right ()
+        _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["bob"])
+        views <- listRoleViews service
+        fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True], [Grant "writer" "select" "test.users" False]]
+
+    it "stops the pass-on once the grant option is revoked" $ withPrivileges $ \service root -> do
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
+        _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True)
+        _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
+        _ <- runPrivilegeCommand service root testDatabase (RevokePrivilegesCommand ["select"] "users" "reader")
+        refused <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False)
+        refused `shouldBe` Left (PrivilegeError "forbidden" "grant option required: SELECT ON users")
+        views <- listRoleViews service
+        fmap (map roleGrants) views `shouldBe` Right [[], []]
+
     it "adds and removes members" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
@@ -539,7 +575,7 @@ privilegeSpec = describe "server privileges" $ do
 
     it "drops a role together with its grants and members" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
-        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["alice"])
         dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader")
         dropped `shouldBe` Right ()
@@ -549,7 +585,7 @@ privilegeSpec = describe "server privileges" $ do
     it "inherits the grants of another role" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
-        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"])
         linked <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"])
         linked `shouldBe` Right ()
@@ -579,7 +615,7 @@ privilegeSpec = describe "server privileges" $ do
     it "drops the inherited edge together with the role" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "writer")
-        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        _ <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "reader" ["writer"])
         _ <- runPrivilegeCommand service root testDatabase (GrantRoleCommand "writer" ["alice"])
         dropped <- runPrivilegeCommand service root testDatabase (DropRoleCommand "reader")
@@ -590,12 +626,12 @@ privilegeSpec = describe "server privileges" $ do
         fmap (map roleMembers) views `shouldBe` Right [["alice"]]
 
     it "refuses a command on a role that does not exist" $ withPrivileges $ \service root -> do
-        missing <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost")
+        missing <- runPrivilegeCommand service root testDatabase (GrantPrivilegesCommand ["select"] "users" "ghost" False)
         missing `shouldBe` Left (PrivilegeError "not_found" "unknown role: ghost")
 
     it "refuses a table grant without a selected database" $ withPrivileges $ \service root -> do
         _ <- runPrivilegeCommand service root testDatabase (CreateRoleCommand "reader")
-        refused <- runPrivilegeCommand service root "" (GrantPrivilegesCommand ["select"] "users" "reader")
+        refused <- runPrivilegeCommand service root "" (GrantPrivilegesCommand ["select"] "users" "reader" False)
         refused `shouldBe` Left (PrivilegeError "no_database" "no database selected")
 
     it "refuses a non-administrator" $ withPrivileges $ \service _ -> do
@@ -631,12 +667,26 @@ privilegeSpec = describe "server privileges" $ do
         service <- newPrivileges base
         _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader")
         _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer")
-        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader")
+        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" False)
         _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "reader" ["writer"])
         linked <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "writer" ["alice"])
         linked `shouldBe` Right ()
         authorizeSql service (Ordinary testAccount) "SELECT * FROM users" `shouldReturn` Right ()
 
+    it "keeps a grant option on the real storage" $ withIpcStorage $ do
+        base <- ipcBackend
+        service <- newPrivileges base
+        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "reader")
+        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (CreateRoleCommand "writer")
+        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantPrivilegesCommand ["select"] "users" "reader" True)
+        _ <- runPrivilegeCommand service (Root testRootName) testDatabase (GrantRoleCommand "reader" ["alice"])
+        views <- listRoleViews service
+        fmap (map roleGrants) views `shouldBe` Right [[Grant "reader" "select" "test.users" True], []]
+        passed <- runPrivilegeCommand service (Ordinary testAccount) testDatabase (GrantPrivilegesCommand ["select"] "users" "writer" False)
+        passed `shouldBe` Right ()
+        after <- listRoleViews service
+        fmap (map roleGrants) after `shouldBe` Right [[Grant "reader" "select" "test.users" True], [Grant "writer" "select" "test.users" False]]
+
 -- 真存储夹具：一个用例一份数据目录，跑完关链路删干净
 
 -- | 本次用例的数据目录（用例串行跑，固定名够用）