urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-25 13:04:17 +03:00
Code Issues Packages Projects Releases Wiki Activity

link: social bookmarking core implementation

Browse Source 
Stores URLs and their titles for the local ship. Can listen to
"submissions" on foreign ships.

Has a primitive perspective on groups, treating them as
always-interesting. Auto-subscribes to all ships in all groups.

Foreign communications untested.
This commit is contained in:
Fang 2019-11-19 17:26:05 +01:00
parent a272f7c868
commit a95449cc64
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
6 changed files with 728 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

222
pkg/arvo/app/link-listen-hook.hoon Normal file
View File

@ -0,0 +1,222 @@
:: link-listen-hook: get your friends' bookmarks
::
:: on-init, subscribes to all groups on this ship.
:: for every ship in a group, we subscribe to their link's local-pages
:: at the group path (through link-proxy-hook),
:: and forwards all entries into our link as submissions.
::
/- *link, group-store
/+ default-agent, verb
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb &
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%groups ~] wire)
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%links @ ^] wire)
=^ cards state
(take-links-sign:do (slav %p i.t.wire) t.t.wire sign)
[cards this]
?: ?=([%forward ^] wire)
=^ cards state
(take-forward-sign:do t.wire sign)
[cards this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
::
|_ =bowl:gall
::
:: groups subscription
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /all]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to groups. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial (handle-group-initial !<(groups:group-store vase))
%group-update (handle-group-update !<(group-update:group-store vase))
==
==
::
++ handle-group-initial
|= =groups:group-store
^- (quip card _state)
=| cards=(list card)
=/ groups=(list [=path =group:group-store])
~(tap by groups)
|-
?~ groups [cards state]
=^ caz state
%- handle-group-update
[%add [group path]:i.groups]
$(cards (weld cards caz), groups t.groups)
::
++ handle-group-update
|= upd=group-update:group-store
^- (quip card _state)
:_ state
?+ -.upd ~
?(%path %add %remove)
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to subscribe to ourselves
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
%. [i.whos pax.upd]
?: ?=(%remove -.upd)
end-link-subscription
start-link-subscription
==
::
:: link subscriptions
::
++ start-link-subscription
|= [who=ship where=path]
^- card
:* %pass
[%links (scot %p who) where]
%agent
[who %link-hook]
%watch
[%local-pages where]
==
::
++ end-link-subscription
|= [who=ship where=path]
^- card
:* %pass
[%links (scot %p who) where]
%agent
[who %link-hook]
%leave
~
==
::
++ take-links-sign
|= [who=ship where=path =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links who where] !!)
%kick [[(start-link-subscription who where)]~ state]
::
%watch-ack
?~ p.sign
~& [dap.bowl 'groups subscription success']
[~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to groups. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-update (handle-link-update who where !<(update vase))
==
==
::
++ handle-link-update
|= [who=ship where=path =update]
^- (quip card _state)
?> ?=(%local-pages -.update)
?> =(src.bowl who)
:_ state
%+ turn pages.update
|= =page
^- card
:* %pass
[%forward (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%hear where src.bowl page])
==
::
++ take-forward-sign
|= [=wire =sign:agent:gall]
^- (quip card _state)
~| [%unexpected-sign on=[%forward wire] -.sign]
?> ?=(%poke-ack -.sign)
?~ p.sign [~ state]
=/ =tank
:- %leaf
;: weld
(trip dap.bowl)
" failed to save submission from "
(spud wire)
==
%- (slog tank u.p.sign)
[~ state]
--

231
pkg/arvo/app/link-proxy-hook.hoon Normal file
View File

@ -0,0 +1,231 @@
:: link-proxy-hook: make local pages available to foreign ships
::
:: this is a "proxy" style hook, relaying foreign subscriptions into local
:: stores if permission conditions are met.
:: the patterns herein should one day be generalized into a proxy-hook lib.
::
:: this adopts a very primitive view of groups-store as containing only
:: groups of interesting (rather than uninteresting) ships. it sets the
:: permission condition to be that ship must be in group matching the path
:: it's subscribing to.
:: we check this on-watch, but also subscribe to groups so that we can kick
:: subscriptions if needed (eg ship removed from group).
::
:: we deduplicate incoming subscriptions on the same path, ensuring we have
:: exactly one local subscription per unique incoming subscription path.
:: this comes at the cost of assuming that the store's initial response is
:: whatever's returned by the scry at that path, but perhaps that should
:: become part of the stores standard anyway.
::
/- *link, group-store
/+ default-agent, verb
|%
+$ state-0
$: %0
::TODO we use this to detect "first sub started" and "last sub left",
:: but can't we use [wex sup]:bowl for that?
active=(map path (set ship))
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb &
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %&) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
:: the local ship should just use link-store directly
::TODO do we want to allow this anyway, to avoid client-side target checks?
::
?< (team:title [our src]:bowl)
?> (permitted:do src.bowl path)
=^ cards state
(start-proxy:do src.bowl path)
[cards this]
::
++ on-leave
|= =path
^- (quip card _this)
=^ cards state
(stop-proxy:do src.bowl path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%groups ~] wire)
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%proxy ^] wire)
=^ cards state
(handle-proxy-sign t.wire sign)
[cards this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ permitted
|= [who=ship =path]
^- ?
:: we only expose /local-pages, and only to ships in the relevant group
::
?. ?=([%local-pages ^] path) |
=; group
?& ?=(^ group)
(~(has in u.group) who)
==
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc `^path`path %noun) ::TODO TMI
==
::
:: groups subscription
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /all]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to group store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state]
%group-update (handle-group-update !<(group-update:group-store vase))
==
==
::
++ handle-group-update
|= upd=group-update:group-store
^- (quip card _state)
:_ state
?. ?=(%remove -.upd) ~
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to remove to ourselves
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
::NOTE this depends kind of unfortunately on the fact that we only accept
:: subscriptions to /local-pages/* paths. it'd be more correct if we
:: "just" looked at all paths in the map, and found the matching ones.
(kick-proxy i.whos [%local-pages pax.upd])
::
:: proxy subscriptions
::
++ kick-proxy
|= [who=ship =path]
^- card
[%give %kick `path `who]
::
++ handle-proxy-sign
|= [=path =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack path] !!)
%fact [[%give %fact `path cage.sign]~ state]
%kick [[(proxy-pass-link-store path %watch path)]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to link-store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
==
::
++ proxy-pass-link-store
|= [=path =task:agent:gall]
^- card
:* %pass
[%proxy path]
%agent
[our.bowl %link-store]
task
==
::
++ initial-response
|= =path
^- card
=/ initial=update
[%local-pages path .^(pages %gx path)]
[%give %fact ~ %link-update !>(initial)]
::
++ start-proxy
|= [who=ship =path]
^- (quip card _state)
:_ state(active (~(put ju active) path who))
:_ ~
:: if we already have a local subscription open,
::
?. =(~ (~(get ju active) path))
:: gather the initial response ourselves, and send that.
::
(initial-response path)
:: else, open a local subscription,
:: sending outward its initial response when we hear it.
::
(proxy-pass-link-store path %watch path)
::
++ stop-proxy
|= [who=ship =path]
^- (quip card _state)
=. active (~(del ju active) path who)
:_ state
:: if there are still subscriptions remaining, do nothing.
::
?. =(~ (~(get ju active) path)) ~
:: else, close the local subscription.
::
[(proxy-pass-link-store path %leave ~)]~
--

172
pkg/arvo/app/link-store.hoon Normal file
View File

@ -0,0 +1,172 @@
:: link: social bookmarking
::
:: the paths under which links are submitted are generally expected to
:: correspond to existing group paths. for strictly-local collections of
:: links, arbitrary paths are probably fair game, but could trip up
:: primitive ui implementations.
::
:: scry and subscription paths:
::
:: /local-pages/[some-group] all pages we saved by recency
:: /submissions/[some-group] all submissions by recency
::
/+ *link, default-agent, verb
::
|%
+$ state-0
$: %0
by-group=(map path links)
by-site=(map site (list [path submission]))
==
::
+$ links
$: ::NOTE all lists by recency
=submissions
ours=pages
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb &
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title [our src]:bowl) ::TODO /lib/store
=^ cards state
?+ mark (on-poke:def mark vase)
%json (do-action:do (action:de-json !<(json vase)))
%link-action (do-action:do !<(action vase))
==
[cards this]
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y ?(%local-pages %submissions) ~]
``noun+!>(~(key by by-group))
::
[%x %local-pages ^]
``noun+!>((get-local-pages:do t.t.path))
::
[%x %submissions ^]
``noun+!>((get-submissions:do t.t.path))
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [our src]:bowl) ::TODO /lib/store
:_ this
|^ ?+ path (on-watch:def path)
[%local-pages ^]
%+ give %link-update
[%local-pages t.path (get-local-pages:do t.path)]
::
[%submissions ^]
%+ give %link-update
[%submissions t.path (get-submissions:do t.path)]
==
::
++ give
|* [=mark =noun]
^- (list card)
[%give %fact ~ mark !>(noun)]~
--
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
:: writing
::
++ do-action
|= =action
^- (quip card _state)
?- -.action
%add (add-page +.action)
%hear (hear-submission +.action)
==
:: +add-page: save a page ourselves
::
++ add-page
|= [=path title=@t =url]
^- (quip card _state)
?< =(~ path)
:: add page to group ours
::
=/ =links (~(gut by by-group) path *links)
=/ =page [title url now.bowl]
=. ours.links [page ours.links]
=. by-group (~(put by by-group) path links)
:: do generic submission logic
::
=^ cards state
(hear-submission path [our.bowl page])
:: send updates to subscribers
::
:_ state
:_ cards
:+ %give %fact
:+ `[%local-pages path]
%link-update
!>([%local-pages path [page]~])
:: +hear-submission: record page someone else saved
::
++ hear-submission
|= [=path =submission]
^- (quip card _state)
~& [%hear-submission submission]
?< =(~ path)
:: add link to group submissions
::
=/ =links (~(gut by by-group) path *links)
=. submissions.links [submission submissions.links]
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
=/ =site (site-from-url url.submission)
=. by-site (~(add ja by-site) site [path submission])
:: send updates to subscribers
::
:_ state
:_ ~
:+ %give %fact
:+ `[%submissions path]
%link-update
!>([%submissions path [submission]~])
::
:: reading
::
++ get-local-pages
|= =path
^- pages
ours:(~(gut by by-group) path *links)
::
++ get-submissions
|= =path
^- submissions
submissions:(~(gut by by-group) path *links)
--

10
pkg/arvo/gen/link-store/add.hoon Normal file
View File

@ -0,0 +1,10 @@
:: link-store|add: save a link to a path
::
/- *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path title=@t =url ~] ~]
==
:- %link-action
^- action
[%add path title url]

49
pkg/arvo/lib/link.hoon Normal file
View File

@ -0,0 +1,49 @@
:: link: social bookmarking
::
/- *link
::
|%
++ site-from-url
|= =url
^- site
=/ murl=(unit purl:eyre)
(de-purl:html url)
?~ murl 'http://example.com'
%^ cat 3
:: render protocol
::
=* sec p.p.u.murl
?:(sec 'https://' 'http://')
:: render host
::
=* host r.p.u.murl
?- -.host
%& (roll (join '.' p.host) (cury cat 3))
%| (rsh 3 1 (scot %if p.host))
==
::
++ en-json
=, enjs:format
|%
++ page
|= =^page
^- json
%- pairs
:~ 'title'^s+title.page
'url'^s+url.page
'timestamp'^(time time.page)
==
--
::
++ de-json
=, dejs:format
|%
++ action
|= =json
^- ^action
?> ?=([%o [%add *] ~ ~] json)
:- %add ::TODO +of doesn't please type system?
%. q.n.p.json
(ot 'path'^pa 'title'^so 'url'^so ~)
--
--

44
pkg/arvo/sur/link.hoon Normal file
View File

@ -0,0 +1,44 @@
:: link: social bookmarking
::
:: link operates on the core structure of "pages", which are URLs saved at a
:: specific time with a specific title.
:: submissions, then, are pages received from a specific ship.
::
|%
:: primitives
::
+$ url @t
+$ site @t :: domain, host, etc.
:: +page: a saved URL with timestamp and custom title
::
+$ page
$: title=@t
=url
=time
==
:: +submission: a page saved by a ship
::
+$ submission
$: =ship
page
==
:: lists, reverse chronological / newest first
::
+$ pages (list page)
+$ submissions (list submission)
::
:: +action: local actions
::
+$ action
$% [%add =path title=@t =url]
[%hear =path from=ship =page] ::TODO just =submission?
==
:: +update: local updates
::
::NOTE we include paths explicitly to support the "subscribed to all" case
::
+$ update
$% [%local-pages =path =pages]
[%submissions =path =submissions]
==
--