:: /app/collections/hoon :: /? 309 /- hall /+ collections /= cols /^ collection:collections /; |= a=(map knot item:collections) [*config:collections a] /: /===/web/collections /_ /collection-item/ :: =, collections =, space:userlib :: |% += move [bone card] += card $% [%info wire ship toro:clay] [%poke wire dock poke] [%perm wire ship desk path rite:clay] == += poke $% [%hall-action action:hall] [%collection-action action:collections] [%json json] == -- :: :::: :: |_ [bol=bowl:gall state=collection] :: ++ this . :: :::: ++ prep |= old=(unit *) ^- (quip move _this) ?~ old =< ta-done (ta-hall-create-circle:ta /c 'collections') =/ old-col ((soft collection) u.old) ?~ old-col [~ this(state cols)] =^ mow this =< ta-done (ta-update:ta u.old-col) [mow this(state cols)] :: :: mack: acknowledgement for permissions :: ++ mack |= [wir=wire err=(unit tang)] ^- (quip move _this) ?~ err [~ this] (mean u.err) :::::: :: utilities :: ++ base-spur `spur`/web/collections ++ base-beam `beam`[byk.bol (flop base-spur)] ++ base-path `path`(en-beam:format base-beam) :: ++ path-to-circle |= pax=path ^- circle:hall =. pax ?: ?=([%web %collections *] pax) (weld /c (slag 2 `path`pax)) ?: ?=([%collections *] pax) (weld /c (slag 1 `path`pax)) ?: ?=([%c *] pax) `path`pax `path`(weld /c pax) =/ nam=term %+ roll `(list @ta)`pax |= [seg=@ta out=term] %^ cat 3 ?:(=(%$ out) out (cat 3 out '-')) ((hard @tas) seg) [our.bol nam] :: ++ allowed-by |= [who=@p dic=dict:clay] =/ in-list=? ?| (~(has in p.who.rul.dic) who) :: %- ~(rep by q.who.rul.dic) |= [[@ta cru=crew:clay] out=_|] ?: out & (~(has in cru) who) == ?: =(%black mod.rul.dic) !in-list in-list :: ++ collection-notify |= [pax=path conf=config] ^- json %- pairs:enjs:format :~ ['owner' [%s (crip (scow %p owner.conf))]] ['path' [%a (turn pax |=(a=@ta `json`[%s a]))]] ['name' [%s name.conf]] ['date' [%s (crip (scow %da last-modified.conf))]] ['type' [%s type.conf]] == :: ++ item-notify |= [pax=path raw=raw-item] ^- json =/ owner (fall (~(get by meta.raw) %owner) ~.anon) =/ dat (fall (~(get by meta.raw) %last-modified) (scot %da now.bol)) =/ nom (fall (~(get by meta.raw) %name) ~.no-title) =/ typ (fall (~(get by meta.raw) %type) ~.no-type) %- pairs:enjs:format :~ ['owner' [%s owner]] ['path' [%a (turn pax |=(a=@ta `json`[%s a]))]] ['name' [%s nom]] ['date' [%s dat]] ['type' [%s typ]] ['content' [%s data.raw]] == :: :: :: ++ poke-noun |= a=* ^- (quip move _this) :: =/ pax ((hard path) a) =/ yo=item (~(got by data.cols) ~.yoyo) ?> ?=(%both -.yo) =/ new-front (~(put by meta.raw.yo) %new-field ~.fuck-off) =/ new-body (crip (weld (trip data.raw.yo) "new line\0a")) =/ new-contents (update-umd-front new-front data.raw.yo) =/ act=action:collections :* our.bol %home :~ [%write /web/collections/yoyo/umd %umd new-body] == == =/ mow=move [ost.bol %poke /poke-act [our.bol %collections] %collection-action act] [[mow]~ this] :: ++ poke-collection-action |= act=action:collections ^- (quip move _this) :: ~& act ?. =(who.act our.bol) :: :: forward poke if its not meant for us :_ this :_ ~ :* ost.bol %poke /forward-collection-action [who.act %collections] %collection-action act == :: :: resolve %collection, %post, or %comment to %write action =. acts.act %+ turn acts.act |= a=sub-action ^- sub-action ?: ?=(%collection -.a) =/ conf=config :* [byk.bol (flop (weld pax.a /[name.a]/collection-config))] name.a desc.a our.bol now.bol now.bol type.a comments.a ~ visible.a == [%write (weld pax.a /[name.a]/collection-config) %collection-config conf] :: ?: ?=(%post -.a) =/ front=(map knot cord) %- my :~ [%name name.a] [%comments ?:(comments.a ~..y ~..n)] [%owner (scot %p src.bol)] [%date-created (scot %da now.bol)] [%last-modified (scot %da now.bol)] [%type type.a] == [%write (weld pax.a /[name.a]/umd) %umd (update-umd-front front content.a)] :: ?: ?=(%comment -.a) =/ dat (scot %da now.bol) =/ front=(map knot cord) %- my :~ [%owner (scot %p src.bol)] [%date-created dat] [%last-modified dat] == [%write (weld pax.a /[dat]/umd) %umd (update-umd-front front content.a)] :: a :: :: if its from us no need to check permissions ?: =(src.bol our.bol) ta-done:(ta-act:ta act) :: :: if not from us, check if every action in the list is permitted :: if even one isn't, don't reject the whole list =/ success=? %+ levy acts.act |= a=sub-action =/ pax (path +<.a) ?+ -.a !! %write =/ perms .^([dict:clay dict:clay] %cp pax) (allowed-by src.bol +.perms) %delete =/ perms .^([dict:clay dict:clay] %cp pax) (allowed-by src.bol +.perms) %perms | == :: ?: success ta-done:(ta-act:ta act) [~ this] :: XX TODO: report failure :: :::::: :::::: :: ++ ta |_ moves=(list move) :: :: core control :: ++ ta-this . ++ ta-done [(flop moves) this] ++ ta-emit |= mov=move %_ ta-this moves [mov moves] == ++ ta-emil |= mos=(list move) %_ ta-this moves (welp (flop mos) moves) == :: :: interface :: ++ ta-act |= act=action:collections ^+ ta-this |- ?~ acts.act ta-this =* a i.acts.act =. ta-this ?+ -.a !! %write (ta-write pax.a `cage`[-.for.a !>(+.for.a)]) %delete (ta-remove pax.a) %perms (ta-set-permissions pax.a r.a w.a) == $(acts.act t.acts.act) :: :: clay updates :: ++ ta-update |= old=collection ^+ ta-this :: ~& old+old :: ~& new+cols ?: =(old cols) :: ~& %no-update ta-this (ta-update-collection old cols /web/collections) :: ++ ta-insert-item |= [new=item pax=path] ^+ ta-this :: ~& insert+[-.new pax] =/ parent-path (scag (dec (lent pax)) pax) :: ?- -.new :: %collection =. ta-this (ta-hall-json parent-path 'new collection' (collection-notify pax meta.col.new)) :: =. ta-this (ta-hall-create-circle pax description.meta.col.new) =/ items=(list [nom=@ta =item]) ~(tap by data.col.new) |- ?~ items ta-this =. ta-this (ta-insert-item item.i.items (weld pax [nom.i.items ~])) $(items t.items) :: %both =. ta-this (ta-hall-json parent-path 'new collection' (collection-notify pax meta.col.new)) =. ta-this (ta-hall-json parent-path 'new item' (item-notify pax raw.new)) =. ta-this (ta-hall-create-circle pax description.meta.col.new) =/ items=(list [nom=@ta =item]) ~(tap by data.col.new) =. ta-this |- ?~ items ta-this =. ta-this (ta-insert-item item.i.items (weld pax [nom.i.items ~])) $(items t.items) :: ?: ?& (~(has by meta.raw.new) %comments) =('.y' (~(got by meta.raw.new) %comments)) == (ta-generate-comments pax) ta-this :: %raw =. ta-this (ta-hall-json parent-path 'new item' (item-notify pax raw.new)) ?: ?& (~(has by meta.raw.new) %comments) =('.y' (~(got by meta.raw.new) %comments)) == (ta-generate-comments pax) ta-this :: == :: ++ ta-remove-item |= [old=item pax=path] ^+ ta-this :: ~& remove+[-.old pax] :: flush permissions :: notify parent of deletion =/ parent (scag (dec (lent pax)) pax) :: recurse for children ?- -.old :: %collection =. ta-this (ta-hall-json parent 'deleted collection' (collection-notify pax meta.col.old)) =. ta-this (ta-flush-permissions (weld pax /collection-config)) =/ items=(list [nom=@ta =item]) ~(tap by data.col.old) |- ?~ items ta-this =. ta-this (ta-remove-item item.i.items (weld pax [nom.i.items ~])) $(items t.items) :: %both =. ta-this (ta-hall-json parent 'deleted collection' (collection-notify pax meta.col.old)) =. ta-this (ta-hall-json parent 'deleted item' (item-notify pax raw.old)) =. ta-this (ta-flush-permissions pax) =. ta-this (ta-flush-permissions (weld pax /collection-config)) =/ items=(list [nom=@ta =item]) ~(tap by data.col.old) |- ?~ items ta-this =. ta-this (ta-remove-item item.i.items (weld pax [nom.i.items ~])) $(items t.items) :: %raw =. ta-this (ta-flush-permissions pax) (ta-hall-json parent 'deleted item' (item-notify pax raw.old)) :: == :: :: :: ++ ta-update-item :: always make sure removals happen first and insertions happen last :: because removals flush permissions and insertions set them :: |= [old=item new=item pax=path] ^+ ta-this :: ~& update-item+[-.old -.new pax] ?: =(old new) ta-this :: :: check for changes in item type ?: &(?=(%collection -.old) ?=(%collection -.new)) (ta-update-collection col.old col.new pax) ?: &(?=(%raw -.old) ?=(%raw -.new)) (ta-update-raw-item raw.old raw.new pax) ?: &(?=(%both -.old) ?=(%both -.new)) :: update raw item =. ta-this (ta-update-collection col.old col.new pax) (ta-update-raw-item raw.old raw.new pax) :: ?: &(?=(%collection -.old) ?=(%raw -.new)) :: remove collection :: insert raw item =. ta-this (ta-remove-item old pax) (ta-insert-item new pax) :: ?: &(?=(%collection -.old) ?=(%both -.new)) :: insert raw item :: update-collection =. ta-this (ta-update-collection col.old col.new pax) (ta-insert-item new pax) :: ?: &(?=(%raw -.old) ?=(%collection -.new)) :: remove raw item :: insert collection =. ta-this (ta-remove-item old pax) (ta-insert-item new pax) :: ?: &(?=(%raw -.old) ?=(%both -.new)) :: insert collection :: update raw item =. ta-this (ta-update-raw-item raw.old raw.new pax) (ta-insert-item new pax) :: ?: &(?=(%both -.old) ?=(%raw -.new)) :: remove collection :: update raw item =. ta-this (ta-remove-item [%collection col.old] pax) (ta-update-raw-item raw.old raw.new pax) :: ?: &(?=(%both -.old) ?=(%collection -.new)) :: remove raw item :: update collection =. ta-this (ta-remove-item [%raw raw.old] pax) (ta-update-collection col.old col.new pax) :: ta-this :: ++ ta-update-raw-item |= [old=raw-item new=raw-item pax=path] ^+ ta-this :: ~& update-raw-item+[-.old -.new pax] ?: =(old new) ta-this :: =? ta-this !=(data.old data.new) =/ parent-path (scag (dec (lent pax)) pax) (ta-hall-json parent-path 'edited item' (item-notify pax new)) :: XX fil :: =? ta-this ?& =('.y' (fall (~(get by meta.new) %comments) '.n')) =('.n' (fall (~(get by meta.old) %comments) '.n')) == :: create comments (ta-generate-comments pax) :: =? ta-this ?& =('.n' (fall (~(get by meta.new) %comments) '.n')) =('.y' (fall (~(get by meta.old) %comments) '.n')) == :: delete comments (ta-remove (weld pax /collection-config)) :: :: check if file has been modified :: and if so update last modified field =/ told (trip data.old) =/ newt (trip data.new) =/ old-con (slag (need (find ";>" told)) told) =/ new-con (slag (need (find ";>" newt)) newt) =? ta-this !=(old-con new-con) =/ contents=@t %+ update-umd-front (~(put by meta.new) %last-modified (scot %da now.bol)) data.new :: ~& %update-last-modified :: ~& contents :: ~& (weld pax /umd) (ta-write (weld pax /umd) %umd !>(contents)) :: ta-this :: ++ ta-update-collection |= $: old=collection new=collection pax=path == ^+ ta-this :: ~& update-collection+pax :: =? ta-this !=(meta.old meta.new) =/ parent-path (scag (dec (lent pax)) pax) (ta-hall-json parent-path 'edited collection' (collection-notify pax meta.new)) :: ?: =(data.old data.new) ta-this :: :: new values of all changed items =/ upd-new (~(dif in (~(int by data.old) data.new)) data.old) :: old values of all changed items =/ upd-old (~(dif in (~(int by data.new) data.old)) data.new) :: all totally new entries =/ ins-new (~(dif by data.new) data.old) :: all deleted entries =/ del-old (~(dif by data.old) data.new) :: =/ upd-new=(list [nom=knot =item]) ~(tap by upd-new) =/ upd-old=(list [nom=knot =item]) ~(tap by upd-old) =/ ins-new=(list [nom=knot =item]) ~(tap by ins-new) =/ del-old=(list [nom=knot =item]) ~(tap by del-old) :: =/ lam |=([[a=knot item] out=(list path)] [(weld pax [a ~]) out]) :: ~& upd-new+(roll upd-new lam) :: ~& upd-old+(roll upd-old lam) :: ~& ins-new+(roll ins-new lam) :: ~& del-old+(roll del-old lam) :: =. ta-this |- ?~ upd-new ta-this ?< ?=(~ upd-old) =* new-item i.upd-new =* old-item i.upd-old =/ new-pax (weld pax [nom.new-item ~]) =. ta-this (ta-update-item item.old-item item.new-item new-pax) :: %= $ upd-new t.upd-new upd-old t.upd-old == :: =. ta-this |- ?~ ins-new ta-this =* new-item i.ins-new =/ new-pax (weld pax [nom.new-item ~]) =. ta-this (ta-insert-item +.new-item (weld pax [-.new-item ~])) $(ins-new t.ins-new) :: =. ta-this |- ?~ del-old ta-this =* old-item i.del-old =/ old-pax (weld pax [nom.old-item ~]) =. ta-this (ta-remove-item +.old-item (weld pax [-.old-item ~])) $(del-old t.del-old) :: ta-this :: ++ ta-generate-comments |= pax=path ^+ ta-this =/ sup=path [%collection-config (flop pax)] =/ pat (en-beam:format [byk.bol sup]) =/ cay=config :* [byk.bol sup] 'comments' 'comments' our.bol now.bol now.bol %comments | ~ | == (ta-write (flop sup) %collection-config !>(cay)) :: :: writing files :: ++ ta-write |= [pax=path cay=cage] :: ~& writing+pax ^+ ta-this =. pax (en-beam:format byk.bol (flop pax)) %+ ta-emit ost.bol [%info (weld /ta-write pax) our.bol (foal pax cay)] :: ++ ta-remove |= pax=path =. pax (en-beam:format byk.bol (flop pax)) ^+ ta-this %+ ta-emit ost.bol [%info (weld /ta-remove pax) our.bol (fray pax)] :: :: permissions :: ++ ta-set-permissions |= [pax=path r=rule:clay w=rule:clay] :: =. pax (weld base-spur pax) ^+ ta-this %+ ta-emit ost.bol [%perm (weld /perms pax) our.bol q.byk.bol pax [%rw `r `w]] :: ++ ta-flush-permissions |= pax=path :: =. pax (weld base-spur pax) ^+ ta-this %+ ta-emit ost.bol [%perm (weld /perms pax) our.bol q.byk.bol pax [%rw ~ ~]] :: :: hall :: ++ ta-hall-action |= act=action:hall ^+ ta-this %+ ta-emit ost.bol [%poke /col-hall-action [our.bol %hall] %hall-action act] :: ++ ta-hall-actions |= act=(list $?(~ action:hall)) ^+ ta-this ?~ act ta-this ?~ i.act $(act t.act) %= $ ta-this (ta-hall-action i.act) act t.act == :: ++ ta-hall-create-circle :: |= [pax=path description=@t] ^+ ta-this =/ circ=circle:hall (path-to-circle pax) =/ parent=circle:hall ?: =(nom.circ %c) [our.bol %inbox] (path-to-circle (scag (dec (lent pax)) pax)) %- ta-hall-actions :: XX TODO make this depend on clay perms :~ [%create nom.circ description %journal] [%source nom.parent & (sy `source:hall`[circ ~] ~)] == :: ++ ta-hall-lin |= [pax=path msg=cord] ^+ ta-this =/ circ=circle:hall (path-to-circle pax) %- ta-hall-action [%phrase [circ ~ ~] [%lin | msg]~] :: ++ ta-hall-json |= [pax=path header=@t jon=json] ^+ ta-this =/ circ=circle:hall (path-to-circle pax) %- ta-hall-action :+ %phrase [circ ~ ~] [%fat [%text ~[header]] [%lin | (crip (en-json:html jon))]]~ :: -- --