add support for create/drop role, grant, revoke

Language/SQL/SimpleSQL/Parser.lhs

@@ -1459,7 +1459,8 @@ TODO: change style
 >                                  ,createTable
 >                                  ,createView
 >                                  ,createDomain
->                                  ,createSequence]
+>                                  ,createSequence
+>                                  ,createRole]
 >     ,keyword_ "alter" *> choice [alterTable
 >                                 ,alterDomain
 >                                 ,alterSequence]
@@ -1467,7 +1468,8 @@ TODO: change style
 >                                ,dropTable
 >                                ,dropView
 >                                ,dropDomain
->                                ,dropSequence]
+>                                ,dropSequence
+>                                ,dropRole]
 >     ,delete
 >     ,truncateSt
 >     ,insert
@@ -1477,6 +1479,8 @@ TODO: change style
 >     ,releaseSavepoint
 >     ,commit
 >     ,rollback
+>     ,grant
+>     ,revoke
 >     ,SelectStatement <$> queryExpr
 >     ]
 
@@ -1793,6 +1797,82 @@ slightly hacky parser for signed integers
 > rollback = keyword_ "rollback" >> optional (keyword_ "work") >>
 >     Rollback <$> optionMaybe (keywords_ ["to", "savepoint"] *> name)
 
+
+------------------------------
+
+= Access control
+
+TODO: fix try at the 'on'
+
+> grant :: Parser Statement
+> grant = keyword_ "grant" >> (try priv <|> role)
+>   where
+>     priv = GrantPrivilege
+>            <$> commaSep privilegeAction
+>            <*> (keyword_ "on" *> privilegeObject)
+>            <*> (keyword_ "to" *> commaSep name)
+>            <*> option WithoutGrantOption
+>                (WithGrantOption <$ keywords_ ["with","grant","option"])
+>     role = GrantRole
+>            <$> commaSep name
+>            <*> (keyword_ "to" *> commaSep name)
+>            <*> option WithoutAdminOption
+>                (WithAdminOption <$ keywords_ ["with","admin","option"])
+
+> createRole :: Parser Statement
+> createRole = keyword_ "role" >>
+>     CreateRole <$> name
+
+> dropRole :: Parser Statement
+> dropRole = keyword_ "role" >>
+>     DropRole <$> name
+
+TODO: fix try at the 'on'
+
+> revoke :: Parser Statement
+> revoke = keyword_ "revoke" >> (try priv <|> role)
+>   where
+>     priv = RevokePrivilege
+>            <$> option NoGrantOptionFor
+>                (GrantOptionFor <$ keywords_ ["grant","option","for"])
+>            <*> commaSep privilegeAction
+>            <*> (keyword_ "on" *> privilegeObject)
+>            <*> (keyword_ "from" *> commaSep name)
+>            <*> dropBehaviour
+>     role = RevokeRole
+>            <$> option NoAdminOptionFor
+>                (AdminOptionFor <$ keywords_ ["admin","option", "for"])
+>            <*> commaSep name
+>            <*> (keyword_ "from" *> commaSep name)
+>            <*> dropBehaviour
+
+> privilegeAction :: Parser PrivilegeAction
+> privilegeAction = choice
+>     [PrivAll <$ keywords_ ["all","privileges"]
+>     ,keyword_ "select" >>
+>      PrivSelect <$> option [] (parens $ commaSep name)
+>     ,PrivDelete <$ keyword_ "delete"
+>     ,PrivUsage <$ keyword_ "usage"
+>     ,PrivTrigger <$ keyword_ "trigger"
+>     ,PrivExecute <$ keyword_ "execute"
+>     ,keyword_ "insert" >>
+>      PrivInsert <$> option [] (parens $ commaSep name)
+>     ,keyword_ "update" >>
+>      PrivUpdate <$> option [] (parens $ commaSep name)
+>     ,keyword_ "references" >>
+>      PrivReferences <$> option [] (parens $ commaSep name)
+>     ]
+
+> privilegeObject :: Parser PrivilegeObject
+> privilegeObject = choice
+>     [keyword_ "domain" >> PrivDomain <$> names
+>     ,keyword_ "type" >> PrivType <$> names
+>     ,keyword_ "sequence" >> PrivSequence <$> names
+>     ,keywords_ ["specific","function"] >> PrivFunction <$> names
+>     ,optional (keyword_ "table") >> PrivTable <$> names
+>     ]
+
+
 ----------------------------
 
 wrapper to parse a series of statements. They must be separated by

Language/SQL/SimpleSQL/Pretty.lhs

@@ -560,7 +560,7 @@ which have been changed to try to improve the layout of the output.
 >     text "drop" <+> text "view" <+> names n <+> dropBehav b
 
 
-== access control
+== transactions
 
 > statement _ StartTransaction =
 >     texts ["start", "transaction"]
