grant permission single ship

docs/permissions.md

@@ -1,17 +1,9 @@
 ```
-GRANT { ADMINREAD TO { PARENT | SIBLINGS | MOONS | <@p> [ ,...n ] }
+GRANT { ADMINREAD | READONLY | READWRITE } 
-        | READONLY TO { PARENT | SIBLINGS | MOONS | <@p> [ ,...n ] }
+         TO { PARENT | SIBLINGS | MOONS | <@p> [ ,...n ] }
-          <grant-target>
+         ON { DATABASE <database-name>
-        | READWRITE TO { PARENT | SIBLINGS | MOONS }
+              | NAMESPACE [<database-name>]<namespace-name>
-          <grant-target>
+              | [<db-qualifer>]{<view-name> | <table-name> }
-       }
-```
-
-```
-<grant-target> ::=
-  ON { <database-name>
-       | [<database-name>]<namespace-name>
-       | { [<db-qualifer>]<view-name> | [<db-qualifer>]<table-name> }
 ```
 
 Example:

urql/lib/parse.hoon

@@ -12,6 +12,7 @@
     drop-namespace:ast
     drop-table:ast
     drop-view:ast
+    grant:ast
     truncate-table:ast
   ==
 +$  command
@@ -26,6 +27,7 @@
     %drop-namespace
     %drop-table
     %drop-view
+    %grant
     %truncate-table
   ==
 ::
@@ -85,6 +87,11 @@
   ?:  ?=([@ %~] a)                                            :: name
     (qualified-object:ast %qualified-object ~ current-database 'dbo' `@t`-.a)
   !!
+++  qualified-namespace
+  |=  [a=* current-database=@t]
+  ?:  ?=([@ @] [a])
+    a
+  [current-database a]
 ::
 ::  parse urQL script
 ::
@@ -126,6 +133,7 @@
       (cold %drop-namespace ;~(plug whitespace (jester 'drop') whitespace (jester 'namespace')))
       (cold %drop-table ;~(plug whitespace (jester 'drop') whitespace (jester 'table')))
       (cold %drop-view ;~(plug whitespace (jester 'drop') whitespace (jester 'view')))
+      (cold %grant ;~(plug whitespace (jester 'grant')))
       (cold %truncate-table ;~(plug whitespace (jester 'truncate') whitespace (jester 'table')))
 ::      (cold  ;~(plug whitespace (jester '') whitespace (jester '')))
       ==
@@ -289,6 +297,57 @@
             [`command-ast`(drop-view:ast %drop-view parsed %.n) commands]
         ==
       !!
