urbit/pkg/landscape/app/group-view.hoon
2021-11-08 14:30:32 -06:00

442 lines
11 KiB
Plaintext

/- view-sur=group-view, group-store, *group, metadata=metadata-store, hark=hark-store
/+ default-agent, agentio, mdl=metadata,
resource, dbug, grpl=group, conl=contact, verb
|%
++ card card:agent:gall
::
+$ base-state-0
joining=(map rid=resource [=ship =progress:view])
::
+$ base-state-1
joining=(map rid=resource request:view)
::
+$ state-zero
[%0 base-state-0]
::
+$ state-one
[%1 base-state-0]
::
+$ state-two
[%2 base-state-1]
::
+$ versioned-state
$% state-zero
state-one
state-two
==
::
++ view view-sur
--
=| state-two
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
gc ~(. +> bowl)
io ~(. agentio bowl)
++ on-init
`this
++ on-save
!>(state)
::
++ on-load
|= =vase
=+ !<(old=versioned-state vase)
=| cards=(list card)
|^
?- -.old
%2 [cards this(state old)]
%1 $(-.old %2, +.old (base-state-to-1 +.old))
%0 $(-.old %1, cards :_(cards (poke-self:pass:io noun+!>(%cleanup))))
==
::
++ base-state-to-1
|= base-state-0
%- ~(gas by *(map resource request:view))
(turn ~(tap by joining) request-to-1)
::
++ request-to-1
|= [rid=resource =ship =progress:view]
^- [resource request:view]
:- rid
%* . *request:view
started now.bowl
hidden %.n
ship ship
progress progress
==
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%noun mark)
=^ cards state
poke-noun:gc
[cards this]
?. ?=(%group-view-action mark)
(on-poke:def mark vase)
=+ !<(=action:view vase)
=^ cards state
?+ -.action !!
%join jn-abet:(jn-start:join:gc +.action)
%retry jn-abet:(jn-retry:join:gc +.action)
%hide (hide:gc +.action)
==
[cards this]
::
++ on-watch
|= =path
?+ path (on-watch:def path)
[%all ~]
:_ this
:_ ~
%+ fact:io
:- %group-view-update
!>(`update:view`[%initial joining])
~
==
::
++ on-peek on-peek:def
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards state
?+ wire (on-agent:def:gc wire sign)
[%join %ship @ @ *]
=/ rid
(de-path:resource t.wire)
?. (~(has by joining) rid) `state
jn-abet:(jn-agent:(jn-abed:join:gc rid) t.t.t.t.wire sign)
==
[cards this]
::
++ on-arvo on-arvo:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
|_ =bowl:gall
++ met ~(. mdl bowl)
++ grp ~(. grpl bowl)
++ io ~(. agentio bowl)
++ con ~(. conl bowl)
++ def ~(. (default-agent state %|) bowl)
++ hide
|= rid=resource
^- (quip card _state)
=/ =request:view (~(got by joining) rid)
?: ?=(final:view progress.request)
=. joining (~(del by joining) rid)
:_ state
(fact:io group-view-update+!>(`update:view`[%initial joining]) /all ~)^~
:- (fact:io group-view-update+!>([%hide rid]) /all ~)^~
state(joining (~(put by joining) rid request(hidden %.y)))
::
++ has-joined
|= rid=resource
=- ?=(^ -)
?~ grp=(peek-group:met %groups rid)
(peek-group:met %graph rid)
grp
::
++ poke-noun
^- (quip card _state)
=; new-joining=(map resource request:view)
`state(joining new-joining)
%+ roll ~(tap by joining)
|= [[rid=resource =request:view] out=_joining]
?. (has-joined rid) out
(~(del by out) rid)
::
++ join
|_ [rid=resource =ship cards=(list card)]
++ jn-core .
++ emit-many
|= crds=(list card)
jn-core(cards (weld (flop crds) cards))
::
++ emit
|= =card
jn-core(cards [card cards])
::
++ tx-progress
|= =progress:view
=. joining
(~(jab by joining) rid |=(req=request:view req(progress progress)))
=; =cage
(emit (fact:io cage /all tx+(en-path:resource rid) ~))
group-view-update+!>([%progress rid progress])
::
++ pass
=> |%
++ pull-action
pull-hook-action+!>([%join ship rid])
--
|%
::
++ watch-md (watch-our:(jn-pass-io /md) %metadata-store /updates)
++ watch-groups (watch-our:(jn-pass-io /groups) %group-store /groups)
++ watch-md-nacks (watch-our:(jn-pass-io /md-nacks) %metadata-pull-hook /nack)
++ watch-grp-nacks (watch-our:(jn-pass-io /grp-nacks) %group-pull-hook /nack)
::
++ add-us
%+ poke:(jn-pass-io /add)
[ship %group-push-hook]
group-update-0+!>([%add-members rid (silt our.bowl ~)])
::
++ pull-groups
(poke-our:(jn-pass-io /poke) %group-pull-hook pull-action)
++ pull-md
(poke-our:(jn-pass-io /poke) %metadata-pull-hook pull-action)
++ pull-co
(poke-our:(jn-pass-io /poke) %contact-pull-hook pull-action)
::
++ share-co
%+ poke:(jn-pass-io /poke)
[entity.rid %contact-push-hook]
[%contact-share !>([%share our.bowl])]
::
++ pull-gra
|= gr=resource
(poke-our:(jn-pass-io /poke) %graph-pull-hook pull-hook-action+!>([%add entity .]:gr))
::
++ retry
(poke-self:pass:io group-view-action+!>([%join rid ship]))
--
++ jn-pass-io
|= pax=path
~(. pass:io (welp join+(en-path:resource rid) pax))
::
++ jn-abed
|= r=resource
=/ =request:view
(~(got by joining) r)
jn-core(rid r, ship ship.request)
::
++ jn-abet
^- (quip card _state)
[(flop cards) state]
::
++ jn-start
|= [rid=resource =^ship]
^+ jn-core
?> ?= $@(~ [~ %done])
(bind (~(get by joining) rid) |=(request:view progress))
=. joining
(~(put by joining) rid [%.n now.bowl ship %start])
=. jn-core
(jn-abed rid)
=. jn-core
%- emit
%+ fact:io
group-view-update+!>([%started rid (~(got by joining) rid)])
~[/all]
?< ~|("already joined {<rid>}" (has-joined rid))
=. jn-core (emit add-us:pass)
=. jn-core (tx-progress %start)
=> (emit watch-md:pass)
=> (emit watch-groups:pass)
=> (emit watch-grp-nacks:pass)
(emit watch-md-nacks:pass)
::
++ jn-retry
|= r=resource
^+ jn-core
=. jn-core (jn-abed r)
=. jn-core (cleanup %retry)
(emit retry:pass)
::
++ cleanup
|= =progress:view
=. jn-core
(tx-progress progress)
=. jn-core
(emit (leave-our:(jn-pass-io /groups) %group-store))
=. jn-core
(emit (leave-our:(jn-pass-io /md) %metadata-store))
=. jn-core
(emit (leave-our:(jn-pass-io /md-nacks) %metadata-pull-hook))
=. jn-core
(emit (leave-our:(jn-pass-io /grp-nacks) %group-pull-hook))
=/ =request:view (~(got by joining) rid)
=? jn-core ?&(!=(progress %retry) (gth (sub now.bowl started.request) ~s30))
notify
=. joining (~(del by joining) rid)
jn-core
::
++ notify
%- emit
%+ poke-our:(jn-pass-io /hark) %hark-store
=- hark-action+!>(-)
^- action:hark
|^
[%add-note bin body]
++ bin
^- bin:hark
[/ [q.byk.bowl /join/(scot %p entity.rid)/[name.rid]]]
++ title
|= [name=@t rest=@t]
text/(rap 3 'Joining group: "' name '" ' rest ~)
++ body
^- body:hark
=/ =request:view (~(got by joining) rid)
?> ?=(final:view progress.request)
=/ name (rap 3 (scot %p entity.rid) '/' name.rid ~)
?- progress.request
::
%done
=/ =metadatum:metadata (need (peek-metadatum:met %groups rid))
:* ~[(title title.metadatum 'succeeded')]
~
now.bowl
/
/groups/(scot %p entity.rid)/[name.rid]
==
::
?(%strange %retry)
:* ~[(title name 'errored unexpectedly')]
~
now.bowl
/
/
==
::
%no-perms
:* ~[(title name 'failed, you are not permitted to join the group')]
~
now.bowl
/
/
==
==
--
::
++ jn-agent
|= [=wire =sign:agent:gall]
^+ jn-core
|^
?+ -.wire ~|("bad %join wire" !!)
%add :: join group
?> ?=(%poke-ack -.sign)
?^ p.sign
(cleanup %no-perms)
=. jn-core
(tx-progress %added)
(emit pull-groups:pass)
::
%groups
?+ -.sign !!
%fact (groups-fact +.sign)
%watch-ack (ack +.sign)
%kick (emit watch-groups:pass)
==
::
%poke
?> ?=(%poke-ack -.sign)
(ack +.sign)
::
%md
?+ -.sign !!
%fact (md-fact +.sign)
%watch-ack (ack +.sign)
%kick (emit watch-md:pass)
==
::
%pull-graphs
?> ?=(%poke-ack -.sign)
%- cleanup
?^(p.sign %strange %done)
::
%md-nacks
?+ -.sign !!
%watch-ack (ack +.sign)
%kick (emit watch-md-nacks:pass)
::
%fact
?. =(%resource p.cage.sign) jn-core
=+ !<(nack=resource q.cage.sign)
?. =(nack rid) jn-core
(cleanup %strange)
==
::
%grp-nacks
?+ -.sign !!
%watch-ack (ack +.sign)
%kick (emit watch-grp-nacks:pass)
::
%fact
?. =(%resource p.cage.sign) jn-core
=+ !<(nack=resource q.cage.sign)
?. =(nack rid) jn-core
(cleanup %strange)
==
==
::
++ groups-fact
|= =cage
?. ?=(%group-update-0 p.cage) jn-core
=+ !<(=update:group-store q.cage)
?. ?=(%initial-group -.update) jn-core
?. =(rid resource.update) jn-core
=. jn-core (emit pull-md:pass)
=. jn-core (emit pull-co:pass)
?: scry-is-public:con
(emit share-co:pass)
jn-core
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update-2 mark) jn-core
=+ !<(=update:metadata vase)
?. ?=(%initial-group -.update) jn-core
?. =(group.update rid) jn-core
|^ ^+ jn-core
=/ feed feed-rid
=. jn-core (cleanup %done)
=/ hidden hidden:(need (scry-group:grp rid))
=? jn-core ?&(!hidden ?=(^ feed))
%- emit
(pull-gra:pass (need feed))
=? jn-core !hidden
%- emit-many
(turn graphs pull-gra:pass)
jn-core
::
++ feed-rid
^- (unit resource)
=/ list-md=(list [=md-resource:metadata =association:metadata])
%+ skim ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]
=(app-name.md-resource %groups)
?~ list-md ~
=* metadatum metadatum.association.i.list-md
?. ?& ?=(%group -.config.metadatum)
?=([~ ~ *] feed.config.metadatum)
==
~
`resource.u.u.feed.config.metadatum
::
++ graphs
^- (list resource)
%+ murn ~(tap by associations.update)
|= [=md-resource:metadata =association:metadata]
?. =(app-name.md-resource %graph) ~
`resource.md-resource
--
::
++ ack
|= err=(unit tang)
?~ err jn-core
%- (slog u.err)
(cleanup %strange)
::
--
--
--