/+ store=graph-store, sigs=signatures, default-agent, dbug ~% %graph-store-top ..is ~ |% +$ card card:agent:gall +$ versioned-state $% state-0 == +$ state-0 [%0 network:store] ++ orm orm:store ++ orm-log orm-log:store -- :: =| state-0 =* state - :: %- agent:dbug ^- agent:gall ~% %graph-store-agent ..card ~ |_ =bowl:gall +* this . def ~(. (default-agent this %|) bowl) :: ++ on-init [~ this] ++ on-save !>(state) ++ on-load |= old=vase ^- (quip card _this) [~ this(state !<(state-0 old))] :: ++ on-poke ~/ %graph-store-poke |= [=mark =vase] ^- (quip card _this) |^ ?> (team:title our.bowl src.bowl) =^ cards state ?+ mark (on-poke:def mark vase) %graph-action (graph-action !<(action:store vase)) %json (graph-action (action:dejs:store !<(json vase))) == [cards this] :: ++ graph-action |= =action:store ^- (quip card _state) |^ ?> ?=(%0 -.action) ?- +<.action %add-graph (add-graph +>.action) %remove-graph (remove-graph +>.action) %add-nodes (add-nodes +>.action) %remove-nodes (remove-nodes +>.action) %add-signatures (add-signatures +>.action) %remove-signatures (remove-signatures +>.action) %add-tag (add-tag +>.action) %remove-tag (remove-tag +>.action) == :: ++ add-graph |= [=resource:store =graph:store] ^- (quip card _state) ?< (~(has by graphs) resource) :- (give [/updates /keys ~] [%add-graph resource graph]) %_ state graphs (~(put by graphs) resource graph) action-logs (~(put by action-logs) resource (gas:orm-log ~ ~)) == :: ++ remove-graph |= =resource:store ^- (quip card _state) ?> (~(has by graphs) resource) :- (give [/updates /keys ~] [%remove-graph resource]) %_ state graphs (~(del by graphs) resource) action-logs (~(del by action-logs) resource) == :: ++ add-nodes |= [=resource:store nodes=(map index:store node:store)] ^- (quip card _state) |^ =/ =graph:store (~(got by graphs) resource) =/ =action-log:store (~(got by action-logs) resource) =. action-log (put:orm-log action-log now.bowl [%0 [%add-nodes resource nodes]]) :: :- (give [/updates]~ [%add-nodes resource nodes]) %_ state action-logs (~(put by action-logs) resource action-log) graphs %+ ~(put by graphs) resource (add-node-list resource graph ~(tap by nodes)) == :: ++ add-node-list |= $: =resource:store =graph:store node-list=(list [index:store node:store]) == ^- graph:store ?~ node-list graph =* index -.i.node-list =* node +.i.node-list %_ $ node-list t.node-list graph (add-node-at-index graph index node ~) == :: ++ add-node-at-index |= $: =graph:store =index:store =node:store parent-hash=(unit hash:store) == ^- graph:store ?~ index graph =* atom i.index %^ put:orm graph atom :: add child :: ?~ t.index =* p post.node =/ =validated-portion:store [parent-hash author.p index.p time-sent.p contents.p] =/ =hash:store (mug validated-portion) ?~ hash.p node ~| "hash of post does not match calculated hash" ?> =(hash u.hash.p) node :: recurse children :: ~| "index does not exist to add a node to!" =/ parent=node:store (need (get:orm graph atom)) %_ parent children ^- internal-graph:store :- %graph %_ $ index t.index parent-hash hash.post.parent graph ?: ?=(%graph -.children.parent) p.children.parent (gas:orm ~ ~) == == -- :: ++ remove-nodes |= [=resource:store indices=(set index:store)] ^- (quip card _state) |^ =/ =graph:store (~(got by graphs) resource) =/ =action-log:store (~(got by action-logs) resource) =. action-log (put:orm-log action-log now.bowl [%0 [%remove-nodes resource indices]]) :: :- (give [/updates]~ [%remove-nodes resource indices]) %_ state action-logs (~(put by action-logs) resource action-log) graphs %+ ~(put by graphs) resource (remove-indices resource graph ~(tap in indices)) == :: ++ remove-indices |= [=resource:store =graph:store indices=(list index:store)] ^- graph:store ?~ indices graph %_ $ indices t.indices graph (remove-index graph i.indices) == :: ++ remove-index |= [=graph:store =index:store] ^- graph:store ?~ index graph =* atom i.index :: last index in list :: ?~ t.index +:`[* graph:store]`(del:orm graph atom) ~| "parent index does not exist to remove a node from!" =/ =node:store (need (get:orm graph atom)) ~| "child index does not exist to remove a node from!" ?> ?=(%graph -.children.node) %^ put:orm graph atom node(p.children $(graph p.children.node, index t.index)) -- :: ++ add-signatures |= [=uid:store =signatures:store] ^- (quip card _state) |^ =* resource resource.uid =/ =graph:store (~(got by graphs) resource) =/ =action-log:store (~(got by action-logs) resource) =. action-log (put:orm-log action-log now.bowl [%0 [%add-signatures uid signatures]]) :: :- (give [/updates]~ [%add-signatures uid signatures]) %_ state action-logs (~(put by action-logs) resource action-log) graphs (~(put by graphs) resource (add-at-index graph index.uid signatures)) == :: ++ add-at-index |= [=graph:store =index:store =signatures:store] ^- graph:store ?~ index graph =* atom i.index ~| "node does not exist to add signatures to!" =/ =node:store (need (get:orm graph atom)) :: last index in list :: %^ put:orm graph atom ?~ t.index ~| "cannot add signatures to a node missing a hash" ?> ?=(^ hash.post.node) ~| "signatures did not match public keys!" ?> (are-signatures-valid:sigs signatures u.hash.post.node now.bowl) node(signatures.post (~(uni in signatures) signatures.post.node)) ~| "child graph does not exist to add signatures to!" ?> ?=(%graph -.children.node) node(p.children $(graph p.children.node, index t.index)) -- :: ++ remove-signatures |= [=uid:store =signatures:store] ^- (quip card _state) |^ =* resource resource.uid =/ =graph:store (~(got by graphs) resource) =/ =action-log:store (~(got by action-logs) resource) =. action-log %^ put:orm-log action-log now.bowl [%0 [%remove-signatures uid signatures]] :: :- (give [/updates]~ [%remove-signatures uid signatures]) %_ state action-logs (~(put by action-logs) resource action-log) graphs %+ ~(put by graphs) resource (remove-at-index graph index.uid signatures) == :: ++ remove-at-index |= [=graph:store =index:store =signatures:store] ^- graph:store ?~ index graph =* atom i.index ~| "node does not exist to add signatures to!" =/ =node:store (need (get:orm graph atom)) :: last index in list :: %^ put:orm graph atom ?~ t.index node(signatures.post (~(dif in signatures) signatures.post.node)) ~| "child graph does not exist to add signatures to!" ?> ?=(%graph -.children.node) node(p.children $(graph p.children.node, index t.index)) -- :: ++ add-tag |= [=term =resource:store] ^- (quip card _state) ?> (~(has by graphs) resource) :- (give [/updates]~ [%add-tag term resource]) %_ state tag-queries (~(put ju tag-queries) term resource) == :: ++ remove-tag |= [=term =resource:store] ^- (quip card _state) ?> (~(has by graphs) resource) :- (give [/updates]~ [%remove-tag term resource]) %_ state tag-queries (~(del ju tag-queries) term resource) == :: ++ give |= [paths=(list path) update=update-0:store] ^- (list card) [%give %fact paths [%graph-update !>([%0 update])]]~ -- -- :: ++ on-watch ~/ %graph-store-watch |= =path ^- (quip card _this) |^ ?> (team:title our.bowl src.bowl) =/ cards=(list card) ?+ path (on-watch:def path) [%updates ~] ~ [%keys ~] (give [%keys ~(key by graphs)]) == [cards this] :: ++ give |= update=update-0:store ^- (list card) [%give %fact ~ [%graph-update !>([%0 update])]]~ -- :: ++ on-peek ~/ %graph-store-peek |= =path ^- (unit (unit cage)) ?+ path (on-peek:def path) [%x %keys ~] ``noun+!>(~(key by graphs)) [%x %tags ~] ``noun+!>(~(key by tag-queries)) [%x %graph @ @ ~] =/ =ship (slav %p i.t.t.path) =/ =term i.t.t.t.path =/ graph=(unit graph:store) (~(get by graphs) [ship term]) ?~ graph ~ ``noun+!>(u.graph) :: :: [%x %graph-subset @ @ @ @ ~] :: =/ =ship (slav %p i.t.t.path) :: =/ =term i.t.t.t.path :: :: TODO: parse out either '~' literal into null or parse out @ud :: =/ start=(unit @ud) :: =/ graph=(unit graph:store) (~(get by graphs) [ship term]) :: ?~ graph ~ :: ``noun+!>((subset:orm u.graph [~ :: ``noun+!>(u.graph) :: [%x %node @ @ @ *] =/ =ship (slav %p i.t.t.path) =/ =term i.t.t.t.path =/ =index:store (turn t.t.t.t.path |=(=cord (slav %ud cord))) =/ parent-graph=(unit graph:store) (~(get by graphs) [ship term]) ?~ parent-graph ~ =/ node=(unit node:store) ~ =/ =graph:store u.parent-graph |- ?~ index ?~ node ~ ``noun+!>(u.node) ?~ t.index =. node (get:orm graph i.index) ?~ node ~ ``noun+!>(u.node) =. node (get:orm graph i.index) ?~ node ~ ?- -.children.u.node %empty ~ %graph $(graph p.children.u.node, index t.index) == == :: ++ on-arvo on-arvo:def ++ on-agent on-agent:def ++ on-leave on-leave:def ++ on-fail on-fail:def --