@@ -578,7 +578,52 @@ which have been changed to try to improve the layout of the output.
 >     text "rollback"
 >     <+> maybe empty (\n -> texts ["to","savepoint"] <+> name n) mn
 
-== transactions
+== access control
+
+> statement _ (GrantPrivilege pas po rs go) =
+>     text "grant" <+> commaSep (map privAct pas)
+>     <+> text "on" <+> privObj po
+>     <+> text "to" <+> commaSep (map name rs)
+>     <+> grantOpt go
+>   where
+>     grantOpt WithGrantOption = texts ["with","grant","option"]
+>     grantOpt WithoutGrantOption = empty
+
+> statement _ (GrantRole rs trs ao) =
+>     text "grant" <+> commaSep (map name rs)
+>     <+> text "to" <+> commaSep (map name trs)
+>     <+> adminOpt ao
+>   where
+>     adminOpt WithAdminOption = texts ["with","admin","option"]
+>     adminOpt WithoutAdminOption = empty
+
+> statement _ (CreateRole nm) =
+>     texts ["create","role"] <+> name nm
+
+> statement _ (DropRole nm) =
+>     texts ["drop","role"] <+> name nm
+
+> statement _ (RevokePrivilege go pas po rs db) =
+>     text "revoke"
+>     <+> grantOptFor go
+>     <+> commaSep (map privAct pas)
+>     <+> text "on" <+> privObj po
+>     <+> text "from" <+> commaSep (map name rs)
+>     <+> dropBehav db
+>   where
+>     grantOptFor GrantOptionFor = texts ["grant","option","for"]
+>     grantOptFor NoGrantOptionFor = empty
+
+> statement _ (RevokeRole ao rs trs db) =
+>     text "revoke"
+>     <+> adminOptFor ao
+>     <+> commaSep (map name rs)
+>     <+> text "from" <+> commaSep (map name trs)
+>     <+> dropBehav db
+>   where
+>     adminOptFor AdminOptionFor = texts ["admin","option","for"]
+>     adminOptFor NoAdminOptionFor = empty
+
 
 == sessions
 
@@ -718,6 +763,29 @@ which have been changed to try to improve the layout of the output.
 > tableConstraint d (TableCheckConstraint v) = text "check" <+> parens (valueExpr d v)
 
 
+> privAct :: PrivilegeAction -> Doc
+> privAct PrivAll = texts ["all","privileges"]
+> privAct (PrivSelect cs) = text "select" <+> maybeColList cs
+> privAct (PrivInsert cs) = text "insert" <+> maybeColList cs
+> privAct (PrivUpdate cs) = text "update" <+> maybeColList cs
+> privAct (PrivReferences cs) = text "references" <+> maybeColList cs
+> privAct PrivDelete = text "delete"
+> privAct PrivUsage = text "usage"
+> privAct PrivTrigger = text "trigger"
+> privAct PrivExecute = text "execute"
+
+> maybeColList :: [Name] -> Doc
+> maybeColList cs =
+>     if null cs
+>     then empty
+>     else parens (commaSep $ map name cs)
+
+> privObj :: PrivilegeObject -> Doc
+> privObj (PrivTable nm) = names nm
+> privObj (PrivDomain nm) = text "domain" <+> names nm
+> privObj (PrivType nm) = text "type" <+> names nm
+> privObj (PrivSequence nm) = text "sequence" <+> names nm
+> privObj (PrivFunction nm) = texts ["specific", "function"] <+> names nm
 
 = utils
 

Language/SQL/SimpleSQL/Syntax.lhs

@@ -49,6 +49,12 @@
 >     ,AlterTableAction(..)
 >     ,CheckOption(..)
 >     ,AlterDomainAction(..)
+>     ,AdminOption(..)
+>     ,GrantOption(..)
+>     ,PrivilegeObject(..)
+>     ,PrivilegeAction(..)
+>     ,AdminOptionFor(..)
+>     ,GrantOptionFor(..)
 >      -- * Dialect
 >     ,Dialect(..)
 >      -- * Comment
@@ -458,12 +464,13 @@ I'm not sure if this is valid syntax or not.
 >   | FreeLocator
 >   | HoldLocator  -}
 >     -- access control
->   {-  | GrantPrivilege
+>   | GrantPrivilege [PrivilegeAction] PrivilegeObject [Name] GrantOption
->   | GrantRole
+>   | GrantRole [Name] [Name] AdminOption
->   | CreateRole
+>   | CreateRole Name
->   | DropRole
+>   | DropRole Name
->   | RevokePrivilege
+>   | RevokePrivilege GrantOptionFor [PrivilegeAction] PrivilegeObject
->   | RevokeRole -}
+>             [Name] DropBehaviour
+>   | RevokeRole AdminOptionFor [Name] [Name] DropBehaviour
 >     -- transaction management
 >   | StartTransaction
 >   --  | SetTransaction
