Add lure backend

This commit is contained in:
~midsum-salrux 2023-03-21 13:44:21 -04:00
parent 2382fe9a1a
commit f46038449e
39 changed files with 3651 additions and 0 deletions

164
desk/app/bait.hoon Normal file
View File

@ -0,0 +1,164 @@
/- reel
/+ default-agent, verb, dbug, server, *reel
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
::
+$ state-0
$: %0
todd=(map [inviter=ship token=cord] description=cord)
==
+$ state-1
$: %1
token-metadata=(map [inviter=ship token=cord] metadata:reel)
==
--
::
|%
++ landing-page
|= =metadata:reel
^- manx
=/ description
?. =(tag.metadata 'groups-0') ""
(trip (~(got by fields.metadata) 'description'))
;html
;head
;title:"Lure"
==
;body
;p: {description}
Enter your @p:
;form(method "post")
;input(type "text", name "ship", id "ship", placeholder "~sampel");
;button(type "submit"):"Request invite"
==
;script: ship = document.cookie.split("; ").find((row) => row.startsWith("ship="))?.split("=")[1]; document.getElementById("ship").value=(ship || "~sampel-palnet")
==
==
::
++ sent-page
|= invitee=ship
^- manx
;html
;head
;title:"Lure"
==
;body
Your invite has been sent! Go to your ship to accept it.
;script: document.cookie="ship={(trip (scot %p invitee))}"
==
==
--
::
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
[[%pass /eyre/connect %arvo %e %connect [~ /lure] dap.bowl]~ this]
::
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(versioned-state old-state)
?- -.old
%1
`this(state old)
%0
`this(state *state-1)
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([id=@ta inbound-request:eyre] vase)
|^
:_ this
=/ full-line=request-line:server (parse-request-line:server url.request)
=/ line
?: ?=([%lure @ @ *] site.full-line)
t.site.full-line
?: ?=([@ @ *] site.full-line)
site.full-line
!!
?+ method.request (give not-found:gen:server)
%'GET'
?: ?=([%bait %who ~] line)
(give (json-response:gen:server s+(scot %p our.bowl)))
=/ inviter (slav %p i.line)
=/ token i.t.line
=/ =metadata:reel (fall (~(get by token-metadata) [inviter token]) *metadata:reel)
?: ?=([@ @ %metadata ~] line)
(give (json-response:gen:server (enjs-metadata metadata)))
(give (manx-response:gen:server (landing-page metadata)))
%'POST'
=/ inviter (slav %p i.line)
=/ token i.t.line
?~ body.request
(give not-found:gen:server)
?. =('ship=%7E' (end [3 8] q.u.body.request))
(give not-found:gen:server)
=/ joiner (slav %p (cat 3 '~' (rsh [3 8] q.u.body.request)))
:* :* %pass /bite %agent [inviter %reel]
%poke %reel-bite !>([%bite-1 token joiner inviter])
==
:* %pass /bite %agent [our.bowl %reel]
%poke %reel-bite !>([%bite-1 token joiner inviter])
==
(give (manx-response:gen:server (sent-page joiner)))
==
==
::
++ give
|= =simple-payload:http
(give-simple-payload:app:server id simple-payload)
--
%bait-describe
=+ !<([token=cord =metadata:reel] vase)
`this(token-metadata (~(put by token-metadata) [src.bowl token] metadata))
::
%bait-undescribe
=+ !<(token=cord vase)
`this(token-metadata (~(del by token-metadata) [src.bowl token]))
%bind-slash
:_ this
~[[%pass /eyre/connect %arvo %e %connect [~ /] dap.bowl]]
%unbind-slash
:_ this
~[[%pass /eyre/connect %arvo %e %connect [~ /] %docket]]
==
::
++ on-agent on-agent:def
++ on-watch
|= =path
^- (quip card _this)
?> =(our.bowl src.bowl)
?+ path (on-watch:def path)
[%http-response *] `this
==
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%eyre %bound *]
~? !accepted.sign-arvo
[dap.bowl 'eyre bind rejected!' binding.sign-arvo]
[~ this]
==
::
++ on-fail on-fail:def
--

164
desk/app/greeting.hoon Normal file
View File

@ -0,0 +1,164 @@
/- reel, chat
/+ default-agent, verb, dbug, server
::
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
+$ state-0
$: %0
token=cord
pals-tag=cord
dm-text=cord
==
--
|%
++ landing-page
|= [token=cord dm-text=cord pals-tag=cord description=cord]
^- manx
;html
;head
;title:"Greetings"
==
;body
;form(method "post")
invite link token (should be URL-safe)
;input(type "text", name "token", value "{(trip token)}");
pals tag for invitee
;input(type "text", name "pals-tag", value "{(trip pals-tag)}");
direct message contents (sent to the invitee after clicking)
;textarea(name "dm-text"):"{(trip dm-text)}"
invite link description
;textarea(name "description"):"{(trip description)}"
On save, you\'ll get an invite link
;button(type "submit"):"Save"
==
==
==
::
++ sent-page
|= [our=ship bait=cord token=cord]
^- manx
;html
;head
;title:"Greetings"
==
;body
Here is your invite link:
{(trip bait)}{<our>}/{(trip token)}
==
==
++ frisk :: parse url-encoded form args
|= body=@t
%- ~(gas by *(map @t @t))
(fall (rush body yquy:de-purl:html) ~)
--
::
=| state-0
=* state -
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %.n) bowl)
::
++ on-init
:_ this
:~ [%pass /bite-wire %agent [our.bowl %reel] %watch /bites]
[%pass /eyre/connect %arvo %e %connect [~ /greeting] dap.bowl]
==
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark !!
%leave :_ this ~[[%pass /bite-wire %agent [our.bowl %reel] %leave ~]]
%watch :_ this ~[[%pass /bite-wire %agent [our.bowl %reel] %watch /bites]]
::
%handle-http-request
=+ !<([id=@ta inbound-request:eyre] vase)
|^
=/ line=request-line:server (parse-request-line:server url.request)
=/ m=metadata:reel
.^(metadata:reel %gx [(scot %p our.bowl) %reel (scot %da now.bowl) %metadata token %noun ~])
?+ method.request :_ this (give not-found:gen:server)
%'GET'
=/ description
(fall (~(get by fields.m) 'description') '')
:_ this (give (manx-response:gen:server (landing-page token dm-text pals-tag description)))
%'POST'
?~ body.request
:_ this (give not-found:gen:server)
=/ params ~(got by (frisk q.u.body.request))
=/ bait
.^(cord %gx [(scot %p our.bowl) %reel (scot %da now.bowl) %service %noun ~])
=/ new-meta=metadata:reel
[%greeting-0 (~(put by fields.m) 'description' (params 'description'))]
:_ this(token (params 'token'), dm-text (params 'dm-text'), pals-tag (params 'pals-tag'))
:- :* %pass /describe %agent [our.bowl %reel] %poke %reel-describe
!>([(params 'token') new-meta])
==
(give (manx-response:gen:server (sent-page our.bowl bait (params 'token'))))
==
::
++ give
|= =simple-payload:http
(give-simple-payload:app:server id simple-payload)
--
==
::
++ on-watch
|= =path
^- (quip card _this)
?> =(our.bowl src.bowl)
?+ path (on-watch:def path)
[%http-response *] `this
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?- -.sign
%watch-ack `this
%kick `this
%poke-ack `this
%fact
=+ !<(=bite:reel q.cage.sign)
?> =(token token.bite)
?> ?=([%bite-1 *] bite)
=/ =action:dm:chat
:* joiner.bite
[joiner.bite now.bowl]
%add
replying=~
author=our.bowl
sent=now.bowl
content=[%story `~[dm-text]]
==
=/ meet
[%meet joiner.bite (~(put in *(set @ta)) pals-tag)]
:_ this
:~ [%pass /dm %agent [our.bowl %chat] %poke %dm-action !>(action)]
[%pass /meet %agent [our.bowl %pals] %poke %pals-command !>(meet)]
==
==
::
++ on-fail
|= [=term =tang]
(mean ':sub +on-fail' term tang)
::
++ on-leave
|= =path
`this
::
++ on-save !>(state)
++ on-load |=(old=vase `this(state !<(_state old)))
++ on-arvo on-arvo:def
++ on-peek on-peek:def
::
--