+    %grant
+      =/  permission
+            ;~(pfix whitespace ;~(pose (jester 'adminread') (jester 'readonly') (jester 'readwrite')))
+      =/  grantee
+            ;~(pose (jester 'parent') (jester 'siblings') (jester 'moons') (stag %ship parse-ship)) 
+      =/  parse-grantee
+            ;~(pfix whitespace ;~(pfix (jester 'to') ;~(pfix whitespace grantee)))
+      =/  on-database  ;~(plug (jester 'database') parse-face)
+      =/  on-namespace
+            ;~(plug (jester 'namespace') (cook |=(a=* (qualified-namespace [a current-database])) parse-qualified-2-name))
+      =/  grant-object
+            ;~(pfix whitespace ;~(pfix (jester 'on') ;~(pfix whitespace ;~(pose on-database on-namespace parse-qualified-3object))))
+      =/  parse-grant  ;~  plug
+            permission
+            parse-grantee
+            ;~(sfix grant-object end-or-next-command)
+            ==
+      ~|  "Cannot parse grant {<p.q.command-nail>}"   
+      =/  grant-nail  (parse-grant [[1 1] q.q.command-nail])
+      =/  parsed  (wonk grant-nail)
+      =/  next-cursor  
+        (get-next-cursor [script-position +<.command-nail p.q.u.+3:q.+3:grant-nail])
+      ?:  ?=([@ [@ @] [@ @]] [parsed])    ::"grant adminread to ~sampel-palnet on database db"
+        %=  $                             
+          script           q.q.u.+3.q:grant-nail
+          script-position  next-cursor
+          commands         
+            [`command-ast`(grant:ast %grant -.parsed (limo ~[+<+.parsed]) +>.parsed) commands]
+        ==
+      ?:  ?=([@ @ [@ @]] [parsed])                  ::"grant adminread to parent on database db"
+        %=  $                             
+          script           q.q.u.+3.q:grant-nail
+          script-position  next-cursor
+          commands         
+            [`command-ast`(grant:ast %grant -.parsed +<.parsed +>.parsed) commands]
+        ==
+      ?:  ?=([@ [@ @] [@ *]] [parsed])              ::"grant Readwrite to ~sampel-palnet on namespace db.ns"
+        %=  $                                       ::"grant adminread to ~sampel-palnet on namespace ns" (ns previously cooked) 
+          script           q.q.u.+3.q:grant-nail    ::"grant Readwrite to ~sampel-palnet on db.ns.table"
+          script-position  next-cursor
+          commands         
+            [`command-ast`(grant:ast %grant -.parsed (limo ~[+<+.parsed]) +>.parsed) commands]
+        ==
+      ?:  ?=([@ @ [@ [@ *]]] [parsed])        ::"grant readonly to siblings on namespace db.ns"
+        %=  $                                 ::"grant readwrite to moons on namespace ns" (ns previously cooked) 
+          script           q.q.u.+3.q:grant-nail
+          script-position  next-cursor
+          commands         
+            [`command-ast`(grant:ast %grant -.parsed +<.parsed +>.parsed) commands]
+        ==
+      !!
     %truncate-table
       =/  parse-truncate-table  ;~  sfix
             ;~(pfix whitespace parse-qualified-object)

urql/sur/ast.hoon

@@ -333,14 +333,13 @@
 ::
 +$  grant-permission     ?(%adminread %readonly %readwrite)
 +$  grantee              ?(%parent %siblings %moons (list @p))
++$  grant-object         ?([%database @t] [%namespace [@t @t]] qualified-object)
 +$  grant
   $:
     %grant
     permission=grant-permission
     to=grantee
-    database=(unit @t)
+    grant-target=grant-object               :: because table or view
-    namespace=(unit @t)
-    object=(unit qualified-object)               :: because table or view
   ==
 +$  grant-permission-all  ?(%adminread %readonly %readwrite %all)
 +$  grantee-all           ?(%parent %siblings %moons %all (list @p))

urql/tests/lib/parse.hoon

@@ -228,7 +228,7 @@
 :: fail when table name is qualified with ship
 ++  test-drop-table-11
   %-  expect-fail
-  |.  (parse:parse(current-database 'other-db') "DROP table ~zod.db.ns.nAme")
+  |.  (parse:parse(current-database 'other-db') "DROP table ~zod.db.ns.name")
 ::
 :: drop view
 ::
@@ -294,7 +294,98 @@
 :: fail when view name is qualified with ship
 ++  test-drop-view-11
   %-  expect-fail
