tloncorp/landscape
1
1
Fork 0
mirror of https://github.com/tloncorp/landscape.git synced 2024-12-25 01:31:30 +03:00
Code Issues Packages Projects Releases Wiki Activity

bark, growl: activity summary logging

Browse Source 
Includes the bark/growl system for sharing activity summaries. The growl
agent respects the "activity logging" consent flag used by groups,
defaults to not sharing if that flag is not set, and only shares with
the "bark host" when prompted. (The bark host, in turn, currently only
stores responses for hosted ships.)

Also includes all the groups-side dependencies this has, which it needs
for the chats & groups types. Hard-including those files will save us
some run-around during deploy.

Co-authored-by: midsum-salrux <nathan@tlon.io>
This commit is contained in:
fang 2023-07-24 22:27:29 +02:00
commit 7455e2d778
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
32 changed files with 4032 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
desk/app/bark.hoon Normal file
View File

@ -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
--

125
desk/app/growl.hoon Normal file
View File

@ -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
--

1
desk/desk.bill
View File

@ -8,4 +8,5 @@
%reel
%bait
%vitals
%growl
==

919
desk/lib/graph-store.hoon Normal file
View File

@ -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]
--
--

19
desk/lib/migrate.hoon Normal file
View File

@ -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)
--

57
desk/lib/resource.hoon Normal file
View File

@ -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
==
--

99
desk/lib/summarize.hoon Normal file
View File

@ -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)
--

11
desk/mar/bark/add-recipient.hoon Normal file
View File

@ -0,0 +1,11 @@
|_ rec=ship
++ grad %noun
++ grab
|%
++ noun ship
--
++ grow
|%
++ noun rec
--
--

20
desk/mar/bark/receive-summary.hoon Normal file
View File

@ -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
--
--

11
desk/mar/bark/remove-recipient.hoon Normal file
View File

@ -0,0 +1,11 @@
|_ rec=ship
++ grad %noun
++ grab
|%
++ noun ship
--
++ grow
|%
++ noun rec
--
--

11
desk/mar/growl/summarize.hoon Normal file
View File

@ -0,0 +1,11 @@
|_ requested=time
++ grad %noun
++ grab
|%
++ noun time
--
++ grow
|%
++ noun requested
--
--

347
desk/sur/chat-0.hoon Normal file
View File

@ -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
--

352
desk/sur/chat-1.hoon Normal file
View File

@ -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
--

372
desk/sur/chat.hoon Normal file
View File

@ -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
--

57
desk/sur/cite.hoon Normal file
View File

@ -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
==
--

15
desk/sur/epic.hoon Normal file
View File

@ -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
::
--

272
desk/sur/graph-store.hoon Normal file
View File

@ -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]
==
--
--

39
desk/sur/group-store.hoon Normal file
View File

@ -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]
==
--

109
desk/sur/group.hoon Normal file
View File

@ -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)]
==
--
--
--

360
desk/sur/groups.hoon Normal file
View File

@ -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)
--

21
desk/sur/meta.hoon Normal file
View File

@ -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]
==
--

138
desk/sur/metadata-store.hoon Normal file
View File

@ -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
==
==
::
--
--

91
desk/sur/post.hoon Normal file
View File

@ -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
==
--
--

11
desk/sur/pull-hook.hoon Normal file
View File

@ -0,0 +1,11 @@
/- *resource
|%
+$ action
$% [%add =ship =resource]
[%remove =resource]
==
::
+$ update
$% [%tracking tracking=(map resource ship)]
==
--

10
desk/sur/resource.hoon Normal file
View File

@ -0,0 +1,10 @@
^?
|%
+$ resource [=entity name=term]
+$ resources (set resource)
::
+$ entity
$@ ship
$% !!
==
--

61
desk/ted/hosting/email.hoon Normal file
View File

@ -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/{<ship>}/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]))
--

59
desk/ted/mail-hosted-user.hoon Normal file
View File

@ -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.-
--

46
desk/ted/mailchimp/ping.hoon Normal file
View File

@ -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 ~]
--

69
desk/ted/mailchimp/send-template.hoon Normal file
View File

@ -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
--

60
desk/ted/mailchimp/send.hoon Normal file
View File

@ -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 ~]
--

77
desk/ted/mailchimp/update-merge-fields.hoon Normal file
View File

@ -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
--

66
desk/ted/save-summary.hoon Normal file
View File

@ -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))