urbit/pkg/arvo/app/link-view.hoon
Fang 05e651970e
link: require explicit opt-in for new collections
Instead of auto-watching a new collection when it gets added to group
associations, require that the user explicitly choose to view it.

Of course, creation counts as opting in, so watch the collections we
create by default.
2020-04-09 19:01:58 +02:00

620 lines
16 KiB
Plaintext

:: link-view: frontend endpoints
::
:: endpoints, mapping onto link-store's paths. p is for page as in pagination.
:: updates only work for page 0.
:: as with link-store, urls are expected to use +wood encoding.
::
:: /json/[p]/submissions pages for all groups
:: /json/[p]/submissions/[some-group] page for one group
:: /json/[p]/discussions/[wood-url]/[some-group] page for url in group
:: /json/[n]/submission/[wood-url]/[some-group] nth matching submission
:: /json/seen mark-as-read updates
::
/- *link-view,
*invite-store, group-store,
link-listen-hook,
group-hook, permission-hook, permission-group-hook,
metadata-hook, contact-view
/+ *link, metadata, *server, default-agent, verb, dbug
::
|%
+$ state-0
$: %0
~
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /connect %arvo %e %connect [~ /'~link'] dap.bowl]
[%pass /submissions %agent [our.bowl %link-store] %watch /submissions]
[%pass /discussions %agent [our.bowl %link-store] %watch /discussions]
[%pass /seen %agent [our.bowl %link-store] %watch /seen]
::
=+ [%add dap.bowl /tile '/~link/js/tile.js']
[%pass /launch %agent [our.bowl %launch] %poke %launch-action !>(-)]
::
=+ [%invite-action !>([%create /link])]
[%pass /invitatory/create %agent [our.bowl %invite-store] %poke -]
::
=+ /invitatory/link
[%pass - %agent [our.bowl %invite-store] %watch -]
==
::
++ 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.bowl src.bowl)
:_ this
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
handle-http-request:do
::
%link-action
[(handle-action:do !<(action vase)) ~]
::
%link-view-action
(handle-view-action:do !<(view-action vase))
==
::
++ on-watch
|= =path
^- (quip card _this)
?: ?| ?=([%http-response *] path)
?=([%json %seen ~] path)
==
[~ this]
?: ?=([%tile ~] path)
:_ this
~[give-tile-data:do]
?. ?=([%json @ @ *] path)
(on-watch:def path)
=/ p=@ud (slav %ud i.t.path)
?+ t.t.path (on-watch:def path)
[%submissions ~]
:_ this
(give-initial-submissions:do p ~)
::
[%submissions ^]
:_ this
(give-initial-submissions:do p t.t.t.path)
::
[%submission @ ^]
:_ this
(give-specific-submission:do p (break-discussion-path t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path t.t.t.path))
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
=/ app=term
?: ?=([%invites *] wire)
%invite-store
%link-store
[%pass wire %agent [our.bowl app] %watch wire]~
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark (on-agent:def wire sign)
%invite-update [(handle-invite-update:do !<(invite-update vase)) this]
%link-initial [~ this]
::
%link-update
:_ this
:- (send-update:do !<(update vase))
?: =(/discussions wire) ~
~[give-tile-data:do]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%e %bound *] sign-arvo)
(on-arvo:def wire sign-arvo)
~? !accepted.sign-arvo
[dap.bowl "bind rejected!" binding.sign-arvo]
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
+* md ~(. metadata bowl)
::
++ page-size 25
++ get-paginated
|* [p=(unit @ud) l=(list)]
^- [total=@ud pages=@ud page=_l]
:+ (lent l)
%+ add (div (lent l) page-size)
(min 1 (mod (lent l) page-size))
?~ p l
%+ scag page-size
%+ slag (mul u.p page-size)
l
::
++ page-to-json
=, enjs:format
|* $: page-number=@ud
[total-items=@ud total-pages=@ud page=(list)]
item-to-json=$-(* json)
==
^- json
%- pairs
:~ 'totalItems'^(numb total-items)
'totalPages'^(numb total-pages)
'pageNumber'^(numb page-number)
'page'^a+(turn page item-to-json)
==
::
++ handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
?. =(src.bowl our.bowl)
[[403 ~] ~]
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
?+ method.request.inbound-request not-found:gen
%'GET'
(handle-get req-head request-line)
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
^- simple-payload:http
:: try to load file from clay
::
?~ ext.request-line
:: for extension-less requests, always just serve the index.html.
:: that way the js can load and figure out how to deal with that route.
::
$(request-line [[`%html ~[%'~link' 'index']] args.request-line])
=/ file=(unit octs)
?. ?=([%'~link' *] site.request-line) ~
(get-file-at /app/link [t.site u.ext]:request-line)
?~ file not-found:gen
?+ u.ext.request-line not-found:gen
%html (html-response:gen u.file)
%js (js-response:gen u.file)
%css (css-response:gen u.file)
%png (png-response:gen u.file)
==
::
++ get-file-at
|= [base=path file=path ext=@ta]
^- (unit octs)
:: only expose html, css and js files for now
::
?. ?=(?(%html %css %js %png) ext)
~
=/ =path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
(snoc (weld base file) ext)
==
?. .^(? %cu path)
~
%- some
%- as-octs:mimes:html
.^(@ %cx path)
::
++ do-poke
|= [app=term =mark =vase]
^- card
[%pass /create/[app]/[mark] %agent [our.bowl app] %poke mark vase]
::
++ handle-invite-update
|= upd=invite-update
^- (list card)
?. ?=(%accepted -.upd) ~
?. =(/link path.upd) ~
:~ :: sync the group
::
%^ do-poke %group-hook
%group-hook-action
!> ^- group-hook-action:group-hook
[%add ship path]:invite.upd
::
:: sync the metadata
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%add-synced ship path]:invite.upd
==
::
++ handle-action
|= =action
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ handle-view-action
|= act=view-action
^- (list card)
?- -.act
%create (handle-create +.act)
%delete (handle-delete +.act)
%invite (handle-invite +.act)
==
::
++ handle-create
|= [=path title=@t description=@t members=create-members real-group=?]
^- (list card)
=/ group-path=^path
?- -.members
%group path.members
::
%ships
%+ weld
?:(real-group ~ [~.~]~)
[(scot %p our.bowl) path]
==
=; group-setup=(list card)
%+ weld group-setup
:~ :: add collection to metadata-store
::
%^ do-poke %metadata-hook
%metadata-action
!> ^- metadata-action:md
:^ %add group-path
[%link path]
%* . *metadata:md
title title
description description
date-created now.bowl
creator our.bowl
==
::
:: expose the metadata
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%add-owned group-path]
::
:: watch the collection ourselves
::
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:link-listen-hook
[%watch path]
==
?: ?=(%group -.members) ~
:: if the group is "real", make contact-view do the heavy lifting
::
?: real-group
:_ ~
%^ do-poke %contact-view
%contact-view-action
!> ^- contact-view-action:contact-view
[%create group-path ships.members title description]
:: for "unmanaged" groups, do it ourselves
::
:* :: create the new group
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%bundle group-path]
::
:: fill the new group
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%add (~(put in ships.members) our.bowl) group-path]
::
:: make group available
::
%^ do-poke %group-hook
%group-hook-action
!> ^- group-hook-action:group-hook
[%add our.bowl group-path]
::
:: mirror group into a permission
::
%^ do-poke %permission-group-hook
%permission-group-hook-action
!> ^- permission-group-hook-action:permission-group-hook
[%associate group-path [group-path^%white ~ ~]]
::
:: expose the permission
::
%^ do-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action:permission-hook
[%add-owned group-path group-path]
::
:: send invites
::
%+ turn ~(tap in ships.members)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-hook
group-path
ship
title
==
==
::
++ handle-delete
|= =path
^- (list card)
=/ groups=(list ^path)
(groups-from-resource:md [%link path])
%- zing
%+ turn groups
|= =group=^path
%+ snoc
^- (list card)
:: if it's a real group, we can't/shouldn't unsync it. this leaves us with
:: no way to stop propagation of collection deletion.
::
?. ?=([%'~' ^] group-path) ~
:: if it's an unmanaged group, we just stop syncing the group & metadata,
:: and clean up the group (after un-hooking it, to not push deletion).
::
:~ %^ do-poke %group-hook
%group-hook-action
!> ^- group-hook-action:group-hook
[%remove group-path]
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%remove group-path]
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%unbundle group-path]
==
:: remove collection from metadata-store
::
%^ do-poke %metadata-store
%metadata-action
!> ^- metadata-action:md
[%remove group-path [%link path]]
::
++ handle-invite
|= [=path ships=(set ship)]
^- (list card)
%- zing
%+ turn (groups-from-resource:md %link path)
|= =group=^path
^- (list card)
:- %^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%add ships group-path]
:: for managed groups, rely purely on group logic for invites
::
?. ?=([%'~' ^] group-path)
~
:: for unmanaged groups, send invites manually
::
%+ turn ~(tap in ships)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-hook
group-path
ship
(rsh 3 1 (spat path))
==
:: +give-tile-data: total unread count as json object
::
::NOTE the full recalc of totals here probably isn't the end of the world.
:: but in case it is, well, here it is.
::
++ give-tile-data
^- card
=; =json
[%give %fact ~[/tile] %json !>(json)]
%+ frond:enjs:format 'unseen'
%- numb:enjs:format
%- %~ rep in
(scry-for (jug path url) /unseen)
|= [[=path unseen=(set url)] total=@ud]
%+ add total
~(wyt in unseen)
::
:: +give-initial-submissions: page of submissions on path
::
:: for the / path, give page for every path
::
:: result is in the shape of: {
:: "/some/path": {
:: totalItems: 1,
:: totalPages: 1,
:: pageNumber: 0,
:: page: [
:: { commentCount: 1, ...restOfTheSubmission }
:: ]
:: },
:: "/maybe/more": { etc }
:: }
::
++ give-initial-submissions
|= [p=@ud =path]
^- (list card)
:_ ?: =(0 p) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'initial-submissions'
%- pairs:enjs:format
%+ turn
%~ tap by
%+ scry-for (map ^path submissions)
[%submissions path]
|= [=^path =submissions]
^- [@t json]
:- (spat path)
=; =json
:: add unseen count
::
?> ?=(%o -.json)
:- %o
%+ ~(put by p.json) 'unseenCount'
%- numb:enjs:format
%~ wyt in
%+ scry-for (set url)
[%unseen path]
%^ page-to-json p
%+ get-paginated `p
submissions
|= =submission
^- json
=/ =json (submission:en-json submission)
?> ?=([%o *] json)
:: add in seen status
::
=. p.json
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path path url.submission)]
:: add in comment count
::
=; comment-count=@ud
:- %o
%+ ~(put by p.json) 'commentCount'
(numb:enjs:format comment-count)
%- lent
~| [path url.submission]
^- comments
=- (~(got by (~(got by -) path)) url.submission)
%+ scry-for (per-path-url comments)
:- %discussions
(build-discussion-path path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:en-json u.sub)
=/ =submissions
=- (~(got by -) path)
%+ scry-for (map ^path submissions)
[%submissions path]
|-
?~ submissions ~
=* sub i.submissions
?. =(url.sub url)
$(submissions t.submissions)
?: =(0 n) `sub
$(n (dec n), submissions t.submissions)
::
++ give-initial-discussions
|= [p=@ud =path =url]
^- (list card)
:_ ?: =(0 p) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'initial-discussions'
%^ page-to-json p
%+ get-paginated `p
=- (~(got by (~(got by -) path)) url)
%+ scry-for (per-path-url comments)
[%discussions (build-discussion-path path url)]
comment:en-json
::
++ send-update
|= =update
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
(update:en-json update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
(update:en-json update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path [path url]:update)
::
%observation
%+ give-json
(update:en-json update)
~[/json/seen]
==
::
++ give-json
|= [=json paths=(list path)]
^- card
[%give %fact paths %json !>(json)]
::
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
--