@@ -642,6 +649,38 @@ I'm not sure if this is valid syntax or not.
 >     deriving (Eq,Show,Read,Data,Typeable)
 
 
+> data AdminOption = WithAdminOption | WithoutAdminOption
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data GrantOption = WithGrantOption | WithoutGrantOption
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data AdminOptionFor = AdminOptionFor | NoAdminOptionFor
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data GrantOptionFor = GrantOptionFor | NoGrantOptionFor
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data PrivilegeObject =
+>       PrivTable [Name]
+>     | PrivDomain [Name]
+>     | PrivType [Name]
+>     | PrivSequence [Name]
+>     | PrivFunction [Name]
+>     deriving (Eq,Show,Read,Data,Typeable)
+
+> data PrivilegeAction =
+>       PrivAll
+>     | PrivSelect [Name]
+>     | PrivDelete
+>     | PrivInsert [Name]
+>     | PrivUpdate [Name]
+>     | PrivReferences [Name]
+>     | PrivUsage
+>     | PrivTrigger
+>     | PrivExecute
+>     deriving (Eq,Show,Read,Data,Typeable)
+
 --------------------------
 
 > -- | Used to set the dialect used for parsing and pretty printing,

simple-sql-parser.cabal

@@ -2,11 +2,12 @@ name:                simple-sql-parser
 version:             0.5.0
 synopsis:            A parser for SQL.
 
-description:         A parser for SQL. Parses most SQL:2011
+description:
-                     queries, non-query DML, DDL, access control,
+
-                     transaction management and session management
+                     A parser for SQL. Parses most SQL:2011
-                     syntax. Please see the homepage for more
+                     queries, non-query DML, DDL, access control and
-                     information
+                     transaction management syntax. Please see the
+                     homepage for more information
                      <http://jakewheat.github.io/simple-sql-parser/latest>.
 
 homepage:            http://jakewheat.github.io/simple-sql-parser/latest

tools/Language/SQL/SimpleSQL/SQL2011AccessControl.lhs

@@ -7,9 +7,10 @@ grant, etc
 > module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
 
 > sql2011AccessControlTests :: TestItem