-  |.  (parse:parse(current-database 'other-db') "DROP view ~zod.db.ns.nAme")
+  |.  (parse:parse(current-database 'other-db') "DROP view ~zod.db.ns.name")
+::
+:: grant permission
+::
+:: tests 1, 2, 3, 5, and extra whitespace characters, ship-database, parent-database
+++  test-grant-1
+  =/  expected1  [%grant permission=%adminread to=~[~sampel-palnet] grant-target=[%database 'db']]
+  =/  expected2  [%grant permission=%adminread to=%parent grant-target=[%database 'db']]
+  %+  expect-eq
+    !>  ~[expected1 expected2]
+    !>  (parse:parse(current-database 'other-db') "grant  adminread\0a tO \0d ~sampel-palnet on\0a database  db;Grant adminRead to paRent on dataBase db")
+::
+:: leading and trailing whitespace characters, end delimiter not required on single, ship-qualified-ns
+++  test-grant-2
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=~[~sampel-palnet] grant-target=[%namespace 'db' 'ns']]]
+    !>  (parse:parse(current-database 'db2') "   \09Grant Readwrite   to ~sampel-palnet on namespace db.ns ")
+::
+:: ship unqualified ns
+++  test-grant-3
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=~[~sampel-palnet] grant-target=[%namespace 'db2' 'ns']]]
+    !>  (parse:parse(current-database 'db2') "Grant Readwrite to ~sampel-palnet on namespace ns")
+::
+:: siblings qualified ns
+++  test-grant-4
+  %+  expect-eq
+    !>  ~[[%grant permission=%readonly to=%siblings grant-target=[%namespace 'db' 'ns']]]
+    !>  (parse:parse(current-database 'db2') "grant readonly to SIBLINGS on namespace db.ns")
+::
+:: moons unqualified ns
+++  test-grant-5
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=%moons grant-target=[%namespace 'db2' 'ns']]]
+    !>  (parse:parse(current-database 'db2') "Grant Readwrite to moonS on namespace ns")
+::
+:: ship db.ns.table
+++  test-grant-6
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=~[~sampel-palnet] grant-target=[%qualified-object ship=~ database='db' namespace='ns' name='table']]]
+    !>  (parse:parse(current-database 'db2') "Grant Readwrite to ~sampel-palnet on db.ns.table")
+::
+:: parent db.ns.table
+++  test-grant-7
+  %+  expect-eq
+    !>  ~[[%grant permission=%adminread to=%parent grant-target=[%qualified-object ship=~ database='db' namespace='ns' name='table']]]
+    !>  (parse:parse(current-database 'db2') "grant adminread to parent on db.ns.table")
+::
+:: ship db..table
+++  test-grant-8
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=~[~sampel-palnet] grant-target=[%qualified-object ship=~ database='db' namespace='dbo' name='table']]]
+    !>  (parse:parse(current-database 'db2') "Grant Readwrite to ~sampel-palnet on db..table")
+::
+:: parent on db..table
+++  test-grant-9
+  %+  expect-eq
+    !>  ~[[%grant permission=%adminread to=%parent grant-target=[%qualified-object ship=~ database='db' namespace='dbo' name='table']]]
+    !>  (parse:parse(current-database 'db2') "grant adminread to parent on db..table")
+::
+:: ship table
+++  test-grant-10
+  %+  expect-eq
+    !>  ~[[%grant permission=%readwrite to=~[~sampel-palnet] grant-target=[%qualified-object ship=~ database='db2' namespace='dbo' name='table']]]
+    !>  (parse:parse(current-database 'db2') "Grant Readwrite to ~sampel-palnet on table")
+::
+:: parent table
+++  test-grant-11
+  %+  expect-eq
+    !>  ~[[%grant permission=%adminread to=%parent grant-target=[%qualified-object ship=~ database='db2' namespace='dbo' name='table']]]
+    !>  (parse:parse(current-database 'db2') "grant adminread to parent on table")
+::
+:: fail when database qualifier is not a term
+++  test-grant-12
+  %-  expect-fail
+  |.  (parse:parse(current-database 'db2') "grant adminread to parent on Db.ns.table")
+::
+:: fail when namespace qualifier is not a term
+++  test-grant-13
+  %-  expect-fail
+  |.  (parse:parse(current-database 'db2') "grant adminread to parent on db.Ns.table")
+::
+:: fail when table name is not a term
+++  test-grant-14
+  %-  expect-fail
+  |.  (parse:parse(current-database 'other-db') "grant adminread to parent on Table")
+::
+:: fail when table name is qualified with ship
+++  test-grant-15
+  %-  expect-fail
+  |.  (parse:parse(current-database 'other-db') "DROP view ~zod.db.ns.name")
+::
 ::
 :: truncate table
 ::