114
desk/app/grouper.hoon Normal file
View File

@ -0,0 +1,114 @@
/- reel, groups
/+ default-agent, verb, dbug
::
|%
++ enabled-groups (set cord)
++ outstanding-pokes (set (pair ship cord))
+$ card card:agent:gall
+$ versioned-state
$% state-1
state-0
==
+$ state-1 [%1 =enabled-groups =outstanding-pokes]
+$ state-0 [%0 =enabled-groups]
--
::
=| state-1
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %.n) bowl)
::
++ on-init
:_ this
~[[%pass /bite-wire %agent [our.bowl %reel] %watch /bites]]
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%leave :_ this ~[[%pass /bite-wire %agent [our.bowl %reel] %leave ~]]
%watch :_ this ~[[%pass /bite-wire %agent [our.bowl %reel] %watch /bites]]
::
%grouper-enable
=+ !<(name=cord vase)
`this(enabled-groups (~(put in enabled-groups) name))
%grouper-disable
=+ !<(name=cord vase)
`this(enabled-groups (~(del in enabled-groups) name))
%grouper-ask-enabled
=+ !<(name=cord vase)
=/ enabled (~(has in enabled-groups) name)
:_ this
~[[%pass [%ask name ~] %agent [src.bowl %grouper] %poke %grouper-answer-enabled !>([name enabled])]]
%grouper-answer-enabled
=/ [name=cord enabled=?] !<([cord ?] vase)
:_ this
~[[%give %fact ~[[%group-enabled (scot %p src.bowl) name ~]] %json !>(b+enabled)]]
==
::
++ on-watch
|= =path
^- (quip card _this)
?> =(our.bowl src.bowl)
?+ path (on-watch:def path)
[%group-enabled @ @ ~]
=/ target=ship (slav %p i.t.path)
=/ group=cord i.t.t.path
?: (~(has in outstanding-pokes) [target group]) `this
:_ this(outstanding-pokes (~(put in outstanding-pokes) [target group]))
~[[%pass path %agent [target %grouper] %poke %grouper-ask-enabled !>(group)]]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%group-enabled @ @ ~] wire)
?+ -.sign (on-agent:def wire sign)
%poke-ack
`this(outstanding-pokes (~(del in outstanding-pokes) [src.bowl i.t.t.wire]))
==
?- -.sign
%poke-ack `this
%watch-ack `this
%kick `this
%fact
=+ !<(=bite:reel q.cage.sign)
?> (~(has in enabled-groups) token.bite)
?> ?=([%bite-1 *] bite)
=/ =invite:groups [[our.bowl token.bite] joiner.bite]
:_ this
~[[%pass /invite %agent [our.bowl %groups] %poke %group-invite !>(invite)]]
==
::
++ 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
%1
`this(state old)
%0
`this(state *state-1)
==
++ on-arvo on-arvo:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path [~ ~]
[%x %enabled @ ~]
``json+!>([%b (~(has in enabled-groups) i.t.t.path)])
==
::
--

154
desk/app/reel.hoon Normal file
View File

@ -0,0 +1,154 @@
/- reel
/+ default-agent, verb, dbug, *reel
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
==
::
:: vic: URL of bait service
:: civ: @p of bait service
:: our-metadata: map from tokens to their metadata
:: outstanding-pokes: ships we have poked and await a response from
::
+$ state-0
$: %0
vic=@t
civ=ship
descriptions=(map cord cord)
==
+$ state-1
$: %1
vic=@t
civ=ship
our-metadata=(map cord metadata:reel)
==
+$ state-2
$: %2
vic=@t
civ=ship
our-metadata=(map cord metadata:reel)
outstanding-pokes=(set (pair ship cord))
==
++ url-for-token
|= [vic=cord our=ship token=cord]
(crip "{(trip vic)}{(trip (scot %p our))}/{(trip token)}")
--
=| state-2
=* state -
::
%- agent:dbug
%+ verb |
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
`this(vic 'https://tlon.network/lure/', civ ~loshut-lonreg)
::
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(versioned-state old-state)
?- -.old
%2
`this(state old)
%1
`this(state [%2 'https://tlon.network/lure/' ~loshut-lonreg ~ ~])
%0
`this(state [%2 'https://tlon.network/lure/' ~loshut-lonreg ~ ~])
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%reel-command
?> =(our.bowl src.bowl)
=+ !<(=command:reel vase)
?- -.command
%set-service
:_ this(vic vic.command)
~[[%pass /set-ship %arvo %k %fard q.byk.bowl %reel-set-ship %noun !>(vic)]]
%set-ship
`this(civ civ.command)
==
::
%reel-bite
=+ !<(=bite:reel vase)
[[%give %fact ~[/bites] mark !>(bite)]~ this]
::
%reel-describe
=+ !<([token=cord =metadata:reel] vase)
:_ this(our-metadata (~(put by our-metadata) token metadata))
~[[%pass /describe %agent [civ %bait] %poke %bait-describe !>([token metadata])]]
%reel-undescribe
=+ !<(token=cord vase)
:_ this(our-metadata (~(del by our-metadata) token))
~[[%pass /undescribe %agent [civ %bait] %poke %bait-undescribe !>(token)]]
%reel-want-token-link
=+ !<(token=cord vase)
:_ this
=/ result=(unit [cord cord])
?. (~(has by our-metadata) token) ~
`[token (url-for-token vic our.bowl token)]
~[[%pass [%token-link-want token ~] %agent [src.bowl %reel] %poke %reel-give-token-link !>(result)]]
%reel-give-token-link
=+ !<(result=(unit [cord cord]) vase)
?~ result `this
=/ [token=cord url=cord] u.result
:_ this
~[[%give %fact ~[[%token-link (scot %p src.bowl) token ~]] %json !>(s+url)]]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%token-link @ @ ~] wire)
?+ -.sign (on-agent:def wire sign)
%poke-ack
`this(outstanding-pokes (~(del in outstanding-pokes) [src.bowl i.t.t.wire]))
==
(on-agent:def wire sign)
::
++ on-watch
|= =path
^- (quip card _this)
?> =(our.bowl src.bowl)
?+ path (on-watch:def path)
[%bites ~] `this
[%token-link @ @ ~]
=/ target (slav %p i.t.path)
=/ group i.t.t.path
?~ (~(has in outstanding-pokes) [target group]) `this
:_ this(outstanding-pokes (~(put in outstanding-pokes) [target group]))
~[[%pass path %agent [target %reel] %poke %reel-want-token-link !>(group)]]
==
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path [~ ~]
[%x %service ~] ``noun+!>(vic)
[%x %bait ~] ``reel-bait+!>([vic civ])
::
[%x %metadata @ ~]
=/ =metadata:reel (fall (~(get by our-metadata) i.t.t.path) *metadata:reel)
``reel-metadata+!>(metadata)
==
::
++ on-arvo
|= [=wire sign=sign-arvo]
^- (quip card:agent:gall _this)
?> ?=([%set-ship ~] wire)
?> ?=([%khan %arow *] sign)
?: ?=(%.n -.p.sign)
((slog 'reel: fetch bait ship failed' p.p.sign) `this)
`this
++ on-fail on-fail:def
--

View File

@ -3,4 +3,8 @@
%hark-store
%hark-system-hook
%settings-store
%reel
%bait
%grouper
%greeting
==

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

20
desk/lib/reel.hoon Normal file
View File

@ -0,0 +1,20 @@
/- reel
|%
++ enjs-metadata
|= =metadata:reel
^- json
=/ fields
%+ turn ~(tap by fields.metadata)
|= [key=cord value=cord]
^- [cord json]
[key s+value]
%- pairs:enjs:format
:~ ['tag' s+tag.metadata]
['fields' (pairs:enjs:format fields)]
==
++ dejs-metadata
%- ot:dejs:format
:~ tag+so:dejs:format
fields+(om so):dejs:format
==
--

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

View File

@ -0,0 +1,12 @@
/- reel
|_ [token=cord =metadata:reel]
++ grad %noun
++ grab
|%
++ noun (pair cord metadata:reel)
--
++ grow
|%
++ noun [token metadata]
--
--

View File

@ -0,0 +1,11 @@
|_ token=cord
++ grad %noun
++ grab
|%
++ noun cord
--
++ grow
|%
++ noun token
--
--

View File

@ -0,0 +1,11 @@
|_ [name=cord enabled=?]
++ grad %noun
++ grab
|%
++ noun (pair cord ?)
--
++ grow
|%
++ noun [name enabled]
--
--

View File

@ -0,0 +1,11 @@
|_ name=cord
++ grad %noun
++ grab
|%
++ noun cord
--
++ grow
|%
++ noun name
--
--

View File

@ -0,0 +1,12 @@
|_ name=cord
++ grad %noun
++ grab
|%
++ noun cord
++ json so:dejs:format
--
++ grow
|%
++ noun name
--
--

View File

@ -0,0 +1,12 @@
|_ name=cord
++ grad %noun
++ grab
|%
++ noun cord
++ json so:dejs:format
--
++ grow
|%
++ noun name
--
--

18
desk/mar/reel/bait.hoon Normal file
View File

@ -0,0 +1,18 @@
/- reel
|_ [vic=cord civ=ship]
++ grad %noun
++ grab
|%
++ noun (pair cord ship)
++ json
%- ot:dejs:format
:~ url+so:dejs:format
ship+(cu:dejs:format |=(=cord (slav %p cord)) so:dejs:format)
==
--
++ grow
|%
++ noun [vic civ]
++ json (pairs:enjs:format ~[['url' s+vic] ['ship' s+(scot %p civ)]])
--
--

12
desk/mar/reel/bite.hoon Normal file
View File

@ -0,0 +1,12 @@
/- reel
|_ =bite:reel
++ grad %noun
++ grab
|%
++ noun bite:reel
--
++ grow
|%
++ noun bite
--
--

View File

@ -0,0 +1,19 @@
/- reel
|_ =command:reel
++ grad %noun
++ grab
|%
++ noun command:reel
++ json
|= j=^json
:- %set-service
%. j
%- ot:dejs:format
:~ url+so:dejs:format
==
--
++ grow
|%
++ noun command
--
--

View File

@ -0,0 +1,14 @@
/- reel
/+ *reel
|_ [token=cord =metadata:reel]
++ grad %noun
++ grab
|%
++ noun (pair cord cord)
++ json (ot:dejs:format ~[token+so:dejs:format metadata+dejs-metadata])
--
++ grow
|%
++ noun [token metadata]
--
--

View File

@ -0,0 +1,13 @@
|_ description=cord
++ grad %noun
++ grab
|%
++ noun cord
++ json so:dejs:format
--
++ grow
|%
++ noun description
++ json [%s description]
--
--

View File

@ -0,0 +1,11 @@
|_ token-url=(unit [token=cord url=cord])
++ grad %noun
++ grab
|%
++ noun (unit (pair cord cord))
--
++ grow
|%
++ noun token-url
--
--

View File

@ -0,0 +1,15 @@
/- reel
/+ *reel
|_ =metadata:reel
++ grad %noun
++ grab
|%
++ noun metadata
++ json dejs-metadata
--
++ grow
|%
++ noun metadata
++ json (enjs-metadata metadata)
--
--

View File

@ -0,0 +1,14 @@
/- reel
/+ *reel
|_ token=cord
++ grad %noun
++ grab
|%
++ noun (pair cord cord)
++ json (ot:dejs:format ~[token+so:dejs:format])
--
++ grow
|%
++ noun token
--
--

View File

@ -0,0 +1,11 @@
|_ token=cord
++ grad %noun
++ grab
|%
++ noun cord
--
++ grow
|%
++ noun token
--
--

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.hoon Normal file
View File

@ -0,0 +1,352 @@
/- g=groups, graph-store, zer=chat-0
/- meta
/- metadata-store
/- cite
/- e=epic
/+ lib-graph=graph-store
|%
++ old
|%
++ zero zer
--
::
:: $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
==
::
:: $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)]
==
--
--
--

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

@ -0,0 +1,351 @@
/- meta, e=epic
/- old=group
/- grp=group-store
/- metadata-store
|%
:: $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]
[%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]
==
--

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

13
desk/sur/reel.hoon Normal file
View File

@ -0,0 +1,13 @@
|%
+$ command
$% [%set-service vic=@t]
[%set-ship civ=@p]
==
::
+$ bite
$% [%bite-0 token=@ta ship=@p]
[%bite-1 token=@ta joiner=@p inviter=@p]
==
::
+$ metadata [tag=term fields=(map cord cord)]
--

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

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

14
desk/ted/set-ship.hoon Normal file
View File

@ -0,0 +1,14 @@
/- spider
/+ *strandio
=, strand=strand:spider
=, strand-fail=strand-fail:libstrand:spider
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=+ !<(vic=cord arg)
;< our=@p bind:m get-our
;< =json bind:m (fetch-json "{(trip vic)}bait/who")
=/ =ship (slav %p (so:dejs:format json))
;< ~ bind:m (poke [our %reel] reel-command+!>([%set-ship ship]))
(pure:m !>(~))