-> sql2011AccessControlTests = Group "sql 2011 access control tests" []
+> sql2011AccessControlTests = Group "sql 2011 access control tests" [
 
 12 Access control
 
@@ -72,11 +73,155 @@ grant, etc
     CURRENT_USER
   | CURRENT_ROLE
 
+>      (TestStatement SQL2011
+>       "grant all privileges on tbl1 to role1"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivTable [Name "tbl1"])
+>        [Name "role1"] WithoutGrantOption)
+
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on tbl1 to role1,role2"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivTable [Name "tbl1"])
+>        [Name "role1",Name "role2"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on tbl1 to role1 with grant option"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivTable [Name "tbl1"])
+>        [Name "role1"] WithGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on table tbl1 to role1"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivTable [Name "tbl1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on domain mydom to role1"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivDomain [Name "mydom"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on type t1 to role1"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivType [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant all privileges on sequence s1 to role1"
+>      $ GrantPrivilege [PrivAll]
+>        (PrivSequence [Name "s1"])
+>        [Name "role1"] WithoutGrantOption)
+
+
+>     ,(TestStatement SQL2011
+>       "grant select on table t1 to role1"
+>      $ GrantPrivilege [PrivSelect []]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant select(a,b) on table t1 to role1"
+>      $ GrantPrivilege [PrivSelect [Name "a", Name "b"]]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant delete on table t1 to role1"
+>      $ GrantPrivilege [PrivDelete]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant insert on table t1 to role1"
+>      $ GrantPrivilege [PrivInsert []]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant insert(a,b) on table t1 to role1"
+>      $ GrantPrivilege [PrivInsert [Name "a", Name "b"]]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant update on table t1 to role1"
+>      $ GrantPrivilege [PrivUpdate []]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant update(a,b) on table t1 to role1"
+>      $ GrantPrivilege [PrivUpdate [Name "a", Name "b"]]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant references on table t1 to role1"
+>      $ GrantPrivilege [PrivReferences []]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant references(a,b) on table t1 to role1"
+>      $ GrantPrivilege [PrivReferences [Name "a", Name "b"]]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant usage on table t1 to role1"
+>      $ GrantPrivilege [PrivUsage]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant trigger on table t1 to role1"
+>      $ GrantPrivilege [PrivTrigger]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+
+>     ,(TestStatement SQL2011
+>       "grant execute on specific function f to role1"
+>      $ GrantPrivilege [PrivExecute]
+>        (PrivFunction [Name "f"])
+>        [Name "role1"] WithoutGrantOption)
+
+>     ,(TestStatement SQL2011
+>       "grant select,delete on table t1 to role1"
+>      $ GrantPrivilege [PrivSelect [], PrivDelete]
+>        (PrivTable [Name "t1"])
+>        [Name "role1"] WithoutGrantOption)
+
+skipping for now:
+
+what is 'under' action?
+
+collation, character set, translation, member thing, methods
+
+for review
+
+some pretty big things missing in the standard:
+
+schema, database
+
+functions, etc., by argument types since they can be overloaded
+
+
+
 12.4 <role definition>
 
 <role definition> ::=
   CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
 
+>     ,(TestStatement SQL2011
+>       "create role rolee"
+>      $ CreateRole (Name "rolee"))
+
+
 12.5 <grant role statement>
 
 <grant role statement> ::=
@@ -88,11 +233,30 @@ grant, etc
 <role granted> ::=
   <role name>
 
+>     ,(TestStatement SQL2011
+>       "grant role1 to public"
+>      $ GrantRole [Name "role1"] [Name "public"] WithoutAdminOption)
+
+>     ,(TestStatement SQL2011
+>       "grant role1,role2 to role3,role4"
+>      $ GrantRole [Name "role1",Name "role2"]
+>                  [Name "role3", Name "role4"] WithoutAdminOption)
+
+>     ,(TestStatement SQL2011
+>       "grant role1 to role3 with admin option"
+>      $ GrantRole [Name "role1"] [Name "role3"] WithAdminOption)
+
+
 12.6 <drop role statement>
 
 <drop role statement> ::=
   DROP ROLE <role name>
 
+>     ,(TestStatement SQL2011
+>       "drop role rolee"
+>      $ DropRole (Name "rolee"))
+
+
 12.7 <revoke statement>
 
 <revoke statement> ::=
@@ -109,6 +273,20 @@ grant, etc
     GRANT OPTION FOR
   | HIERARCHY OPTION FOR
 
+
+>     ,(TestStatement SQL2011
+>       "revoke select on t1 from role1"
+>      $ RevokePrivilege NoGrantOptionFor [PrivSelect []]
+>               (PrivTable [Name "t1"])
+>               [Name "role1"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "revoke grant option for select on t1 from role1,role2 cascade"
+>      $ RevokePrivilege GrantOptionFor [PrivSelect []]
+>                        (PrivTable [Name "t1"])
+>               [Name "role1",Name "role2"] Cascade)
+
+
 <revoke role statement> ::=
   REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]
       FROM <grantee> [ { <comma> <grantee> }... ]
@@ -117,3 +295,21 @@ grant, etc
 
 <role revoked> ::=
   <role name>
+
+>     ,(TestStatement SQL2011
+>       "revoke role1 from role2"
+>      $ RevokeRole NoAdminOptionFor [Name "role1"]
+>                   [Name "role2"] DefaultDropBehaviour)
+
+>     ,(TestStatement SQL2011
+>       "revoke role1,role2 from role3,role4"
+>      $ RevokeRole NoAdminOptionFor [Name "role1",Name "role2"]
+>                   [Name "role3",Name "role4"] DefaultDropBehaviour)
+
+
+>     ,(TestStatement SQL2011
+>       "revoke admin option for role1 from role2 cascade"
+>      $ RevokeRole AdminOptionFor [Name "role1"] [Name "role2"] Cascade)
+
+
+>    ]

website/index.asciidoc

@@ -65,8 +65,6 @@ link:https://github.com/JakeWheat/intro_to_parsing/blob/master/SimpleSQLQueryPar
 ** TODO
 * Transaction management
 ** TODO
-* Session management
-** TODO
 
 See the link:supported_sql.html[] page for details on
 the supported SQL.

website/supported_sql.asciidoc

@@ -14,11 +14,11 @@ See the link:test_cases.html[simple-sql-parser test cases] page for
 examples.
 
 The target dialect of SQL at this time is ISO/ANSI SQL:2011. The
-parser supports queries, DDL, non-query DML, access control, transaction
+parser supports queries, DDL, non-query DML, access control and
-management and session management syntax. The parser and syntax does
+transaction management syntax. The parser and syntax does not follow
-not follow the standard grammar closely - they permit a lot of things
+the standard grammar closely - they permit a lot of things which the
-which the grammar in the standard forbids. The intended usage is that
+grammar in the standard forbids. The intended usage is that an
-an additional pass over the ast can be made if you want to carefully
+additional pass over the ast can be made if you want to carefully
 prohibit everything that the standard doesn't allow.
 
 Apart from this permissiveness, some work has been put into trying to
@@ -154,7 +154,3 @@ todo
 == Transaction management
 
 todo
-
-== Session management
-
-todo