diff --git a/desks/realm/app/bedrock.hoon b/desks/realm/app/bedrock.hoon index ce37b057d7..818a56f9de 100644 --- a/desks/realm/app/bedrock.hoon +++ b/desks/realm/app/bedrock.hoon @@ -46,13 +46,18 @@ ++ on-load |= old-state=vase ^- (quip card _this) - =/ old !<(versioned-state old-state) + ::=/ old !<(versioned-state old-state) + :: REMOVE WHEN YOU WANT DATA TO ACTUALLY STICK AROUND + =/ default-state=state-0 *state-0 + :: make sure the relay table exists on-init + =. tables.default-state + (~(gas by *^tables) ~[[%relay *pathed-table] [%vote *pathed-table] [%react *pathed-table]]) :: do a quick check to make sure we are subbed to /updates in %spaces =/ cards ?: (~(has by wex.bowl) [/spaces our.bowl %spaces]) ~ [%pass /spaces %agent [our.bowl %spaces] %watch /updates]~ - [cards this(state old)] + [cards this(state default-state)] :: ++ on-poke |= [=mark =vase] @@ -264,7 +269,7 @@ ~& > "{}: /next/[path] kicked us, resubbing {(spud newpath)}" :_ this :~ - [%pass wire %agent [src.bowl %db] %watch newpath] + [%pass wire %agent [src.bowl dap.bowl] %watch newpath] == %fact :: handle the update by updating our local state and diff --git a/desks/realm/lib/db.hoon b/desks/realm/lib/db.hoon index 88befa56e9..b87d925092 100644 --- a/desks/realm/lib/db.hoon +++ b/desks/realm/lib/db.hoon @@ -16,12 +16,17 @@ ++ get-db |= [=type:common =path =id:common state=state-0] ^- (unit row) - =/ ptbl (~(get by tables.state) type) - ?~ ptbl ~ - =/ tbl (~(get by u.ptbl) path) + =/ tbl (get-tbl type path state) ?~ tbl ~ (~(get by u.tbl) id) :: +++ get-tbl + |= [=type:common =path state=state-0] + ^- (unit table) + =/ ptbl (~(get by tables.state) type) + ?~ ptbl ~ + (~(get by u.ptbl) path) +:: ++ del-db |= [=type:common =path =id:common state=state-0 t=@da] ^- state-0 @@ -48,7 +53,59 @@ %relay &(=(id.data.rel id.r) =(ship.id.rel our.bowl)) == - +:: +++ meets-constraints + |= [=path-row =row state=state-0 =bowl:gall] + ^- ? + =/ tbl=(unit table) (get-tbl type.row path.path-row state) + ?~ tbl %.y :: there's nothing in this table, so any row we add is unique along all possible columns + =/ uconst=(unit constraint) (~(get by constraints.path-row) type.row) + =/ const=(unit constraint) + ?~ uconst (~(get by default-constraints) type.row) + uconst + ?~ const %.y :: there is neither a defined-constraint nor a default-constraint, thus this "meets constraints" + %- ~(all in uniques.u.const) + |= cols=unique-columns + ^- ? + =/ where=(list [column-accessor *]) + %+ turn + ~(tap in cols) + |= ca=column-accessor + :- ca + (snag-val-from-row ca row) + =/ matches=(list ^row) (find-from-where u.tbl where) + ?~ matches %.y + %.n +:: +++ find-from-where + |= [tbl=table conds=(list [i=column-accessor v=*])] + ^- (list row) + %+ skim + ~(val by tbl) + |= r=row + %+ levy + conds + |= cond=[i=column-accessor v=*] + =(v.cond (snag-val-from-row i.cond r)) +:: +++ snag-val-from-row + |= [i=column-accessor r=row] + ?@ i (snag-by-index i +.data.r) + ?: =(i "ship.id") ship.id.r + ?: =(i "t.id") t.id.r + ?: =(i "v") v.r + ?: =(i "created-at") created-at.r + ?: =(i "updated-at") updated-at.r + ?: =(i "received-at") received-at.r + !! :: unsupported name +:: +++ snag-by-index + |= [i=@ r=*] + |- + ?@ r !! + ?: =(0 i) -:r + $(r +:r, i (dec i)) +:: ++ has-create-permissions |= [=path-row =row state=state-0 =bowl:gall] ^- ? @@ -115,12 +172,12 @@ ++ get-path-card |= [=ship =path-row peers=ship-roles] ^- card - [%pass /dbpoke %agent [ship %db] %poke %db-action !>([%get-path path-row peers])] + [%pass /dbpoke %agent [ship %bedrock] %poke %db-action !>([%get-path path-row peers])] :: ++ delete-path-card |= [=ship =path] ^- card - [%pass /dbpoke %agent [ship %db] %poke %db-action !>([%delete-path path])] + [%pass /dbpoke %agent [ship %bedrock] %poke %db-action !>([%delete-path path])] :: ++ del-path-in-tables |= [state=state-0 =path] @@ -454,12 +511,10 @@ :: tests: ::bedrock &db-action [%create-path /example %host ~ ~ ~ ~[[~zod %host] [~bus %member]]] ::bedrock &db-action [%add-peer /example ~fed %member] -::bedrock &db-action [%create /example %foo 0 [%general ~[1 'a']] ~[['num' 'ud'] ['str' 't']]] -::bedrock &db-action [%create /example %vote 0 [%vote [%.y our %foo [our now] /example]] ~] +::bedrock &db-action [%create [~zod now] /example %foo 0 [%general ~[1 'a']] ~[['num' 'ud'] ['str' 't']]] +::bedrock &db-action [%create [~zod now] /example %vote 0 [%vote [%.y %foo [~zod ~2023.6.21..22.25.01..e411] /example]] ~] :: from ~bus: -::~zod/bedrock &db-action [%create /example %vote 0 [%vote %.y our %foo [~zod now] /example] ~] -::bedrock &db-action [%edit /example [our ~2023.5.22..20.15.47..86fe] %foo 0 [%general ~[2 'b']] *@da *@da *@da] -::bedrock &db-action [%remove %foo /example [our ~2023.5.22..20.15.47..86fe]] +::~zod/bedrock &db-action [%create /example %foo 0 [%general ~[1 'a']] ~[['num' 'ud'] ['str' 't']]] :: :: in zod ::bedrock &db-action [%create-path /example %host ~ ~ ~ ~[[~zod %host] [~bus %member]]] @@ -709,7 +764,7 @@ =/ path-sub-wire (weld /next/(scot %da updated-at.path-row) path) =/ cards=(list card) :~ :: poke %delete-path to the ship we are kicking - [%pass /dbpoke %agent [ship %db] %poke %db-action !>([%delete-path path])] + [%pass /dbpoke %agent [ship %bedrock] %poke %db-action !>([%delete-path path])] :: tell subs that we deleted `ship` [%give %fact [/db (weld /path path) path-sub-wire ~] db-changes+!>([%del-peer path ship now.bowl]~)] :: kick subs to force them to re-sub for next update @@ -732,6 +787,7 @@ ++ get-path |= [[=path-row peers=ship-roles] state=state-0 =bowl:gall] ^- (quip card state-0) + ~& "%get-path {}" :: ensure the path doesn't already exist =/ pre-existing (~(get by paths.state) path.path-row) ?> =(~ pre-existing) @@ -772,7 +828,7 @@ %pass (weld /next path.path-row) %agent - [src.bowl %db] + [src.bowl dap.bowl] %watch (weld /next/(scot %da updated-at.path-row) path.path-row) ] @@ -814,6 +870,8 @@ ::~zod/bedrock &db-action [%create /example %vote 0 [%vote %.y our %foo [~zod now] /example] ~] |= [[=req-id =input-row] state=state-0 =bowl:gall] ^- (quip card state-0) + =/ vent-path=path /vent/(scot %p src.req-id)/(scot %da now.req-id) + =/ kickcard=card [%give %kick ~[vent-path] ~] :: form row from input =/ row=row [ path.input-row @@ -830,12 +888,16 @@ =/ path-row=path-row (~(got by paths.state) path.row) ?. (has-create-permissions path-row row state bowl) ~& >>> "{(scow %p src.bowl)} tried to create a %{(scow %tas type.row)} row where they didn't have permissions" - `state + [~[kickcard] state] :: forward the request if we aren't the host ?. =(host.path-row our.bowl) ~& >> "{} tried to have us ({}) create a row in {} where we are not the host. forwarding the poke to the host: {}" :_ state - [%pass /dbpoke %agent [host.path-row %db] %poke %db-action !>([%create req-id input-row])]~ + [%pass /dbpoke %agent [host.path-row dap.bowl] %poke %db-action !>([%create req-id input-row])]~ + :: ensure that the row meets constraints + ?. (meets-constraints path-row row state bowl) + ~& >>> "{(scow %p src.bowl)} tried to create a %{(scow %tas type.row)} row where they violated constraints" + [~[kickcard] state] :: update path =/ path-sub-wire (weld /next/(scot %da updated-at.path-row) path.row) @@ -846,15 +908,14 @@ =. state (add-row-to-db row schema.input-row state) :: emit the change to subscribers - =/ vent-path=path /vent/(scot %p src.req-id)/(scot %da now.req-id) =/ cards=(list card) :~ :: tell subs about the new row [%give %fact [/db (weld /path path.row) path-sub-wire ~] db-changes+!>([%add-row row schema.input-row]~)] :: kick subs to force them to re-sub for next update [%give %kick [path-sub-wire ~] ~] :: give vent response - [%give %fact ~[vent-path] db-vent+!>([%row-id id.row])] - [%give %kick ~[vent-path] ~] + [%give %fact ~[vent-path] db-vent+!>([%row row schema.input-row])] + kickcard == ~& > "publishing new row to {(spud path-sub-wire)} (and also kicking)" @@ -864,7 +925,7 @@ :: generally, you'd only bother passing the schema if you are changing the version of the row ::db &db-action [%edit [our ~2023.5.22..17.21.47..9d73] /example %foo 0 [%general ~[2 'b']] ~] |= [[=id:common =input-row] state=state-0 =bowl:gall] - ~& "%db agent - %edit poke" + ~& "%bedrock agent - %edit poke" ^- (quip card state-0) :: permissions =/ old-row (~(got by (~(got by (~(got by tables.state) type.input-row)) path.input-row)) id) :: old row must first exist @@ -876,7 +937,7 @@ ?. =(host.path-row our.bowl) ~& >> "{} tried to have us ({}) edit a row in {} where we are not the host. forwarding the poke to the host: {}" :_ state - [%pass /dbpoke %agent [host.path-row %db] %poke %db-action !>([%edit id input-row])]~ + [%pass /dbpoke %agent [host.path-row dap.bowl] %poke %db-action !>([%edit id input-row])]~ :: schema checking =/ sch=schema @@ -932,7 +993,7 @@ ?. =(host.path-row our.bowl) ~& >> "{} tried to have us ({}) remove a row in {} where we are not the host. forwarding the poke to the host: {}" :_ state - [%pass /dbpoke %agent [host.path-row %db] %poke %db-action !>([%remove type path id])]~ + [%pass /dbpoke %agent [host.path-row dap.bowl] %poke %db-action !>([%remove type path id])]~ :: update path =/ foreign-ship-sub-wire (weld /next/(scot %da updated-at.path-row) path) @@ -965,6 +1026,7 @@ ::bedrock &db-action [%relay [~bus now] /target %relay 0 [%relay [~zod ~2023.6.13..15.57.34..aa97] %foo /example 0 %all %.n] ~] |= [[=req-id =input-row] state=state-0 =bowl:gall] ^- (quip card state-0) + ~& %relay :: first check that the input is actually a %relay ?+ -.data.input-row !! %relay @@ -1049,6 +1111,7 @@ [%create de-create-input-row] [%edit (ot ~[[%id de-id] [%input-row de-input-row]])] [%remove remove] + [%relay de-create-input-row] == :: ++ de-create-input-row @@ -1318,8 +1381,8 @@ |= =vent ^- json ?- -.vent - %ack s/%ack - %row-id (frond row-id+(row-id-to-json id.vent)) + %ack s/%ack + %row (en-row row.vent (~(put by *schemas) [type.row.vent v.row.vent] schema.vent)) == :: ++ en-db-changes @@ -1520,7 +1583,9 @@ ['revision' (numb revision.data.row)] == == - =/ keyvals (weld basekvs dynamickvs) + =/ keyvals + :_ basekvs + data+(pairs dynamickvs) (pairs keyvals) :: ++ en-path-row diff --git a/desks/realm/sur/common.hoon b/desks/realm/sur/common.hoon index 457a9b2a5b..c17c17d329 100644 --- a/desks/realm/sur/common.hoon +++ b/desks/realm/sur/common.hoon @@ -17,10 +17,10 @@ :: like/dislike upvote/downvote +$ vote - $: up=? :: true for like/upvote, false for dislike/downvote - parent-type=type :: table name of the thing this vote is attached to - parent-id=id :: id of the thing this vote is attached to - parent-path=path + $: up=? :: true for like/upvote, false for dislike/downvote 0 -> 2 + parent-type=type :: table name of the thing this vote is attached to 1 -> 6 + parent-id=id :: id of the thing this vote is attached to 2 -> 14 + parent-path=path :: 3 -> 30 == :: 5 star rating, 100% scoring, etc diff --git a/desks/realm/sur/db.hoon b/desks/realm/sur/db.hoon index 4d5d038199..5aa9835309 100644 --- a/desks/realm/sur/db.hoon +++ b/desks/realm/sur/db.hoon @@ -61,7 +61,7 @@ =replication default-access=access-rules :: for everything not found in the table-access =table-access :: allows a path to specify role-based access rules on a per-table basis - =constraints + =constraints :: if there is not a constraint rule for a given type, the default constraints for types will be applied space=(unit [=path =role:membership]) :: if the path-row is created from a space, record the info created-at=@da updated-at=@da @@ -74,11 +74,19 @@ +$ permission-scope ?(%table %own %none) :: by default the host can CED everything and everyone else can CED the objects they created ++ default-access-rules (~(gas by *access-rules) ~[[%host [%.y %table %table]] [%$ [%.y %own %own]]]) -+$ constraints (set constraint) ++$ constraints (map type:common constraint) +$ constraint [=type:common =uniques =check] +$ uniques (set unique-columns) :: the various uniqueness rules that must all be true -+$ unique-columns (set @t) :: names of columns that taken together must be unique in the table+path ++$ unique-columns (set column-accessor) :: names of columns that taken together must be unique in the table+path +$ check ~ :: I want check to be the mold for a gate that takes in a row and produces %.y or %.n, which will allow applications to specify arbitrary check functions to constrain their data +++ default-vote-constraint [%vote (silt ~[(~(gas in *unique-columns) ~[1 2 3 "ship.id"])]) ~] +++ default-rating-constraint [%rating (silt ~[(~(gas in *unique-columns) ~[3 4 5 "ship.id" 2])]) ~] +++ default-constraints + %- ~(gas by *constraints) + :~ [%vote default-vote-constraint] + [%rating default-rating-constraint] + == ++$ column-accessor ?(@ud tape) :: used for dumping the current state of every row on a given path +$ fullpath $: =path-row @@ -168,7 +176,7 @@ +$ req-id [src=ship now=@da] :: the request-id, used for threads and venting :: +$ vent - $% [%row-id =id:common] + $% [%row =row =schema] [%ack ~] == -- diff --git a/desks/realm/ted/venter.hoon b/desks/realm/ted/venter.hoon index ec0d1f3e03..44ca41f24b 100644 --- a/desks/realm/ted/venter.hoon +++ b/desks/realm/ted/venter.hoon @@ -12,24 +12,38 @@ ^- form:m =/ axn=(unit action:db) !<((unit action:db) arg) ?~ axn (strand-fail %no-arg ~) -?. ?=(%create -.u.axn) (strand-fail %bad-action ~) +?. |(?=(%create -.u.axn) ?=(%relay -.u.axn)) (strand-fail %bad-action ~) ;< our=@p bind:m get-our ;< now=@da bind:m get-time -=/ data-path=path path.input-row.u.axn +=/ data-path=?(path ~) + ?+ -.u.axn ~ + %create path.input-row.u.axn + %relay path.input-row.u.axn + == +?~ data-path (strand-fail %type-not-create-or-relay ~) =/ scry-path=wire %+ weld - /gx/db/host/path + /gx/bedrock/host/path %+ weld data-path /noun =/ =wire /vent/(scot %p our)/(scot %da now) ;< host=ship bind:m (scry ship scry-path) -;< ~ bind:m (watch wire [host %db] wire) -;< ~ bind:m (poke [host %db] db-action+!>([%create [our now] +>.u.axn])) -;< cage=(unit cage) bind:m (take-fact-or-kick wire) -?^ cage - (pure:m q.u.cage) -(pure:m !>([%ack ~])) +;< ~ bind:m (watch wire [host %bedrock] wire) +?+ -.u.axn (strand-fail %type-not-create-or-relay ~) + %create + ;< ~ bind:m (poke [host %bedrock] db-action+!>([%create [our now] +>.u.axn])) + ;< cage=(unit cage) bind:m (take-fact-or-kick wire) + ?^ cage + (pure:m q.u.cage) + (pure:m !>([%ack ~])) + %relay + ;< ~ bind:m (poke [host %bedrock] db-action+!>([%relay [our now] +>.u.axn])) + ;< cage=(unit cage) bind:m (take-fact-or-kick wire) + ?^ cage + (pure:m q.u.cage) + (pure:m !>([%ack ~])) +== :: ++ take-fact-or-kick |= =wire