diff --git a/desk/app/bark.hoon b/desk/app/bark.hoon new file mode 100644 index 0000000..cdade5e --- /dev/null +++ b/desk/app/bark.hoon @@ -0,0 +1,127 @@ +:: bark: gathers summaries from ships, sends emails to their owners +:: +:: general flow is that bark gets configured with api keys and recipient +:: ships. on-demand, bark asks either all or a subset of recipients for +:: an activity summary (through the growl agent on their ships), and upon +:: receiving responses, uses the mailchimp api to upload the received +:: deets for that ship, and/or triggers an email send. +:: +/+ default-agent, verb, dbug +:: +|% ++$ card card:agent:gall ++$ state-0 + $: %0 + api=[tlon=@t mailchimp=[key=@t list-id=@t]] + recipients=(set ship) + == +:: +++ next-timer + |= now=@da + :: west-coast midnights for minimal ameri-centric disruption + %+ add ~d1.h7 + (sub now (mod now ~d1)) +-- +:: +=| state-0 +=* state - +%- agent:dbug +%+ verb | +^- agent:gall +|_ =bowl:gall ++* this . + def ~(. (default-agent this %.n) bowl) +++ on-init + ^- (quip card _this) + :_ this + [%pass /fetch %arvo %b %wait (next-timer now.bowl)]~ +:: +++ on-arvo + |= [=wire sign=sign-arvo] + ^- (quip card _this) + ?> =(/fetch wire) + ?> ?=(%wake +<.sign) + =^ caz this (on-poke %bark-generate-summaries !>(~)) + :_ this + :_ caz + [%pass /fetch %arvo %b %wait (next-timer now.bowl)] +:: +++ on-poke + |= [=mark =vase] + ^- (quip card _this) + ?+ mark (on-poke:def mark vase) + %noun + =+ !<([m=@ n=*] vase) + $(mark m, vase (need (slew 3 vase))) + :: + %set-tlon-api-key + `this(tlon.api !<(@t vase)) + :: + %set-mailchimp-api-key + `this(mailchimp.api !<([key=@t list=@t] vase)) + :: + %bark-add-recipient + =+ !<(=ship vase) + ?> =(src.bowl ship) + `this(recipients (~(put in recipients) ship)) + :: + %bark-remove-recipient + =+ !<(=ship vase) + ?> =(src.bowl ship) + `this(recipients (~(del in recipients) ship)) + :: + %bark-generate-summaries + ?> =(src.bowl our.bowl) + :_ this + =- ~(tap in -) + ^- (set card) + %- ~(run in recipients) + |= =ship + ^- card + [%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)] + :: + %bark-target-summaries + ?> =(src.bowl our.bowl) + :_ this + %+ turn + (skim !<((list ship) vase) ~(has in recipients)) + |= =ship + ^- card + [%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)] + :: + %bark-receive-summary + =/ result + !< %- unit + $: requested=time + $= summary + ::NOTE see also /lib/summarize + $% [%life active=[s=@ud r=@ud g=@t] inactive=[d=@ud c=@ud g=@t c=@t]] + == == + vase + ?~ result + `this(recipients (~(del in recipients) src.bowl)) + ::TODO maybe drop the result (or re-request) if the timestamp is too old? + :_ this + :~ :* %pass /save-summary/(scot %p src.bowl)/(scot %da requested.u.result) + %arvo %k %fard + %garden %save-summary %noun + !>(`[tlon.api mailchimp.api src.bowl summary.u.result]) + == + == + == +++ on-watch on-watch:def +++ on-agent on-agent:def +++ on-fail + |= [=term =tang] + (mean ':sub +on-fail' term tang) +++ on-leave + |= =path + `this +++ on-save !>(state) +++ on-load + |= old-state=vase + ^- (quip card _this) + =/ old !<(state-0 old-state) + `this(state old) +++ on-peek on-peek:def +-- diff --git a/desk/app/growl.hoon b/desk/app/growl.hoon new file mode 100644 index 0000000..998c340 --- /dev/null +++ b/desk/app/growl.hoon @@ -0,0 +1,125 @@ +/- settings +/+ summarize, default-agent, verb, dbug +:: +|% ++$ card card:agent:gall ++$ versioned-state + $% state-0 + == ++$ state-0 [%0 enabled=_| bark-host=_~rilfet-palsum] +-- +:: +:: This agent should eventually go into landscape +:: +=| state-0 +=* state - +%- agent:dbug +%+ verb | +^- agent:gall +|_ =bowl:gall ++* this . + def ~(. (default-agent this %.n) bowl) +:: +++ on-init + =; consent=? + =^ caz this (on-poke ?:(consent %enable %disable) !>(~)) + :_ this + ::NOTE sadly, we cannot subscribe to items that may not exist right now, + :: so we subscribe to the whole bucket instead + [[%pass /settings %agent [our.bowl %settings] %watch /desk/groups] caz] + =+ .^ =data:settings + %gx + (scot %p our.bowl) + %settings + (scot %da now.bowl) + /desk/groups/settings-data + == + ?> ?=(%desk -.data) + =; =val:settings + ?>(?=(%b -.val) p.val) + %+ %~ gut by + (~(gut by desk.data) %groups ~) + 'logActivity' + [%b |] +:: +++ on-poke + |= [=mark =vase] + ^- (quip card _this) + ?+ mark (on-poke:def mark vase) + %noun + =+ !<([m=@ n=*] vase) + $(mark m, vase (need (slew 3 vase))) + :: + %set-host + ?> =(src.bowl our.bowl) + `this(bark-host !<(ship vase)) + :: + %enable + :_ this(enabled %.y) + ~[[%pass /add-recipient %agent [bark-host %bark] %poke %bark-add-recipient !>(our.bowl)]] + :: + %disable + :_ this(enabled %.n) + ~[[%pass /remove-recipient %agent [bark-host %bark] %poke %bark-remove-recipient !>(our.bowl)]] + :: + %growl-summarize + ?. enabled + :_ this + ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(~)]] + =/ requested !<(time vase) + =/ activity ~(summarize-activity summarize [our now]:bowl) + =/ inactivity ~(summarize-inactivity summarize [our now]:bowl) + :_ this + ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(`[requested %life activity inactivity])]] + == +:: +++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card _this) + ?. ?=([%settings ~] wire) (on-agent:def wire sign) + ?- -.sign + %poke-ack !! + :: + %watch-ack + ?~ p.sign [~ this] + %- (slog 'growl failed settings subscription' u.p.sign) + [~ this] + :: + %kick + [[%pass /settings %agent [our.bowl %settings] %watch /desk/groups]~ this] + :: + %fact + ?. =(%settings-event p.cage.sign) (on-agent:def wire sign) + =+ !<(=event:settings q.cage.sign) + =/ new=? + =; =val:settings + ?:(?=(%b -.val) p.val |) + ?+ event b+| + [%put-bucket %groups %groups *] (~(gut by bucket.event) 'logActivity' b+|) + [%del-bucket %groups %groups] b+| + [%put-entry %groups %groups %'logActivity' *] val.event + [%del-entry %groups %groups %'logActivity'] b+| + == + ?: =(new enabled) [~ this] + (on-poke ?:(new %enable %disable) !>(~)) + == +:: +++ on-watch on-watch:def +++ on-fail + |= [=term =tang] + (mean ':sub +on-fail' term tang) +++ on-leave + |= =path + `this +++ on-save !>(state) +++ on-load + |= old-state=vase + ^- (quip card _this) + =/ old !<(versioned-state old-state) + ?- -.old + %0 + `this(state old) + == +++ on-arvo on-arvo:def +++ on-peek on-peek:def +-- diff --git a/desk/desk.bill b/desk/desk.bill index 43c5815..4d9f9cf 100644 --- a/desk/desk.bill +++ b/desk/desk.bill @@ -8,4 +8,5 @@ %reel %bait %vitals + %growl == diff --git a/desk/lib/graph-store.hoon b/desk/lib/graph-store.hoon new file mode 100644 index 0000000..df11d03 --- /dev/null +++ b/desk/lib/graph-store.hoon @@ -0,0 +1,919 @@ +/- sur=graph-store, pos=post, pull-hook, hark=hark-store +/+ res=resource, migrate +=< [sur .] +=< [pos .] +=, sur +=, pos +|% +++ hark-content + |= =content + ^- content:hark + ?- -.content + %text content + %mention ship+ship.content + %url text+url.content + %code text+'A code excerpt' + %reference text+'A reference' + == +:: +++ hark-contents + |= cs=(list content) + (turn cs hark-content) +:: NOTE: move these functions to zuse +++ nu :: parse number as hex + |= jon=json + ?> ?=([%s *] jon) + (rash p.jon hex) +:: +++ re :: recursive reparsers + |* [gar=* sef=_|.(fist:dejs-soft:format)] + |= jon=json + ^- (unit _gar) + =- ~! gar ~! (need -) - + ((sef) jon) +:: +++ dank :: tank + ^- $-(json (unit tank)) + =, ^? dejs-soft:format + %+ re *tank |. ~+ + %- of :~ + leaf+sa + palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~) + rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~) + == +:: +++ orm ((on atom node) gth) +++ orm-log ((on time logged-update) gth) +:: +++ enjs + =, enjs:format + |% + :: + ++ signatures + |= s=^signatures + ^- json + [%a (turn ~(tap in s) signature)] + :: + ++ signature + |= s=^signature + ^- json + %- pairs + :~ [%signature s+(scot %ux p.s)] + [%ship (ship q.s)] + [%life (numb r.s)] + == + :: + ++ index + |= ind=^index + ^- json + :- %s + ?: =(~ ind) + '/' + %+ roll ind + |= [cur=@ acc=@t] + ^- @t + =/ num (numb cur) + ?> ?=(%n -.num) + (rap 3 acc '/' p.num ~) + :: + ++ uid + |= u=^uid + ^- json + %- pairs + :~ [%resource (enjs:res resource.u)] + [%index (index index.u)] + == + :: + ++ content + |= c=^content + ^- json + ?- -.c + %mention (frond %mention (ship ship.c)) + %text (frond %text s+text.c) + %url (frond %url s+url.c) + %reference (frond %reference (reference +.c)) + %code + %+ frond %code + %- pairs + :- [%expression s+expression.c] + :_ ~ + :- %output + :: virtualize output rendering, +tank:enjs:format might crash + :: + =/ result=(each (list json) tang) + (mule |.((turn output.c tank))) + ?- -.result + %& a+p.result + %| a+[a+[%s '[[output rendering error]]']~]~ + == + == + :: + ++ reference + |= ref=^reference + |^ + %+ frond -.ref + ?- -.ref + %graph (graph +.ref) + %group (group +.ref) + %app (app +.ref) + == + :: + ++ graph + |= [grp=res gra=res idx=^index] + %- pairs + :~ graph+s+(enjs-path:res gra) + group+s+(enjs-path:res grp) + index+(index idx) + == + :: + ++ group + |= grp=res + s+(enjs-path:res grp) + :: + ++ app + |= [=^ship =desk p=^path] + %- pairs + :~ ship+s+(scot %p ship) + desk+s+desk + path+(path p) + == + -- + :: + ++ maybe-post + |= mp=^maybe-post + ^- json + ?- -.mp + %| s+(scot %ux p.mp) + %& (post p.mp) + == + :: + ++ post + |= p=^post + ^- json + %- pairs + :~ [%author (ship author.p)] + [%index (index index.p)] + [%time-sent (time time-sent.p)] + [%contents [%a (turn contents.p content)]] + [%hash ?~(hash.p ~ s+(scot %ux u.hash.p))] + [%signatures (signatures signatures.p)] + == + :: + ++ update + |= upd=^update + ^- json + |^ (frond %graph-update (pairs ~[(encode q.upd)])) + :: + ++ encode + |= upd=action + ^- [cord json] + ?- -.upd + %add-graph + :- %add-graph + %- pairs + :~ [%resource (enjs:res resource.upd)] + [%graph (graph graph.upd)] + [%mark ?~(mark.upd ~ s+u.mark.upd)] + [%overwrite b+overwrite.upd] + == + :: + %remove-graph + [%remove-graph (enjs:res resource.upd)] + :: + %add-nodes + :- %add-nodes + %- pairs + :~ [%resource (enjs:res resource.upd)] + [%nodes (nodes nodes.upd)] + == + :: + %remove-posts + :- %remove-posts + %- pairs + :~ [%resource (enjs:res resource.upd)] + [%indices (indices indices.upd)] + == + :: + %add-signatures + :- %add-signatures + %- pairs + :~ [%uid (uid uid.upd)] + [%signatures (signatures signatures.upd)] + == + :: + %remove-signatures + :- %remove-signatures + %- pairs + :~ [%uid (uid uid.upd)] + [%signatures (signatures signatures.upd)] + == + :: + %add-tag + :- %add-tag + %- pairs + :~ [%term s+term.upd] + [%uid (uid uid.upd)] + == + :: + %remove-tag + :- %remove-tag + %- pairs + :~ [%term s+term.upd] + [%uid (uid uid.upd)] + == + :: + %archive-graph + [%archive-graph (enjs:res resource.upd)] + :: + %unarchive-graph + [%unarchive-graph (enjs:res resource.upd)] + :: + %keys + [%keys [%a (turn ~(tap in resources.upd) enjs:res)]] + :: + %tags + [%tags [%a (turn ~(tap in tags.upd) |=(=term s+term))]] + :: + %run-updates + [%run-updates ~] + :: + %tag-queries + :- %tag-queries + %- pairs + %+ turn ~(tap by tag-queries.upd) + |= [=term uids=(set ^uid)] + ^- [cord json] + [term [%a (turn ~(tap in uids) uid)]] + == + :: + ++ graph + |= g=^graph + ^- json + %- pairs + %+ turn + (tap:orm g) + |= [a=atom n=^node] + ^- [@t json] + :_ (node n) + =/ idx (numb a) + ?> ?=(%n -.idx) + p.idx + :: + ++ node + |= n=^node + ^- json + %- pairs + :~ [%post (maybe-post post.n)] + :- %children + ?- -.children.n + %empty ~ + %graph (graph +.children.n) + == + == + :: + ++ nodes + |= m=(map ^index ^node) + ^- json + %- pairs + %+ turn ~(tap by m) + |= [n=^index o=^node] + ^- [@t json] + :_ (node o) + =/ idx (index n) + ?> ?=(%s -.idx) + p.idx + :: + ++ indices + |= i=(set ^index) + ^- json + [%a (turn ~(tap in i) index)] + :: + -- + -- +:: +++ dejs + =, dejs:format + |% + ++ update + |= jon=json + ^- ^update + :- *time + ^- action + =< (decode jon) + |% + ++ decode + %- of + :~ [%add-nodes add-nodes] + [%remove-posts remove-posts] + [%add-signatures add-signatures] + [%remove-signatures remove-signatures] + :: + [%add-graph add-graph] + [%remove-graph remove-graph] + :: + [%add-tag add-tag] + [%remove-tag remove-tag] + :: + [%archive-graph archive-graph] + [%unarchive-graph unarchive-graph] + [%run-updates run-updates] + :: + [%keys keys] + [%tags tags] + [%tag-queries tag-queries] + == + :: + ++ add-graph + %- ot + :~ [%resource dejs:res] + [%graph graph] + [%mark (mu so)] + [%overwrite bo] + == + :: + ++ graph + |= a=json + ^- ^graph + =/ or-mp ((on atom ^node) gth) + %+ gas:or-mp ~ + %+ turn ~(tap by ((om node) a)) + |* [b=cord c=*] + ^- [atom ^node] + => .(+< [b c]=+<) + [(rash b dem) c] + :: + ++ remove-graph (ot [%resource dejs:res]~) + ++ archive-graph (ot [%resource dejs:res]~) + ++ unarchive-graph (ot [%resource dejs:res]~) + :: + ++ add-nodes + %- ot + :~ [%resource dejs:res] + [%nodes nodes] + == + :: + ++ nodes (op ;~(pfix fas (more fas dem)) node) + :: + ++ node + %- ot + :~ [%post maybe-post] + [%children internal-graph] + == + :: + ++ internal-graph + |= jon=json + ^- ^internal-graph + ?~ jon + [%empty ~] + [%graph (graph jon)] + :: + ++ maybe-post + |= jon=json + ^- ^maybe-post + ?~ jon !! + ?+ -.jon !! + %s [%| (nu jon)] + %o [%& (post jon)] + == + :: + ++ post + %- ot + :~ [%author (su ;~(pfix sig fed:ag))] + [%index index] + [%time-sent di] + [%contents (ar content)] + [%hash (mu nu)] + [%signatures (as signature)] + == + :: + ++ content + %- of + :~ [%mention (su ;~(pfix sig fed:ag))] + [%text so] + [%url so] + [%reference reference] + [%code eval] + == + :: + ++ reference + |^ + %- of + :~ graph+graph + group+dejs-path:res + app+app + == + :: + ++ graph + %- ot + :~ group+dejs-path:res + graph+dejs-path:res + index+index + == + :: + ++ app + %- ot + :~ ship+(su ;~(pfix sig fed:ag)) + desk+so + path+pa + == + -- + :: + ++ tang + |= jon=^json + ^- ^tang + ?> ?=(%a -.jon) + %- zing + %+ turn + p.jon + |= jo=^json + ^- (list tank) + ?> ?=(%a -.jo) + %+ turn + p.jo + |= j=^json + ?> ?=(%s -.j) + ^- tank + leaf+(trip p.j) + :: + ++ eval + %- ot + :~ expression+so + output+tang + == + :: + ++ remove-posts + %- ot + :~ [%resource dejs:res] + [%indices (as index)] + == + :: + ++ add-signatures + %- ot + :~ [%uid uid] + [%signatures (as signature)] + == + :: + ++ remove-signatures + %- ot + :~ [%uid uid] + [%signatures (as signature)] + == + :: + ++ signature + %- ot + :~ [%hash nu] + [%ship (su ;~(pfix sig fed:ag))] + [%life ni] + == + :: + ++ uid + %- ot + :~ [%resource dejs:res] + [%index index] + == + :: + ++ index (su ;~(pfix fas (more fas dem))) + :: + ++ add-tag + %- ot + :~ [%term so] + [%uid uid] + == + :: + ++ remove-tag + %- ot + :~ [%term so] + [%uid uid] + == + :: + ++ keys + |= =json + *resources + :: + ++ tags + |= =json + *(set term) + :: + ++ tag-queries + |= =json + *^tag-queries + :: + ++ run-updates + |= a=json + ^- [resource update-log] + [*resource *update-log] + -- + ++ pa + |= j=json + ^- path + ?> ?=(%s -.j) + ?: =('/' p.j) / + (stab p.j) + :: + -- +:: +++ create + |_ [our=ship now=time] + ++ post + |= [=index contents=(list content)] + ^- ^post + :* our + index + now + contents + ~ + *signatures + == + -- +:: +++ upgrade + |% + :: + :: +two + :: + ++ marked-graph-to-two + |= [=graph:one m=(unit mark)] + [(graph-to-two graph) m] + :: + ++ graph-to-two + |= =graph:one + (graph:(upgrade ,post:one ,maybe-post:two) graph post-to-two) + :: + ++ post-to-two + |= p=post:one + ^- maybe-post:two + [%& p] + :: + :: + :: +one + :: + ++ update-log-to-one + |= =update-log:zero + ^- update-log:one + %+ gas:orm-log:one *update-log:one + %+ turn (tap:orm-log:zero update-log) + |= [=time =logged-update:zero] + ^- [^time logged-update:one] + :- time + :- p.logged-update + (logged-update-to-one q.logged-update) + :: + ++ logged-update-to-one + |= upd=logged-update-0:zero + ^- logged-action:one + ?+ -.upd upd + %add-graph upd(graph (graph-to-one graph.upd)) + %add-nodes upd(nodes (~(run by nodes.upd) node-to-one)) + == + :: + ++ node-to-one + |= =node:zero + (node:(upgrade ,post:zero ,post:one) node post-to-one) + :: + ++ graph-to-one + |= =graph:zero + (graph:(upgrade ,post:zero ,post:one) graph post-to-one) + :: + ++ marked-graph-to-one + |= [=graph:zero m=(unit mark)] + [(graph-to-one graph) m] + :: + ++ post-to-one + |= p=post:zero + ^- post:one + p(contents (contents-to-one contents.p)) + :: + ++ contents-to-one + |= cs=(list content:zero) + ^- (list content:one) + %+ murn cs + |= =content:zero + ^- (unit content:one) + ?: ?=(%reference -.content) ~ + `content + :: + ++ upgrade + |* [in-pst=mold out-pst=mold] + => + |% + ++ in-orm + ((on atom in-node) gth) + +$ in-node + [post=in-pst children=in-internal-graph] + +$ in-graph + ((mop atom in-node) gth) + +$ in-internal-graph + $~ [%empty ~] + $% [%graph p=in-graph] + [%empty ~] + == + :: + ++ out-orm + ((on atom out-node) gth) + +$ out-node + [post=out-pst children=out-internal-graph] + +$ out-graph + ((mop atom out-node) gth) + +$ out-internal-graph + $~ [%empty ~] + $% [%graph p=out-graph] + [%empty ~] + == + -- + |% + :: + ++ graph + |= $: gra=in-graph + fn=$-(in-pst out-pst) + == + ^- out-graph + %+ gas:out-orm *out-graph + ^- (list [atom out-node]) + %+ turn (tap:in-orm gra) + |= [a=atom n=in-node] + ^- [atom out-node] + [a (node n fn)] + :: + ++ node + |= [nod=in-node fn=$-(in-pst out-pst)] + ^- out-node + :- (fn post.nod) + ^- out-internal-graph + ?: ?=(%empty -.children.nod) + [%empty ~] + [%graph (graph p.children.nod fn)] + -- + :: + ++ zero-load + :: =* infinitely recurses + =, store=zero + =, orm=orm:zero + =, orm-log=orm-log:zero + |% + ++ change-revision-graph + |= [=graph:store q=(unit mark)] + ^- [graph:store (unit mark)] + |^ + :_ q + ?+ q graph + [~ %graph-validator-link] convert-links + [~ %graph-validator-publish] convert-publish + == + :: + ++ convert-links + %+ gas:orm *graph:store + %+ turn (tap:orm graph) + |= [=atom =node:store] + ^- [^atom node:store] + :: top-level + :: + :+ atom post.node + ?: ?=(%empty -.children.node) + [%empty ~] + :- %graph + %+ gas:orm *graph:store + %+ turn (tap:orm p.children.node) + |= [=^atom =node:store] + ^- [^^atom node:store] + :: existing comments get turned into containers for revisions + :: + :^ atom + post.node(contents ~, hash ~) + %graph + %+ gas:orm *graph:store + :_ ~ :- %0 + :_ [%empty ~] + post.node(index (snoc index.post.node atom), hash ~) + :: + ++ convert-publish + %+ gas:orm *graph:store + %+ turn (tap:orm graph) + |= [=atom =node:store] + ^- [^atom node:store] + :: top-level + :: + :+ atom post.node + ?: ?=(%empty -.children.node) + [%empty ~] + :- %graph + %+ gas:orm *graph:store + %+ turn (tap:orm p.children.node) + |= [=^atom =node:store] + ^- [^^atom node:store] + :: existing container for publish note revisions + :: + ?+ atom !! + %1 [atom node] + %2 + :+ atom post.node + ?: ?=(%empty -.children.node) + [%empty ~] + :- %graph + %+ gas:orm *graph:store + %+ turn (tap:orm p.children.node) + |= [=^^atom =node:store] + ^- [^^^atom node:store] + :+ atom post.node(contents ~, hash ~) + :- %graph + %+ gas:orm *graph:store + :_ ~ :- %1 + :_ [%empty ~] + post.node(index (snoc index.post.node atom), hash ~) + == + -- + :: + ++ maybe-unix-to-da + |= =atom + ^- @ + :: (bex 127) is roughly 226AD + ?. (lte atom (bex 127)) + atom + (add ~1970.1.1 (div (mul ~s1 atom) 1.000)) + :: + ++ convert-unix-timestamped-node + |= =node:store + ^- node:store + =. index.post.node + (convert-unix-timestamped-index index.post.node) + ?. ?=(%graph -.children.node) + node + :+ post.node + %graph + (convert-unix-timestamped-graph p.children.node) + :: + ++ convert-unix-timestamped-index + |= =index:store + (turn index maybe-unix-to-da) + :: + ++ convert-unix-timestamped-graph + |= =graph:store + %+ gas:orm *graph:store + %+ turn + (tap:orm graph) + |= [=atom =node:store] + ^- [^atom node:store] + :- (maybe-unix-to-da atom) + (convert-unix-timestamped-node node) + -- + -- +++ import + |= [arc=* our=ship] + ^- (quip card:agent:gall [%6 network]) + |^ + =/ sty [%6 (remake-network ;;(tree-network +.arc))] + :_ sty + %+ turn ~(tap by graphs.sty) + |= [rid=resource =marked-graph] + ^- card:agent:gall + ?: =(our entity.rid) + =/ =cage [%push-hook-action !>([%add rid])] + [%pass / %agent [our %graph-push-hook] %poke cage] + (try-rejoin rid 0) + :: + +$ tree-network + $: graphs=tree-graphs + tag-queries=(tree [term (tree uid)]) + update-logs=tree-update-logs + archive=tree-graphs + ~ + == + +$ tree-graphs (tree [resource tree-marked-graph]) + +$ tree-marked-graph [p=tree-graph q=(unit ^mark)] + +$ tree-graph (tree [atom tree-node]) + +$ tree-node [post=tree-maybe-post children=tree-internal-graph] + +$ tree-internal-graph + $~ [%empty ~] + $% [%graph p=tree-graph] + [%empty ~] + == + +$ tree-update-logs (tree [resource tree-update-log]) + +$ tree-update-log (tree [time tree-logged-update]) + +$ tree-logged-update + $: p=time + $= q + $% [%add-graph =resource =tree-graph mark=(unit ^mark) ow=?] + [%add-nodes =resource nodes=(tree [index tree-node])] + [%remove-posts =resource indices=(tree index)] + [%add-signatures =uid signatures=tree-signatures] + [%remove-signatures =uid signatures=tree-signatures] + == + == + +$ tree-signatures (tree signature) + +$ tree-maybe-post (each tree-post hash) + +$ tree-post + $: author=ship + =index + time-sent=time + contents=(list content) + hash=(unit hash) + signatures=tree-signatures + == + :: + ++ remake-network + |= t=tree-network + ^- network + :* (remake-graphs graphs.t) + (remake-jug:migrate tag-queries.t) + (remake-update-logs update-logs.t) + (remake-graphs archive.t) + ~ + == + :: + ++ remake-graphs + |= t=tree-graphs + ^- graphs + %- remake-map:migrate + (~(run by t) remake-marked-graph) + :: + ++ remake-marked-graph + |= t=tree-marked-graph + ^- marked-graph + [(remake-graph p.t) q.t] + :: + ++ remake-graph + |= t=tree-graph + ^- graph + %+ gas:orm *graph + %+ turn ~(tap by t) + |= [a=atom tn=tree-node] + ^- [atom node] + [a (remake-node tn)] + :: + ++ remake-internal-graph + |= t=tree-internal-graph + ^- internal-graph + ?: ?=(%empty -.t) + [%empty ~] + [%graph (remake-graph p.t)] + :: + ++ remake-node + |= t=tree-node + ^- node + :- (remake-post post.t) + (remake-internal-graph children.t) + :: + ++ remake-update-logs + |= t=tree-update-logs + ^- update-logs + %- remake-map:migrate + (~(run by t) remake-update-log) + :: + ++ remake-update-log + |= t=tree-update-log + ^- update-log + =/ ulm ((on time logged-update) gth) + %+ gas:ulm *update-log + %+ turn ~(tap by t) + |= [=time tlu=tree-logged-update] + ^- [^time logged-update] + [time (remake-logged-update tlu)] + :: + ++ remake-logged-update + |= t=tree-logged-update + ^- logged-update + :- p.t + ?- -.q.t + %add-graph + :* %add-graph + resource.q.t + (remake-graph tree-graph.q.t) + mark.q.t + ow.q.t + == + :: + %add-nodes + :- %add-nodes + :- resource.q.t + %- remake-map:migrate + (~(run by nodes.q.t) remake-node) + :: + %remove-posts + [%remove-posts resource.q.t (remake-set:migrate indices.q.t)] + :: + %add-signatures + [%add-signatures uid.q.t (remake-set:migrate signatures.q.t)] + :: + %remove-signatures + [%remove-signatures uid.q.t (remake-set:migrate signatures.q.t)] + == + :: + ++ remake-post + |= t=tree-maybe-post + ^- maybe-post + ?- -.t + %| t + %& t(signatures.p (remake-set:migrate signatures.p.t)) + == + :: + ++ try-rejoin + |= [rid=resource nack-count=@] + ^- card:agent:gall + =/ res-path (en-path:res rid) + =/ wire [%try-rejoin (scot %ud nack-count) res-path] + =/ =cage + :- %pull-hook-action + !> ^- action:pull-hook + [%add [entity .]:rid] + [%pass wire %agent [our %graph-pull-hook] %poke cage] + -- +-- diff --git a/desk/lib/migrate.hoon b/desk/lib/migrate.hoon new file mode 100644 index 0000000..2cafcb5 --- /dev/null +++ b/desk/lib/migrate.hoon @@ -0,0 +1,19 @@ +^? |% +++ remake-set + |* s=(tree) + (sy ~(tap in s)) +:: +++ remake-map + |* m=(tree) + (my ~(tap by m)) +:: +++ remake-jug + |* j=(tree [* (tree)]) + %- remake-map + (~(run by j) remake-set) +:: +++ remake-map-of-map + |* mm=(tree [* (tree)]) + %- remake-map + (~(run by mm) remake-map) +-- diff --git a/desk/lib/resource.hoon b/desk/lib/resource.hoon new file mode 100644 index 0000000..f84acb0 --- /dev/null +++ b/desk/lib/resource.hoon @@ -0,0 +1,57 @@ +/- sur=resource +=< resource +|% ++$ resource resource:sur +++ en-path + |= =resource + ^- path + ~[%ship (scot %p entity.resource) name.resource] +:: +++ de-path + |= =path + ^- resource + (need (de-path-soft path)) +:: +++ de-path-soft + |= =path + ^- (unit resource) + ?. ?=([%ship @ @ *] path) + ~ + =/ ship + (slaw %p i.t.path) + ?~ ship + ~ + `[u.ship i.t.t.path] +:: +++ enjs + |= =resource + ^- json + =, enjs:format + %- pairs + :~ ship+(ship entity.resource) + name+s+name.resource + == +:: +++ enjs-path + |= =resource + %- spat + (en-path resource) +:: +++ dejs-path + %- su:dejs:format + ;~ pfix + (jest '/ship/') + ;~((glue fas) ;~(pfix sig fed:ag) urs:ab) + == +:: +++ dejs + =, dejs:format + ^- $-(json resource) + |= jon=json + ~| dejs+%resource + %. jon + %- ot + :~ ship+(su ;~(pfix sig fed:ag)) + name+so + == +-- diff --git a/desk/lib/summarize.hoon b/desk/lib/summarize.hoon new file mode 100644 index 0000000..029c726 --- /dev/null +++ b/desk/lib/summarize.hoon @@ -0,0 +1,99 @@ +:: summarize: utilities for summarizing groups/chat state in various ways +:: +/- chat, groups +:: +|_ [our=@p now=@da] +:: +range: period of time to summarize over +:: +limit: max amount of msgs to count per channel +:: +++ range ~d7 +++ limit 9.999 +:: +++ scry-path + |= [=term =spur] + [(scot %p our) term (scot %da now) spur] +:: +++ summarize-activity + ^- $: sent=@ud + received=@ud + most-sent-group=@t + == + =- :+ s r + =/ g=flag:chat + =< - + ::TODO crashes if no groups + %+ snag 0 + %+ sort ~(tap by g) + |=([[* a=@ud] [* b=@ud]] (gth a b)) + =< title.meta + .^ group:groups + %gx + (scry-path %groups /groups/(scot %p p.g)/[q.g]/group) + == + %+ roll + %~ tap in + .^ (map flag:chat chat:chat) + %gx + (scry-path %chat /chats/chats) + == + =* onn ((on time writ:chat) lte) + |= [[c=flag:chat chat:chat] g=(map flag:chat @ud) s=@ud r=@ud] + =+ .^ log=((mop time writ:chat) lte) + %gx + %+ scry-path %chat + /chat/(scot %p p.c)/[q.c]/writs/newer/(scot %ud (sub now range))/(scot %ud limit)/chat-writs + == + :- %+ ~(put by g) group.perm + (add (~(gut by g) group.perm 0) (wyt:onn log)) + %+ roll (tap:onn log) + |= [[time writ:chat] s=_s r=_r] + ?:(=(our author) [+(s) r] [s +(r)]) +:: +++ summarize-inactivity + ^- $: unread-dms=@ud :: unread dm count + unread-etc=@ud :: unread chats count + top-group=@t :: most active group + top-channel=@t :: most active channel + == + =+ .^ =briefs:chat + %gx + (scry-path %chat /briefs/chat-briefs) + == + :: accumulate unread counts + :: + =/ [dum=@ud duc=@ud] + %- ~(rep by briefs) + |= [[w=whom:chat brief:briefs:chat] n=@ud m=@ud] + ?: ?=(%flag -.w) [n (add m count)] + [(add n count) m] + :+ dum duc + :: gather all chat channels & their groups & unread counts + :: + =/ faz=(list [g=flag:chat c=flag:chat n=@ud]) + %+ turn + %~ tap in + .^ (map flag:chat chat:chat) + %gx + (scry-path %chat /chats/chats) + == + |= [c=flag:chat chat:chat] + :+ group.perm c + count:(~(gut by briefs) flag+c *brief:briefs:chat) + =. faz (sort faz |=([[* * a=@ud] [* * b=@ud]] (gth a b))) + :: get display titles of most active channel and its group + :: + ::NOTE in rare cases, we might not know of the existence of the associated + :: group. simply skip past it and try the next one... + =+ .^ =groups:groups + %gx + =- ~& [%scrying -] - + (scry-path %groups /groups/groups) + == + |- + ?~ faz ['???' '???'] ::TODO better copy + ?. (~(has by groups) g.i.faz) + $(faz t.faz) + =/ =group:^groups (~(got by groups) g.i.faz) + :- title.meta.group + title.meta:(~(got by channels.group) %chat c.i.faz) +-- \ No newline at end of file diff --git a/desk/mar/bark/add-recipient.hoon b/desk/mar/bark/add-recipient.hoon new file mode 100644 index 0000000..54a0b22 --- /dev/null +++ b/desk/mar/bark/add-recipient.hoon @@ -0,0 +1,11 @@ +|_ rec=ship +++ grad %noun +++ grab + |% + ++ noun ship + -- +++ grow + |% + ++ noun rec + -- +-- diff --git a/desk/mar/bark/receive-summary.hoon b/desk/mar/bark/receive-summary.hoon new file mode 100644 index 0000000..293b0af --- /dev/null +++ b/desk/mar/bark/receive-summary.hoon @@ -0,0 +1,20 @@ +=> |% + +$ result + %- unit + $: requested=time + $= summary + ::NOTE see also /lib/summarize + $% [%life active=[s=@ud r=@ud g=@t] inactive=[d=@ud c=@ud g=@t c=@t]] + == == + -- +|_ =result +++ grad %noun +++ grab + |% + ++ noun ^result + -- +++ grow + |% + ++ noun result + -- +-- diff --git a/desk/mar/bark/remove-recipient.hoon b/desk/mar/bark/remove-recipient.hoon new file mode 100644 index 0000000..54a0b22 --- /dev/null +++ b/desk/mar/bark/remove-recipient.hoon @@ -0,0 +1,11 @@ +|_ rec=ship +++ grad %noun +++ grab + |% + ++ noun ship + -- +++ grow + |% + ++ noun rec + -- +-- diff --git a/desk/mar/growl/summarize.hoon b/desk/mar/growl/summarize.hoon new file mode 100644 index 0000000..6276989 --- /dev/null +++ b/desk/mar/growl/summarize.hoon @@ -0,0 +1,11 @@ +|_ requested=time +++ grad %noun +++ grab + |% + ++ noun time + -- +++ grow + |% + ++ noun requested + -- +-- diff --git a/desk/sur/chat-0.hoon b/desk/sur/chat-0.hoon new file mode 100644 index 0000000..b4f4559 --- /dev/null +++ b/desk/sur/chat-0.hoon @@ -0,0 +1,347 @@ +/- g=groups, graph-store +/- meta +/- metadata-store +/- cite +/- e=epic +/+ lib-graph=graph-store +|% +:: $writ: a chat message ++$ writ [seal memo] +:: $id: an identifier for chat messages ++$ id (pair ship time) +:: $feel: either an emoji identifier like :wave: or a URL for custom ++$ feel @ta ++$ said (pair flag writ) +:: +:: $seal: the id of a chat and its meta-responses +:: +:: id: the id of the message +:: feels: reactions to a message +:: replied: set of replies to a message +:: ++$ seal + $: =id + feels=(map ship feel) + replied=(set id) + == +:: +:: $whom: a polymorphic identifier for chats +:: ++$ whom + $% [%flag p=flag] + [%ship p=ship] + [%club p=id:club] + == +:: +:: $briefs: a map of chat/club/dm unread information +:: +:: brief: the last time a message was read, how many messages since, +:: and the id of the last read message +:: +++ briefs + =< briefs + |% + +$ briefs + (map whom brief) + +$ brief + [last=time count=@ud read-id=(unit id)] + +$ update + (pair whom brief) + -- +:: ++$ remark-action + (pair whom remark-diff) +:: ++$ remark-diff + $% [%read ~] + [%read-at p=time] + [?(%watch %unwatch) ~] + == +:: +:: $flag: an identifier for a $chat channel +:: ++$ flag (pair ship term) +:: +:: $diff: represents an update to state +:: +:: %writs: a chat message update +:: %add-sects: add sects to writer permissions +:: %del-sects: delete sects from writers +:: %create: create a new chat +:: ++$ diff + $% [%writs p=diff:writs] + :: + [%add-sects p=(set sect:g)] + [%del-sects p=(set sect:g)] + :: + [%create p=perm q=pact] + == +:: $index: a map of chat message id to server received message time +:: ++$ index (map id time) +:: +:: $pact: a double indexed map of chat messages, id -> time -> message +:: ++$ pact + $: wit=writs + dex=index + == +:: +:: $club: a direct line of communication between multiple parties +:: +:: uses gossip to ensure all parties keep in sync +:: +++ club + =< club + |% + :: $id: an identification signifier for a $club + :: + +$ id @uvH + :: $net: status of club + :: + +$ net ?(%archive %invited %done) + +$ club [=pact crew] + :: + :: $crew: a container for the metadata for the club + :: + :: team: members that have accepted an invite + :: hive: pending members that have been invited + :: met: metadata representing club + :: net: status + :: pin: should the $club be pinned to the top + :: + +$ crew + $: team=(set ship) + hive=(set ship) + met=data:meta + =net + pin=_| + == + :: $rsvp: a $club invitation response + :: + +$ rsvp [=id =ship ok=?] + :: $create: a request to create a $club with a starting set of ships + :: + +$ create + [=id hive=(set ship)] + :: $invite: the contents to send in an invitation to someone + :: + +$ invite [=id team=(set ship) hive=(set ship) met=data:meta] + :: $echo: number of times diff has been echoed + :: + +$ echo @ud + +$ diff (pair echo delta) + :: + +$ delta + $% [%writ =diff:writs] + [%meta meta=data:meta] + [%team =ship ok=?] + [%hive by=ship for=ship add=?] + [%init team=(set ship) hive=(set ship) met=data:meta] + == + :: + +$ action (pair id diff) + -- +:: +:: $writs: a set of time ordered chat messages +:: +++ writs + =< writs + |% + +$ writs + ((mop time writ) lte) + ++ on + ((^on time writ) lte) + +$ diff + (pair id delta) + +$ delta + $% [%add p=memo] + [%del ~] + [%add-feel p=ship q=feel] + [%del-feel p=ship] + == + -- +:: +:: $dm: a direct line of communication between two ships +:: +:: net: status of dm +:: id: a message identifier +:: action: an update to the dm +:: rsvp: a response to a dm invitation +:: +++ dm + =< dm + |% + +$ dm + $: =pact + =remark + =net + pin=_| + == + +$ net ?(%inviting %invited %archive %done) + +$ id (pair ship time) + +$ diff diff:writs + +$ action (pair ship diff) + +$ rsvp [=ship ok=?] + -- +:: +:: $log: a time ordered map of all modifications to groups +:: ++$ log + ((mop time diff) lte) +++ log-on + ((on time diff) lte) ++$ remark + [last-read=time watching=_| ~] +:: +:: $chat: a group based channel for communicating +:: ++$ chat + [=net =remark =log =perm =pact] +:: +:: $notice: the contents of an automated message +:: +:: pfix: text preceding ship name +:: sfix: text following ship name +:: ++$ notice [pfix=@t sfix=@t] +:: +:: $content: the contents of a message whether handwritten or automated +:: ++$ content + $% [%story p=story] + [%notice p=notice] + == +:: +:: $draft: the contents of an unsent message at a particular $whom +:: ++$ draft + (pair whom story) +:: +:: $story: handwritten contents of a message +:: +:: blocks precede inline content +:: ++$ story + (pair (list block) (list inline)) +:: +:: $block: content which stands on it's own outside of inline content +:: ++$ block + $% [%image src=cord height=@ud width=@ud alt=cord] + [%cite =cite] + == +:: +:: $inline: a representation of text with or without formatting +:: +:: @t: plain text +:: %italics: italic text +:: %bold: bold text +:: %strike: strikethrough text +:: %blockquote: blockquote surrounded content +:: %inline-code: code formatting for small snippets +:: %ship: a mention of a ship +:: %block: link/reference to blocks +:: %code: code formatting for large snippets +:: %tag: tag gets special signifier +:: %link: link to a URL with a face +:: %break: line break +:: ++$ inline + $@ @t + $% [%italics p=(list inline)] + [%bold p=(list inline)] + [%strike p=(list inline)] + [%blockquote p=(list inline)] + [%inline-code p=cord] + [%ship p=ship] + [%block p=@ud q=cord] + [%code p=cord] + [%tag p=cord] + [%link p=cord q=cord] + [%break ~] + == +:: +:: $memo: a chat message with metadata +:: +:: replying: what message we're replying to +:: author: writer of the message +:: sent: time (from sender) when the message was sent +:: content: body of the message +:: ++$ memo + $: replying=(unit id) + author=ship + sent=time + =content + == +:: +:: $net: an indicator of whether I'm a host or subscriber +:: +:: %load: iniating chat join +:: %pub: am publisher/host with fresh log +:: %sub: subscribed to the ship +:: ++$ net + $% [%sub host=ship load=_| =saga:e] + [%pub ~] + == +:: +:: $action: the complete set of data required to edit a chat +:: ++$ action + (pair flag update) +:: +:: $update: a representation in time of a modification of a chat +:: ++$ update + (pair time diff) +:: +:: $logs: a time ordered map of all modifications to groups +:: ++$ logs + ((mop time diff) lte) +:: +:: $perm: represents the permissions for a channel and gives a pointer +:: back to the group it belongs to. +:: ++$ perm + $: writers=(set sect:g) + group=flag:g + == +:: +:: $leave: a flag to pass for a channel leave +:: ++$ leave flag:g +:: +:: $create: represents a request to create a channel +:: +:: The name will be used as part of the flag which represents the +:: channel. $create is consumed by the chat agent first +:: and then passed to the groups agent to register the channel with +:: the group. +:: +:: Write permission is stored with the specific agent in the channel, +:: read permission is stored with the group's data. +:: ++$ create + $: group=flag:g + name=term + title=cord + description=cord + readers=(set sect:g) + writers=(set sect:g) + == +++ met metadata-store ++$ club-import [ships=(set ship) =association:met =graph:gra] ++$ club-imports (map flag club-import) +:: ++$ import [writers=(set ship) =association:met =update-log:gra =graph:gra] +:: ++$ imports (map flag import) +:: +++ gra graph-store +++ orm-gra orm:lib-graph +++ orm-log-gra orm-log:lib-graph +-- diff --git a/desk/sur/chat-1.hoon b/desk/sur/chat-1.hoon new file mode 100644 index 0000000..acaca73 --- /dev/null +++ b/desk/sur/chat-1.hoon @@ -0,0 +1,352 @@ +/- g=groups, graph-store +/- meta +/- metadata-store +/- cite +/- e=epic +/+ lib-graph=graph-store +|% +:: $writ: a chat message ++$ writ [seal memo] +:: $id: an identifier for chat messages ++$ id (pair ship time) +:: $feel: either an emoji identifier like :wave: or a URL for custom ++$ feel @ta ++$ said (pair flag writ) +:: +:: $seal: the id of a chat and its meta-responses +:: +:: id: the id of the message +:: feels: reactions to a message +:: replied: set of replies to a message +:: ++$ seal + $: =id + feels=(map ship feel) + replied=(set id) + == +:: +:: $whom: a polymorphic identifier for chats +:: ++$ whom + $% [%flag p=flag] + [%ship p=ship] + [%club p=id:club] + == +:: +:: $briefs: a map of chat/club/dm unread information +:: +:: brief: the last time a message was read, how many messages since, +:: and the id of the last read message +:: +++ briefs + =< briefs + |% + +$ briefs + (map whom brief) + +$ brief + [last=time count=@ud read-id=(unit id)] + +$ update + (pair whom brief) + -- +:: ++$ remark-action + (pair whom remark-diff) +:: ++$ remark-diff + $% [%read ~] + [%read-at p=time] + [?(%watch %unwatch) ~] + == +:: +:: $flag: an identifier for a $chat channel +:: ++$ flag (pair ship term) +:: +:: $diff: represents an update to state +:: +:: %writs: a chat message update +:: %add-sects: add sects to writer permissions +:: %del-sects: delete sects from writers +:: %create: create a new chat +:: ++$ diff + $% [%writs p=diff:writs] + :: + [%add-sects p=(set sect:g)] + [%del-sects p=(set sect:g)] + :: + [%create p=perm q=pact] + == +:: $index: a map of chat message id to server received message time +:: ++$ index (map id time) +:: +:: $pact: a double indexed map of chat messages, id -> time -> message +:: ++$ pact + $: wit=writs + dex=index + == +:: +:: $club: a direct line of communication between multiple parties +:: +:: uses gossip to ensure all parties keep in sync +:: +++ club + =< club + |% + :: $id: an identification signifier for a $club + :: + +$ id @uvH + :: $net: status of club + :: + +$ net ?(%archive %invited %done) + +$ club [=remark =pact crew] + :: + :: $crew: a container for the metadata for the club + :: + :: team: members that have accepted an invite + :: hive: pending members that have been invited + :: met: metadata representing club + :: net: status + :: pin: should the $club be pinned to the top + :: + +$ crew + $: team=(set ship) + hive=(set ship) + met=data:meta + =net + pin=_| + == + :: $rsvp: a $club invitation response + :: + +$ rsvp [=id =ship ok=?] + :: $create: a request to create a $club with a starting set of ships + :: + +$ create + [=id hive=(set ship)] + :: $invite: the contents to send in an invitation to someone + :: + +$ invite [=id team=(set ship) hive=(set ship) met=data:meta] + :: $echo: number of times diff has been echoed + :: + +$ echo @ud + +$ diff (pair echo delta) + :: + +$ delta + $% [%writ =diff:writs] + [%meta meta=data:meta] + [%team =ship ok=?] + [%hive by=ship for=ship add=?] + [%init team=(set ship) hive=(set ship) met=data:meta] + == + :: + +$ action (pair id diff) + -- +:: +:: $writs: a set of time ordered chat messages +:: +++ writs + =< writs + |% + +$ writs + ((mop time writ) lte) + ++ on + ((^on time writ) lte) + +$ diff + (pair id delta) + +$ delta + $% [%add p=memo] + [%del ~] + [%add-feel p=ship q=feel] + [%del-feel p=ship] + == + -- +:: +:: $dm: a direct line of communication between two ships +:: +:: net: status of dm +:: id: a message identifier +:: action: an update to the dm +:: rsvp: a response to a dm invitation +:: +++ dm + =< dm + |% + +$ dm + $: =pact + =remark + =net + pin=_| + == + +$ net ?(%inviting %invited %archive %done) + +$ id (pair ship time) + +$ diff diff:writs + +$ action (pair ship diff) + +$ rsvp [=ship ok=?] + -- +:: +:: $log: a time ordered map of all modifications to groups +:: ++$ log + ((mop time diff) lte) +++ log-on + ((on time diff) lte) ++$ remark + [last-read=time watching=_| ~] +:: +:: $chat: a group based channel for communicating +:: ++$ chat + [=net =remark =log =perm =pact] +:: +:: $notice: the contents of an automated message +:: +:: pfix: text preceding ship name +:: sfix: text following ship name +:: ++$ notice [pfix=@t sfix=@t] +:: +:: $content: the contents of a message whether handwritten or automated +:: ++$ content + $% [%story p=story] + [%notice p=notice] + == +:: +:: $draft: the contents of an unsent message at a particular $whom +:: ++$ draft + (pair whom story) +:: +:: $story: handwritten contents of a message +:: +:: blocks precede inline content +:: ++$ story + (pair (list block) (list inline)) +:: +:: $block: content which stands on it's own outside of inline content +:: ++$ block + $% [%image src=cord height=@ud width=@ud alt=cord] + [%cite =cite] + == +:: +:: $inline: a representation of text with or without formatting +:: +:: @t: plain text +:: %italics: italic text +:: %bold: bold text +:: %strike: strikethrough text +:: %blockquote: blockquote surrounded content +:: %inline-code: code formatting for small snippets +:: %ship: a mention of a ship +:: %block: link/reference to blocks +:: %code: code formatting for large snippets +:: %tag: tag gets special signifier +:: %link: link to a URL with a face +:: %break: line break +:: ++$ inline + $@ @t + $% [%italics p=(list inline)] + [%bold p=(list inline)] + [%strike p=(list inline)] + [%blockquote p=(list inline)] + [%inline-code p=cord] + [%ship p=ship] + [%block p=@ud q=cord] + [%code p=cord] + [%tag p=cord] + [%link p=cord q=cord] + [%break ~] + == +:: +:: $memo: a chat message with metadata +:: +:: replying: what message we're replying to +:: author: writer of the message +:: sent: time (from sender) when the message was sent +:: content: body of the message +:: ++$ memo + $: replying=(unit id) + author=ship + sent=time + =content + == +:: +:: $net: an indicator of whether I'm a host or subscriber +:: +:: %load: iniating chat join +:: %pub: am publisher/host with fresh log +:: %sub: subscribed to the ship +:: ++$ net + $% [%sub host=ship load=_| =saga:e] + [%pub ~] + == +:: +:: $action: the complete set of data required to edit a chat +:: ++$ action + (pair flag update) +:: +:: $update: a representation in time of a modification of a chat +:: ++$ update + (pair time diff) +:: +:: $logs: a time ordered map of all modifications to groups +:: ++$ logs + ((mop time diff) lte) +:: +:: $perm: represents the permissions for a channel and gives a pointer +:: back to the group it belongs to. +:: ++$ perm + $: writers=(set sect:g) + group=flag:g + == +:: $join: a group + channel flag to join a channel, group required for perms +:: ++$ join + $: group=flag:g + chan=flag:g + == +:: $leave: a flag to pass for a channel leave +:: ++$ leave flag:g +:: +:: $create: represents a request to create a channel +:: +:: The name will be used as part of the flag which represents the +:: channel. $create is consumed by the chat agent first +:: and then passed to the groups agent to register the channel with +:: the group. +:: +:: Write permission is stored with the specific agent in the channel, +:: read permission is stored with the group's data. +:: ++$ create + $: group=flag:g + name=term + title=cord + description=cord + readers=(set sect:g) + writers=(set sect:g) + == +++ met metadata-store ++$ club-import [ships=(set ship) =association:met =graph:gra] ++$ club-imports (map flag club-import) +:: ++$ import [writers=(set ship) =association:met =update-log:gra =graph:gra] +:: ++$ imports (map flag import) +:: +++ gra graph-store +++ orm-gra orm:lib-graph +++ orm-log-gra orm-log:lib-graph +-- diff --git a/desk/sur/chat.hoon b/desk/sur/chat.hoon new file mode 100644 index 0000000..11f7d0b --- /dev/null +++ b/desk/sur/chat.hoon @@ -0,0 +1,372 @@ +/- g=groups, graph-store, uno=chat-1, zer=chat-0 +/- meta +/- metadata-store +/- cite +/- e=epic +/+ lib-graph=graph-store +|% +++ old + |% + ++ zero zer + ++ one uno + -- +:: +mar: mark name +++ okay `epic:e`0 +++ mar + |% + ++ act `mark`(rap 3 %chat-action '-' (scot %ud okay) ~) + ++ upd `mark`(rap 3 %chat-update '-' (scot %ud okay) ~) + ++ log `mark`(rap 3 %chat-logs '-' (scot %ud okay) ~) + -- +:: +:: $scan: search results ++$ scan (list (pair time writ)) +:: $writ: a chat message ++$ writ [seal memo] +:: $id: an identifier for chat messages ++$ id (pair ship time) +:: $feel: either an emoji identifier like :wave: or a URL for custom ++$ feel @ta ++$ said (pair flag writ) +:: +:: $seal: the id of a chat and its meta-responses +:: +:: id: the id of the message +:: feels: reactions to a message +:: replied: set of replies to a message +:: ++$ seal + $: =id + feels=(map ship feel) + replied=(set id) + == +:: +:: $whom: a polymorphic identifier for chats +:: ++$ whom + $% [%flag p=flag] + [%ship p=ship] + [%club p=id:club] + == +:: +:: $briefs: a map of chat/club/dm unread information +:: +:: brief: the last time a message was read, how many messages since, +:: and the id of the last read message +:: +++ briefs + =< briefs + |% + +$ briefs + (map whom brief) + +$ brief + [last=time count=@ud read-id=(unit id)] + +$ update + (pair whom brief) + -- +:: ++$ remark-action + (pair whom remark-diff) +:: ++$ remark-diff + $% [%read ~] + [%read-at p=time] + [?(%watch %unwatch) ~] + == +:: +:: $flag: an identifier for a $chat channel +:: ++$ flag (pair ship term) +:: +:: $diff: represents an update to state +:: +:: %writs: a chat message update +:: %add-sects: add sects to writer permissions +:: %del-sects: delete sects from writers +:: %create: create a new chat +:: ++$ diff + $% [%writs p=diff:writs] + :: + [%add-sects p=(set sect:g)] + [%del-sects p=(set sect:g)] + :: + [%create p=perm q=pact] + == +:: $index: a map of chat message id to server received message time +:: ++$ index (map id time) +:: +:: $pact: a double indexed map of chat messages, id -> time -> message +:: ++$ pact + $: wit=writs + dex=index + == +:: +:: $club: a direct line of communication between multiple parties +:: +:: uses gossip to ensure all parties keep in sync +:: +++ club + =< club + |% + :: $id: an identification signifier for a $club + :: + +$ id @uvH + :: $net: status of club + :: + +$ net ?(%archive %invited %done) + +$ club [=heard =remark =pact =crew] + :: + :: $crew: a container for the metadata for the club + :: + :: team: members that have accepted an invite + :: hive: pending members that have been invited + :: met: metadata representing club + :: net: status + :: pin: should the $club be pinned to the top + :: + +$ crew + $: team=(set ship) + hive=(set ship) + met=data:meta + =net + pin=_| + == + :: $rsvp: a $club invitation response + :: + +$ rsvp [=id =ship ok=?] + :: $create: a request to create a $club with a starting set of ships + :: + +$ create + [=id hive=(set ship)] + :: $invite: the contents to send in an invitation to someone + :: + +$ invite [=id team=(set ship) hive=(set ship) met=data:meta] + :: $uid: unique identifier for each club action + :: + +$ uid @uv + :: $heard: the set of action uid's we've already heard + :: + +$ heard (set uid) + :: + +$ diff (pair uid delta) + :: + +$ delta + $% [%writ =diff:writs] + [%meta meta=data:meta] + [%team =ship ok=?] + [%hive by=ship for=ship add=?] + [%init team=(set ship) hive=(set ship) met=data:meta] + == + :: + +$ action (pair id diff) + -- +:: +:: $writs: a set of time ordered chat messages +:: +++ writs + =< writs + |% + +$ writs + ((mop time writ) lte) + ++ on + ((^on time writ) lte) + +$ diff + (pair id delta) + +$ delta + $% [%add p=memo] + [%del ~] + [%add-feel p=ship q=feel] + [%del-feel p=ship] + == + -- +:: +:: $dm: a direct line of communication between two ships +:: +:: net: status of dm +:: id: a message identifier +:: action: an update to the dm +:: rsvp: a response to a dm invitation +:: +++ dm + =< dm + |% + +$ dm + $: =pact + =remark + =net + pin=_| + == + +$ net ?(%inviting %invited %archive %done) + +$ id (pair ship time) + +$ diff diff:writs + +$ action (pair ship diff) + +$ rsvp [=ship ok=?] + -- +:: +:: $log: a time ordered map of all modifications to chats +:: ++$ log + ((mop time diff) lte) +++ log-on + ((on time diff) lte) ++$ remark + [last-read=time watching=_| ~] +:: +:: $chat: a group based channel for communicating +:: ++$ chat + [=net =remark =log =perm =pact] +:: +:: $notice: the contents of an automated message +:: +:: pfix: text preceding ship name +:: sfix: text following ship name +:: ++$ notice [pfix=@t sfix=@t] +:: +:: $content: the contents of a message whether handwritten or automated +:: ++$ content + $% [%story p=story] + [%notice p=notice] + == +:: +:: $draft: the contents of an unsent message at a particular $whom +:: ++$ draft + (pair whom story) +:: +:: $story: handwritten contents of a message +:: +:: blocks precede inline content +:: ++$ story + (pair (list block) (list inline)) +:: +:: $block: content which stands on it's own outside of inline content +:: ++$ block + $% [%image src=cord height=@ud width=@ud alt=cord] + [%cite =cite] + == +:: +:: $inline: a representation of text with or without formatting +:: +:: @t: plain text +:: %italics: italic text +:: %bold: bold text +:: %strike: strikethrough text +:: %blockquote: blockquote surrounded content +:: %inline-code: code formatting for small snippets +:: %ship: a mention of a ship +:: %block: link/reference to blocks +:: %code: code formatting for large snippets +:: %tag: tag gets special signifier +:: %link: link to a URL with a face +:: %break: line break +:: ++$ inline + $@ @t + $% [%italics p=(list inline)] + [%bold p=(list inline)] + [%strike p=(list inline)] + [%blockquote p=(list inline)] + [%inline-code p=cord] + [%ship p=ship] + [%block p=@ud q=cord] + [%code p=cord] + [%tag p=cord] + [%link p=cord q=cord] + [%break ~] + == +:: +:: $memo: a chat message with metadata +:: +:: replying: what message we're replying to +:: author: writer of the message +:: sent: time (from sender) when the message was sent +:: content: body of the message +:: ++$ memo + $: replying=(unit id) + author=ship + sent=time + =content + == +:: +:: $net: an indicator of whether I'm a host or subscriber +:: +:: %load: iniating chat join +:: %pub: am publisher/host with fresh log +:: %sub: subscribed to the ship +:: ++$ net + $% [%sub host=ship load=_| =saga:e] + [%pub ~] + == +:: +:: $action: the complete set of data required to edit a chat +:: ++$ action + (pair flag update) +:: +:: $update: a representation in time of a modification of a chat +:: ++$ update + (pair time diff) +:: +:: $logs: a time ordered map of all modifications to groups +:: ++$ logs + ((mop time diff) lte) +:: +:: $perm: represents the permissions for a channel and gives a pointer +:: back to the group it belongs to. +:: ++$ perm + $: writers=(set sect:g) + group=flag:g + == +:: $join: a group + channel flag to join a channel, group required for perms +:: ++$ join + $: group=flag:g + chan=flag:g + == +:: $leave: a flag to pass for a channel leave +:: ++$ leave flag:g +:: +:: $create: represents a request to create a channel +:: +:: The name will be used as part of the flag which represents the +:: channel. $create is consumed by the chat agent first +:: and then passed to the groups agent to register the channel with +:: the group. +:: +:: Write permission is stored with the specific agent in the channel, +:: read permission is stored with the group's data. +:: ++$ create + $: group=flag:g + name=term + title=cord + description=cord + readers=(set sect:g) + writers=(set sect:g) + == +++ met metadata-store ++$ club-import [ships=(set ship) =association:met =graph:gra] ++$ club-imports (map flag club-import) +:: ++$ import [writers=(set ship) =association:met =update-log:gra =graph:gra] +:: ++$ imports (map flag import) +:: +++ gra graph-store +++ orm-gra orm:lib-graph +++ orm-log-gra orm-log:lib-graph +-- diff --git a/desk/sur/cite.hoon b/desk/sur/cite.hoon new file mode 100644 index 0000000..387342b --- /dev/null +++ b/desk/sur/cite.hoon @@ -0,0 +1,57 @@ +/- g=groups +=< cite +|% +++ purse + |= =(pole knot) + ^- (unit cite) + ?. =(~.1 -.pole) ~ + =. pole +.pole + ?+ pole ~ + [%chan agent=@ ship=@ name=@ rest=*] + =/ ship (slaw %p ship.pole) + ?~ ship ~ + `[%chan [agent.pole u.ship name.pole] rest.pole] + :: + [%desk ship=@ name=@ rest=*] + =/ ship (slaw %p ship.pole) + ?~ ship ~ + `[%desk [u.ship name.pole] rest.pole] + :: + [%group ship=@ name=@ ~] + =/ ship (slaw %p ship.pole) + ?~ ship ~ + `[%group u.ship name.pole] + == +++ parse + |= =path + ^- cite + (need (purse path)) +:: +++ print + |= c=cite + |^ ^- path + :- (scot %ud 1) + ?- -.c + %chan chan/(welp (nest nest.c) wer.c) + %desk desk/(welp (flag flag.c) wer.c) + %group group/(flag flag.c) + %bait bait/:(welp (flag grp.c) (flag gra.c) wer.c) + == + ++ flag + |= f=flag:g + ~[(scot %p p.f) q.f] + ++ nest + |= n=nest:g + [p.n (flag q.n)] + -- +:: ++$ cite + $% [%chan =nest:g wer=path] + [%group =flag:g] + [%desk =flag:g wer=path] + [%bait grp=flag:g gra=flag:g wer=path] + :: scry into groups when you receive a bait for a chat that doesn't exist yet + :: work out what app + == +-- + diff --git a/desk/sur/epic.hoon b/desk/sur/epic.hoon new file mode 100644 index 0000000..30d7f7e --- /dev/null +++ b/desk/sur/epic.hoon @@ -0,0 +1,15 @@ +|% +:: $saga: version synchronisation state +:: %dex: publisher is ahead +:: %lev: we are ahead +:: %chi: full sync +:: ++$ saga + $% [%dex ver=@ud] + [%lev ~] + [%chi ~] + == + ++$ epic @ud +:: +-- diff --git a/desk/sur/graph-store.hoon b/desk/sur/graph-store.hoon new file mode 100644 index 0000000..4824449 --- /dev/null +++ b/desk/sur/graph-store.hoon @@ -0,0 +1,272 @@ +/- *post +|% ++$ graph ((mop atom node) gth) ++$ marked-graph [p=graph q=(unit mark)] +:: ++$ maybe-post (each post hash) ++$ node [post=maybe-post children=internal-graph] ++$ graphs (map resource marked-graph) +:: ++$ tag-queries (jug term uid) +:: ++$ update-log ((mop time logged-update) gth) ++$ update-logs (map resource update-log) +:: ++$ internal-graph + $~ [%empty ~] + $% [%graph p=graph] + [%empty ~] + == +:: ++$ network + $: =graphs + =tag-queries + =update-logs + archive=graphs + ~ + == +:: ++$ update [p=time q=action] +:: ++$ logged-update [p=time q=logged-action] + +:: ++$ logged-action + $% [%add-graph =resource =graph mark=(unit mark) overwrite=?] + [%add-nodes =resource nodes=(map index node)] + [%remove-posts =resource indices=(set index)] + [%add-signatures =uid =signatures] + [%remove-signatures =uid =signatures] + == +:: ++$ action + $% logged-action + [%remove-graph =resource] + :: + [%add-tag =term =uid] + [%remove-tag =term =uid] + :: + [%archive-graph =resource] + [%unarchive-graph =resource] + [%run-updates =resource =update-log] + :: + :: NOTE: cannot be sent as pokes + :: + [%keys =resources] + [%tags tags=(set term)] + [%tag-queries =tag-queries] + == +:: ++$ permissions + [admin=permission-level writer=permission-level reader=permission-level] +:: +:: $permission-level: levels of permissions in increasing order +:: +:: %no: May not add/remove node +:: %self: May only nodes beneath nodes that were added by +:: the same pilot, may remove nodes that the pilot 'owns' +:: %yes: May add a node or remove node ++$ permission-level + ?(%no %self %yes) +:: +:: %graph-store types version 2 +:: +++ two + =< [. post-one] + =, post-one + |% + +$ maybe-post (each post hash) + ++ orm ((on atom node) gth) + ++ orm-log ((on time logged-update) gth) + :: + +$ graph ((mop atom node) gth) + +$ marked-graph [p=graph q=(unit mark)] + :: + +$ node [post=maybe-post children=internal-graph] + +$ graphs (map resource marked-graph) + :: + +$ tag-queries (jug term resource) + :: + +$ update-log ((mop time logged-update) gth) + +$ update-logs (map resource update-log) + :: + +$ internal-graph + $~ [%empty ~] + $% [%graph p=graph] + [%empty ~] + == + :: + +$ network + $: =graphs + =tag-queries + =update-logs + archive=graphs + validators=(set mark) + == + :: + +$ update [p=time q=action] + :: + +$ logged-update [p=time q=logged-action] + :: + +$ logged-action + $% [%add-graph =resource =graph mark=(unit mark) overwrite=?] + [%add-nodes =resource nodes=(map index node)] + [%remove-nodes =resource indices=(set index)] + [%add-signatures =uid =signatures] + [%remove-signatures =uid =signatures] + == + :: + +$ action + $% logged-action + [%remove-graph =resource] + :: + [%add-tag =term =resource] + [%remove-tag =term =resource] + :: + [%archive-graph =resource] + [%unarchive-graph =resource] + [%run-updates =resource =update-log] + :: + :: NOTE: cannot be sent as pokes + :: + [%keys =resources] + [%tags tags=(set term)] + [%tag-queries =tag-queries] + == + -- +:: +:: %graph-store types version 1 +:: +++ one + =< [. post-one] + =, post-one + |% + ++ orm ((on atom node) gth) + ++ orm-log ((on time logged-update) gth) + :: + +$ graph ((mop atom node) gth) + +$ marked-graph [p=graph q=(unit mark)] + :: + +$ node [=post children=internal-graph] + +$ graphs (map resource marked-graph) + :: + +$ tag-queries (jug term resource) + :: + +$ update-log ((mop time logged-update) gth) + +$ update-logs (map resource update-log) + :: + +$ internal-graph + $~ [%empty ~] + $% [%graph p=graph] + [%empty ~] + == + :: + +$ network + $: =graphs + =tag-queries + =update-logs + archive=graphs + validators=(set mark) + == + :: + +$ update [p=time q=action] + :: + +$ logged-update [p=time q=logged-action] + :: + +$ logged-action + $% [%add-graph =resource =graph mark=(unit mark) overwrite=?] + [%add-nodes =resource nodes=(map index node)] + [%remove-nodes =resource indices=(set index)] + [%add-signatures =uid =signatures] + [%remove-signatures =uid =signatures] + == + :: + +$ action + $% logged-action + [%remove-graph =resource] + :: + [%add-tag =term =resource] + [%remove-tag =term =resource] + :: + [%archive-graph =resource] + [%unarchive-graph =resource] + [%run-updates =resource =update-log] + :: + :: NOTE: cannot be sent as pokes + :: + [%keys =resources] + [%tags tags=(set term)] + [%tag-queries =tag-queries] + == + -- +:: +:: %graph-store types version 0 +:: +++ zero + =< [. post-zero] + =, post-zero + |% + ++ orm ((ordered-map atom node) gth) + ++ orm-log ((ordered-map time logged-update) gth) + :: + +$ graph ((mop atom node) gth) + +$ marked-graph [p=graph q=(unit mark)] + :: + +$ node [=post children=internal-graph] + +$ graphs (map resource marked-graph) + :: + +$ tag-queries (jug term resource) + :: + +$ update-log ((mop time logged-update) gth) + +$ update-logs (map resource update-log) + :: + :: + +$ internal-graph + $~ [%empty ~] + $% [%graph p=graph] + [%empty ~] + == + :: + +$ network + $: =graphs + =tag-queries + =update-logs + archive=graphs + validators=(set mark) + == + :: + +$ update + $% [%0 p=time q=update-0] + == + :: + +$ logged-update + $% [%0 p=time q=logged-update-0] + == + :: + +$ logged-update-0 + $% [%add-graph =resource =graph mark=(unit mark) overwrite=?] + [%add-nodes =resource nodes=(map index node)] + [%remove-nodes =resource indices=(set index)] + [%add-signatures =uid =signatures] + [%remove-signatures =uid =signatures] + == + :: + +$ update-0 + $% logged-update-0 + [%remove-graph =resource] + :: + [%add-tag =term =resource] + [%remove-tag =term =resource] + :: + [%archive-graph =resource] + [%unarchive-graph =resource] + [%run-updates =resource =update-log] + :: + :: NOTE: cannot be sent as pokes + :: + [%keys =resources] + [%tags tags=(set term)] + [%tag-queries =tag-queries] + == + -- +-- diff --git a/desk/sur/group-store.hoon b/desk/sur/group-store.hoon new file mode 100644 index 0000000..5a3931f --- /dev/null +++ b/desk/sur/group-store.hoon @@ -0,0 +1,39 @@ +/- *group, *resource +^? +|% +:: +:: $action: request to change group-store state +:: +:: %add-group: add a group +:: %add-members: add members to a group +:: %remove-members: remove members from a group +:: %add-tag: add a tag to a set of ships +:: %remove-tag: remove a tag from a set of ships +:: %change-policy: change a group's policy +:: %remove-group: remove a group from the store +:: %expose: unset .hidden flag +:: ++$ action + $% [%add-group =resource =policy hidden=?] + [%add-members =resource ships=(set ship)] + [%remove-members =resource ships=(set ship)] + [%add-tag =resource =tag ships=(set ship)] + [%remove-tag =resource =tag ships=(set ship)] + [%change-policy =resource =diff:policy] + [%remove-group =resource ~] + [%expose =resource ~] + == +:: $update: a description of a processed state change +:: +:: %initial: describe groups upon new subscription +:: ++$ update + $% initial + action + == ++$ initial + $% [%initial-group =resource =group] + [%initial =groups] + == +-- + diff --git a/desk/sur/group.hoon b/desk/sur/group.hoon new file mode 100644 index 0000000..c580649 --- /dev/null +++ b/desk/sur/group.hoon @@ -0,0 +1,109 @@ +/- *resource +:: +^? +|% +:: +++ groups-state-one + |% + +$ groups (map resource group) + :: + +$ tag $@(group-tag [app=term tag=term]) + :: + +$ tags (jug tag ship) + :: + +$ group + $: members=(set ship) + =tags + =policy + hidden=? + == + -- +:: $groups: a mapping from group-ids to groups +:: ++$ groups (map resource group) +:: $group-tag: an identifier used by groups +:: +:: These tags should have precise semantics, as they are shared across all +:: apps. +:: ++$ group-tag ?(role-tag) +:: $tag: an identifier used to identify a subset of members +:: +:: Tags may be used and recognised differently across apps. +:: for example, you could use tags like `%author`, `%bot`, `%flagged`... +:: ++$ tag $@(group-tag [app=term =resource tag=term]) +:: $role-tag: a kind of $group-tag that identifies a privileged user +:: +:: These roles are +:: %admin: Administrator, can do everything except delete the group +:: %moderator: Moderator, can add/remove/ban users +:: %janitor: Has no special meaning inside group-store, +:: but may be given additional privileges in other apps. +:: ++$ role-tag + ?(%admin %moderator %janitor) +:: $tags: a mapping from a $tag to the members it identifies +:: ++$ tags (jug tag ship) +:: $group: description of a group of users +:: +:: .members: members of the group +:: .tag-queries: a map of tags to subsets of members +:: .policy: permissions for the group +:: .hidden: is group unmanaged ++$ group + $: members=(set ship) + =tags + =policy + hidden=? + == +:: $policy: access control for a group +:: +++ policy + =< policy + |% + :: + +$ policy + $% invite + open + == + :: $diff: change group policy + +$ diff + $% [%invite diff:invite] + [%open diff:open] + [%replace =policy] + == + :: $invite: allow only invited ships + ++ invite + =< invite-policy + |% + :: + +$ invite-policy + [%invite pending=(set ship)] + :: $diff: add or remove invites + :: + +$ diff + $% [%add-invites invitees=(set ship)] + [%remove-invites invitees=(set ship)] + == + -- + :: $open: allow all unbanned ships of approriate rank + :: + ++ open + =< open-policy + |% + :: + +$ open-policy + [%open ban-ranks=(set rank:title) banned=(set ship)] + :: $diff: ban or allow ranks and ships + :: + +$ diff + $% [%allow-ranks ranks=(set rank:title)] + [%ban-ranks ranks=(set rank:title)] + [%ban-ships ships=(set ship)] + [%allow-ships ships=(set ship)] + == + -- + -- +-- diff --git a/desk/sur/groups.hoon b/desk/sur/groups.hoon new file mode 100644 index 0000000..eca00f5 --- /dev/null +++ b/desk/sur/groups.hoon @@ -0,0 +1,360 @@ +/- meta, e=epic +/- old=group +/- grp=group-store +/- metadata-store +|% +++ okay `epic:e`2 +++ mar + |% + ++ act `mark`(rap 3 %group-action '-' (scot %ud okay) ~) + ++ upd `mark`(rap 3 %group-update '-' (scot %ud okay) ~) + ++ log `mark`(rap 3 %group-log '-' (scot %ud okay) ~) + ++ int `mark`(rap 3 %group-init '-' (scot %ud okay) ~) + -- +:: $flag: ID for a group +:: ++$ flag (pair ship term) +:: +:: $nest: ID for a channel, {app}/{ship}/{name} +:: ++$ nest (pair dude:gall flag) +:: +:: $sect: ID for cabal, similar to a role +:: ++$ sect term +:: +:: $zone: channel grouping +:: +:: includes its own metadata for display and keeps the order of +:: channels within. +:: +:: zone: the term that represents the ID of a zone +:: realm: the metadata representing the zone and the order of channels +:: delta: the set of actions that can be taken on a zone +:: %add: create a zone +:: %del: delete the zone +:: %edit: modify the zone metadata +:: %mov: reorders the zone in the group +:: %mov-nest: reorders a channel within the zone +:: +++ zone + =< zone + |% + +$ zone @tas + +$ realm + $: met=data:meta + ord=(list nest) + == + +$ diff (pair zone delta) + +$ delta + $% [%add meta=data:meta] + [%del ~] + [%edit meta=data:meta] + [%mov idx=@ud] + [%mov-nest =nest idx=@ud] + == + -- +:: +:: $fleet: group members and their associated metadata +:: +:: vessel: a user's set of sects or roles and the time that they joined +:: @da default represents an admin added member that has yet to join +:: +++ fleet + =< fleet + |% + +$ fleet (map ship vessel) + +$ vessel + $: sects=(set sect) + joined=time + == + +$ diff + $% [%add ~] + [%del ~] + [%add-sects sects=(set sect)] + [%del-sects sects=(set sect)] + == + -- +:: +:: $channel: a medium for interaction +:: +++ channel + =< channel + |% + +$ preview + $: =nest + meta=data:meta + group=^preview + == + :: + +$ channels (map nest channel) + :: + :: $channel: a collection of metadata about a specific agent integration + :: + :: meta: title, description, image, cover + :: added: when the channel was created + :: zone: what zone or section to bucket in + :: join: should the channel be joined by new members + :: readers: what sects can see the channel, empty means anyone + :: + +$ channel + $: meta=data:meta + added=time + =zone + join=? + readers=(set sect) + == + :: + :: $diff: represents the set of actions you can take on a channel + :: + :: add: create a channel + :: edit: edit a channel + :: del: delete a channel + :: add-sects: add sects to readers + :: del-sects: delete sects from readers + :: zone: change the zone of the channel + :: join: toggle default join + :: + +$ diff + $% [%add =channel] + [%edit =channel] + [%del ~] + :: + [%add-sects sects=(set sect)] + [%del-sects sects=(set sect)] + :: + [%zone =zone] + :: + [%join join=_|] + == + -- +:: +:: $group: collection of people and the pathways in which they interact +:: +:: group holds all data around members, permissions, channel +:: organization, and its own metadata to represent the group +:: ++$ group + $: =fleet + cabals=(map sect cabal) + zones=(map zone realm:zone) + zone-ord=(list zone) + =bloc + =channels:channel + imported=(set nest) + =cordon + secret=? + meta=data:meta + == +:: +:: $cabal: metadata representing a $sect or role +:: +++ cabal + =< cabal + |% + :: + +$ cabal + [meta=data:meta ~] + :: + +$ diff + $% [%add meta=data:meta] + [%edit meta=data:meta] + [%del ~] + == + -- +:: +:: $cordon: group entry and visibility permissions +:: +++ cordon + =< cordon + |% + :: + :: $open: a group with open entry, only bans are barred entry + :: + ++ open + |% + :: $ban: set of ships and ranks/classes that are not allowed entry + :: + :: bans can either be done at the individual ship level or by the + :: rank level (comet/moon/etc.) + :: + +$ ban [ships=(set ship) ranks=(set rank:title)] + +$ diff + $% [%add-ships p=(set ship)] + [%del-ships p=(set ship)] + :: + [%add-ranks p=(set rank:title)] + [%del-ranks p=(set rank:title)] + == + -- + :: + :: $shut: a group with closed entry, everyone barred entry + :: + :: a shut cordon means that the group is closed, but still visible. + :: people may request entry and either be accepted or denied or + :: they may be invited directly + :: + :: ask: represents those requesting entry + :: pending: represents those who've been invited + :: + ++ shut + |% + +$ state [pend=(set ship) ask=(set ship)] + +$ kind ?(%ask %pending) + +$ diff + $% [%add-ships p=kind q=(set ship)] + [%del-ships p=kind q=(set ship)] + == + -- + :: + :: $cordon: a set of metadata to represent the entry policy for a group + :: + :: open: a group with open entry, only bans barred entry + :: shut: a group with closed entry, everyone barred entry + :: afar: a custom entry policy defined by another agent + :: + +$ cordon + $% [%shut state:shut] + [%afar =flag =path desc=@t] + [%open =ban:open] + == + :: + :: $diff: the actions you can take on a cordon + :: + +$ diff + $% [%shut p=diff:shut] + [%open p=diff:open] + [%swap p=cordon] + == + -- +:: +:: $bloc: superuser sects +:: +:: sects in the bloc set are allowed to make modifications to the group +:: and its various metadata and permissions +:: +++ bloc + =< bloc + |% + +$ bloc (set sect) + +$ diff + $% [%add p=(set sect)] + [%del p=(set sect)] + == + -- +:: +:: $diff: the general set of changes that can be made to a group +:: ++$ diff + $% [%fleet p=(set ship) q=diff:fleet] + [%cabal p=sect q=diff:cabal] + [%channel p=nest q=diff:channel] + [%bloc p=diff:bloc] + [%cordon p=diff:cordon] + [%zone p=diff:zone] + [%meta p=data:meta] + [%secret p=?] + [%create p=group] + [%del ~] + == +:: +:: $action: the complete set of data required to edit a group +:: ++$ action + (pair flag update) +:: +:: $update: a representation in time of a modification of a group +:: ++$ update + (pair time diff) +:: +:: $create: a request to make a group +:: ++$ create + $: name=term + title=cord + description=cord + image=cord + cover=cord + =cordon + members=(jug ship sect) + secret=? + == +:: ++$ init [=time =group] +:: ++$ groups + (map flag group) ++$ net-groups + (map flag [net group]) +:: +:: $log: a time ordered map of all modifications to groups +:: ++$ log + ((mop time diff) lte) +:: +++ log-on + ((on time diff) lte) +:: +:: $net: an indicator of whether I'm a host or subscriber +:: ++$ net + $~ [%pub ~] + $% [%pub p=log] + [%sub p=time load=_| =saga:e] + == +:: +:: $join: a join request, can elect to join all channels +:: ++$ join + $: =flag + join-all=? + == +:: +:: $knock: a request to enter a closed group +:: ++$ knock flag +:: +:: $progress: the state of a group join +:: ++$ progress + ?(%knocking %adding %watching %done %error) +:: +:: $claim: a mark for gangs to represent a join in progress +:: ++$ claim + $: join-all=? + =progress + == +:: +:: $preview: the metadata and entry policy for a group +:: ++$ preview + $: =flag + meta=data:meta + =cordon + =time + secret=? + == +:: ++$ previews (map flag preview) +:: +:: $invite: a marker to show you've been invited to a group +:: ++$ invite (pair flag ship) +:: +:: $gang: view of foreign group +:: ++$ gang + $: cam=(unit claim) + pev=(unit preview) + vit=(unit invite) + == +:: ++$ gangs (map flag gang) +++ met metadata-store +:: ++$ import [self=association:met chan=(map flag =association:met) roles=(set flag) =group:old] +:: ++$ imports (map flag import) +-- diff --git a/desk/sur/meta.hoon b/desk/sur/meta.hoon new file mode 100644 index 0000000..d8abbfa --- /dev/null +++ b/desk/sur/meta.hoon @@ -0,0 +1,21 @@ +|% +:: $data: generic metadata for various entities +:: +:: title: the pretty text representing what something is called +:: description: a longer text entry giving a detailed summary +:: image: an image URL or color string used as an icon/avatar +:: cover: an image URL or color string, used as a header +:: ++$ data + $: title=cord + description=cord + image=cord + cover=cord + == ++$ diff + $% [%title =cord] + [%description =cord] + [%image =cord] + [%cover =cord] + == +-- diff --git a/desk/sur/metadata-store.hoon b/desk/sur/metadata-store.hoon new file mode 100644 index 0000000..9979f3e --- /dev/null +++ b/desk/sur/metadata-store.hoon @@ -0,0 +1,138 @@ +/- *resource +^? +|% +:: ++$ app-name term ++$ md-resource [=app-name =resource] ++$ association [group=resource =metadatum] ++$ associations (map md-resource association) ++$ group-preview + $: group=resource + channels=associations + members=@ud + channel-count=@ud + =metadatum + == +:: ++$ color @ux ++$ url @t +:: +:: $vip-metadata: variation in permissions +:: +:: This will be passed to the graph-permissions mark +:: conversion to allow for custom permissions. +:: +:: %reader-comments: Allow readers to comment, regardless +:: of whether they can write. (notebook, collections) +:: %member-metadata: Allow members to add channels (groups) +:: %host-feed: Only host can post to group feed +:: %admin-feed: Only admins and host can post to group feed +:: %$: No variation +:: ++$ vip-metadata + $? %reader-comments + %member-metadata + %host-feed + %admin-feed + %$ + == +:: ++$ md-config + $~ [%empty ~] + $% [%group feed=(unit (unit md-resource))] + [%graph module=term] + [%empty ~] + == +:: ++$ edit-field + $% [%title title=cord] + [%description description=cord] + [%color color=@ux] + [%picture =url] + [%preview preview=?] + [%hidden hidden=?] + [%vip vip=vip-metadata] + == +:: ++$ metadatum + $: title=cord + description=cord + =color + date-created=time + creator=ship + config=md-config + picture=url + preview=? + hidden=? + vip=vip-metadata + == +:: ++$ action + $% [%add group=resource resource=md-resource =metadatum] + [%remove group=resource resource=md-resource] + [%edit group=resource resource=md-resource =edit-field] + [%initial-group group=resource =associations] + == +:: ++$ hook-update + $% [%req-preview group=resource] + [%preview group-preview] + == +:: ++$ update + $% action + [%associations =associations] + $: %updated-metadata + group=resource + resource=md-resource + before=metadatum + =metadatum + == + == +:: historical +++ one + |% + :: + +$ action + $~ [%remove *resource *md-resource] + $< %edit ^action + :: + +$ update + $~ [%remove *resource *md-resource] + $< %edit ^update + :: + -- +++ zero + |% + :: + +$ association [group=resource =metadatum] + :: + +$ associations (map md-resource association) + :: + +$ metadatum + $: title=cord + description=cord + =color + date-created=time + creator=ship + module=term + picture=url + preview=? + vip=vip-metadata + == + :: + +$ update + $% [%add group=resource resource=md-resource =metadatum] + [%remove group=resource resource=md-resource] + [%initial-group group=resource =associations] + [%associations =associations] + $: %updated-metadata + group=resource + resource=md-resource + before=metadatum + =metadatum + == + == + :: + -- +-- diff --git a/desk/sur/post.hoon b/desk/sur/post.hoon new file mode 100644 index 0000000..2dacb65 --- /dev/null +++ b/desk/sur/post.hoon @@ -0,0 +1,91 @@ +/- *resource +|% ++$ index (list atom) ++$ uid [=resource =index] +:: +:: +sham (half sha-256) hash of +validated-portion ++$ hash @ux +:: ++$ signature [p=@ux q=ship r=life] ++$ signatures (set signature) ++$ post + $: author=ship + =index + time-sent=time + contents=(list content) + hash=(unit hash) + =signatures + == +:: ++$ indexed-post [a=atom p=post] +:: ++$ validated-portion + $: parent-hash=(unit hash) + author=ship + time-sent=time + contents=(list content) + == +:: ++$ reference + $% [%graph group=resource =uid] + [%group group=resource] + [%app =ship =desk =path] + == +:: ++$ content + $% [%text text=cord] + [%mention =ship] + [%url url=cord] + [%code expression=cord output=(list tank)] + [%reference =reference] + == +:: +++ post-one + |% + :: + +$ indexed-post [a=atom p=post] + :: + +$ post + $: author=ship + =index + time-sent=time + contents=(list content) + hash=(unit hash) + =signatures + == + :: + +$ content + $% [%text text=cord] + [%mention =ship] + [%url url=cord] + [%code expression=cord output=(list tank)] + [%reference =reference] + == + :: + +$ reference + $% [%graph group=resource =uid] + [%group group=resource] + == + -- +:: +++ post-zero + |% + :: + +$ content + $% [%text text=cord] + [%mention =ship] + [%url url=cord] + [%code expression=cord output=(list tank)] + [%reference =uid] + == + :: + +$ post + $: author=ship + =index + time-sent=time + contents=(list content) + hash=(unit hash) + =signatures + == + -- +-- diff --git a/desk/sur/pull-hook.hoon b/desk/sur/pull-hook.hoon new file mode 100644 index 0000000..1c66648 --- /dev/null +++ b/desk/sur/pull-hook.hoon @@ -0,0 +1,11 @@ +/- *resource +|% ++$ action + $% [%add =ship =resource] + [%remove =resource] + == +:: ++$ update + $% [%tracking tracking=(map resource ship)] + == +-- diff --git a/desk/sur/resource.hoon b/desk/sur/resource.hoon new file mode 100644 index 0000000..fef7a7b --- /dev/null +++ b/desk/sur/resource.hoon @@ -0,0 +1,10 @@ +^? +|% ++$ resource [=entity name=term] ++$ resources (set resource) +:: ++$ entity + $@ ship + $% !! + == +-- diff --git a/desk/ted/hosting/email.hoon b/desk/ted/hosting/email.hoon new file mode 100644 index 0000000..d0ee47d --- /dev/null +++ b/desk/ted/hosting/email.hoon @@ -0,0 +1,61 @@ +:: Hosting/Email +:: Query the Hosting backend for a customer's email address +:: +:: > -bark!hosting-email "[API_KEY]" ~dovmer-davmet +:: +:: API Response: +:: { +:: "ship": "dovmer-davmet", +:: "email": "james.muturi+t17@tlon.io" +:: } +:: +:: Output: +:: james.muturi+t17@tlon.io +:: +/- spider +/+ *strandio +=, strand=strand:spider +=, dejs:format +|^ ted +++ build-headers + |= api-key=tape + ^- header-list:http + :~ ['Content-Type' 'application/json'] + ['APIKey' (crip api-key)] + == +++ api-get + |= [api-key=tape ship=@p] + %: send-request + method=%'GET' + url=(crip "https://tlon.network/v1/ships/{}/email") + header-list=(build-headers api-key) + body=~ + == +++ mine-json + %- ot + :~ ship+so + email+so + == +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) + ^- form:m + =/ arg-mold + $: api-key=tape + ship=@p + == + =/ args !<((unit arg-mold) arg) + ?~ args (pure:m !>(~)) + ;< ~ bind:m (api-get api-key.u.args ship.u.args) + ;< rep=client-response:iris bind:m + take-client-response + ?> ?=(%finished -.rep) + ?~ full-file.rep (pure:m !>(~)) + =/ body=cord q.data.u.full-file.rep + =/ parsed=(unit json) (de-json:html body) + ?~ parsed (pure:m !>(~)) + ?~ u.parsed (pure:m !>(~)) + =/ mined (mine-json u.parsed) + (pure:m !>([~ +.mined])) +-- diff --git a/desk/ted/mail-hosted-user.hoon b/desk/ted/mail-hosted-user.hoon new file mode 100644 index 0000000..1928dd4 --- /dev/null +++ b/desk/ted/mail-hosted-user.hoon @@ -0,0 +1,59 @@ +/- spider, hark +/+ *strandio +=, strand=strand:spider +=, dejs:format +|^ ted +++ template-vars + |= [=ship =carpet:hark] + ^- (map cord cord) + %- malt + :~ ['name' (scot %p ship)] + ['notifications' (crip (a-co:co ~(wyt by yarns.carpet)))] + == +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) + ^- form:m + =/ arg-mold + $: tlon-api-key=tape + mandrill-api-key=tape + =ship + =carpet:hark + == + =/ args !<((unit arg-mold) arg) + ?~ args !! + ;< ~ bind:m + %- send-raw-card + :* %pass /check-email/(scot %p ship.u.args) + %arvo %k %fard + %garden %hosting-email %noun + !>(`[tlon-api-key.u.args ship.u.args]) + == + ;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo + ?> ?=([%check-email @ *] mire) + ?> =(i.t.mire (scot %p ship.u.args)) + ?> ?=([%khan %arow %.y %noun *] mine) + :: + =/ [%khan %arow %.y %noun vs=vase] mine + =+ !<((unit cord) vs) + ?~ - !! + =/ email u.- + ;< ~ bind:m + %- send-raw-card + :* %pass /send-mailchimp-email/(scot %p ship.u.args) + %arvo %k %fard + %garden %mailchimp-send-template %noun + !>(`[mandrill-api-key.u.args (trip email) "landscape-weekly-digest" (template-vars ship.u.args carpet.u.args)]) + == + ;< [wimp=wire simp=sign-arvo] bind:m take-sign-arvo + ?> ?=([%send-mailchimp-email @ *] wimp) + ?> =(i.t.wimp (scot %p ship.u.args)) + ?> ?=([%khan %arow %.y %noun *] simp) + :: + =/ [%khan %arow %.y %noun vs=vase] simp + =+ !<((unit cord) vs) + ?~ - !! + %- pure:m + !> u.- +-- diff --git a/desk/ted/mailchimp/ping.hoon b/desk/ted/mailchimp/ping.hoon new file mode 100644 index 0000000..45ac847 --- /dev/null +++ b/desk/ted/mailchimp/ping.hoon @@ -0,0 +1,46 @@ +:: Mailchimp/Ping +:: a health check endpoint for the Mailchimp Transactional API +:: +:: > -bark!mailchimp-ping "[API_KEY]" +:: "PONG!" +:: +/- spider +/+ *strandio +=, strand=strand:spider +=, dejs:format +=/ m (strand ,vase) +|^ ted +++ api-post + |= api-key=tape + %: send-request + method=%'POST' + url=url + header-list=['Content-Type'^'application/json' ~] + ^= body + %- some %- as-octt:mimes:html + %- en-json:html + %- pairs:enjs:format + :~ ['key' s+(crip api-key)] + == + == +++ url 'https://mandrillapp.com/api/1.0/users/ping' +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) + ^- form:m + =/ arg-mold + $: api-key=tape + == + =/ args !<((unit arg-mold) arg) + ?~ args + (pure:m !>(~)) + ;< ~ bind:m (api-post api-key.u.args) + ;< rep=client-response:iris bind:m + take-client-response + ?> ?=(%finished -.rep) + ?~ full-file.rep !! + =/ body=cord q.data.u.full-file.rep + %- pure:m + !> [body ~] +-- diff --git a/desk/ted/mailchimp/send-template.hoon b/desk/ted/mailchimp/send-template.hoon new file mode 100644 index 0000000..2e6e414 --- /dev/null +++ b/desk/ted/mailchimp/send-template.hoon @@ -0,0 +1,69 @@ +:: Mailchimp/Send Template +:: send an email template via the Mailchimp Transactional API +:: +:: > -bark!mailchimp-send-template "[MANDRILL_API_KEY]" "someone@example.com" "template-name" vars :: vars is a (map cord cord) +:: +/- spider +/+ *strandio +=, strand=strand:spider +=, dejs:format +=/ m (strand ,vase) +|^ ted +++ var-json + |= [k=cord v=cord] + (pairs:enjs:format ~[['name' s+k] ['content' s+v]]) +++ vars-json + |= vars=(map cord cord) + [%a (turn ~(tap by vars) |=([p=cord q=cord] (var-json p q)))] +++ api-post + |= [api-key=tape to-email=tape template-name=tape vars=(map cord cord)] + %: send-request + method=%'POST' + url=url + header-list=['Content-Type'^'application/json' ~] + ^= body + %- some + %- as-octt:mimes:html + %- en-json:html + %- pairs:enjs:format + :~ ['key' s+(crip api-key)] + ['template_name' s+(crip template-name)] + :: null template_content is fine for now; but in the future, if we + :: need to inject complex HTML, this thread should be updated to + :: support it + ['template_content' ~] + :- 'message' + %- pairs:enjs:format + :~ + ['merge_language' s+'handlebars'] + :- 'to' + [%a ~[(pairs:enjs:format ~[['email' s+(crip to-email)] ['type' s+'to']])]] + :- 'merge_vars' + [%a ~[(pairs:enjs:format ~[['rcpt' s+(crip to-email)] ['vars' (vars-json vars)]])]] + == + == + == +++ url 'https://mandrillapp.com/api/1.0/messages/send-template' +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) + ^- form:m + =/ arg-mold + $: api-key=tape + to-email=tape + template-name=tape + vars=(map cord cord) + == + =/ args !<((unit arg-mold) arg) + ?~ args + (pure:m !>(~)) + ;< ~ bind:m (api-post api-key.u.args to-email.u.args template-name.u.args vars.u.args) + ;< rep=client-response:iris bind:m + take-client-response + ?> ?=(%finished -.rep) + ?~ full-file.rep !! + =/ body=cord q.data.u.full-file.rep + %- pure:m + !> `body +-- diff --git a/desk/ted/mailchimp/send.hoon b/desk/ted/mailchimp/send.hoon new file mode 100644 index 0000000..47e52ca --- /dev/null +++ b/desk/ted/mailchimp/send.hoon @@ -0,0 +1,60 @@ +:: Mailchimp/Send +:: send an email via the Mailchimp Transactional API +:: +:: > -bark!mailchimp-send "[API_KEY]" "someone@example.com" "message subject" "message body" +:: +/- spider +/+ *strandio +=, strand=strand:spider +=, dejs:format +=/ m (strand ,vase) +|^ ted +++ api-post + |= [api-key=tape to-email=tape subject=tape body=tape] + %: send-request + method=%'POST' + url=url + header-list=['Content-Type'^'application/json' ~] + ^= body + %- some + %- as-octt:mimes:html + %- en-json:html + %- pairs:enjs:format + :~ ['key' s+(crip api-key)] + :- 'message' + %- pairs:enjs:format + :~ ['subject' s+(crip subject)] + ['html' s+(crip body)] + ['from_email' s+'no-reply@tlon.io'] + ['from_name' s+'Tlon Local'] + :- 'to' + [%a ~[(pairs:enjs:format ~[['email' s+(crip to-email)] ['type' s+'to']])]] + == + == + == +++ url 'https://mandrillapp.com/api/1.0/messages/send' +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) + ^- form:m + =/ arg-mold + $: api-key=tape + to-email=tape + subject=tape + body=tape + == + =/ args !<((unit arg-mold) arg) + ~& args + ?~ args + (pure:m !>(~)) + ;< ~ bind:m (api-post api-key.u.args to-email.u.args subject.u.args body.u.args) + ;< rep=client-response:iris bind:m + take-client-response + ?> ?=(%finished -.rep) + ?~ full-file.rep !! + =/ body=cord q.data.u.full-file.rep + ~& rep + %- pure:m + !> [body ~] +-- diff --git a/desk/ted/mailchimp/update-merge-fields.hoon b/desk/ted/mailchimp/update-merge-fields.hoon new file mode 100644 index 0000000..f269f8c --- /dev/null +++ b/desk/ted/mailchimp/update-merge-fields.hoon @@ -0,0 +1,77 @@ +:: -mailchimp-update-merge-fields: set/update merge field(s) for an email +:: +:: produces a success flag (whether response status was 200 or not) and +:: either the response body, or some error string in case of local failure. +:: +:: > -bark!mailchimp-update-merge-fields 'apikey' 'list-id' 'sampel@example.com' fields +:: where fields is a (map cord json) +:: and the list-id is most easily discovered through the /lists api +:: +/- spider +/+ *strandio +=, strand=strand:spider +=, dejs:format +=/ m (strand ,vase) +|^ ted +++ api-post + |= [[apik=@t list-id=@t] mail=@t vars=(map cord json)] + %: send-request + method=%'PATCH' + url=(url list-id mail) + :: + ^= header-list + :~ ['content-type' 'application/json'] + (basic-auth-header 'anystring' apik) + == + :: + ^= body + %- some + %- as-octt:mimes:html + %- en-json:html + %- pairs:enjs:format + ['merge_fields' o+vars]~ + == +:: +++ url + |= [list-id=@t email=@t] + ^- @t + %+ rap 3 + ::NOTE us14 is the datacenter for our account, hardcoded + :~ 'https://us14.api.mailchimp.com/3.0/lists/' + list-id + '/members/' + email ::TODO force lowercase? + '?skip_merge_validation=false' + == +:: +++ basic-auth-header ::TODO into http auth library + |= [user=@t pass=@t] + ^- [key=@t value=@t] + :- 'authorization' + =+ full=(rap 3 user ':' pass ~) + %^ cat 3 'Basic ' + (en:base64:mimes:html (met 3 full) full) +:: +++ ted + ^- thread:spider + |= arg=vase + =/ m (strand ,vase) :: [gud=? res=@t] + ^- form:m + =/ arg-mold + $: api=[key=cord list-id=cord] + to-email=cord + vars=(map cord json) + == + =/ args !<((unit arg-mold) arg) + ?~ args (pure:m !>(|^%bad-args)) + ;< ~ bind:m + (api-post u.args) + ;< rep=client-response:iris bind:m + take-client-response + ?> ?=(%finished -.rep) + %- pure:m + !> ^- [gud=? res=@t] + :- =(200 status-code.response-header.rep) + ?~ full-file.rep %empty-body + q.data.u.full-file.rep +-- diff --git a/desk/ted/save-summary.hoon b/desk/ted/save-summary.hoon new file mode 100644 index 0000000..9a73c09 --- /dev/null +++ b/desk/ted/save-summary.hoon @@ -0,0 +1,66 @@ +:: -save-summary: unpack growl summary, store in mailchimp merge fields +:: +:: crashes on failure. on success, produces the result message from the +:: -mailchimp-update-merge-fields thread. +:: +/- spider, hark +/+ *strandio +=, strand=strand:spider +=, dejs:format +^- thread:spider +|= arg=vase +=/ m (strand ,vase) +^- form:m +=/ arg-mold + $: tlon-api-key=cord + mailchimp=[key=cord list-id=cord] + =ship + :: + $= summary + $% [%life [sen=@ud rec=@ud gro=@t] [dms=@ud etc=@ud group=@t chat=@t]] + == + == +=/ args !<([~ arg-mold] arg) +;< ~ bind:m + %- send-raw-card + :* %pass /check-email/(scot %p ship.args) + %arvo %k %fard + %garden %hosting-email %noun + !>(`[(trip tlon-api-key.args) ship.args]) + == +;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo +?> ?=([%check-email @ *] mire) +?> =(i.t.mire (scot %p ship.args)) +?> ?=([%khan %arow %.y %noun *] mine) +:: +=/ [%khan %arow %.y %noun vs=vase] mine +=+ !<(mail=(unit cord) vs) +?> ?=(^ mail) +;< ~ bind:m + %- send-raw-card + :* %pass /update-merge-fields/(scot %p ship.args) + %arvo %k %fard + %garden %mailchimp-update-merge-fields %noun + =; vars=(map @t json) + !>(`[mailchimp.args u.mail vars]) + %- ~(gas by *(map @t json)) + =, summary.args + :~ ['MSGS_SENT' (numb:enjs:format sen)] + ['MSGS_RECD' (numb:enjs:format rec)] + ['GROUP_SENT' s+gro] + :: + ['UNREAD_DMS' (numb:enjs:format dms)] + ['UNREAD_MSG' (numb:enjs:format etc)] + ['GROUP_NAME' s+group] + ['CHNL_NAME' s+chat] + == + == +;< [wimp=wire simp=sign-arvo] bind:m take-sign-arvo +?> ?=([%update-merge-fields @ *] wimp) +?> =(i.t.wimp (scot %p ship.args)) +?> ?=([%khan %arow %.y %noun *] simp) +:: +=/ [%khan %arow %.y %noun vs=vase] simp +=+ !<([gud=? msg=@t] vs) +?. gud ~|(msg !!) +(pure:m !>(msg))