mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-09-20 06:58:16 +03:00
Merge remote-tracking branch 'origin/release/next-userspace' into lf/graph-permissioning
This commit is contained in:
commit
c16f2365bf
9
.github/ISSUE_TEMPLATE/config.yml
vendored
9
.github/ISSUE_TEMPLATE/config.yml
vendored
@ -1,11 +1,8 @@
|
||||
blank_issues_enabled: true
|
||||
contact_links:
|
||||
- name: Landscape design issue
|
||||
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=design+issue&template=report-a-design-issue.md&title=
|
||||
about: Submit non-functionality, design-specific issues to the Landscape team here.
|
||||
- name: Landscape feature request
|
||||
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=feature+request&template=feature_request.md&title=
|
||||
about: Landscape is comprised of Tlon's user applications and client for Urbit. Submit Landscape feature requests here.
|
||||
- name: Submit a Landscape issue
|
||||
url: https://github.com/urbit/landscape/issues/new/choose
|
||||
about: Issues with Landscape (Tlon's flagship client) should be filed at urbit/landscape. This includes groups, chats, collections, notebooks, and more.
|
||||
- name: urbit-dev mailing list
|
||||
url: https://groups.google.com/a/urbit.org/g/dev
|
||||
about: Developer questions and discussions also take place on the urbit-dev mailing list.
|
||||
|
39
.github/ISSUE_TEMPLATE/os1-bug-report.md
vendored
39
.github/ISSUE_TEMPLATE/os1-bug-report.md
vendored
@ -1,39 +0,0 @@
|
||||
---
|
||||
name: Landscape bug report
|
||||
about: 'Use this template to file a bug for any Landscape app: Chat, Publish, Links, Groups,
|
||||
Weather or Clock'
|
||||
title: ''
|
||||
labels: landscape
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
**Describe the bug**
|
||||
A clear and concise description of what the bug is.
|
||||
|
||||
**To Reproduce**
|
||||
Steps to reproduce the behavior:
|
||||
1. Go to '...'
|
||||
2. Click on '....'
|
||||
3. Scroll down to '....'
|
||||
4. See error
|
||||
|
||||
**Expected behavior**
|
||||
A clear and concise description of what you expected to happen.
|
||||
|
||||
**Screenshots**
|
||||
If applicable, add screenshots to help explain your problem. If possible, please also screenshot your browser's dev console. Here are [Chrome's docs](https://developers.google.com/web/tools/chrome-devtools/open) for using this feature.
|
||||
|
||||
**Desktop (please complete the following information):**
|
||||
- OS: [e.g. MacOS 10.15.3]
|
||||
- Browser [e.g. chrome, safari]
|
||||
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
|
||||
|
||||
**Smartphone (please complete the following information):**
|
||||
- Device: [e.g. iPhone6]
|
||||
- OS: [e.g. iOS8.1]
|
||||
- Browser [e.g. stock browser, safari]
|
||||
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
|
||||
|
||||
**Additional context**
|
||||
Add any other context about the problem here.
|
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:271d575a87373f4ed73b195780973ed41cb72be21b428a645c42a49ab5f786ee
|
||||
size 8873583
|
||||
oid sha256:6b4b198b552066fdee2a694a3134bf641b20591bebda21aa90920f4107f04f20
|
||||
size 9065500
|
||||
|
@ -155,8 +155,7 @@ let
|
||||
contents = {
|
||||
"${name}/urbit" = "${urbit}/bin/urbit";
|
||||
"${name}/urbit-worker" = "${urbit}/bin/urbit-worker";
|
||||
# temporarily removed for compatibility reasons
|
||||
# "${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
|
||||
"${name}/urbit-king" = "${urbit-king}/bin/urbit-king";
|
||||
};
|
||||
};
|
||||
|
||||
|
@ -1,571 +1,27 @@
|
||||
:: contact-hook [landscape]
|
||||
:: contact-hook [landscape]: deprecated
|
||||
::
|
||||
::
|
||||
/- *contact-hook,
|
||||
*contact-view,
|
||||
inv=invite-store,
|
||||
*metadata-hook,
|
||||
*metadata-store,
|
||||
*group
|
||||
/+ *contact-json,
|
||||
default-agent,
|
||||
dbug,
|
||||
group-store,
|
||||
verb,
|
||||
resource,
|
||||
grpl=group,
|
||||
*migrate
|
||||
~% %contact-hook-top ..part ~
|
||||
/+ default-agent
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
::
|
||||
+$ versioned-state
|
||||
$% state-zero
|
||||
state-one
|
||||
state-two
|
||||
state-three
|
||||
==
|
||||
::
|
||||
+$ state-zero [%0 state-base]
|
||||
+$ state-one [%1 state-base]
|
||||
+$ state-two [%2 state-base]
|
||||
+$ state-three [%3 state-base]
|
||||
+$ state-base
|
||||
$: =synced
|
||||
invite-created=_|
|
||||
==
|
||||
--
|
||||
=| state-three
|
||||
=* state -
|
||||
%- agent:dbug
|
||||
%+ verb |
|
||||
::
|
||||
^- agent:gall
|
||||
=<
|
||||
|_ bol=bowl:gall
|
||||
+* this .
|
||||
contact-core +>
|
||||
cc ~(. contact-core bol)
|
||||
def ~(. (default-agent this %|) bol)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
:_ this(invite-created %.y)
|
||||
:~ (invite-poke:cc [%create %contacts])
|
||||
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]
|
||||
[%pass /group %agent [our.bol %group-store] %watch /groups]
|
||||
==
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
=/ old !<(versioned-state old-vase)
|
||||
=| cards=(list card)
|
||||
|^
|
||||
|- ^- (quip card _this)
|
||||
?: ?=(%3 -.old)
|
||||
[cards this(state old)]
|
||||
?: ?=(%2 -.old)
|
||||
%_ $
|
||||
old [%3 +.old]
|
||||
::
|
||||
cards
|
||||
%+ welp
|
||||
cards
|
||||
%- zing
|
||||
%+ turn
|
||||
~(tap by synced.old)
|
||||
|= [=path =ship]
|
||||
^- (list card)
|
||||
?. =(ship our.bol)
|
||||
~
|
||||
?> ?=([%ship *] path)
|
||||
:~ (pass-store contacts+t.path %leave ~)
|
||||
(pass-store contacts+path %watch contacts+path)
|
||||
==
|
||||
==
|
||||
?: ?=(%1 -.old)
|
||||
%_ $
|
||||
-.old %2
|
||||
::
|
||||
synced.old
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by synced.old)
|
||||
|= [=path =ship]
|
||||
[ship+path ship]
|
||||
::
|
||||
cards
|
||||
^- (list card)
|
||||
;: welp
|
||||
:~ [%pass /group %agent [our.bol %group-store] %leave ~]
|
||||
[%pass /group %agent [our.bol %group-store] %watch /groups]
|
||||
==
|
||||
kick-old-subs
|
||||
cards
|
||||
==
|
||||
==
|
||||
%_ $
|
||||
-.old %1
|
||||
::
|
||||
cards
|
||||
:_ cards
|
||||
[%pass /group %agent [our.bol %group-store] %watch /updates]
|
||||
==
|
||||
++ kick-old-subs
|
||||
=/ paths
|
||||
%+ turn
|
||||
~(val by sup.bol)
|
||||
|=([=ship =path] path)
|
||||
?~ paths ~
|
||||
[%give %kick paths ~]~
|
||||
::
|
||||
++ pass-store
|
||||
|= [=wire =task:agent:gall]
|
||||
^- card
|
||||
[%pass wire %agent [our.bol %contact-store] task]
|
||||
--
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
=^ cards state
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%json
|
||||
(poke-json:cc !<(json vase))
|
||||
::
|
||||
%contact-action
|
||||
(poke-contact-action:cc !<(contact-action vase))
|
||||
::
|
||||
%contact-hook-action
|
||||
(poke-hook-action:cc !<(contact-hook-action vase))
|
||||
::
|
||||
%import
|
||||
?> (team:title our.bol src.bol)
|
||||
(poke-import:cc q.vase)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
?+ path (on-watch:def path)
|
||||
[%contacts *] [(watch-contacts:cc t.path) this]
|
||||
[%synced *] [(watch-synced:cc t.path) this]
|
||||
==
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
?+ -.sign (on-agent:def wire sign)
|
||||
%kick [(kick:cc wire) this]
|
||||
%watch-ack
|
||||
=^ cards state
|
||||
(watch-ack:cc wire p.sign)
|
||||
[cards this]
|
||||
::
|
||||
%fact
|
||||
?+ p.cage.sign (on-agent:def wire sign)
|
||||
%contact-update
|
||||
=^ cards state
|
||||
(fact-contact-update:cc wire !<(contact-update q.cage.sign))
|
||||
[cards this]
|
||||
::
|
||||
%group-update
|
||||
=^ cards state
|
||||
(fact-group-update:cc wire !<(update:group-store q.cage.sign))
|
||||
[cards this]
|
||||
::
|
||||
%invite-update [~ this]
|
||||
==
|
||||
==
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path (on-peek:def path)
|
||||
[%x %export ~]
|
||||
``noun+!>(state)
|
||||
[%x %synced ~]
|
||||
``noun+!>(~(key by synced))
|
||||
==
|
||||
++ on-arvo
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card _this)
|
||||
?. ?=([%try-rejoin @ @ *] wire)
|
||||
(on-arvo:def wire sign-arvo)
|
||||
=/ nack-count=@ud (slav %ud i.t.wire)
|
||||
=/ who=@p (slav %p i.t.t.wire)
|
||||
=/ pax t.t.t.wire
|
||||
?> ?=([%behn %wake *] sign-arvo)
|
||||
~? ?=(^ error.sign-arvo)
|
||||
"behn errored in backoff timers, continuing anyway"
|
||||
:_ this
|
||||
[(try-rejoin:cc who pax +(nack-count))]~
|
||||
::
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
::
|
||||
|_ bol=bowl:gall
|
||||
++ grp ~(. grpl bol)
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bol)
|
||||
::
|
||||
++ poke-json
|
||||
|= jon=json
|
||||
^- (quip card _state)
|
||||
(poke-contact-action (json-to-action jon))
|
||||
++ on-init on-init:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-save !>(~)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
[~ this]
|
||||
::
|
||||
++ poke-contact-action
|
||||
|= act=contact-action
|
||||
^- (quip card _state)
|
||||
:_ state
|
||||
?+ -.act !!
|
||||
%edit (handle-contact-action path.act ship.act act)
|
||||
%add (handle-contact-action path.act ship.act act)
|
||||
%remove (handle-contact-action path.act ship.act act)
|
||||
==
|
||||
::
|
||||
++ handle-contact-action
|
||||
|= [=path =ship act=contact-action]
|
||||
^- (list card)
|
||||
:: local
|
||||
?: (team:title our.bol src.bol)
|
||||
?. |(=(path /~/default) (~(has by synced) path)) ~
|
||||
=/ shp ?:(=(path /~/default) our.bol (~(got by synced) path))
|
||||
=/ appl ?:(=(shp our.bol) %contact-store %contact-hook)
|
||||
[%pass / %agent [shp appl] %poke %contact-action !>(act)]~
|
||||
:: foreign
|
||||
=/ shp (~(got by synced) path)
|
||||
?. |(=(shp our.bol) =(src.bol ship)) ~
|
||||
:: scry group to check if ship is a member
|
||||
=/ =group (need (group-scry path))
|
||||
?. (~(has in members.group) shp) ~
|
||||
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~
|
||||
::
|
||||
++ poke-hook-action
|
||||
|= act=contact-hook-action
|
||||
^- (quip card _state)
|
||||
?- -.act
|
||||
%add-owned
|
||||
?> (team:title our.bol src.bol)
|
||||
=/ contact-path [%contacts path.act]
|
||||
?: (~(has by synced) path.act)
|
||||
[~ state]
|
||||
=. synced (~(put by synced) path.act our.bol)
|
||||
:_ state
|
||||
:~ [%pass contact-path %agent [our.bol %contact-store] %watch contact-path]
|
||||
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
|
||||
==
|
||||
::
|
||||
%add-synced
|
||||
?> (team:title our.bol src.bol)
|
||||
?: (~(has by synced) path.act) [~ state]
|
||||
=. synced (~(put by synced) path.act ship.act)
|
||||
=/ contact-path [%contacts path.act]
|
||||
:_ state
|
||||
:~ [%pass contact-path %agent [ship.act %contact-hook] %watch contact-path]
|
||||
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
|
||||
==
|
||||
::
|
||||
%remove
|
||||
=/ ship (~(get by synced) path.act)
|
||||
?~ ship [~ state]
|
||||
?: &(=(u.ship our.bol) (team:title our.bol src.bol))
|
||||
:: delete one of our.bol own paths
|
||||
:_ state(synced (~(del by synced) path.act))
|
||||
%- zing
|
||||
:~ (pull-wire [%contacts path.act])
|
||||
[%give %kick ~[[%contacts path.act]] ~]~
|
||||
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
|
||||
==
|
||||
?. |(=(u.ship src.bol) (team:title our.bol src.bol))
|
||||
:: if neither ship = source or source = us, do nothing
|
||||
[~ state]
|
||||
:: delete a foreign ship's path
|
||||
=/ cards
|
||||
(handle-contact-action path.act our.bol [%remove path.act our.bol])
|
||||
:_ state(synced (~(del by synced) path.act))
|
||||
%- zing
|
||||
:~ (pull-wire [%contacts path.act])
|
||||
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
|
||||
cards
|
||||
==
|
||||
==
|
||||
::
|
||||
++ poke-import
|
||||
|= arc=*
|
||||
^- (quip card _state)
|
||||
=/ sty=state-three
|
||||
[%3 (remake-map ;;((tree [path ship]) +<.arc)) ;;(? +>.arc)]
|
||||
:_ sty
|
||||
%+ turn ~(tap by synced.sty)
|
||||
|= [=path =ship]
|
||||
^- card
|
||||
=/ contact-path [%contacts path]
|
||||
?: =(our.bol ship)
|
||||
[%pass contact-path %agent [our.bol %contact-store] %watch contact-path]
|
||||
(try-rejoin ship contact-path 0)
|
||||
::
|
||||
++ try-rejoin
|
||||
|= [who=@p pax=path nack-count=@ud]
|
||||
^- card
|
||||
=/ =wire
|
||||
[%try-rejoin (scot %ud nack-count) (scot %p who) pax]
|
||||
[%pass wire %agent [who %contact-hook] %watch pax]
|
||||
::
|
||||
++ watch-contacts
|
||||
|= pax=path
|
||||
^- (list card)
|
||||
?> ?=(^ pax)
|
||||
?> (~(has by synced) pax)
|
||||
:: scry groups to check if ship is a member
|
||||
=/ =group (need (group-scry pax))
|
||||
?> (~(has in members.group) src.bol)
|
||||
=/ contacts (need (contacts-scry pax))
|
||||
[%give %fact ~ %contact-update !>([%contacts pax contacts])]~
|
||||
::
|
||||
++ watch-synced
|
||||
|= pax=path
|
||||
^- (list card)
|
||||
?> (team:title our.bol src.bol)
|
||||
[%give %fact ~ %contact-hook-update !>([%initial synced])]~
|
||||
::
|
||||
++ watch-ack
|
||||
|= [wir=wire saw=(unit tang)]
|
||||
^- (quip card _state)
|
||||
?~ saw
|
||||
[~ state]
|
||||
?: ?=([%try-rejoin @ *] wir)
|
||||
=/ nack-count=@ud (slav %ud i.t.wir)
|
||||
=/ wakeup=@da
|
||||
(add now.bol (mul ~s1 (bex (min 19 nack-count))))
|
||||
:_ state
|
||||
[%pass wir %arvo %b %wait wakeup]~
|
||||
::
|
||||
?> ?=(^ wir)
|
||||
[~ state(synced (~(del by synced) t.wir))]
|
||||
::
|
||||
++ migrate
|
||||
|= wir=wire
|
||||
^- wire
|
||||
?> ?=([%contacts @ @ *] wir)
|
||||
[%contacts %ship t.wir]
|
||||
::
|
||||
++ kick
|
||||
|= wir=wire
|
||||
^- (list card)
|
||||
?+ wir !!
|
||||
[%try-rejoin @ @ *]
|
||||
$(wir t.t.t.wir)
|
||||
::
|
||||
[%inv ~]
|
||||
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]~
|
||||
::
|
||||
[%group ~]
|
||||
[%pass /group %agent [our.bol %group-store] %watch /groups]~
|
||||
::
|
||||
[%contacts @ *]
|
||||
=/ wir
|
||||
?: =(%ship i.t.wir)
|
||||
wir
|
||||
(migrate wir)
|
||||
?> ?=([%contacts @ @ *] wir)
|
||||
?. (~(has by synced) t.wir) ~
|
||||
=/ =ship (~(got by synced) t.wir)
|
||||
?: =(ship our.bol)
|
||||
[%pass wir %agent [our.bol %contact-store] %watch wir]~
|
||||
[%pass wir %agent [ship %contact-hook] %watch wir]~
|
||||
==
|
||||
::
|
||||
++ fact-contact-update
|
||||
|= [wir=wire fact=contact-update]
|
||||
^- (quip card _state)
|
||||
|^
|
||||
?: (team:title our.bol src.bol)
|
||||
(local fact)
|
||||
:_ state
|
||||
(foreign fact)
|
||||
::
|
||||
++ give-fact
|
||||
|= [=path update=contact-update]
|
||||
^- (list card)
|
||||
[%give %fact ~[[%contacts path]] %contact-update !>(update)]~
|
||||
::
|
||||
++ local
|
||||
|= fact=contact-update
|
||||
^- (quip card _state)
|
||||
?+ -.fact [~ state]
|
||||
%add
|
||||
:_ state
|
||||
(give-fact path.fact [%add path.fact ship.fact contact.fact])
|
||||
::
|
||||
%edit
|
||||
:_ state
|
||||
(give-fact path.fact [%edit path.fact ship.fact edit-field.fact])
|
||||
::
|
||||
%delete
|
||||
=. synced (~(del by synced) path.fact)
|
||||
`state
|
||||
==
|
||||
::
|
||||
++ foreign
|
||||
|= fact=contact-update
|
||||
^- (list card)
|
||||
?+ -.fact ~
|
||||
%contacts
|
||||
=/ owner (~(got by synced) path.fact)
|
||||
?> =(owner src.bol)
|
||||
=/ have-contacts=(unit contacts)
|
||||
(contacts-scry path.fact)
|
||||
?~ have-contacts
|
||||
:: if we don't have any contacts yet,
|
||||
:: create the entry, and %add every contact
|
||||
::
|
||||
:- (contact-poke [%create path.fact])
|
||||
%+ turn ~(tap by contacts.fact)
|
||||
|= [=ship =contact]
|
||||
(contact-poke [%add path.fact ship contact])
|
||||
:: if we already have some, decide between %add, %remove and recreate
|
||||
:: on a per-contact basis
|
||||
::
|
||||
%- zing
|
||||
%+ turn
|
||||
%~ tap in
|
||||
%- ~(uni in ~(key by contacts.fact))
|
||||
~(key by u.have-contacts)
|
||||
|= =ship
|
||||
^- (list card)
|
||||
=/ have=(unit contact) (~(get by u.have-contacts) ship)
|
||||
=/ want=(unit contact) (~(get by contacts.fact) ship)
|
||||
?~ have
|
||||
[(contact-poke %add path.fact ship (need want))]~
|
||||
?~ want
|
||||
[(contact-poke %remove path.fact ship)]~
|
||||
?: =(u.want u.have) ~
|
||||
::TODO probably want an %all edit-field that resolves to more granular
|
||||
:: updates within the contact-store?
|
||||
:~ (contact-poke %remove path.fact ship)
|
||||
(contact-poke %add path.fact ship u.want)
|
||||
==
|
||||
::
|
||||
%add
|
||||
=/ owner (~(get by synced) path.fact)
|
||||
?~ owner ~
|
||||
?> |(=(u.owner src.bol) =(src.bol ship.fact))
|
||||
~[(contact-poke [%add path.fact ship.fact contact.fact])]
|
||||
::
|
||||
%remove
|
||||
=/ owner (~(get by synced) path.fact)
|
||||
?~ owner ~
|
||||
?> |(=(u.owner src.bol) =(src.bol ship.fact))
|
||||
~[(contact-poke [%remove path.fact ship.fact])]
|
||||
::
|
||||
%edit
|
||||
=/ owner (~(got by synced) path.fact)
|
||||
?> |(=(owner src.bol) =(src.bol ship.fact))
|
||||
~[(contact-poke [%edit path.fact ship.fact edit-field.fact])]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ fact-group-update
|
||||
|= [wir=wire fact=update:group-store]
|
||||
^- (quip card _state)
|
||||
?: ?=(%initial -.fact)
|
||||
[~ state]
|
||||
=/ group=(unit group)
|
||||
(scry-group:grp resource.fact)
|
||||
|^
|
||||
?+ -.fact [~ state]
|
||||
%initial-group (initial-group +.fact)
|
||||
%remove-members (remove +.fact)
|
||||
%remove-group (unbundle +.fact)
|
||||
==
|
||||
::
|
||||
++ initial-group
|
||||
|= [rid=resource =^group]
|
||||
^- (quip card _state)
|
||||
?: hidden.group [~ state]
|
||||
=/ =path
|
||||
(en-path:resource rid)
|
||||
?: (~(has by synced) path)
|
||||
[~ state]
|
||||
(poke-hook-action %add-synced entity.rid path)
|
||||
::
|
||||
++ unbundle
|
||||
|= [rid=resource ~]
|
||||
^- (quip card _state)
|
||||
=/ =path
|
||||
(en-path:resource rid)
|
||||
?. (~(has by synced) path)
|
||||
?~ (contacts-scry path)
|
||||
[~ state]
|
||||
:_ state
|
||||
[(contact-poke [%delete path])]~
|
||||
:_ state(synced (~(del by synced) path))
|
||||
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
|
||||
[(contact-poke [%delete path])]
|
||||
==
|
||||
::
|
||||
++ remove
|
||||
|= [rid=resource ships=(set ship)]
|
||||
^- (quip card _state)
|
||||
:: if pax is synced, remove member from contacts and kick their sub
|
||||
?~ group
|
||||
[~ state]
|
||||
?: hidden.u.group [~ state]
|
||||
=/ =path
|
||||
(en-path:resource rid)
|
||||
=/ owner=(unit ship) (~(get by synced) path)
|
||||
?~ owner
|
||||
:_ state
|
||||
%+ turn ~(tap in ships)
|
||||
|= =ship
|
||||
(contact-poke [%remove path ship])
|
||||
:_ state
|
||||
%- zing
|
||||
%+ turn ~(tap in ships)
|
||||
|= =ship
|
||||
:~ [%give %kick ~[[%contacts path]] `ship]
|
||||
?: =(ship our.bol)
|
||||
(contact-poke [%delete path])
|
||||
(contact-poke [%remove path ship])
|
||||
==
|
||||
--
|
||||
::
|
||||
++ invite-poke
|
||||
|= act=action:inv
|
||||
^- card
|
||||
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
|
||||
::
|
||||
++ contact-poke
|
||||
|= act=contact-action
|
||||
^- card
|
||||
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
|
||||
::
|
||||
++ contacts-scry
|
||||
|= pax=path
|
||||
^- (unit contacts)
|
||||
=. pax
|
||||
;: weld
|
||||
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contacts
|
||||
pax
|
||||
/noun
|
||||
==
|
||||
.^((unit contacts) %gx pax)
|
||||
::
|
||||
++ group-scry
|
||||
|= pax=path
|
||||
.^ (unit group)
|
||||
%gx
|
||||
;:(weld /(scot %p our.bol)/group-store/(scot %da now.bol) /groups pax /noun)
|
||||
==
|
||||
::
|
||||
++ pull-wire
|
||||
|= pax=path
|
||||
^- (list card)
|
||||
?> ?=(^ pax)
|
||||
=/ shp (~(get by synced) t.pax)
|
||||
?~ shp ~
|
||||
?: =(u.shp our.bol)
|
||||
[%pass pax %agent [our.bol %contact-store] %leave ~]~
|
||||
[%pass pax %agent [u.shp %contact-hook] %leave ~]~
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
|
45
pkg/arvo/app/contact-pull-hook.hoon
Normal file
45
pkg/arvo/app/contact-pull-hook.hoon
Normal file
@ -0,0 +1,45 @@
|
||||
/- *resource
|
||||
/+ store=contact-store, contact, default-agent, verb, dbug, pull-hook
|
||||
~% %contact-pull-hook-top ..part ~
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
++ config
|
||||
^- config:pull-hook
|
||||
:* %contact-store
|
||||
update:store
|
||||
%contact-update
|
||||
%contact-push-hook
|
||||
==
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
%- (agent:pull-hook config)
|
||||
^- (pull-hook:pull-hook config)
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
dep ~(. (default:pull-hook this config) bowl)
|
||||
con ~(. contact bowl)
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(~)
|
||||
++ on-load on-load:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-pull-nack
|
||||
|= [=resource =tang]
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
?~ (get-contact:con entity.resource) ~
|
||||
=- [%pass /pl-nack %agent [our.bowl %contact-store] %poke %contact-update -]~
|
||||
!> ^- update:store
|
||||
[%remove entity.resource]
|
||||
::
|
||||
++ on-pull-kick |=(=resource `/)
|
||||
--
|
69
pkg/arvo/app/contact-push-hook.hoon
Normal file
69
pkg/arvo/app/contact-push-hook.hoon
Normal file
@ -0,0 +1,69 @@
|
||||
/+ store=contact-store, res=resource, contact, default-agent, dbug, push-hook
|
||||
~% %contact-push-hook-top ..part ~
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
++ config
|
||||
^- config:push-hook
|
||||
:* %contact-store
|
||||
/updates
|
||||
update:store
|
||||
%contact-update
|
||||
%contact-pull-hook
|
||||
==
|
||||
::
|
||||
+$ agent (push-hook:push-hook config)
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
%- (agent:push-hook config)
|
||||
^- agent
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
con ~(. contact bowl)
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(~)
|
||||
++ on-load on-load:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
::
|
||||
++ should-proxy-update
|
||||
|= =vase
|
||||
^- ?
|
||||
=/ =update:store !<(update:store vase)
|
||||
?- -.update
|
||||
%initial %.n
|
||||
%add %.y
|
||||
%remove %.y
|
||||
%edit %.y
|
||||
%allow %.n
|
||||
%disallow %.n
|
||||
%set-public %.n
|
||||
==
|
||||
::
|
||||
++ initial-watch
|
||||
|= [=path =resource:res]
|
||||
^- vase
|
||||
?> (is-allowed:con src.bowl)
|
||||
!> ^- update:store
|
||||
=/ contact=(unit contact:store) (get-contact:con our.bowl)
|
||||
:+ %add
|
||||
our.bowl
|
||||
?^ contact u.contact
|
||||
*contact:store
|
||||
::
|
||||
++ take-update
|
||||
|= =vase
|
||||
^- [(list card) agent]
|
||||
=/ =update:store !<(update:store vase)
|
||||
?. ?=(%disallow -.update) [~ this]
|
||||
:_ this
|
||||
[%give %kick ~[resource+(en-path:res [our.bowl %our])] ~]~
|
||||
--
|
@ -1,279 +1,220 @@
|
||||
:: contact-store [landscape]:
|
||||
::
|
||||
:: data store that holds group-based contact data
|
||||
:: data store that holds individual contact data
|
||||
::
|
||||
/+ *contact-json, default-agent, dbug, *migrate
|
||||
/- store=contact-store, *resource
|
||||
/+ default-agent, dbug, *migrate
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
+$ state-4
|
||||
$: %4
|
||||
=rolodex:store
|
||||
allowed-groups=(set resource)
|
||||
allowed-ships=(set ship)
|
||||
is-public=_|
|
||||
==
|
||||
+$ versioned-state
|
||||
$% state-zero
|
||||
state-one
|
||||
state-two
|
||||
state-three
|
||||
==
|
||||
::
|
||||
+$ rolodex-0 (map path contacts-0)
|
||||
+$ contacts-0 (map ship contact-0)
|
||||
+$ avatar-0 [content-type=@t octs=[p=@ud q=@t]]
|
||||
+$ contact-0
|
||||
$: nickname=@t
|
||||
email=@t
|
||||
phone=@t
|
||||
website=@t
|
||||
notes=@t
|
||||
color=@ux
|
||||
avatar=(unit avatar-0)
|
||||
==
|
||||
::
|
||||
+$ state-zero
|
||||
$: %0
|
||||
rolodex=rolodex-0
|
||||
==
|
||||
+$ state-one
|
||||
$: %1
|
||||
=rolodex
|
||||
==
|
||||
+$ state-two
|
||||
$: %2
|
||||
=rolodex
|
||||
==
|
||||
+$ state-three
|
||||
$: %3
|
||||
=rolodex
|
||||
$% [%0 *]
|
||||
[%1 *]
|
||||
[%2 *]
|
||||
[%3 *]
|
||||
state-4
|
||||
==
|
||||
--
|
||||
::
|
||||
=| state-three
|
||||
=| state-4
|
||||
=* state -
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
=<
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
contact-core +>
|
||||
cc ~(. contact-core bowl)
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
=. rolodex (~(put by rolodex) our.bowl *contact:store)
|
||||
[~ this(state state)]
|
||||
::
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
=/ old !<(versioned-state old-vase)
|
||||
?+ -.old
|
||||
=. rolodex (~(put by rolodex) our.bowl *contact:store)
|
||||
[~ this(state state)]
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
=/ old !<(versioned-state old-vase)
|
||||
=| cards=(list card)
|
||||
|-
|
||||
?: ?=(%3 -.old)
|
||||
[cards this(state old)]
|
||||
?: ?=(%2 -.old)
|
||||
%_ $
|
||||
-.old %3
|
||||
::
|
||||
rolodex.old
|
||||
=/ def
|
||||
(~(get by rolodex.old) /ship/~/default)
|
||||
?~ def
|
||||
rolodex.old
|
||||
=. rolodex.old
|
||||
(~(del by rolodex.old) /ship/~/default)
|
||||
=. rolodex.old
|
||||
(~(put by rolodex.old) /~/default u.def)
|
||||
rolodex.old
|
||||
==
|
||||
?: ?=(%1 -.old)
|
||||
=/ new-rolodex=^rolodex
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by rolodex.old)
|
||||
|= [=path =contacts]
|
||||
[ship+path contacts]
|
||||
%_ $
|
||||
old [%2 new-rolodex]
|
||||
::
|
||||
cards
|
||||
=/ paths
|
||||
%+ turn
|
||||
~(val by sup.bol)
|
||||
|=([=ship =path] path)
|
||||
?~ paths cards
|
||||
:_ cards
|
||||
[%give %kick paths ~]
|
||||
==
|
||||
|
||||
=/ new-rolodex=^rolodex
|
||||
%- ~(run by rolodex.old)
|
||||
|= cons=contacts-0
|
||||
^- contacts
|
||||
%- ~(run by cons)
|
||||
|= con=contact-0
|
||||
^- contact
|
||||
:* nickname.con
|
||||
email.con
|
||||
phone.con
|
||||
website.con
|
||||
notes.con
|
||||
color.con
|
||||
~
|
||||
==
|
||||
$(old [%1 new-rolodex])
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
=^ cards state
|
||||
?+ mark (on-poke:def mark vase)
|
||||
::%json (poke-json:cc !<(json vase))
|
||||
%contact-action
|
||||
(poke-contact-action:cc !<(contact-action vase))
|
||||
::
|
||||
%import
|
||||
(poke-import:cc q.vase)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
|^
|
||||
=/ cards=(list card)
|
||||
?+ path (on-watch:def path)
|
||||
[%all ~] (give %contact-update !>([%initial rolodex]))
|
||||
[%updates ~] ~
|
||||
[%contacts @ *]
|
||||
%+ give %contact-update
|
||||
!>([%contacts t.path (~(got by rolodex) t.path)])
|
||||
==
|
||||
[cards this]
|
||||
%4 [~ this(state old)]
|
||||
==
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
|^
|
||||
=/ cards=(list card)
|
||||
?+ path (on-watch:def path)
|
||||
[%all ~] (give [%initial rolodex is-public])
|
||||
[%updates ~] ~
|
||||
::
|
||||
++ give
|
||||
|= =cage
|
||||
^- (list card)
|
||||
[%give %fact ~ cage]~
|
||||
--
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path (on-peek:def path)
|
||||
[%x %all ~] ``noun+!>(rolodex)
|
||||
[%x %contacts *]
|
||||
?~ t.t.path
|
||||
~
|
||||
``noun+!>((~(get by rolodex) t.t.path))
|
||||
::
|
||||
[%x %contact *]
|
||||
:: /:path/:ship
|
||||
=/ pax `^path`(flop t.t.path)
|
||||
?~ pax ~
|
||||
=/ =ship (slav %p i.pax)
|
||||
?~ t.pax ~
|
||||
=> .(pax `(list @ta)`(flop t.pax))
|
||||
=/ contacts=(unit contacts) (~(get by rolodex) pax)
|
||||
?~ contacts
|
||||
~
|
||||
``noun+!>((~(get by u.contacts) ship))
|
||||
::
|
||||
[%x %export ~]
|
||||
``noun+!>(state)
|
||||
[%our ~]
|
||||
%- give
|
||||
:+ %add
|
||||
our.bowl
|
||||
=/ contact=(unit contact:store) (~(get by rolodex) our.bowl)
|
||||
?~ contact *contact:store
|
||||
u.contact
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
++ give
|
||||
|= =update:store
|
||||
^- (list card)
|
||||
[%give %fact ~ [%contact-update !>(update)]]~
|
||||
--
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
|^
|
||||
=^ cards state
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%contact-update (update !<(update:store vase))
|
||||
%import (import q.vase)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ update
|
||||
|= =update:store
|
||||
^- (quip card _state)
|
||||
|^
|
||||
?- -.update
|
||||
%initial (handle-initial +.update)
|
||||
%add (handle-add +.update)
|
||||
%remove (handle-remove +.update)
|
||||
%edit (handle-edit +.update)
|
||||
%allow (handle-allow +.update)
|
||||
%disallow (handle-disallow +.update)
|
||||
%set-public (handle-set-public +.update)
|
||||
==
|
||||
::
|
||||
++ handle-initial
|
||||
|= [rolo=rolodex:store is-public=?]
|
||||
^- (quip card _state)
|
||||
=. rolodex (~(uni by rolodex) rolo)
|
||||
:_ state(rolodex rolodex, is-public is-public)
|
||||
(send-diff [%initial rolodex is-public] %.n)
|
||||
::
|
||||
++ handle-add
|
||||
|= [=ship =contact:store]
|
||||
^- (quip card _state)
|
||||
=. last-updated.contact now.bowl
|
||||
:- (send-diff [%add ship contact] =(ship our.bowl))
|
||||
state(rolodex (~(put by rolodex) ship contact))
|
||||
::
|
||||
++ handle-remove
|
||||
|= =ship
|
||||
^- (quip card _state)
|
||||
?> (~(has by rolodex) ship)
|
||||
:- (send-diff [%remove ship] =(ship our.bowl))
|
||||
?: =(ship our.bowl)
|
||||
state(rolodex (~(put by rolodex) our.bowl *contact:store))
|
||||
state(rolodex (~(del by rolodex) ship))
|
||||
::
|
||||
++ handle-edit
|
||||
|= [=ship =edit-field:store]
|
||||
|^
|
||||
^- (quip card _state)
|
||||
=/ contact (~(got by rolodex) ship)
|
||||
=. contact (edit-contact contact edit-field)
|
||||
=. last-updated.contact now.bowl
|
||||
:- (send-diff [%edit ship edit-field] =(ship our.bowl))
|
||||
state(rolodex (~(put by rolodex) ship contact))
|
||||
::
|
||||
++ edit-contact
|
||||
|= [=contact:store edit=edit-field:store]
|
||||
^- contact:store
|
||||
?- -.edit
|
||||
%nickname contact(nickname nickname.edit)
|
||||
%bio contact(bio bio.edit)
|
||||
%status contact(status status.edit)
|
||||
%color contact(color color.edit)
|
||||
%avatar contact(avatar avatar.edit)
|
||||
%cover contact(cover cover.edit)
|
||||
::
|
||||
%add-group
|
||||
contact(groups (~(put in groups.contact) resource.edit))
|
||||
::
|
||||
%remove-group
|
||||
contact(groups (~(del in groups.contact) resource.edit))
|
||||
==
|
||||
--
|
||||
::
|
||||
++ handle-allow
|
||||
|= =beings:store
|
||||
^- (quip card _state)
|
||||
:- (send-diff [%allow beings] %.n)
|
||||
?- -.beings
|
||||
%group state(allowed-groups (~(put in allowed-groups) resource.beings))
|
||||
%ships state(allowed-ships (~(uni in allowed-ships) ships.beings))
|
||||
==
|
||||
::
|
||||
++ handle-disallow
|
||||
|= =beings:store
|
||||
^- (quip card _state)
|
||||
:- (send-diff [%disallow beings] %.y)
|
||||
?- -.beings
|
||||
%group state(allowed-groups (~(del in allowed-groups) resource.beings))
|
||||
%ships state(allowed-ships (~(dif in allowed-ships) ships.beings))
|
||||
==
|
||||
::
|
||||
++ handle-set-public
|
||||
|= public=?
|
||||
^- (quip card _state)
|
||||
:_ state(is-public public)
|
||||
(send-diff [%set-public public] %.n)
|
||||
::
|
||||
++ send-diff
|
||||
|= [=update:store our=?]
|
||||
^- (list card)
|
||||
=/ paths=(list path)
|
||||
?: our
|
||||
[/updates /our /all ~]
|
||||
[/updates /all ~]
|
||||
[%give %fact paths %contact-update !>(update)]~
|
||||
--
|
||||
::
|
||||
++ import
|
||||
|= arc=*
|
||||
^- (quip card _state)
|
||||
:: note: we are purposefully wiping all state before state-4
|
||||
[~ *state-4]
|
||||
--
|
||||
::
|
||||
|_ bol=bowl:gall
|
||||
::
|
||||
::++ poke-json
|
||||
:: |= =json
|
||||
:: ^- (quip move _this)
|
||||
:: ?> (team:title our.bol src.bol)
|
||||
:: (poke-contact-action (json-to-action json))
|
||||
::
|
||||
++ poke-contact-action
|
||||
|= action=contact-action
|
||||
^- (quip card _state)
|
||||
?> (team:title our.bol src.bol)
|
||||
?- -.action
|
||||
%create (handle-create +.action)
|
||||
%delete (handle-delete +.action)
|
||||
%add (handle-add +.action)
|
||||
%remove (handle-remove +.action)
|
||||
%edit (handle-edit +.action)
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path (on-peek:def path)
|
||||
[%x %all ~] ``noun+!>(rolodex)
|
||||
::
|
||||
[%x %contact @ ~]
|
||||
=/ =ship (slav %p i.t.t.path)
|
||||
=/ contact=(unit contact:store) (~(get by rolodex) ship)
|
||||
?~ contact [~ ~]
|
||||
:- ~ :- ~ :- %contact-update
|
||||
!> ^- update:store
|
||||
[%add ship u.contact]
|
||||
::
|
||||
[%x %allowed-ship @ ~]
|
||||
=/ =ship (slav %p i.t.t.path)
|
||||
``noun+!>((~(has in allowed-ships) ship))
|
||||
::
|
||||
[%x %allowed-groups ~]
|
||||
``noun+!>(allowed-groups)
|
||||
==
|
||||
::
|
||||
++ poke-import
|
||||
|= arc=*
|
||||
^- (quip card _state)
|
||||
=/ sty=state-three
|
||||
:- %3
|
||||
%- remake-map-of-map
|
||||
;;((tree [path (tree [ship contact])]) +.arc)
|
||||
[~ sty]
|
||||
::
|
||||
++ handle-create
|
||||
|= =path
|
||||
^- (quip card _state)
|
||||
?< (~(has by rolodex) path)
|
||||
:- (send-diff path [%create path])
|
||||
state(rolodex (~(put by rolodex) path *contacts))
|
||||
::
|
||||
++ handle-delete
|
||||
|= =path
|
||||
^- (quip card _state)
|
||||
?. (~(has by rolodex) path) [~ state]
|
||||
:- (send-diff path [%delete path])
|
||||
state(rolodex (~(del by rolodex) path))
|
||||
::
|
||||
++ handle-add
|
||||
|= [=path =ship =contact]
|
||||
^- (quip card _state)
|
||||
=/ contacts (~(got by rolodex) path)
|
||||
?< (~(has by contacts) ship)
|
||||
=. contacts (~(put by contacts) ship contact)
|
||||
:- (send-diff path [%add path ship contact])
|
||||
state(rolodex (~(put by rolodex) path contacts))
|
||||
::
|
||||
++ handle-remove
|
||||
|= [=path =ship]
|
||||
^- (quip card _state)
|
||||
=/ contacts (~(got by rolodex) path)
|
||||
?. (~(has by contacts) ship) [~ state]
|
||||
=. contacts (~(del by contacts) ship)
|
||||
:- (send-diff path [%remove path ship])
|
||||
state(rolodex (~(put by rolodex) path contacts))
|
||||
::
|
||||
++ handle-edit
|
||||
|= [=path =ship =edit-field]
|
||||
^- (quip card _state)
|
||||
=/ contacts (~(got by rolodex) path)
|
||||
=/ contact (~(got by contacts) ship)
|
||||
=. contact (edit-contact contact edit-field)
|
||||
=. contacts (~(put by contacts) ship contact)
|
||||
:- (send-diff path [%edit path ship edit-field])
|
||||
state(rolodex (~(put by rolodex) path contacts))
|
||||
::
|
||||
++ edit-contact
|
||||
|= [con=contact edit=edit-field]
|
||||
^- contact
|
||||
?- -.edit
|
||||
%nickname con(nickname nickname.edit)
|
||||
%email con(email email.edit)
|
||||
%phone con(phone phone.edit)
|
||||
%website con(website website.edit)
|
||||
%notes con(notes notes.edit)
|
||||
%color con(color color.edit)
|
||||
%avatar con(avatar avatar.edit)
|
||||
==
|
||||
::
|
||||
++ send-diff
|
||||
|= [pax=path upd=contact-update]
|
||||
^- (list card)
|
||||
:~ :*
|
||||
%give %fact
|
||||
~[/all /updates [%contacts pax]]
|
||||
%contact-update !>(upd)
|
||||
== ==
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
|
@ -1,343 +1,27 @@
|
||||
:: contact-view [landscape]:
|
||||
::
|
||||
:: sets up contact JS client and combines commands
|
||||
:: into semantic actions for the UI
|
||||
::
|
||||
/-
|
||||
inv=invite-store,
|
||||
*contact-hook,
|
||||
metadata=metadata-store,
|
||||
pull-hook,
|
||||
push-hook
|
||||
/+ *server, *contact-json, default-agent, dbug, verb,
|
||||
grpl=group, mdl=metadata, resource,
|
||||
group-store
|
||||
:: contact-view [landscape]: deprecated
|
||||
::
|
||||
/+ default-agent
|
||||
|%
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
==
|
||||
::
|
||||
+$ state-0
|
||||
$: %0
|
||||
~
|
||||
==
|
||||
::
|
||||
+$ card card:agent:gall
|
||||
--
|
||||
=| state-0
|
||||
=* state -
|
||||
::
|
||||
%- agent:dbug
|
||||
%+ verb |
|
||||
^- agent:gall
|
||||
=<
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
contact-core +>
|
||||
cc ~(. contact-core bowl)
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
:~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates]
|
||||
(contact-poke:cc [%create /~/default])
|
||||
(contact-poke:cc [%add /~/default our.bowl *contact])
|
||||
:* %pass /srv %agent [our.bol %file-server]
|
||||
%poke %file-server-action
|
||||
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
|
||||
==
|
||||
==
|
||||
::
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
=/ old ((soft state-0) q.old-vase)
|
||||
?^ old [~ this]
|
||||
:_ this(state [%0 ~])
|
||||
:~ [%pass / %arvo %e %disconnect [~ /'~groups']]
|
||||
[%pass / %arvo %e %connect [~ /'contact-view'] %contact-view]
|
||||
:* %pass /srv %agent [our.bol %file-server]
|
||||
%poke %file-server-action
|
||||
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
|
||||
==
|
||||
==
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%json [(poke-json:cc !<(json vase)) this]
|
||||
%contact-view-action
|
||||
[(poke-contact-view-action:cc !<(contact-view-action vase)) this]
|
||||
::
|
||||
%handle-http-request
|
||||
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
|
||||
:_ this
|
||||
%+ give-simple-payload:app eyre-id
|
||||
%+ require-authorization:app inbound-request
|
||||
poke-handle-http-request:cc
|
||||
==
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
?> (team:title our.bowl src.bowl)
|
||||
?: ?=([%http-response *] path) [~ this]
|
||||
?. =(/primary path) (on-watch:def path)
|
||||
[[%give %fact ~ %json !>((update-to-json [%initial all-scry:cc]))]~ this]
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
?+ -.sign (on-agent:def wire sign)
|
||||
%poke-ack
|
||||
?. ?=([%join-group %ship @ @ ~] wire)
|
||||
(on-agent:def wire sign)
|
||||
?^ p.sign
|
||||
(on-agent:def wire sign)
|
||||
:_ this
|
||||
(joined-group:cc t.wire)
|
||||
::
|
||||
%kick
|
||||
[[%pass / %agent [our.bol %contact-store] %watch /updates]~ this]
|
||||
::
|
||||
%fact
|
||||
?+ p.cage.sign (on-agent:def wire sign)
|
||||
%contact-update
|
||||
=/ update=json (update-to-json !<(contact-update q.cage.sign))
|
||||
[[%give %fact ~[/primary] %json !>(update)]~ this]
|
||||
==
|
||||
==
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card _this)
|
||||
?. ?=(%bound +<.sign-arvo)
|
||||
(on-arvo:def wire sign-arvo)
|
||||
[~ this]
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
::
|
||||
|_ bol=bowl:gall
|
||||
++ grp ~(. grpl bol)
|
||||
++ md ~(. mdl bol)
|
||||
++ poke-json
|
||||
|= jon=json
|
||||
^- (list card)
|
||||
?> (team:title our.bol src.bol)
|
||||
(poke-contact-view-action (json-to-view-action jon))
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bol)
|
||||
::
|
||||
++ poke-contact-view-action
|
||||
|= act=contact-view-action
|
||||
^- (list card)
|
||||
?> (team:title our.bol src.bol)
|
||||
?- -.act
|
||||
%create
|
||||
=/ rid=resource
|
||||
[our.bol name.act]
|
||||
=/ =path
|
||||
(en-path:resource rid)
|
||||
;: weld
|
||||
:~ (group-poke [%add-group rid policy.act %.n])
|
||||
(group-poke [%add-members rid (sy our.bol ~)])
|
||||
(group-push-poke %add rid)
|
||||
(contact-poke [%create path])
|
||||
(contact-hook-poke [%add-owned path])
|
||||
==
|
||||
(create-metadata rid title.act description.act)
|
||||
?. ?=(%invite -.policy.act)
|
||||
~
|
||||
%+ turn
|
||||
~(tap in pending.policy.act)
|
||||
|= =ship
|
||||
(send-invite our.bol %contacts rid ship '')
|
||||
==
|
||||
::
|
||||
%join
|
||||
=/ =cage
|
||||
:- %group-update
|
||||
!> ^- update:group-store
|
||||
[%add-members resource.act (sy our.bol ~)]
|
||||
=/ =wire
|
||||
[%join-group (en-path:resource resource.act)]
|
||||
[%pass wire %agent [entity.resource.act %group-push-hook] %poke cage]~
|
||||
::
|
||||
%invite
|
||||
=* rid resource.act
|
||||
=/ =group (need (scry-group:grp rid))
|
||||
:- (send-invite entity.rid %contacts rid ship.act text.act)
|
||||
?. ?=(%invite -.policy.group) ~
|
||||
~[(add-pending rid ship.act)]
|
||||
::
|
||||
%delete
|
||||
~
|
||||
::
|
||||
%remove
|
||||
=/ rid=resource
|
||||
(de-path:resource path.act)
|
||||
:~ (group-poke %remove-members rid (sy ship.act ~))
|
||||
(contact-poke [%remove path.act ship.act])
|
||||
==
|
||||
::
|
||||
%share
|
||||
:: determine whether to send to our contact-hook or foreign
|
||||
:: send contact-action to contact-hook with %add action
|
||||
[(share-poke recipient.act [%add path.act ship.act contact.act])]~
|
||||
::
|
||||
%groupify
|
||||
=/ =path
|
||||
(en-path:resource resource.act)
|
||||
%+ weld
|
||||
:~ (group-poke %expose resource.act ~)
|
||||
(contact-poke [%create path])
|
||||
(contact-hook-poke [%add-owned path])
|
||||
==
|
||||
(create-metadata resource.act title.act description.act)
|
||||
==
|
||||
++ poke-handle-http-request
|
||||
|= =inbound-request:eyre
|
||||
^- simple-payload:http
|
||||
=+ url=(parse-request-line url.request.inbound-request)
|
||||
=/ name=@t
|
||||
=+ back-path=(flop site.url)
|
||||
?~ back-path
|
||||
''
|
||||
i.back-path
|
||||
?+ site.url not-found:gen
|
||||
[%'contact-view' @ *]
|
||||
=/ =path (flop t.t.site.url)
|
||||
?~ path not-found:gen
|
||||
=/ contact (contact-scry `^path`(snoc (flop t.path) name))
|
||||
?~ contact not-found:gen
|
||||
?~ avatar.u.contact not-found:gen
|
||||
?- -.u.avatar.u.contact
|
||||
%url [[307 ['location' url.u.avatar.u.contact]~] ~]
|
||||
%octt
|
||||
=/ max-3-days ['cache-control' 'max-age=259200']
|
||||
=/ content-type ['content-type' content-type.u.avatar.u.contact]
|
||||
[[200 [content-type max-3-days ~]] `octs.u.avatar.u.contact]
|
||||
==
|
||||
==
|
||||
++ on-init on-init:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-save !>(~)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
[~ this]
|
||||
::
|
||||
++ joined-group
|
||||
|= =path
|
||||
^- (list card)
|
||||
=/ rid=resource
|
||||
(de-path:resource path)
|
||||
:~ (group-pull-poke [%add entity.rid rid])
|
||||
(contact-hook-poke [%add-synced entity.rid path])
|
||||
(pull-metadata rid)
|
||||
==
|
||||
::
|
||||
:: +utilities
|
||||
::
|
||||
++ add-pending
|
||||
|= [rid=resource =ship]
|
||||
^- card
|
||||
=/ app=term
|
||||
?: =(our.bol entity.rid)
|
||||
%group-store
|
||||
%group-push-hook
|
||||
=/ =cage
|
||||
:- %group-update
|
||||
!> ^- action:group-store
|
||||
[%change-policy rid %invite %add-invites (sy ship ~)]
|
||||
[%pass / %agent [entity.rid app] %poke cage]
|
||||
::
|
||||
++ send-invite
|
||||
|= =invite:inv
|
||||
^- card
|
||||
=/ =cage
|
||||
:- %invite-action
|
||||
!> ^- action:inv
|
||||
[%invite %contacts (shaf %invite-uid eny.bol) invite]
|
||||
[%pass / %agent [recipient.invite %invite-hook] %poke cage]
|
||||
::
|
||||
++ contact-poke
|
||||
|= act=contact-action
|
||||
^- card
|
||||
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
|
||||
::
|
||||
++ contact-hook-poke
|
||||
|= act=contact-hook-action
|
||||
^- card
|
||||
[%pass / %agent [our.bol %contact-hook] %poke %contact-hook-action !>(act)]
|
||||
::
|
||||
++ share-poke
|
||||
|= [=ship act=contact-action]
|
||||
^- card
|
||||
[%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)]
|
||||
::
|
||||
++ group-poke
|
||||
|= act=action:group-store
|
||||
^- card
|
||||
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
|
||||
::
|
||||
++ group-push-poke
|
||||
|= act=action:push-hook
|
||||
^- card
|
||||
[%pass / %agent [our.bol %group-push-hook] %poke %push-hook-action !>(act)]
|
||||
::
|
||||
++ group-proxy-poke
|
||||
|= act=action:group-store
|
||||
^- card
|
||||
[%pass / %agent [entity.resource.act %group-push-hook] %poke %group-update !>(act)]
|
||||
::
|
||||
++ group-pull-poke
|
||||
|= act=action:pull-hook
|
||||
^- card
|
||||
[%pass / %agent [our.bol %group-pull-hook] %poke %pull-hook-action !>(act)]
|
||||
::
|
||||
++ metadata-poke
|
||||
|= =action:metadata
|
||||
^- card
|
||||
[%pass / %agent [our.bol %metadata-store] %poke metadata-action+!>(action)]
|
||||
::
|
||||
++ create-metadata
|
||||
|= [rid=resource title=@t description=@t]
|
||||
^- (list card)
|
||||
=/ =metadatum:metadata
|
||||
%* . *metadatum:metadata
|
||||
title title
|
||||
description description
|
||||
date-created now.bol
|
||||
creator our.bol
|
||||
==
|
||||
:~ (metadata-poke [%add rid [%contacts rid] metadatum])
|
||||
(push-metadata rid)
|
||||
==
|
||||
::
|
||||
++ push-metadata
|
||||
|= rid=resource
|
||||
^- card
|
||||
=- [%pass / %agent [our.bol %metadata-push-hook] %poke -]
|
||||
push-hook-action+!>([%add rid])
|
||||
::
|
||||
++ pull-metadata
|
||||
|= rid=resource
|
||||
^- card
|
||||
=- [%pass / %agent [our.bol %metadata-pull-hook] %poke -]
|
||||
pull-hook-action+!>([%add [entity .]:rid])
|
||||
::
|
||||
++ all-scry
|
||||
^- rolodex
|
||||
.^(rolodex %gx /(scot %p our.bol)/contact-store/(scot %da now.bol)/all/noun)
|
||||
::
|
||||
++ contact-scry
|
||||
|= pax=path
|
||||
^- (unit contact)
|
||||
=. pax
|
||||
;: weld
|
||||
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contact
|
||||
pax
|
||||
/noun
|
||||
==
|
||||
.^((unit contact) %gx pax)
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
|
@ -5,7 +5,7 @@
|
||||
/- glob
|
||||
/+ default-agent, verb, dbug
|
||||
|%
|
||||
++ hash 0v7.ttn7o.50403.rf6oh.63hnc.hgpc9
|
||||
++ hash 0v1.39us5.oj5a9.9as9u.od9db.0dipj
|
||||
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
|
||||
+$ all-states
|
||||
$% state-0
|
||||
|
@ -726,7 +726,8 @@
|
||||
$: %0
|
||||
p=time
|
||||
$= q
|
||||
$% [%add-nodes =resource:store nodes=(tree [index:store tree-node])]
|
||||
$% [%add-graph =resource:store =tree-graph mark=(unit ^mark) ow=?]
|
||||
[%add-nodes =resource:store nodes=(tree [index:store tree-node])]
|
||||
[%remove-nodes =resource:store indices=(tree index:store)]
|
||||
[%add-signatures =uid:store signatures=tree-signatures]
|
||||
[%remove-signatures =uid:store signatures=tree-signatures]
|
||||
@ -806,6 +807,14 @@
|
||||
^- logged-update:store
|
||||
:+ %0 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
|
||||
|
@ -29,7 +29,7 @@
|
||||
:: Modify the group. Further documented in /sur/group-store.hoon
|
||||
::
|
||||
::
|
||||
/- *group, *contact-view
|
||||
/- *group
|
||||
/+ store=group-store, default-agent, verb, dbug, resource, *migrate
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
@ -229,11 +229,8 @@
|
||||
|= [recipient=@p out=(list card)]
|
||||
?: =(recipient our.bol)
|
||||
out
|
||||
:_ out
|
||||
%- poke-contact
|
||||
:* %invite rid recipient
|
||||
(crip "Rejoin disconnected group {<entity.rid>}/{<name.rid>}")
|
||||
==
|
||||
:: TODO: figure out contacts integration
|
||||
out
|
||||
:_ out
|
||||
(try-rejoin rid 0)
|
||||
::
|
||||
@ -555,11 +552,6 @@
|
||||
|= =action:store
|
||||
^- card
|
||||
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
|
||||
::
|
||||
++ poke-contact
|
||||
|= act=contact-view-action
|
||||
^- card
|
||||
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
|
||||
:: +send-diff: update subscribers of new state
|
||||
::
|
||||
:: We only allow subscriptions on /groups
|
||||
|
227
pkg/arvo/app/group-view.hoon
Normal file
227
pkg/arvo/app/group-view.hoon
Normal file
@ -0,0 +1,227 @@
|
||||
/- view-sur=group-view, group-store, *group, metadata=metadata-store
|
||||
/+ default-agent, agentio, mdl=metadata, resource, dbug, grpl=group, verb
|
||||
|%
|
||||
++ card card:agent:gall
|
||||
+$ state-zero
|
||||
$: %0
|
||||
joining=(map rid=resource [=ship =progress:view])
|
||||
==
|
||||
++ view view-sur
|
||||
--
|
||||
=| state-zero
|
||||
=* 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=state-zero vase)
|
||||
`this(state old)
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
?. ?=(?(%group-view-action %noun) mark)
|
||||
(on-poke:def mark vase)
|
||||
=+ !<(=action:view vase)
|
||||
?> ?=(%join -.action)
|
||||
=^ cards state
|
||||
jn-abet:(jn-start:join:gc +.action)
|
||||
[cards this]
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
?+ path (on-watch:def path)
|
||||
[%all ~]
|
||||
:_ this
|
||||
:_ ~
|
||||
%+ fact:io
|
||||
:- %group-view-update
|
||||
!> ^- update:view
|
||||
[%initial (~(run by joining) |=([=ship =progress:view] progress))]
|
||||
~
|
||||
==
|
||||
::
|
||||
++ on-peek on-peek:def
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
=^ cards state
|
||||
?+ wire `state
|
||||
[%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)
|
||||
::
|
||||
::
|
||||
++ 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
|
||||
(~(put by joining) rid [ship progress])
|
||||
=; =cage
|
||||
(emit (fact:io cage /all tx+(en-path:resource rid) ~))
|
||||
group-view-update+!>([%progress rid progress])
|
||||
::
|
||||
++ watch-md
|
||||
(emit (watch-our:(jn-pass-io /md) %metadata-store /updates))
|
||||
::
|
||||
++ watch-groups
|
||||
(emit (watch-our:(jn-pass-io /groups) %group-store /groups))
|
||||
::
|
||||
++ jn-pass-io
|
||||
|= pax=path
|
||||
~(. pass:io (welp join+(en-path:resource rid) pax))
|
||||
::
|
||||
++ jn-abed
|
||||
|= r=resource
|
||||
=/ [s=^ship =progress:view]
|
||||
(~(got by joining) r)
|
||||
jn-core(rid r, ship s)
|
||||
::
|
||||
++ jn-abet
|
||||
^- (quip card _state)
|
||||
[(flop cards) state]
|
||||
::
|
||||
++ jn-start
|
||||
|= [rid=resource =^ship]
|
||||
^+ jn-core
|
||||
?< (~(has by joining) rid)
|
||||
=. joining
|
||||
(~(put by joining) rid [ship %start])
|
||||
=. jn-core
|
||||
(jn-abed rid)
|
||||
=/ maybe-group
|
||||
(peek-group:met %groups rid)
|
||||
?^ maybe-group
|
||||
~|("already joined group {<rid>}" !!)
|
||||
=. jn-core
|
||||
%- emit
|
||||
%+ poke:(jn-pass-io /add)
|
||||
[ship %group-push-hook]
|
||||
group-update+!>([%add-members rid (silt our.bowl ~)])
|
||||
=. jn-core (tx-progress %start)
|
||||
=> watch-md
|
||||
watch-groups
|
||||
::
|
||||
++ jn-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^+ jn-core
|
||||
|^
|
||||
?+ -.wire ~|("bad %join wire" !!)
|
||||
%add :: join group
|
||||
?> ?=(%poke-ack -.sign)
|
||||
?^ p.sign
|
||||
(cleanup %no-perms)
|
||||
=> %- emit
|
||||
%+ poke-our:(jn-pass-io /pull-groups) %group-pull-hook
|
||||
pull-hook-action+!>([%add ship rid])
|
||||
(tx-progress %added)
|
||||
::
|
||||
%pull-groups
|
||||
?> ?=(%poke-ack -.sign)
|
||||
(ack +.sign)
|
||||
::
|
||||
%groups
|
||||
?+ -.sign !!
|
||||
%fact (groups-fact +.sign)
|
||||
%watch-ack (ack +.sign)
|
||||
%kick watch-groups
|
||||
==
|
||||
::
|
||||
%pull-md
|
||||
?> ?=(%poke-ack -.sign)
|
||||
(ack +.sign)
|
||||
::
|
||||
%md
|
||||
?+ -.sign !!
|
||||
%fact (md-fact +.sign)
|
||||
%watch-ack (ack +.sign)
|
||||
%kick watch-md
|
||||
==
|
||||
::
|
||||
%pull-graphs
|
||||
?> ?=(%poke-ack -.sign)
|
||||
%- cleanup
|
||||
?^(p.sign %strange %done)
|
||||
==
|
||||
++ groups-fact
|
||||
|= =cage
|
||||
?. ?=(%group-update p.cage) jn-core
|
||||
=+ !<(=update:group-store q.cage)
|
||||
?. ?=(%initial-group -.update) jn-core
|
||||
?. =(rid resource.update) jn-core
|
||||
%- emit
|
||||
%+ poke-our:(jn-pass-io /pull-md) %metadata-pull-hook
|
||||
pull-hook-action+!>([%add [entity .]:rid])
|
||||
::
|
||||
++ md-fact
|
||||
|= [=mark =vase]
|
||||
?. ?=(%metadata-update mark) jn-core
|
||||
=+ !<(=update:metadata vase)
|
||||
?. ?=(%initial-group -.update) jn-core
|
||||
?. =(group.update rid) jn-core
|
||||
=. jn-core (cleanup %done)
|
||||
?. hidden:(need (scry-group:grp rid)) jn-core
|
||||
%- emit-many
|
||||
%+ murn ~(tap by associations.update)
|
||||
|= [=md-resource:metadata =association:metadata]
|
||||
^- (unit card)
|
||||
?. =(app-name.md-resource %graph) ~
|
||||
=* rid resource.md-resource
|
||||
:- ~
|
||||
%+ poke-our:(jn-pass-io /pull-graph) %graph-pull-hook
|
||||
pull-hook-action+!>([%add [entity .]:rid])
|
||||
::
|
||||
++ ack
|
||||
|= err=(unit tang)
|
||||
?~ err jn-core
|
||||
%- (slog u.err)
|
||||
(cleanup %strange)
|
||||
::
|
||||
++ cleanup
|
||||
|= =progress:view
|
||||
=. jn-core
|
||||
(tx-progress progress)
|
||||
=. joining (~(del by joining) rid)
|
||||
=. jn-core
|
||||
(emit (leave-our:(jn-pass-io /groups) %group-store))
|
||||
(emit (leave-our:(jn-pass-io /md) %metadata-store))
|
||||
--
|
||||
--
|
||||
--
|
@ -2,7 +2,7 @@
|
||||
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|
||||
|%
|
||||
+$ state
|
||||
$: %11
|
||||
$: %12
|
||||
drum=state:drum
|
||||
helm=state:helm
|
||||
kiln=state:kiln
|
||||
@ -14,6 +14,7 @@
|
||||
[%8 drum=state:drum helm=state:helm kiln=state:kiln]
|
||||
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
|
||||
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
|
||||
[%11 drum=state:drum helm=state:helm kiln=state:kiln]
|
||||
==
|
||||
+$ any-state-tuple
|
||||
$: drum=any-state:drum
|
||||
|
@ -6,6 +6,7 @@
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
state-1
|
||||
state-2
|
||||
==
|
||||
::
|
||||
+$ invitatory-0 (map serial:store invite-0)
|
||||
@ -19,9 +20,10 @@
|
||||
::
|
||||
+$ state-0 [%0 invites=(map path invitatory-0)]
|
||||
+$ state-1 [%1 =invites:store]
|
||||
+$ state-2 [%2 =invites:store]
|
||||
--
|
||||
::
|
||||
=| state-1
|
||||
=| state-2
|
||||
=* state -
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
@ -43,37 +45,22 @@
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
=/ old !<(versioned-state old-vase)
|
||||
=| cards=(list card)
|
||||
|-
|
||||
?: ?=(%2 -.old)
|
||||
[cards this(state old)]
|
||||
?: ?=(%1 -.old)
|
||||
`this(state old)
|
||||
:- =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]~
|
||||
!> ^- action:store
|
||||
[%create %graph]
|
||||
%= this
|
||||
state
|
||||
:- %1
|
||||
%- ~(gas by *invites:store)
|
||||
%+ murn ~(tap by invites.old)
|
||||
|= [=path =invitatory-0]
|
||||
^- (unit [term invitatory:store])
|
||||
?. ?=([@ ~] path) ~
|
||||
:- ~
|
||||
:- i.path
|
||||
%- ~(gas by *invitatory:store)
|
||||
%+ murn ~(tap by invitatory-0)
|
||||
|= [=serial:store =invite-0]
|
||||
^- (unit [serial:store invite:store])
|
||||
=/ resource=(unit resource:res) (de-path-soft:res path.invite-0)
|
||||
?~ resource ~
|
||||
:- ~
|
||||
:- serial
|
||||
^- invite:store
|
||||
:* ship.invite-0
|
||||
app.invite-0
|
||||
u.resource
|
||||
recipient.invite-0
|
||||
text.invite-0
|
||||
==
|
||||
==
|
||||
=. cards
|
||||
:~ =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
|
||||
!> ^- action:store
|
||||
[%create %groups]
|
||||
::
|
||||
=- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
|
||||
!> ^- action:store
|
||||
[%delete %contacts]
|
||||
==
|
||||
$(-.old %2)
|
||||
$(old [%1 (~(gas by *invites:store) [%graph *invitatory:store]~)])
|
||||
::
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
@ -109,11 +96,19 @@
|
||||
++ poke-import
|
||||
|= arc=*
|
||||
^- (quip card _state)
|
||||
=/ sty=state-1
|
||||
:- %1
|
||||
=/ sty=state-2
|
||||
:- %2
|
||||
%- remake-map-of-map
|
||||
;;((tree [term (tree [serial:store invite:store])]) +.arc)
|
||||
[~ sty]
|
||||
:_ sty
|
||||
:~ =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
|
||||
!> ^- action:store
|
||||
[%create %groups]
|
||||
::
|
||||
=- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]
|
||||
!> ^- action:store
|
||||
[%delete %contacts]
|
||||
==
|
||||
::
|
||||
++ poke-invite-action
|
||||
|= =action:store
|
||||
|
@ -24,6 +24,6 @@
|
||||
<div id="portal-root"></div>
|
||||
<script src="/~landscape/js/channel.js"></script>
|
||||
<script src="/~landscape/js/session.js"></script>
|
||||
<script src="/~landscape/js/bundle/index.7d4248944fe1255cb74b.js"></script>
|
||||
<script src="/~landscape/js/bundle/index.5fdbe84c6b57646a6a6b.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
|
@ -28,8 +28,6 @@
|
||||
%contact-store
|
||||
%contact-hook
|
||||
%invite-store
|
||||
%chat-store
|
||||
%chat-hook
|
||||
%graph-store
|
||||
==
|
||||
|= app=@tas
|
||||
|
@ -55,7 +55,6 @@
|
||||
=+ !<(=update:invite-store q.cage.sign)
|
||||
:_ state
|
||||
?. ?=(%invite -.update) ~
|
||||
?. =(%contacts term.update) ~
|
||||
(get-preview resource.invite.update)^~
|
||||
::
|
||||
%kick [watch-invites^~ state]
|
||||
|
@ -49,7 +49,9 @@
|
||||
=/ members
|
||||
~(wyt in (members:grp rid))
|
||||
=/ =metadatum:store
|
||||
(need (peek-metadatum:met %contacts rid))
|
||||
%- need
|
||||
%+ mate (peek-metadatum:met %groups rid)
|
||||
(peek-metadatum:met %graph rid)
|
||||
:_ this
|
||||
=; =cage
|
||||
[%pass / %agent [src.bowl %metadata-pull-hook] %poke cage]~
|
||||
|
@ -353,7 +353,7 @@
|
||||
++ handle-add
|
||||
|= [group=resource =md-resource:store =metadatum:store]
|
||||
^- (quip card _state)
|
||||
:- %+ send-diff app-name.md-resource
|
||||
:- %- send-diff
|
||||
[%add group md-resource metadatum]
|
||||
%= state
|
||||
associations
|
||||
@ -374,7 +374,7 @@
|
||||
++ handle-remove
|
||||
|= [group=resource =md-resource:store]
|
||||
^- (quip card _state)
|
||||
:- (send-diff app-name.md-resource [%remove group md-resource])
|
||||
:- (send-diff [%remove group md-resource])
|
||||
%= state
|
||||
associations
|
||||
(~(del by associations) md-resource)
|
||||
@ -395,15 +395,15 @@
|
||||
|= [group=resource =associations:store]
|
||||
=/ assocs=(list [=md-resource:store grp=resource =metadatum:store])
|
||||
~(tap by associations)
|
||||
=| cards=(list card)
|
||||
:- (send-diff %initial-group group associations)
|
||||
|-
|
||||
?~ assocs
|
||||
[cards state]
|
||||
state
|
||||
=, assocs
|
||||
?> =(group grp.i)
|
||||
=^ new-cards state
|
||||
=^ cards state
|
||||
(handle-add group [md-resource metadatum]:i)
|
||||
$(cards (weld cards new-cards), assocs t)
|
||||
$(assocs t)
|
||||
::
|
||||
++ metadata-for-app
|
||||
|= =app-name:store
|
||||
@ -428,13 +428,12 @@
|
||||
(~(put by out) md-resource [group metadatum])
|
||||
::
|
||||
++ send-diff
|
||||
|= [=app-name:store =update:store]
|
||||
|= =update:store
|
||||
^- (list card)
|
||||
|^
|
||||
%- zing
|
||||
:~ (update-subscribers /all update)
|
||||
(update-subscribers /updates update)
|
||||
(update-subscribers [%app-name app-name ~] update)
|
||||
==
|
||||
::
|
||||
++ update-subscribers
|
||||
|
103
pkg/arvo/lib/agentio.hoon
Normal file
103
pkg/arvo/lib/agentio.hoon
Normal file
@ -0,0 +1,103 @@
|
||||
=>
|
||||
|%
|
||||
++ card card:agent:gall
|
||||
--
|
||||
::
|
||||
|_ =bowl:gall
|
||||
++ scry
|
||||
|* [desk=@tas =path]
|
||||
?> ?=(^ path)
|
||||
?> ?=(^ t.path)
|
||||
%+ weld
|
||||
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
|
||||
t.t.path
|
||||
::
|
||||
++ pass
|
||||
|_ =wire
|
||||
++ poke
|
||||
|= [=dock =cage]
|
||||
[%pass wire %agent dock %poke cage]
|
||||
::
|
||||
++ poke-our
|
||||
|= [app=term =cage]
|
||||
^- card
|
||||
(poke [our.bowl app] cage)
|
||||
::
|
||||
++ arvo
|
||||
|= =note-arvo
|
||||
^- card
|
||||
[%pass wire %arvo note-arvo]
|
||||
::
|
||||
++ watch
|
||||
|= [=dock =path]
|
||||
[%pass (watch-wire path) %agent dock %watch path]
|
||||
::
|
||||
++ watch-our
|
||||
|= [app=term =path]
|
||||
(watch [our.bowl app] path)
|
||||
::
|
||||
++ watch-wire
|
||||
|= =path
|
||||
^+ wire
|
||||
?. ?=(~ wire)
|
||||
wire
|
||||
agentio-watch+path
|
||||
::
|
||||
++ leave
|
||||
|= =dock
|
||||
[%pass wire %agent dock %leave ~]
|
||||
::
|
||||
++ leave-our
|
||||
|= app=term
|
||||
(leave our.bowl app)
|
||||
::
|
||||
++ leave-path
|
||||
|= [=dock =path]
|
||||
=. wire
|
||||
(watch-wire path)
|
||||
(leave dock)
|
||||
::
|
||||
++ wait
|
||||
|= p=@da
|
||||
(arvo %b %wait p)
|
||||
::
|
||||
++ rest
|
||||
|= p=@da
|
||||
(arvo %b %wait p)
|
||||
::
|
||||
++ warp
|
||||
|= [wer=ship =riff:clay]
|
||||
(arvo %c %warp wer riff)
|
||||
::
|
||||
++ warp-our
|
||||
|= =riff:clay
|
||||
(warp our.bowl riff)
|
||||
::
|
||||
:: right here, right now
|
||||
++ warp-slim
|
||||
|= [genre=?(%sing %next) =care:clay =path]
|
||||
=/ =mood:clay
|
||||
[care r.byk.bowl path]
|
||||
=/ =rave:clay
|
||||
?:(?=(%sing genre) [genre mood] [genre mood])
|
||||
(warp-our q.byk.bowl `rave)
|
||||
--
|
||||
::
|
||||
++ fact-curry
|
||||
|* [=mark =mold]
|
||||
|= [paths=(list path) fac=mold]
|
||||
(fact mark^!>(fac) paths)
|
||||
::
|
||||
++ fact
|
||||
|= [=cage paths=(list path)]
|
||||
^- card
|
||||
[%give %fact paths cage]
|
||||
::
|
||||
++ kick
|
||||
|= paths=(list path)
|
||||
[%give %kick paths ~]
|
||||
::
|
||||
++ kick-only
|
||||
|= [=ship paths=(list path)]
|
||||
[%give %kick paths `ship]
|
||||
--
|
@ -1,265 +0,0 @@
|
||||
/- *contact-view, *contact-hook
|
||||
/+ group-store, resource
|
||||
|%
|
||||
++ nu :: parse number as hex
|
||||
|= jon=json
|
||||
?> ?=([%s *] jon)
|
||||
(rash p.jon hex)
|
||||
::
|
||||
++ hook-update-to-json
|
||||
|= upd=contact-hook-update
|
||||
=, enjs:format
|
||||
^- json
|
||||
%+ frond %contact-hook-update
|
||||
%- pairs
|
||||
%+ turn ~(tap by synced.upd)
|
||||
|= [pax=^path shp=^ship]
|
||||
^- [cord json]
|
||||
[(spat pax) s+(scot %p shp)]
|
||||
::
|
||||
++ rolodex-to-json
|
||||
|= rolo=rolodex
|
||||
=, enjs:format
|
||||
^- json
|
||||
%- pairs
|
||||
%+ turn ~(tap by rolo)
|
||||
|= [pax=^path =contacts]
|
||||
^- [cord json]
|
||||
:- (spat pax)
|
||||
(contacts-to-json pax contacts)
|
||||
::
|
||||
++ contacts-to-json
|
||||
|= [=path con=contacts]
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
%+ turn ~(tap by con)
|
||||
|= [=ship =contact]
|
||||
^- [cord json]
|
||||
[(crip (slag 1 (scow %p ship))) (contact-to-json path ship contact)]
|
||||
::
|
||||
++ contact-to-json
|
||||
|= [=path =ship con=contact]
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ [%nickname s+nickname.con]
|
||||
[%email s+email.con]
|
||||
[%phone s+phone.con]
|
||||
[%website s+website.con]
|
||||
[%notes s+notes.con]
|
||||
[%color s+(scot %ux color.con)]
|
||||
[%avatar (avatar-to-json path ship avatar.con)]
|
||||
==
|
||||
::
|
||||
++ edit-to-json
|
||||
|= [=path =ship edit=edit-field]
|
||||
^- json
|
||||
%+ frond:enjs:format -.edit
|
||||
?- -.edit
|
||||
%nickname s+nickname.edit
|
||||
%email s+email.edit
|
||||
%phone s+phone.edit
|
||||
%website s+website.edit
|
||||
%notes s+notes.edit
|
||||
%color s+(scot %ux color.edit)
|
||||
%avatar (avatar-to-json path ship avatar.edit)
|
||||
==
|
||||
::
|
||||
++ avatar-to-json
|
||||
|= [=path =ship avat=(unit avatar)]
|
||||
^- json
|
||||
?~ avat ~
|
||||
?- -.u.avat
|
||||
%octt
|
||||
:- %s
|
||||
%- crip
|
||||
%- zing
|
||||
:~ "/contact-view"
|
||||
(trip (spat path))
|
||||
"/"
|
||||
(trip (scot %p ship))
|
||||
==
|
||||
::
|
||||
%url s+url.u.avat
|
||||
==
|
||||
::
|
||||
++ update-to-json
|
||||
|= upd=contact-update
|
||||
=, enjs:format
|
||||
^- json
|
||||
%+ frond %contact-update
|
||||
%- pairs
|
||||
:~
|
||||
?: ?=(%initial -.upd)
|
||||
[%initial (rolodex-to-json rolodex.upd)]
|
||||
?: ?=(%create -.upd)
|
||||
[%create (pairs [%path (path path.upd)]~)]
|
||||
?: ?=(%delete -.upd)
|
||||
[%delete (pairs [%path (path path.upd)]~)]
|
||||
?: ?=(%add -.upd)
|
||||
:- %add
|
||||
%- pairs
|
||||
:~ [%path (path path.upd)]
|
||||
[%ship (ship ship.upd)]
|
||||
[%contact (contact-to-json path.upd ship.upd contact.upd)]
|
||||
==
|
||||
?: ?=(%remove -.upd)
|
||||
:- %remove
|
||||
%- pairs
|
||||
:~ [%path (path path.upd)]
|
||||
[%ship (ship ship.upd)]
|
||||
==
|
||||
?: ?=(%edit -.upd)
|
||||
:- %edit
|
||||
%- pairs
|
||||
:~ [%path (path path.upd)]
|
||||
[%ship (ship ship.upd)]
|
||||
[%edit-field (edit-to-json path.upd ship.upd edit-field.upd)]
|
||||
==
|
||||
[*@t *^json]
|
||||
==
|
||||
::
|
||||
++ json-to-view-action
|
||||
|= jon=json
|
||||
^- contact-view-action
|
||||
=, dejs:format
|
||||
=< (parse-json jon)
|
||||
|%
|
||||
++ parse-json
|
||||
%- of
|
||||
:~ [%create create]
|
||||
[%delete delete]
|
||||
[%join dejs:resource]
|
||||
[%invite invite]
|
||||
[%remove remove]
|
||||
[%share share]
|
||||
==
|
||||
::
|
||||
++ create
|
||||
%- ot
|
||||
:~ [%name so]
|
||||
[%policy policy:dejs:group-store]
|
||||
[%title so]
|
||||
[%description so]
|
||||
==
|
||||
::
|
||||
++ invite
|
||||
%- ot
|
||||
:~ [%resource dejs:resource]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
[%text so]
|
||||
==
|
||||
::
|
||||
++ delete (ot [%path pa]~)
|
||||
::
|
||||
++ remove
|
||||
%- ot
|
||||
:~ [%path pa]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
==
|
||||
::
|
||||
++ share
|
||||
%- ot
|
||||
:~ [%recipient (su ;~(pfix sig fed:ag))]
|
||||
[%path pa]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
[%contact cont]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ json-to-action
|
||||
|= jon=json
|
||||
^- contact-action
|
||||
=, dejs:format
|
||||
=< (parse-json jon)
|
||||
|%
|
||||
++ parse-json
|
||||
%- of
|
||||
:~ [%create create]
|
||||
[%delete delete]
|
||||
[%add add]
|
||||
[%remove remove]
|
||||
[%edit edit]
|
||||
==
|
||||
::
|
||||
++ create
|
||||
(ot [%path pa]~)
|
||||
::
|
||||
++ delete
|
||||
(ot [%path pa]~)
|
||||
::
|
||||
++ add
|
||||
%- ot
|
||||
:~ [%path pa]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
[%contact cont]
|
||||
==
|
||||
::
|
||||
++ remove
|
||||
%- ot
|
||||
:~ [%path pa]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
==
|
||||
::
|
||||
++ edit
|
||||
%- ot
|
||||
:~ [%path pa]
|
||||
[%ship (su ;~(pfix sig fed:ag))]
|
||||
[%edit-field edit-fi]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ octet
|
||||
%- ot:dejs:format
|
||||
:~ [%p ni:dejs:format]
|
||||
[%q so:dejs:format]
|
||||
==
|
||||
::
|
||||
++ avat
|
||||
|= jon=json
|
||||
^- avatar
|
||||
|^
|
||||
=/ =avatar (parse-json jon)
|
||||
?- -.avatar
|
||||
%url avatar
|
||||
%octt
|
||||
=. octs.avatar (need (de:base64:mimes:html q.octs.avatar))
|
||||
avatar
|
||||
==
|
||||
::
|
||||
++ parse-json
|
||||
%- of:dejs:format
|
||||
:~ [%octt octt]
|
||||
[%url url]
|
||||
==
|
||||
::
|
||||
++ octt
|
||||
%- ot:dejs:format
|
||||
:~ [%content-type so:dejs:format]
|
||||
[%octs octet]
|
||||
==
|
||||
::
|
||||
++ url so:dejs:format
|
||||
--
|
||||
::
|
||||
++ cont
|
||||
%- ot:dejs:format
|
||||
:~ [%nickname so:dejs:format]
|
||||
[%email so:dejs:format]
|
||||
[%phone so:dejs:format]
|
||||
[%website so:dejs:format]
|
||||
[%notes so:dejs:format]
|
||||
[%color nu]
|
||||
[%avatar (mu:dejs:format avat)]
|
||||
==
|
||||
::
|
||||
++ edit-fi
|
||||
%- of:dejs:format
|
||||
:~ [%nickname so:dejs:format]
|
||||
[%email so:dejs:format]
|
||||
[%phone so:dejs:format]
|
||||
[%website so:dejs:format]
|
||||
[%notes so:dejs:format]
|
||||
[%color nu]
|
||||
[%avatar (mu:dejs:format avat)]
|
||||
==
|
||||
--
|
176
pkg/arvo/lib/contact-store.hoon
Normal file
176
pkg/arvo/lib/contact-store.hoon
Normal file
@ -0,0 +1,176 @@
|
||||
/- sur=contact-store
|
||||
/+ res=resource
|
||||
=< [sur .]
|
||||
=, sur
|
||||
|%
|
||||
++ nu :: parse number as hex
|
||||
|= jon=json
|
||||
?> ?=([%s *] jon)
|
||||
(rash p.jon hex)
|
||||
::
|
||||
++ enjs
|
||||
=, enjs:format
|
||||
|%
|
||||
++ update
|
||||
|= upd=^update
|
||||
^- json
|
||||
%+ frond %contact-update
|
||||
%- pairs
|
||||
:_ ~
|
||||
^- [cord json]
|
||||
?- -.upd
|
||||
%initial
|
||||
:- %initial
|
||||
%- pairs
|
||||
:~ [%rolodex (rolo rolodex.upd)]
|
||||
[%is-public b+is-public.upd]
|
||||
==
|
||||
::
|
||||
%add
|
||||
:- %add
|
||||
%- pairs
|
||||
:~ [%ship (ship ship.upd)]
|
||||
[%contact (cont contact.upd)]
|
||||
==
|
||||
::
|
||||
%remove
|
||||
:- %remove
|
||||
(pairs [%ship (ship ship.upd)]~)
|
||||
::
|
||||
%edit
|
||||
:- %edit
|
||||
%- pairs
|
||||
:~ [%ship (ship ship.upd)]
|
||||
[%edit-field (edit edit-field.upd)]
|
||||
==
|
||||
::
|
||||
%allow
|
||||
:- %allow
|
||||
(pairs [%beings (beng beings.upd)]~)
|
||||
::
|
||||
%disallow
|
||||
:- %disallow
|
||||
(pairs [%beings (beng beings.upd)]~)
|
||||
::
|
||||
%set-public
|
||||
[%set-public b+public.upd]
|
||||
==
|
||||
::
|
||||
++ rolo
|
||||
|= =rolodex
|
||||
^- json
|
||||
%- pairs
|
||||
%+ turn ~(tap by rolodex)
|
||||
|= [=^ship =contact]
|
||||
^- [cord json]
|
||||
[(scot %p ship) (cont contact)]
|
||||
::
|
||||
++ cont
|
||||
|= =contact
|
||||
^- json
|
||||
%- pairs
|
||||
:~ [%nickname s+nickname.contact]
|
||||
[%bio s+bio.contact]
|
||||
[%status s+status.contact]
|
||||
[%color s+(scot %ux color.contact)]
|
||||
[%avatar ?~(avatar.contact ~ s+u.avatar.contact)]
|
||||
[%cover ?~(cover.contact ~ s+u.cover.contact)]
|
||||
[%groups a+(turn ~(tap in groups.contact) |=(r=resource (enjs:res r)))]
|
||||
[%last-updated (time last-updated.contact)]
|
||||
==
|
||||
::
|
||||
++ edit
|
||||
|= field=edit-field
|
||||
^- json
|
||||
%+ frond -.field
|
||||
?- -.field
|
||||
%nickname s+nickname.field
|
||||
%bio s+bio.field
|
||||
%status s+status.field
|
||||
%color s+(scot %ux color.field)
|
||||
%avatar ?~(avatar.field ~ s+u.avatar.field)
|
||||
%cover ?~(cover.field ~ s+u.cover.field)
|
||||
%add-group (enjs:res resource.field)
|
||||
%remove-group (enjs:res resource.field)
|
||||
==
|
||||
::
|
||||
++ beng
|
||||
|= =beings
|
||||
^- json
|
||||
?- -.beings
|
||||
%ships [%a (turn ~(tap in ships.beings) |=(s=^ship s+(scot %p s)))]
|
||||
%group (enjs:res resource.beings)
|
||||
==
|
||||
--
|
||||
::
|
||||
++ dejs
|
||||
=, dejs:format
|
||||
|%
|
||||
++ update
|
||||
|= jon=json
|
||||
^- ^update
|
||||
=< (decode jon)
|
||||
|%
|
||||
++ decode
|
||||
%- of
|
||||
:~ [%initial initial]
|
||||
[%add add-contact]
|
||||
[%remove remove-contact]
|
||||
[%edit edit-contact]
|
||||
[%allow beings]
|
||||
[%disallow beings]
|
||||
[%set-public bo]
|
||||
==
|
||||
::
|
||||
++ initial
|
||||
%- ot
|
||||
:~ [%rolodex (op ;~(pfix sig fed:ag) cont)]
|
||||
[%is-public bo]
|
||||
==
|
||||
::
|
||||
++ add-contact
|
||||
%- ot
|
||||
:~ [%ship (su ;~(pfix sig fed:ag))]
|
||||
[%contact cont]
|
||||
==
|
||||
::
|
||||
++ remove-contact (ot [%ship (su ;~(pfix sig fed:ag))]~)
|
||||
::
|
||||
++ edit-contact
|
||||
%- ot
|
||||
:~ [%ship (su ;~(pfix sig fed:ag))]
|
||||
[%edit-field edit]
|
||||
==
|
||||
::
|
||||
++ beings
|
||||
%- of
|
||||
:~ [%ships (as (su ;~(pfix sig fed:ag)))]
|
||||
[%group dejs:res]
|
||||
==
|
||||
::
|
||||
++ cont
|
||||
%- ot
|
||||
:~ [%nickname so]
|
||||
[%bio so]
|
||||
[%status so]
|
||||
[%color nu]
|
||||
[%avatar (mu so)]
|
||||
[%cover (mu so)]
|
||||
[%groups (as dejs:res)]
|
||||
[%last-updated di]
|
||||
==
|
||||
::
|
||||
++ edit
|
||||
%- of
|
||||
:~ [%nickname so]
|
||||
[%bio so]
|
||||
[%status so]
|
||||
[%color nu]
|
||||
[%avatar (mu so)]
|
||||
[%cover (mu so)]
|
||||
[%add-group dejs:res]
|
||||
[%remove-group dejs:res]
|
||||
==
|
||||
--
|
||||
--
|
||||
--
|
34
pkg/arvo/lib/contact.hoon
Normal file
34
pkg/arvo/lib/contact.hoon
Normal file
@ -0,0 +1,34 @@
|
||||
/- store=contact-store, *resource
|
||||
/+ group
|
||||
|_ =bowl:gall
|
||||
++ scry-for
|
||||
|* [=mold =path]
|
||||
.^ mold
|
||||
%gx
|
||||
(scot %p our.bowl)
|
||||
%contact-store
|
||||
(scot %da now.bowl)
|
||||
(snoc `^path`path %noun)
|
||||
==
|
||||
::
|
||||
++ get-contact
|
||||
|= =ship
|
||||
^- (unit contact:store)
|
||||
=/ upd (scry-for (unit update:store) /contact/(scot %p ship))
|
||||
?~ upd ~
|
||||
?> ?=(%add -.u.upd)
|
||||
`contact.u.upd
|
||||
::
|
||||
++ is-allowed
|
||||
|= =ship
|
||||
^- ?
|
||||
=/ shp (scry-for ? /allowed-ship/(scot %p ship))
|
||||
?: shp %.y
|
||||
=/ allowed-groups ~(tap in (scry-for (set resource) /allowed-groups))
|
||||
=/ grp ~(. group bowl)
|
||||
|-
|
||||
?~ allowed-groups %.n
|
||||
?: (~(has in (members:grp i.allowed-groups)) ship)
|
||||
%.y
|
||||
$(allowed-groups t.allowed-groups)
|
||||
--
|
84
pkg/arvo/lib/group-view.hoon
Normal file
84
pkg/arvo/lib/group-view.hoon
Normal file
@ -0,0 +1,84 @@
|
||||
/- sur=group-view, spider
|
||||
/+ resource, strandio, metadata=metadata-store, store=group-store
|
||||
^?
|
||||
=< [. sur]
|
||||
=, sur
|
||||
|%
|
||||
++ dejs
|
||||
=, dejs:format
|
||||
|%
|
||||
++ action
|
||||
^- $-(json ^action)
|
||||
%- of
|
||||
:~ create+create
|
||||
remove+remove
|
||||
join+join
|
||||
leave+leave
|
||||
==
|
||||
::
|
||||
++ create
|
||||
%- ot
|
||||
:~ name+so
|
||||
policy+policy:dejs:store
|
||||
title+so
|
||||
description+so
|
||||
==
|
||||
::
|
||||
++ remove dejs:resource
|
||||
::
|
||||
++ leave dejs:resource
|
||||
::
|
||||
++ join
|
||||
%- ot
|
||||
:~ resource+dejs:resource
|
||||
ship+(su ;~(pfix sig fed:ag))
|
||||
==
|
||||
--
|
||||
::
|
||||
++ enjs
|
||||
=, enjs:format
|
||||
|%
|
||||
++ update
|
||||
|= upd=^update
|
||||
%+ frond %group-view-update
|
||||
%+ frond -.upd
|
||||
?- -.upd
|
||||
%initial (initial +.upd)
|
||||
%progress (progress +.upd)
|
||||
==
|
||||
::
|
||||
++ progress
|
||||
|= [rid=resource prog=^progress]
|
||||
%- pairs
|
||||
:~ resource+s+(enjs-path:resource rid)
|
||||
progress+s+prog
|
||||
==
|
||||
::
|
||||
++ initial
|
||||
|= init=(map resource ^progress)
|
||||
%- pairs
|
||||
%+ turn ~(tap by init)
|
||||
|= [rid=resource prog=^progress]
|
||||
:_ s+prog
|
||||
(enjs-path:resource rid)
|
||||
--
|
||||
++ cleanup-md
|
||||
|= rid=resource
|
||||
=/ m (strand:spider ,~)
|
||||
^- form:m
|
||||
;< =associations:metadata bind:m
|
||||
%+ scry:strandio associations:metadata
|
||||
%+ weld /gx/metadata-store/group
|
||||
(snoc (en-path:resource rid) %noun)
|
||||
~& associations
|
||||
=/ assocs=(list [=md-resource:metadata association:metadata])
|
||||
~(tap by associations)
|
||||
|-
|
||||
=* loop $
|
||||
?~ assocs
|
||||
(pure:m ~)
|
||||
;< ~ bind:m
|
||||
%+ poke-our:strandio %metadata-store
|
||||
metadata-action+!>([%remove rid md-resource.i.assocs])
|
||||
loop(assocs t.assocs)
|
||||
--
|
@ -91,6 +91,8 @@
|
||||
%herm
|
||||
%contact-store
|
||||
%contact-hook
|
||||
%contact-push-hook
|
||||
%contact-pull-hook
|
||||
%contact-view
|
||||
%metadata-store
|
||||
%s3-store
|
||||
@ -106,6 +108,7 @@
|
||||
%observe-hook
|
||||
%metadata-push-hook
|
||||
%metadata-pull-hook
|
||||
%group-view
|
||||
==
|
||||
::
|
||||
++ deft-fish :: default connects
|
||||
@ -251,6 +254,10 @@
|
||||
=> (se-born | %home %metadata-pull-hook)
|
||||
=> (se-born | %home %metadata-push-hook)
|
||||
(se-born | %home %herm)
|
||||
=? ..on-load (lte hood-version %12)
|
||||
=> (se-born | %home %contact-push-hook)
|
||||
=> (se-born | %home %contact-pull-hook)
|
||||
(se-born | %home %group-view)
|
||||
..on-load
|
||||
::
|
||||
++ reap-phat :: ack connect
|
||||
|
@ -7,6 +7,14 @@
|
||||
++ enjs
|
||||
=, enjs:format
|
||||
|%
|
||||
::
|
||||
++ initial-group
|
||||
|= [group=resource assocs=^associations]
|
||||
%- pairs
|
||||
:~ group+s+(enjs-path:resource group)
|
||||
associations+(associations assocs)
|
||||
==
|
||||
::
|
||||
++ associations
|
||||
|= =^associations
|
||||
=, enjs:format
|
||||
@ -49,7 +57,7 @@
|
||||
^- json
|
||||
%+ frond %metadata-update
|
||||
%- pairs
|
||||
:~ ?+ -.upd *[cord json]
|
||||
:~ ?- -.upd
|
||||
%add
|
||||
:- %add
|
||||
%- pairs
|
||||
@ -77,6 +85,9 @@
|
||||
::
|
||||
%associations
|
||||
[%associations (associations associations.upd)]
|
||||
::
|
||||
%initial-group
|
||||
[%initial-group (initial-group +.upd)]
|
||||
::
|
||||
== ==
|
||||
::
|
||||
@ -110,7 +121,7 @@
|
||||
::
|
||||
++ initial-group
|
||||
|= json
|
||||
[%initial-group *resource *associations]
|
||||
[*resource *associations]
|
||||
::
|
||||
++ add
|
||||
%- ot
|
||||
|
@ -386,18 +386,17 @@
|
||||
[%give %fact paths update-mark.config vase]~
|
||||
::
|
||||
++ forward-update
|
||||
|= =vase
|
||||
|= update=vase
|
||||
^- (list card:agent:gall)
|
||||
=/ rid=(unit resource)
|
||||
(resource-for-update vase)
|
||||
?~ rid ~
|
||||
=/ rid=resource
|
||||
(need (resource-for-update update))
|
||||
=/ =path
|
||||
resource+(en-path:resource u.rid)
|
||||
resource+(en-path:resource rid)
|
||||
=/ =wire
|
||||
(make-wire resource+(en-path:resource u.rid))
|
||||
(make-wire resource+(en-path:resource rid))
|
||||
=/ dap=term
|
||||
?:(=(our.bowl entity.u.rid) store-name.config dap.bowl)
|
||||
[%pass wire %agent [entity.u.rid dap] %poke update-mark.config vase]~
|
||||
?:(=(our.bowl entity.rid) store-name.config dap.bowl)
|
||||
[%pass wire %agent [entity.rid dap] %poke update-mark.config update]~
|
||||
::
|
||||
++ get-conversion
|
||||
.^ tube:clay
|
||||
@ -407,11 +406,13 @@
|
||||
::
|
||||
++ resource-for-update
|
||||
|= update=vase
|
||||
=/ =tube:clay
|
||||
get-conversion
|
||||
%+ bind
|
||||
(mole |.((tube update)))
|
||||
|=(=vase !<(resource vase))
|
||||
^- (unit resource)
|
||||
=/ converted=(each vase (list tank))
|
||||
(mule |.((get-conversion update)))
|
||||
?: ?=(%| -.converted)
|
||||
%- (slog p.converted)
|
||||
~
|
||||
[~ !<(resource p.converted)]
|
||||
::
|
||||
++ build-mark
|
||||
|= rav=?(%sing %next)
|
||||
|
@ -1,10 +0,0 @@
|
||||
/- *contact-hook
|
||||
|_ act=contact-hook-action
|
||||
++ grab |%
|
||||
++ noun contact-hook-action
|
||||
--
|
||||
++ grow |%
|
||||
++ noun act
|
||||
--
|
||||
++ grad %noun
|
||||
--
|
@ -1,15 +0,0 @@
|
||||
/+ *contact-json
|
||||
|_ act=contact-action
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun act
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact-action
|
||||
++ json
|
||||
|= jon=^json
|
||||
(json-to-action jon)
|
||||
--
|
||||
--
|
@ -1,15 +0,0 @@
|
||||
/+ *contact-json
|
||||
|_ upd=contact-hook-update
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun upd
|
||||
++ json (hook-update-to-json upd)
|
||||
--
|
||||
::
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact-hook-update
|
||||
--
|
||||
::
|
||||
--
|
@ -1,16 +0,0 @@
|
||||
/+ *contact-json
|
||||
|_ rolo=rolodex
|
||||
::
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun +<.grow
|
||||
++ json (rolodex-to-json rolo)
|
||||
--
|
||||
::
|
||||
++ grab
|
||||
|%
|
||||
++ noun rolodex
|
||||
--
|
||||
::
|
||||
--
|
@ -1,15 +1,32 @@
|
||||
/+ *contact-json
|
||||
|_ upd=contact-update
|
||||
/+ *contact-store
|
||||
::
|
||||
|_ upd=update
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun upd
|
||||
++ json (update-to-json upd)
|
||||
++ json (update:enjs upd)
|
||||
++ resource
|
||||
|^
|
||||
?- -.upd
|
||||
%initial [nobody %contacts]
|
||||
%add [nobody %contacts]
|
||||
%remove [nobody %contacts]
|
||||
%edit [nobody %contacts]
|
||||
%allow !!
|
||||
%disallow !!
|
||||
%set-public !!
|
||||
==
|
||||
::
|
||||
++ nobody
|
||||
^- @p
|
||||
(bex 128)
|
||||
--
|
||||
--
|
||||
::
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact-update
|
||||
++ noun update
|
||||
++ json update:dejs
|
||||
--
|
||||
::
|
||||
--
|
||||
|
@ -1,12 +0,0 @@
|
||||
/- *contact-view
|
||||
|_ act=contact-view-action
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun act
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact-view-action
|
||||
--
|
||||
--
|
13
pkg/arvo/mar/group/view-action.hoon
Normal file
13
pkg/arvo/mar/group/view-action.hoon
Normal file
@ -0,0 +1,13 @@
|
||||
/+ view=group-view
|
||||
|_ =action:view
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun action
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun action:view
|
||||
++ json action:dejs:view
|
||||
--
|
||||
--
|
13
pkg/arvo/mar/group/view-update.hoon
Normal file
13
pkg/arvo/mar/group/view-update.hoon
Normal file
@ -0,0 +1,13 @@
|
||||
/+ view=group-view
|
||||
|_ =update:view
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun update
|
||||
++ json (update:enjs:view update)
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun update:view
|
||||
--
|
||||
--
|
@ -1,18 +0,0 @@
|
||||
|%
|
||||
+$ contact-hook-action
|
||||
$% :: %add-owned: make a contacts list accessible to foreign ships
|
||||
:: who are members of that list
|
||||
::
|
||||
[%add-owned =path]
|
||||
:: %add-synced: mirror a foreign contacts list to our contact-store
|
||||
::
|
||||
[%add-synced =ship =path]
|
||||
:: %remove: stop mirroring a foreign contacts list or stop allowing
|
||||
:: a local contacts list to be mirrored
|
||||
::
|
||||
[%remove =path]
|
||||
==
|
||||
::
|
||||
+$ synced (map path ship)
|
||||
+$ contact-hook-update [%initial =synced]
|
||||
--
|
@ -1,43 +1,40 @@
|
||||
/- *identity
|
||||
/- *resource
|
||||
|%
|
||||
+$ rolodex (map path contacts)
|
||||
+$ contacts (map ship contact)
|
||||
+$ avatar
|
||||
$% [%octt content-type=@t octs=[p=@ud q=@t]]
|
||||
[%url url=@t]
|
||||
==
|
||||
::
|
||||
+$ rolodex (map ship contact)
|
||||
+$ contact
|
||||
$: nickname=@t
|
||||
email=@t
|
||||
phone=@t
|
||||
website=@t
|
||||
notes=@t
|
||||
bio=@t
|
||||
status=@t
|
||||
color=@ux
|
||||
avatar=(unit avatar)
|
||||
avatar=(unit @t)
|
||||
cover=(unit @t)
|
||||
groups=(set resource)
|
||||
last-updated=@da
|
||||
==
|
||||
::
|
||||
+$ edit-field
|
||||
$% [%nickname nickname=@t]
|
||||
[%email email=@t]
|
||||
[%phone phone=@t]
|
||||
[%website website=@t]
|
||||
[%notes notes=@t]
|
||||
[%bio bio=@t]
|
||||
[%status status=@t]
|
||||
[%color color=@ux]
|
||||
[%avatar avatar=(unit avatar)]
|
||||
[%avatar avatar=(unit @t)]
|
||||
[%add-group =resource]
|
||||
[%remove-group =resource]
|
||||
[%cover cover=(unit @t)]
|
||||
==
|
||||
::
|
||||
+$ contact-action
|
||||
$% [%create =path]
|
||||
[%delete =path]
|
||||
[%add =path =ship =contact]
|
||||
[%remove =path =ship]
|
||||
[%edit =path =ship =edit-field]
|
||||
+$ beings
|
||||
$% [%ships ships=(set ship)]
|
||||
[%group =resource]
|
||||
==
|
||||
::
|
||||
+$ contact-update
|
||||
$% [%initial =rolodex]
|
||||
[%contacts =path =contacts]
|
||||
contact-action
|
||||
+$ update
|
||||
$% [%initial =rolodex is-public=?]
|
||||
[%add =ship =contact]
|
||||
[%remove =ship]
|
||||
[%edit =ship =edit-field]
|
||||
[%allow =beings]
|
||||
[%disallow =beings]
|
||||
[%set-public public=?]
|
||||
==
|
||||
--
|
||||
|
@ -1,27 +0,0 @@
|
||||
/- *contact-store, *group, *resource
|
||||
::
|
||||
|%
|
||||
+$ contact-view-action
|
||||
$% :: %create: create in both groups and contacts
|
||||
::
|
||||
[%create name=term =policy title=@t description=@t]
|
||||
:: %join: join open group in both groups and contacts
|
||||
::
|
||||
[%join =resource]
|
||||
:: %invite: invite to invite-only group and contacts
|
||||
::
|
||||
[%invite =resource =ship text=cord]
|
||||
:: %remove: remove from both groups and contacts
|
||||
::
|
||||
[%remove =path =ship]
|
||||
:: %delete: delete in both groups and contacts
|
||||
::
|
||||
[%delete =path]
|
||||
:: %share: send %add contact-action to to recipient's contact-hook
|
||||
::
|
||||
[%share recipient=ship =path =ship =contact]
|
||||
:: %groupify: create contacts object for a preexisting group
|
||||
::
|
||||
[%groupify =resource title=@t description=@t]
|
||||
==
|
||||
--
|
25
pkg/arvo/sur/group-view.hoon
Normal file
25
pkg/arvo/sur/group-view.hoon
Normal file
@ -0,0 +1,25 @@
|
||||
/- *resource, *group
|
||||
^?
|
||||
|%
|
||||
::
|
||||
+$ action
|
||||
$% :: host side
|
||||
[%create name=term =policy title=@t description=@t]
|
||||
[%remove =resource]
|
||||
:: client side
|
||||
[%join =resource =ship]
|
||||
[%leave =resource]
|
||||
==
|
||||
|
||||
::
|
||||
+$ progress
|
||||
?(%start %added final)
|
||||
::
|
||||
+$ final
|
||||
?(%no-perms %strange %done)
|
||||
::
|
||||
+$ update
|
||||
$% [%initial initial=(map resource progress)]
|
||||
[%progress =resource =progress]
|
||||
==
|
||||
--
|
@ -1,9 +1,10 @@
|
||||
/- spider,
|
||||
graph=graph-store,
|
||||
*metadata-store,
|
||||
met=metadata-store,
|
||||
*group,
|
||||
group-store,
|
||||
inv=invite-store
|
||||
inv=invite-store,
|
||||
push-hook
|
||||
/+ strandio, resource, graph-view
|
||||
=>
|
||||
|%
|
||||
@ -16,13 +17,22 @@
|
||||
=/ m (strand ,resource)
|
||||
?: ?=(%group -.associated)
|
||||
(pure:m rid.associated)
|
||||
=/ =action:group-store
|
||||
[%add-group rid policy.associated %&]
|
||||
;< ~ bind:m (poke-our %group-store %group-action !>(action))
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
;< ~ bind:m (poke-our %group-store %group-action !>([%add-members rid (sy our.bowl ~)]))
|
||||
=/ push-hook-act=cage
|
||||
:- %push-hook-action
|
||||
!> ^- action:push-hook
|
||||
[%add rid]
|
||||
;< ~ bind:m
|
||||
(poke-our %metadata-push-hook push-hook-act)
|
||||
;< ~ bind:m
|
||||
(poke-our %group-push-hook %push-hook-action !>([%add rid]))
|
||||
%+ poke-our %group-store
|
||||
:- %group-update
|
||||
!> ^- update:group-store
|
||||
[%add-group rid policy.associated %.y]
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
;< ~ bind:m
|
||||
(poke-our %group-store group-update+!>([%add-members rid (sy our.bowl ~)]))
|
||||
;< ~ bind:m
|
||||
(poke-our %group-push-hook push-hook-act)
|
||||
(pure:m rid)
|
||||
--
|
||||
::
|
||||
@ -52,13 +62,11 @@
|
||||
::
|
||||
;< group=resource bind:m
|
||||
(handle-group rid.action associated.action)
|
||||
=/ group-path=path
|
||||
(en-path:resource group)
|
||||
::
|
||||
:: Setup metadata
|
||||
::
|
||||
=/ =metadata
|
||||
%* . *metadata
|
||||
=/ =metadatum:met
|
||||
%* . *metadatum:met
|
||||
title title.action
|
||||
description description.action
|
||||
date-created now.bowl
|
||||
@ -66,12 +74,10 @@
|
||||
module module.action
|
||||
preview %.n
|
||||
==
|
||||
=/ =metadata-action
|
||||
[%add group graph+rid.action metadata]
|
||||
=/ met-action=action:met
|
||||
[%add group graph+rid.action metadatum]
|
||||
;< ~ bind:m
|
||||
(poke-our %metadata-push-hook %metadata-update !>(metadata-action))
|
||||
;< ~ bind:m
|
||||
(poke-our %metadata-push-hook %push-hook-action !>([%add group]))
|
||||
(poke-our %metadata-push-hook metadata-update+!>(met-action))
|
||||
::
|
||||
:: Send invites
|
||||
::
|
||||
|
@ -1,4 +1,4 @@
|
||||
/- spider, graph-view, graph=graph-store, *metadata-store, *group, group-store
|
||||
/- spider, graph-view, graph=graph-store, metadata=metadata-store, *group, group-store
|
||||
/+ strandio, resource
|
||||
=>
|
||||
|%
|
||||
@ -8,17 +8,15 @@
|
||||
::
|
||||
++ scry-metadata
|
||||
|= rid=resource
|
||||
=/ m (strand ,(unit resource))
|
||||
;< paxs=(unit (set path)) bind:m
|
||||
%+ scry:strandio ,(unit (set path))
|
||||
=/ m (strand ,resource)
|
||||
;< group=(unit resource) bind:m
|
||||
%+ scry:strandio ,(unit resource)
|
||||
;: weld
|
||||
/gx/metadata-store/resource/graph
|
||||
(en-path:resource rid)
|
||||
/noun
|
||||
==
|
||||
?~ paxs (pure:m ~)
|
||||
?~ u.paxs (pure:m ~)
|
||||
(pure:m `(de-path:resource n.u.paxs))
|
||||
(pure:m (need group))
|
||||
::
|
||||
++ scry-group
|
||||
|= rid=resource
|
||||
@ -42,11 +40,10 @@
|
||||
;< ~ bind:m
|
||||
(poke-our %graph-push-hook %push-hook-action !>([%remove rid]))
|
||||
;< ~ bind:m
|
||||
%+ poke-our %metadata-hook
|
||||
:- %metadata-action
|
||||
!> :+ %remove
|
||||
(en-path:resource group-rid)
|
||||
[%graph (en-path:resource rid)]
|
||||
%+ poke-our %metadata-push-hook
|
||||
:- %metadata-update
|
||||
!> ^- action:metadata
|
||||
[%remove group-rid [%graph rid]]
|
||||
(pure:m ~)
|
||||
::
|
||||
++ delete-tags
|
||||
@ -54,8 +51,7 @@
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ tags=(list [=tag tagged=(set ship)])
|
||||
%+ skim ~(tap by tags.group)
|
||||
|= [=tag tagged=(set ship)]
|
||||
%+ skim ~(tap by tags.group) |= [=tag tagged=(set ship)]
|
||||
?@ tag %.n
|
||||
?& =(app.tag %graph)
|
||||
=(resource.tag graph)
|
||||
@ -81,23 +77,17 @@
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
?. =(our.bowl entity.rid.action)
|
||||
(strand-fail:strandio %bad-request ~)
|
||||
;< ugroup-rid=(unit resource) bind:m
|
||||
;< group-rid=resource bind:m
|
||||
(scry-metadata rid.action)
|
||||
?~ ugroup-rid !!
|
||||
;< =group bind:m
|
||||
(scry-group u.ugroup-rid)
|
||||
(scry-group group-rid)
|
||||
;< ~ bind:m
|
||||
(delete-tags rid.action u.ugroup-rid group)
|
||||
(delete-tags rid.action group-rid group)
|
||||
;< ~ bind:m
|
||||
(delete-graph group-rid rid.action)
|
||||
?. hidden.group
|
||||
;< ~ bind:m
|
||||
(delete-graph u.ugroup-rid rid.action)
|
||||
(pure:m !>(~))
|
||||
;< ~ bind:m
|
||||
(poke-our %group-store %group-action !>([%remove-group rid.action ~]))
|
||||
;< ~ bind:m
|
||||
(poke-our %group-push-hook %push-hook-action !>([%remove rid.action]))
|
||||
;< ~ bind:m (delete-graph u.ugroup-rid rid.action)
|
||||
;< ~ bind:m
|
||||
%+ poke-our %metadata-hook
|
||||
metadata-hook-action+!>([%remove (en-path:resource u.ugroup-rid)])
|
||||
;< =thread-result:strandio bind:m
|
||||
(await-thread:strandio %group-delete !>(`[%remove rid.action]))
|
||||
(pure:m !>(~))
|
||||
|
||||
|
@ -19,42 +19,6 @@
|
||||
/noun
|
||||
==
|
||||
(pure:m res)
|
||||
::
|
||||
++ wait-for-group-join
|
||||
|= rid=resource
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ pax
|
||||
(en-path:resource rid)
|
||||
=/ hold=@dr ~s0..8000
|
||||
|- ^- form:m
|
||||
?> (lte hold ~m5)
|
||||
=* loop $
|
||||
;< u-group=(unit group) bind:m
|
||||
(scry:strandio ,(unit group) (weld /gx/group-store/groups (snoc pax %noun)))
|
||||
?^ u-group
|
||||
(pure:m ~)
|
||||
;< ~ bind:m (sleep:strandio hold)
|
||||
=. hold (mul hold 2)
|
||||
loop
|
||||
::
|
||||
++ wait-for-md
|
||||
|= rid=resource
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ pax
|
||||
(en-path:resource rid)
|
||||
=/ hold=@dr ~s0..8000
|
||||
|- ^- form:m
|
||||
?> (lte hold ~m5)
|
||||
=* loop $
|
||||
;< groups=(jug path md-resource) bind:m
|
||||
(scry:strandio ,(jug path md-resource) /gy/metadata-store/group-indices)
|
||||
?: (~(has by groups) pax)
|
||||
(pure:m ~)
|
||||
;< ~ bind:m (sleep:strandio hold)
|
||||
=. hold (mul hold 2)
|
||||
loop
|
||||
--
|
||||
::
|
||||
^- thread:spider
|
||||
@ -67,30 +31,10 @@
|
||||
?: =(our.bowl entity.rid.action)
|
||||
(fail %bad-request ~)
|
||||
;< group=(unit resource) bind:m (scry-metadata rid.action)
|
||||
?^ group
|
||||
:: We have group, graph is managed
|
||||
;< ~ bind:m
|
||||
%+ poke-our %graph-pull-hook
|
||||
pull-hook-action+!>([%add ship.action rid.action])
|
||||
(pure:m !>(~))
|
||||
:: Else, add group then join
|
||||
?> ?=(^ group)
|
||||
:: We have group, graph is managed
|
||||
;< ~ bind:m
|
||||
%+ (map-err:strandio ,~) |=(* [%forbidden ~])
|
||||
%+ poke
|
||||
[ship.action %group-push-hook]
|
||||
group-update+!>([%add-members rid.action (sy our.bowl ~)])
|
||||
::
|
||||
;< ~ bind:m
|
||||
%+ poke-our %group-pull-hook
|
||||
pull-hook-action+!>([%add ship.action rid.action])
|
||||
;< ~ bind:m (wait-for-group-join rid.action)
|
||||
::
|
||||
;< ~ bind:m
|
||||
%+ poke-our %metadata-pull-hook
|
||||
pull-hook-action+!>([%add ship.action rid.action])::
|
||||
;< ~ bind:m (wait-for-md rid.action)
|
||||
::
|
||||
;< ~ bind:m
|
||||
%+ poke-our %graph-pull-hook
|
||||
pull-hook-action+!>([%add ship.action rid.action])
|
||||
%+ poke-our %graph-pull-hook
|
||||
pull-hook-action+!>([%add ship.action rid.action])
|
||||
(pure:m !>(~))
|
||||
|
||||
|
@ -10,16 +10,14 @@
|
||||
|= rid=resource
|
||||
=/ m (strand ,resource)
|
||||
^- form:m
|
||||
;< pax=(unit (set path)) bind:m
|
||||
%+ scry:strandio ,(unit (set path))
|
||||
;< group=(unit resource) bind:m
|
||||
%+ scry:strandio ,(unit resource)
|
||||
;: weld
|
||||
/gx/metadata-store/resource/graph
|
||||
(en-path:resource rid)
|
||||
/noun
|
||||
==
|
||||
?> ?=(^ pax)
|
||||
?> ?=(^ u.pax)
|
||||
(pure:m (de-path:resource n.u.pax))
|
||||
(pure:m (need group))
|
||||
::
|
||||
++ scry-group
|
||||
|= rid=resource
|
||||
@ -56,21 +54,9 @@
|
||||
(strand-fail:strandio %bad-request ~)
|
||||
;< group-rid=resource bind:m (scry-metadata rid.action)
|
||||
;< g=group bind:m (scry-group group-rid)
|
||||
?. hidden.g
|
||||
;< ~ bind:m (delete-graph now.bowl rid.action)
|
||||
(pure:m !>(~))
|
||||
;< ~ bind:m
|
||||
%+ poke-our %metadata-hook
|
||||
metadata-hook-action+!>([%remove (en-path:resource rid.action)])
|
||||
;< ~ bind:m
|
||||
%+ poke-our %metadata-store
|
||||
:- %metadata-action
|
||||
!> :+ %remove
|
||||
(en-path:resource rid.action)
|
||||
[%graph (en-path:resource rid.action)]
|
||||
;< ~ bind:m
|
||||
(poke-our %group-store %group-action !>([%remove-group rid.action ~]))
|
||||
;< ~ bind:m
|
||||
(poke-our %group-pull-hook %pull-hook-action !>([%remove rid.action]))
|
||||
;< ~ bind:m (delete-graph now.bowl rid.action)
|
||||
?. hidden.g
|
||||
(pure:m !>(~))
|
||||
;< =thread-result:strandio bind:m
|
||||
(await-thread:strandio %group-leave !>([~ [%leave rid.action]]))
|
||||
(pure:m !>(~))
|
||||
|
50
pkg/arvo/ted/group/create.hoon
Normal file
50
pkg/arvo/ted/group/create.hoon
Normal file
@ -0,0 +1,50 @@
|
||||
/- spider,
|
||||
metadata=metadata-store,
|
||||
*group,
|
||||
inv=invite-store,
|
||||
store=group-store,
|
||||
push-hook
|
||||
/+ strandio, resource, view=group-view
|
||||
=>
|
||||
|%
|
||||
++ strand strand:spider
|
||||
++ poke poke:strandio
|
||||
++ poke-our poke-our:strandio
|
||||
--
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ =action:view] arg)
|
||||
?> ?=(%create -.action)
|
||||
?> ((sane %tas) name.action)
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
:: Add graph to graph-store
|
||||
::
|
||||
=/ rid=resource
|
||||
[our.bowl name.action]
|
||||
=/ group-act=action:store
|
||||
[%add-group rid policy.action %.n]
|
||||
;< ~ bind:m (poke-our %group-store %group-action !>(group-act))
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
;< ~ bind:m (poke-our %group-store %group-action !>([%add-members rid (sy our.bowl ~)]))
|
||||
=/ push-hook-act=cage
|
||||
:- %push-hook-action
|
||||
!> ^- action:push-hook
|
||||
[%add rid]
|
||||
;< ~ bind:m
|
||||
(poke-our %group-push-hook push-hook-act)
|
||||
=/ =metadatum:metadata
|
||||
%* . *metadatum:metadata
|
||||
title title.action
|
||||
description description.action
|
||||
date-created now.bowl
|
||||
creator our.bowl
|
||||
==
|
||||
=/ met-action=action:metadata
|
||||
[%add rid groups+rid metadatum]
|
||||
;< ~ bind:m (poke-our %metadata-store %metadata-action !>(met-action))
|
||||
;< ~ bind:m (poke-our %metadata-push-hook push-hook-act)
|
||||
(pure:m !>(~))
|
||||
|
||||
|
30
pkg/arvo/ted/group/delete.hoon
Normal file
30
pkg/arvo/ted/group/delete.hoon
Normal file
@ -0,0 +1,30 @@
|
||||
/- spider,
|
||||
metadata=metadata-store,
|
||||
*group,
|
||||
inv=invite-store,
|
||||
store=group-store,
|
||||
push-hook
|
||||
/+ strandio, resource, view=group-view
|
||||
=>
|
||||
|%
|
||||
++ strand strand:spider
|
||||
++ poke poke:strandio
|
||||
++ poke-our poke-our:strandio
|
||||
--
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
=+ !<([~ =action:view] arg)
|
||||
?> ?=(%remove -.action)
|
||||
=* rid resource.action
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
?> =(our.bowl entity.rid)
|
||||
=/ push-hook-act=cage
|
||||
:- %push-hook-action
|
||||
!> ^- action:push-hook
|
||||
[%remove resource.action]
|
||||
;< ~ bind:m (cleanup-md:view rid)
|
||||
;< ~ bind:m (poke-our %group-store %group-update !>([%remove-group rid ~]))
|
||||
;< ~ bind:m (poke-our %metadata-push-hook push-hook-act)
|
||||
;< ~ bind:m (poke-our %group-push-hook push-hook-act)
|
||||
(pure:m !>(~))
|
29
pkg/arvo/ted/group/leave.hoon
Normal file
29
pkg/arvo/ted/group/leave.hoon
Normal file
@ -0,0 +1,29 @@
|
||||
/- spider,
|
||||
metadata=metadata-store,
|
||||
*group,
|
||||
inv=invite-store,
|
||||
store=group-store,
|
||||
pull-hook
|
||||
/+ strandio, resource, view=group-view
|
||||
=>
|
||||
|%
|
||||
++ strand strand:spider
|
||||
++ poke poke:strandio
|
||||
++ poke-our poke-our:strandio
|
||||
--
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
=+ !<([~ =action:view] arg)
|
||||
?> ?=(%leave -.action)
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=* rid resource.action
|
||||
=/ pull-hook-act=cage
|
||||
:- %pull-hook-action
|
||||
!> ^- action:pull-hook
|
||||
[%remove rid]
|
||||
;< ~ bind:m (poke-our %metadata-pull-hook pull-hook-act)
|
||||
;< ~ bind:m (poke-our %group-pull-hook pull-hook-act)
|
||||
;< ~ bind:m (poke-our %group-store %group-update !>([%remove-group rid ~]))
|
||||
;< ~ bind:m (cleanup-md:view rid)
|
||||
(pure:m !>(~))
|
@ -1,4 +1,4 @@
|
||||
/- spider, grp=group-store, gra=graph-store, met=metadata-store, con=contact-store
|
||||
/- spider, grp=group-store, gra=graph-store, met=metadata-store
|
||||
/+ strandio, res=resource
|
||||
::
|
||||
=* strand strand:spider
|
||||
@ -34,21 +34,6 @@
|
||||
[our.bowl %group-pull-hook]
|
||||
:- %pull-hook-action
|
||||
!>([%remove resource.update])
|
||||
:: stop serving or syncing contacts associated with group
|
||||
::
|
||||
;< ~ bind:m
|
||||
%+ raw-poke
|
||||
[our.bowl %contact-hook]
|
||||
:- %contact-hook-action
|
||||
!>([%remove (en-path:res resource.update)])
|
||||
:: remove contact data associated with group
|
||||
::
|
||||
;< ~ bind:m
|
||||
%+ raw-poke
|
||||
[our.bowl %contact-store]
|
||||
:- %contact-action
|
||||
!> ^- contact-action:con
|
||||
[%delete (en-path:res resource.update)]
|
||||
:: stop serving or syncing metadata associated with group
|
||||
::
|
||||
;< ~ bind:m
|
||||
@ -65,7 +50,7 @@
|
||||
(en-path:res resource.update)
|
||||
/noun
|
||||
==
|
||||
=/ entries=(list [m=md-resource:met g=resource:res =metadata:met])
|
||||
=/ entries=(list [m=md-resource:met g=resource:res *])
|
||||
~(tap by associations)
|
||||
|- ^- form:m
|
||||
=* loop $
|
||||
@ -77,7 +62,7 @@
|
||||
%+ raw-poke
|
||||
[our.bowl %metadata-store]
|
||||
:- %metadata-action
|
||||
!> ^- metadata-action:met
|
||||
!> ^- action:met
|
||||
[%remove g.i.entries m.i.entries]
|
||||
:: archive graph associated with group
|
||||
::
|
||||
|
@ -12,6 +12,7 @@
|
||||
-}
|
||||
module Urbit.Arvo.Common
|
||||
( KingId(..), ServId(..)
|
||||
, Vere(..), Wynn(..)
|
||||
, Json, JsonNode(..)
|
||||
, Desk(..), Mime(..)
|
||||
, Port(..), Turf(..)
|
||||
@ -21,9 +22,10 @@ module Urbit.Arvo.Common
|
||||
, AmesDest, Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
|
||||
) where
|
||||
|
||||
import Urbit.Prelude hiding (Term)
|
||||
import Urbit.Prelude
|
||||
|
||||
import Control.Monad.Fail (fail)
|
||||
import Data.Bits
|
||||
|
||||
import qualified Network.HTTP.Types.Method as H
|
||||
import qualified Urbit.Ob as Ob
|
||||
@ -45,6 +47,25 @@ newtype KingId = KingId { unKingId :: UV }
|
||||
newtype ServId = ServId { unServId :: UV }
|
||||
deriving newtype (Eq, Ord, Show, Num, Enum, Integral, Real, FromNoun, ToNoun)
|
||||
|
||||
-- Arvo Version Negotiation ----------------------------------------------------
|
||||
|
||||
-- Information about the king runtime passed to Arvo.
|
||||
data Vere = Vere { vereName :: Term,
|
||||
vereRev :: [Cord],
|
||||
vereWynn :: Wynn }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance ToNoun Vere where
|
||||
toNoun Vere{..} = toNoun ((vereName, vereRev), vereWynn)
|
||||
|
||||
instance FromNoun Vere where
|
||||
parseNoun n = named "Vere" $ do
|
||||
((vereName, vereRev), vereWynn) <- parseNoun n
|
||||
pure $ Vere {..}
|
||||
|
||||
-- A list of names and their kelvin numbers, used in version negotiations.
|
||||
newtype Wynn = Wynn { unWynn :: [(Term, Word)] }
|
||||
deriving newtype (Eq, Ord, Show, FromNoun, ToNoun)
|
||||
|
||||
-- Http Common -----------------------------------------------------------------
|
||||
|
||||
@ -112,7 +133,7 @@ deriveNoun ''HttpServerConf
|
||||
-- Desk and Mime ---------------------------------------------------------------
|
||||
|
||||
newtype Desk = Desk { unDesk :: Cord }
|
||||
deriving newtype (Eq, Ord, Show, ToNoun, FromNoun)
|
||||
deriving newtype (Eq, Ord, Show, ToNoun, FromNoun, IsString)
|
||||
|
||||
data Mime = Mime Path File
|
||||
deriving (Eq, Ord, Show)
|
||||
@ -146,7 +167,14 @@ newtype Port = Port { unPort :: Word16 }
|
||||
|
||||
-- @if
|
||||
newtype Ipv4 = Ipv4 { unIpv4 :: Word32 }
|
||||
deriving newtype (Eq, Ord, Show, Enum, Real, Integral, Num, ToNoun, FromNoun)
|
||||
deriving newtype (Eq, Ord, Enum, Real, Integral, Num, ToNoun, FromNoun)
|
||||
|
||||
instance Show Ipv4 where
|
||||
show (Ipv4 i) =
|
||||
show ((shiftL i 24) .&. 0xff) ++ "." ++
|
||||
show ((shiftL i 16) .&. 0xff) ++ "." ++
|
||||
show ((shiftL i 8) .&. 0xff) ++ "." ++
|
||||
show (i .&. 0xff)
|
||||
|
||||
-- @is
|
||||
newtype Ipv6 = Ipv6 { unIpv6 :: Word128 }
|
||||
|
@ -18,7 +18,7 @@ import Urbit.Arvo.Common (KingId(..), ServId(..))
|
||||
import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime)
|
||||
import Urbit.Arvo.Common (AmesDest, Turf)
|
||||
import Urbit.Arvo.Common (ReOrg(..), reorgThroughNoun)
|
||||
import Urbit.Arvo.Common (Desk)
|
||||
import Urbit.Arvo.Common (Desk, Wynn)
|
||||
|
||||
|
||||
-- Newt Effects ----------------------------------------------------------------
|
||||
@ -259,20 +259,32 @@ data Ef
|
||||
= EfVane VaneEf
|
||||
| EfVega Cord EvilPath -- second path component, rest of path
|
||||
| EfExit Cord EvilPath -- second path component, rest of path
|
||||
| EfWend Wynn
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
-- XX HACK
|
||||
clip :: Noun -> Noun
|
||||
clip (C (C _ x) y) = C x y
|
||||
clip _ = error "misclip"
|
||||
|
||||
tack :: Noun -> Noun
|
||||
tack (C x y) = C (C (A 0) x) y
|
||||
tack _ = error "mistack"
|
||||
|
||||
instance ToNoun Ef where
|
||||
toNoun = \case
|
||||
toNoun = clip . \case
|
||||
EfVane v -> toNoun $ reorgThroughNoun ("", v)
|
||||
EfExit s p -> toNoun $ ReOrg "" s "exit" p (A 0)
|
||||
EfVega s p -> toNoun $ ReOrg "" s "vega" p (A 0)
|
||||
EfWend w -> toNoun $ reorgThroughNoun ("", w)
|
||||
|
||||
instance FromNoun Ef where
|
||||
parseNoun = parseNoun >=> \case
|
||||
parseNoun = tack >>> parseNoun >=> \case
|
||||
ReOrg "" s "exit" p (A 0) -> pure (EfExit s p)
|
||||
ReOrg "" s "exit" p _ -> fail "%exit effect expects nil value"
|
||||
ReOrg "" s "vega" p (A 0) -> pure (EfVega s p)
|
||||
ReOrg "" s "vega" p _ -> fail "%vega effect expects nil value"
|
||||
ReOrg "" s "wend" p val -> EfWend <$> parseNoun val
|
||||
ReOrg "" s tag p val -> EfVane <$> parseNoun (toNoun (s, tag, p, val))
|
||||
ReOrg _ _ _ _ _ -> fail "Non-empty first path-element"
|
||||
|
||||
|
@ -9,10 +9,10 @@
|
||||
-}
|
||||
module Urbit.Arvo.Event where
|
||||
|
||||
import Urbit.Prelude hiding (Term)
|
||||
import Urbit.Prelude
|
||||
|
||||
import Control.Monad.Fail (fail)
|
||||
import Urbit.Arvo.Common (KingId(..), ServId(..))
|
||||
import Urbit.Arvo.Common (KingId(..), ServId(..), Vere(..))
|
||||
import Urbit.Arvo.Common (Desk, Mime)
|
||||
import Urbit.Arvo.Common (Header(..), HttpEvent)
|
||||
import Urbit.Arvo.Common (AmesDest, Ipv4, Ipv6, Port, Turf)
|
||||
@ -218,9 +218,12 @@ instance Show Entropy where
|
||||
data ArvoEv
|
||||
= ArvoEvWhom () Ship
|
||||
| ArvoEvWack () Entropy
|
||||
| ArvoEvWarn Path Noun
|
||||
| ArvoEvWyrd () Vere
|
||||
| ArvoEvCrud Path Noun
|
||||
| ArvoEvVeer Atom Noun
|
||||
| ArvoEvTrim UD
|
||||
| ArvoEvWhat [Noun]
|
||||
| ArvoEvWhey ()
|
||||
| ArvoEvVerb (Maybe Bool)
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
deriveNoun ''ArvoEv
|
||||
@ -318,50 +321,29 @@ data BlipEv
|
||||
deriveNoun ''BlipEv
|
||||
|
||||
|
||||
-- Boot Events -----------------------------------------------------------------
|
||||
|
||||
data Vane
|
||||
= VaneVane VaneEv
|
||||
| VaneZuse ZuseEv
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data VaneName
|
||||
= Ames | Behn | Clay | Dill | Eyre | Ford | Gall | Iris | Jael
|
||||
deriving (Eq, Ord, Show, Enum, Bounded)
|
||||
|
||||
data ZuseEv
|
||||
= ZEVeer () Cord Path BigCord
|
||||
| ZEVoid Void
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data VaneEv
|
||||
= VEVeer (VaneName, ()) Cord Path BigCord
|
||||
| VEVoid Void
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
deriveNoun ''Vane
|
||||
deriveNoun ''VaneName
|
||||
deriveNoun ''VaneEv
|
||||
deriveNoun ''ZuseEv
|
||||
|
||||
|
||||
-- The Main Event Type ---------------------------------------------------------
|
||||
|
||||
data Ev
|
||||
= EvBlip BlipEv
|
||||
| EvVane Vane
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance ToNoun Ev where
|
||||
toNoun = \case
|
||||
EvBlip v -> toNoun $ reorgThroughNoun (Cord "", v)
|
||||
EvVane v -> toNoun $ reorgThroughNoun (Cord "vane", v)
|
||||
toNoun = toNoun . \case
|
||||
EvBlip v@BlipEvAmes{} -> reorgThroughNoun ("ames", v)
|
||||
EvBlip v@BlipEvArvo{} -> reorgThroughNoun ("", v)
|
||||
EvBlip v@BlipEvBehn{} -> reorgThroughNoun ("behn", v)
|
||||
EvBlip v@BlipEvBoat{} -> reorgThroughNoun ("clay", v)
|
||||
EvBlip v@BlipEvHttpClient{} -> reorgThroughNoun ("iris", v)
|
||||
EvBlip v@BlipEvHttpServer{} -> reorgThroughNoun ("eyre", v)
|
||||
EvBlip v@BlipEvNewt{} -> reorgThroughNoun ("ames", v)
|
||||
EvBlip v@BlipEvSync{} -> reorgThroughNoun ("clay", v)
|
||||
EvBlip v@BlipEvTerm{} -> reorgThroughNoun ("dill", v)
|
||||
|
||||
-- XX We really should check the first path element, but since this is used only
|
||||
-- in the event browser, which otherwise is broken, I don't care right now.
|
||||
instance FromNoun Ev where
|
||||
parseNoun = parseNoun >=> \case
|
||||
ReOrg "" s t p v -> fmap EvBlip $ parseNoun $ toNoun (s,t,p,v)
|
||||
ReOrg "vane" s t p v -> fmap EvVane $ parseNoun $ toNoun (s,t,p,v)
|
||||
ReOrg _ _ _ _ _ -> fail "First path-elem must be ?($ %vane)"
|
||||
ReOrg _ s t p v -> fmap EvBlip $ parseNoun $ toNoun (s,t,p,v)
|
||||
|
||||
|
||||
-- Short Event Names -----------------------------------------------------------
|
||||
@ -373,7 +355,6 @@ instance FromNoun Ev where
|
||||
-}
|
||||
getSpinnerNameForEvent :: Ev -> Maybe Text
|
||||
getSpinnerNameForEvent = \case
|
||||
EvVane _ -> Nothing
|
||||
EvBlip b -> case b of
|
||||
BlipEvAmes _ -> Just "ames"
|
||||
BlipEvArvo _ -> Just "arvo"
|
||||
|
@ -4,6 +4,7 @@
|
||||
module Urbit.King.App
|
||||
( KingEnv
|
||||
, runKingEnvStderr
|
||||
, runKingEnvStderrRaw
|
||||
, runKingEnvLogFile
|
||||
, runKingEnvNoLog
|
||||
, kingEnvKillSignal
|
||||
@ -29,6 +30,7 @@ where
|
||||
import Urbit.King.Config
|
||||
import Urbit.Prelude
|
||||
|
||||
import RIO (logGeneric)
|
||||
import System.Directory ( createDirectoryIfMissing
|
||||
, getXdgDirectory
|
||||
, XdgDirectory(XdgCache)
|
||||
@ -90,6 +92,22 @@ runKingEnvStderr verb lvl inner = do
|
||||
<&> setLogMinLevel lvl
|
||||
withLogFunc logOptions $ \logFunc -> runKingEnv logFunc logFunc inner
|
||||
|
||||
runKingEnvStderrRaw :: Bool -> LogLevel -> RIO KingEnv a -> IO a
|
||||
runKingEnvStderrRaw verb lvl inner = do
|
||||
logOptions <-
|
||||
logOptionsHandle stderr verb
|
||||
<&> setLogUseTime True
|
||||
<&> setLogUseLoc False
|
||||
<&> setLogMinLevel lvl
|
||||
withLogFunc logOptions $ \logFunc ->
|
||||
let lf = wrapCarriage logFunc
|
||||
in runKingEnv lf lf inner
|
||||
|
||||
-- XX loses callstack
|
||||
wrapCarriage :: LogFunc -> LogFunc
|
||||
wrapCarriage lf = mkLogFunc $ \_ ls ll bldr ->
|
||||
runRIO lf $ logGeneric ls ll (bldr <> "\r")
|
||||
|
||||
runKingEnvLogFile :: Bool -> LogLevel -> Maybe FilePath -> RIO KingEnv a -> IO a
|
||||
runKingEnvLogFile verb lvl fileM inner = do
|
||||
logFile <- case fileM of
|
||||
@ -119,7 +137,8 @@ defaultLogFile :: IO FilePath
|
||||
defaultLogFile = do
|
||||
logDir <- getXdgDirectory XdgCache "urbit"
|
||||
createDirectoryIfMissing True logDir
|
||||
pure (logDir </> "king.log")
|
||||
logId :: Word32 <- randomIO
|
||||
pure (logDir </> "king-" <> show logId <> ".log")
|
||||
|
||||
runKingEnvNoLog :: RIO KingEnv a -> IO a
|
||||
runKingEnvNoLog act = runKingEnv mempty mempty act
|
||||
|
@ -382,7 +382,7 @@ replayPartEvs top last = do
|
||||
{-|
|
||||
Interesting
|
||||
-}
|
||||
testPill :: HasLogFunc e => FilePath -> Bool -> Bool -> RIO e ()
|
||||
testPill :: HasKingEnv e => FilePath -> Bool -> Bool -> RIO e ()
|
||||
testPill pax showPil showSeq = do
|
||||
logInfo "Reading pill file."
|
||||
pillBytes <- readFile pax
|
||||
@ -678,10 +678,13 @@ main = do
|
||||
runKingEnv args log =
|
||||
let
|
||||
verb = verboseLogging args
|
||||
runStderr = case args of
|
||||
CLI.CmdRun {} -> runKingEnvStderrRaw
|
||||
_ -> runKingEnvStderr
|
||||
CLI.Log {..} = log
|
||||
in case logTarget lTarget args of
|
||||
CLI.LogFile f -> runKingEnvLogFile verb lLevel f
|
||||
CLI.LogStderr -> runKingEnvStderr verb lLevel
|
||||
CLI.LogStderr -> runStderr verb lLevel
|
||||
CLI.LogOff -> runKingEnvNoLog
|
||||
|
||||
setupSignalHandlers = do
|
||||
|
@ -2,30 +2,32 @@
|
||||
Scry helpers
|
||||
-}
|
||||
|
||||
module Urbit.King.Scry (scryNow) where
|
||||
module Urbit.King.Scry
|
||||
( scryNow
|
||||
, module Urbit.Vere.Pier.Types
|
||||
)
|
||||
where
|
||||
|
||||
import Urbit.Prelude
|
||||
import Urbit.Vere.Serf.Types
|
||||
|
||||
import qualified Urbit.Noun.Time as Time
|
||||
import Urbit.Arvo.Common (Desk)
|
||||
import Urbit.Vere.Pier.Types (ScryFunc)
|
||||
|
||||
scryNow :: forall e n
|
||||
. (HasLogFunc e, FromNoun n)
|
||||
=> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
|
||||
-> Text -- ^ vane + care as two-letter string
|
||||
-> Ship -- ^ ship in scry path, usually the local ship
|
||||
-> Text -- ^ desk in scry path
|
||||
=> ScryFunc
|
||||
-> Term -- ^ vane + care as two-letter string
|
||||
-> Desk -- ^ desk in scry path
|
||||
-> [Text] -- ^ resource path to scry for
|
||||
-> RIO e (Maybe n)
|
||||
scryNow scry vare ship desk path = do
|
||||
env <- ask
|
||||
wen <- io Time.now
|
||||
let wan = tshow $ Time.MkDate wen
|
||||
let pax = Path $ fmap MkKnot $ vare : (tshow ship) : desk : wan : path
|
||||
io (scry wen Nothing pax) >>= \case
|
||||
Just (_, fromNoun @n -> Just v) -> pure $ Just v
|
||||
Just (_, n) -> do
|
||||
logError $ displayShow ("uncanny scry result", vare, pax, n)
|
||||
pure Nothing
|
||||
Nothing -> pure Nothing
|
||||
scryNow scry vare desk path =
|
||||
io (scry Nothing (EachNo $ DemiOnce vare desk (Path $ MkKnot <$> path)))
|
||||
>>= \case
|
||||
Just ("omen", fromNoun @(Path, Term, n) -> Just (_,_,v)) -> pure $ Just v
|
||||
Just (_, fromNoun @n -> Just v) -> pure $ Just v
|
||||
Just (_, n) -> do
|
||||
logError $ displayShow ("uncanny scry result", vare, path, n)
|
||||
pure Nothing
|
||||
Nothing -> pure Nothing
|
||||
|
||||
|
@ -16,6 +16,7 @@ module Urbit.Prelude
|
||||
, io, rio
|
||||
, logTrace
|
||||
, acquireWorker, acquireWorkerBound
|
||||
, hark
|
||||
) where
|
||||
|
||||
import ClassyPrelude
|
||||
@ -38,6 +39,8 @@ import RIO (HasLogFunc, LogFunc, LogLevel(..), logDebug, logError, logFuncL,
|
||||
logInfo, logOptionsHandle, logOther, logWarn, mkLogFunc,
|
||||
setLogMinLevel, setLogUseLoc, setLogUseTime, withLogFunc)
|
||||
|
||||
import qualified RIO
|
||||
|
||||
io :: MonadIO m => IO a -> m a
|
||||
io = liftIO
|
||||
|
||||
@ -47,6 +50,9 @@ rio = liftRIO
|
||||
logTrace :: HasLogFunc e => Utf8Builder -> RIO e ()
|
||||
logTrace = logOther "trace"
|
||||
|
||||
-- | Composes a log message out of textual components.
|
||||
hark :: [Text] -> Utf8Builder
|
||||
hark = RIO.displayBytesUtf8 . foldMap encodeUtf8
|
||||
|
||||
-- Utils for Spawning Worker Threads -------------------------------------------
|
||||
|
||||
|
@ -24,8 +24,7 @@ import Urbit.King.App (HasKingId(..), HasPierEnv(..))
|
||||
import Urbit.Vere.Ames.DNS (NetworkMode(..), ResolvServ(..))
|
||||
import Urbit.Vere.Ames.DNS (galaxyPort, resolvServ)
|
||||
import Urbit.Vere.Ames.UDP (UdpServ(..), fakeUdpServ, realUdpServ)
|
||||
|
||||
import qualified Urbit.Noun.Time as Time
|
||||
import Urbit.Vere.Stat (AmesStat(..), bump, bump')
|
||||
|
||||
|
||||
-- Constants -------------------------------------------------------------------
|
||||
@ -47,7 +46,6 @@ type Version = Word8
|
||||
|
||||
data AmesDrv = AmesDrv
|
||||
{ aTurfs :: TVar (Maybe [Turf])
|
||||
, aDropped :: TVar Word
|
||||
, aVersion :: TVar (Maybe Version)
|
||||
, aUdpServ :: UdpServ
|
||||
, aResolvr :: ResolvServ
|
||||
@ -125,13 +123,14 @@ udpPort isFake who = do
|
||||
udpServ :: (HasLogFunc e, HasNetworkConfig e, HasPortControlApi e)
|
||||
=> Bool
|
||||
-> Ship
|
||||
-> AmesStat
|
||||
-> RIO e UdpServ
|
||||
udpServ isFake who = do
|
||||
udpServ isFake who stat = do
|
||||
mode <- netMode isFake
|
||||
port <- udpPort isFake who
|
||||
case modeAddress mode of
|
||||
Nothing -> fakeUdpServ
|
||||
Just host -> realUdpServ port host
|
||||
Just host -> realUdpServ port host stat
|
||||
|
||||
_bornFailed :: e -> WorkError -> IO ()
|
||||
_bornFailed env _ = runRIO env $ do
|
||||
@ -141,10 +140,11 @@ ames'
|
||||
:: HasPierEnv e
|
||||
=> Ship
|
||||
-> Bool
|
||||
-> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
|
||||
-> AmesStat
|
||||
-> ScryFunc
|
||||
-> (Text -> RIO e ())
|
||||
-> RIO e ([Ev], RAcquire e (DriverApi NewtEf))
|
||||
ames' who isFake scry stderr = do
|
||||
ames' who isFake stat scry stderr = do
|
||||
-- Unfortunately, we cannot use TBQueue because the only behavior
|
||||
-- provided for when full is to block the writer. The implementation
|
||||
-- below uses materially the same data structures as TBQueue, however.
|
||||
@ -164,11 +164,11 @@ ames' who isFake scry stderr = do
|
||||
pure Ouster
|
||||
dequeuePacket = do
|
||||
pM <- tryReadTQueue ventQ
|
||||
when (isJust pM) $ modifyTVar avail (+ 1)
|
||||
when (isJust pM) $ modifyTVar' avail (+ 1)
|
||||
pure pM
|
||||
|
||||
env <- ask
|
||||
let (bornEvs, startDriver) = ames env who isFake scry enqueuePacket stderr
|
||||
let (bornEvs, startDriver) = ames env who isFake stat scry enqueuePacket stderr
|
||||
|
||||
let runDriver = do
|
||||
diOnEffect <- startDriver
|
||||
@ -195,11 +195,12 @@ ames
|
||||
=> e
|
||||
-> Ship
|
||||
-> Bool
|
||||
-> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
|
||||
-> AmesStat
|
||||
-> ScryFunc
|
||||
-> (EvErr -> STM PacketOutcome)
|
||||
-> (Text -> RIO e ())
|
||||
-> ([Ev], RAcquire e (NewtEf -> IO ()))
|
||||
ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
ames env who isFake stat scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
where
|
||||
king = fromIntegral (env ^. kingIdL)
|
||||
|
||||
@ -218,21 +219,28 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
cachedScryLane <- cache scryLane
|
||||
|
||||
aTurfs <- newTVarIO Nothing
|
||||
aDropped <- newTVarIO 0
|
||||
aVersion <- newTVarIO Nothing
|
||||
aVersTid <- trackVersionThread aVersion
|
||||
aUdpServ <- udpServ isFake who
|
||||
aUdpServ <- udpServ isFake who stat
|
||||
aResolvr <- resolvServ aTurfs (usSend aUdpServ) stderr
|
||||
aRecvTid <- queuePacketsThread
|
||||
aDropped
|
||||
aVersion
|
||||
cachedScryLane
|
||||
(send aUdpServ aResolvr mode)
|
||||
aUdpServ
|
||||
stat
|
||||
|
||||
pure (AmesDrv { .. })
|
||||
|
||||
hearFailed _ = pure ()
|
||||
hearFailed AmesStat {..} = runRIO env . \case
|
||||
RunSwap{} -> bump asSwp
|
||||
RunBail gs -> do
|
||||
for gs \(t, es) ->
|
||||
for es \e ->
|
||||
logWarn $ hark
|
||||
["ames: goof: ", unTerm t, ": ", tankToText e]
|
||||
bump asBal
|
||||
RunOkay{} -> bump asOky
|
||||
|
||||
trackVersionThread :: HasLogFunc e => TVar (Maybe Version) -> RIO e (Async ())
|
||||
trackVersionThread versSlot = async $ forever do
|
||||
@ -249,34 +257,43 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
threadDelay (10 * 60 * 1_000_000) -- 10m
|
||||
|
||||
queuePacketsThread :: HasLogFunc e
|
||||
=> TVar Word
|
||||
-> TVar (Maybe Version)
|
||||
=> TVar (Maybe Version)
|
||||
-> (Ship -> RIO e (Maybe [AmesDest]))
|
||||
-> (AmesDest -> ByteString -> RIO e ())
|
||||
-> UdpServ
|
||||
-> AmesStat
|
||||
-> RIO e (Async ())
|
||||
queuePacketsThread dropCtr vers lan forward UdpServ{..} = async $ forever $ do
|
||||
queuePacketsThread vers lan forward UdpServ{..} s@(AmesStat{..}) = async $ forever $ do
|
||||
-- port number, host address, bytestring
|
||||
(p, a, b) <- atomically usRecv
|
||||
(p, a, b) <- atomically (bump' asRcv >> usRecv)
|
||||
ver <- readTVarIO vers
|
||||
|
||||
case decode b of
|
||||
Right (pkt@Packet {..}) | ver == Nothing || ver == Just pktVersion -> do
|
||||
logDebug $ displayShow ("ames: bon packet", pkt, showUD $ bytesAtom b)
|
||||
|
||||
if pktRcvr == who
|
||||
then serfsUp p a b
|
||||
then do
|
||||
bump asSup
|
||||
serfsUp p a b
|
||||
else lan pktRcvr >>= \case
|
||||
Just ls
|
||||
| dest:_ <- filter notSelf ls
|
||||
-> forward dest $ encode pkt
|
||||
{ pktOrigin = pktOrigin <|> Just (ipDest p a) }
|
||||
-> do
|
||||
bump asFwd
|
||||
forward dest $ encode pkt
|
||||
{ pktOrigin = pktOrigin
|
||||
<|> Just (AAIpv4 (Ipv4 a) (fromIntegral p)) }
|
||||
where
|
||||
notSelf (EachYes g) = who /= Ship (fromIntegral g)
|
||||
notSelf (EachNo _) = True
|
||||
_ -> logInfo $ displayShow ("ames: dropping unroutable", pkt)
|
||||
|
||||
Right pkt -> logInfo $ displayShow ("ames: dropping ill-versed", pkt, ver)
|
||||
_ -> do
|
||||
bump asDrt
|
||||
logInfo $ displayShow ("ames: dropping unroutable", pkt)
|
||||
|
||||
Right pkt -> do
|
||||
bump asDvr
|
||||
logInfo $ displayShow ("ames: dropping ill-versed", pkt, ver)
|
||||
|
||||
-- XX better handle misversioned or illegible packets.
|
||||
-- Remarks from 67f06ce5, pkg/urbit/vere/io/ames.c, L1010:
|
||||
@ -293,18 +310,19 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
-- trigger printfs suggesting upgrade.
|
||||
-- they cannot be filtered, as we do not know their semantics
|
||||
--
|
||||
Left e -> logInfo $ displayShow ("ames: dropping malformed", e)
|
||||
Left e -> do
|
||||
bump asDml
|
||||
logInfo $ displayShow ("ames: dropping malformed", e)
|
||||
|
||||
where
|
||||
serfsUp p a b =
|
||||
atomically (enqueueEv (EvErr (hearEv p a b) hearFailed)) >>= \case
|
||||
Intake -> pure ()
|
||||
atomically (enqueueEv (EvErr (hearEv p a b) (hearFailed s))) >>= \case
|
||||
Intake -> bump asSrf
|
||||
Ouster -> do
|
||||
d <- atomically $ do
|
||||
d <- readTVar dropCtr
|
||||
writeTVar dropCtr (d + 1)
|
||||
pure d
|
||||
when (d `rem` packetsDroppedPerComplaint == 0) $
|
||||
bump' asQuf
|
||||
readTVar asQuf
|
||||
when (d `rem` packetsDroppedPerComplaint == 1) $
|
||||
logWarn "ames: queue full; dropping inbound packets"
|
||||
|
||||
stop :: forall e. AmesDrv -> RIO e ()
|
||||
@ -342,12 +360,12 @@ ames env who isFake scry enqueueEv stderr = (initialEvents, runAmes)
|
||||
EachNo addr -> to (ipv4Addr addr)
|
||||
|
||||
scryVersion :: HasLogFunc e => RIO e (Maybe Version)
|
||||
scryVersion = scryNow scry "ax" who "" ["protocol", "version"]
|
||||
scryVersion = scryNow scry "ax" "" ["protocol", "version"]
|
||||
|
||||
scryLane :: HasLogFunc e
|
||||
=> Ship
|
||||
-> RIO e (Maybe [AmesDest])
|
||||
scryLane ship = scryNow scry "ax" who "" ["peers", tshow ship, "forward-lane"]
|
||||
scryLane ship = scryNow scry "ax" "" ["peers", tshow ship, "forward-lane"]
|
||||
|
||||
ipv4Addr (Jammed (AAVoid v )) = absurd v
|
||||
ipv4Addr (Jammed (AAIpv4 a p)) = SockAddrInet (fromIntegral p) (unIpv4 a)
|
||||
|
@ -9,18 +9,19 @@ import Urbit.Prelude
|
||||
import Control.Monad.Fail
|
||||
import Data.Bits
|
||||
import Data.LargeWord
|
||||
import Data.List (genericIndex)
|
||||
import Data.Serialize
|
||||
|
||||
import Urbit.Arvo (AmesDest)
|
||||
import Urbit.Arvo (AmesAddress(..), Ipv4(..), Port(..))
|
||||
|
||||
data Packet = Packet
|
||||
{ pktVersion :: Word8
|
||||
, pktEncrypted :: Bool
|
||||
--
|
||||
, pktSndr :: Ship
|
||||
, pktRcvr :: Ship
|
||||
, pktOrigin :: Maybe AmesDest
|
||||
, pktContent :: Bytes
|
||||
{ pktVersion :: Word3
|
||||
, pktSndr :: Ship
|
||||
, pktRcvr :: Ship
|
||||
, pktSndrTick :: Word4
|
||||
, pktRcvrTick :: Word4
|
||||
, pktOrigin :: Maybe AmesAddress
|
||||
, pktContent :: ByteString
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
@ -28,73 +29,140 @@ instance Show Packet where
|
||||
show Packet {..}
|
||||
= "Packet {pktVersion = "
|
||||
<> show pktVersion
|
||||
<> ", pktEncrypted = "
|
||||
<> show pktEncrypted
|
||||
<> ", pktSndr = "
|
||||
<> show pktSndr
|
||||
<> ", pktRcvr = "
|
||||
<> show pktRcvr
|
||||
<> ", pktSndrTick = "
|
||||
<> show pktSndrTick
|
||||
<> ", pktRcvrTick = "
|
||||
<> show pktRcvrTick
|
||||
<> ", pktOrigin = "
|
||||
<> show pktOrigin
|
||||
<> ", pktContent = "
|
||||
<> showUD (bytesAtom $ unBytes pktContent)
|
||||
<> showUD (bytesAtom pktContent)
|
||||
<> "}"
|
||||
|
||||
{-
|
||||
-- Wire format
|
||||
data PacketHeader = PacketHeader
|
||||
{ pktIsAmes :: Bool -- sim_o
|
||||
, pktVersion :: Word3 -- ver_y
|
||||
, pktSndrClass :: ShipClass -- sac_y
|
||||
, pktRcvrClass :: ShipClass -- rac_y
|
||||
, pktChecksum :: Word20 -- mug_l
|
||||
, pktIsRelayed :: Bool -- rel_o
|
||||
}
|
||||
deriving Eq
|
||||
|
||||
data PacketBody = PacketBody
|
||||
{ pktSndr :: Ship -- sen_d
|
||||
, pktRcvr :: Ship -- rec_d
|
||||
, pktSndrTick :: Word4 -- sic_y
|
||||
, pktRcvrTick :: Word4 -- ric_y
|
||||
, pktContent :: ByteString -- (con_s, con_y)
|
||||
, pktOrigin :: Maybe AmesAddress -- rog_d
|
||||
}
|
||||
deriving Eq
|
||||
-}
|
||||
|
||||
type Word3 = Word8
|
||||
type Word4 = Word8
|
||||
type Word20 = Word32
|
||||
|
||||
data ShipClass
|
||||
= Lord
|
||||
| Planet
|
||||
| Moon
|
||||
| Comet
|
||||
deriving (Eq, Show)
|
||||
|
||||
muk :: ByteString -> Word20
|
||||
muk bs = mugBS bs .&. (2 ^ 20 - 1)
|
||||
|
||||
-- XX check this
|
||||
getAmesAddress :: Get AmesAddress
|
||||
getAmesAddress = AAIpv4 <$> (Ipv4 <$> getWord32le) <*> (Port <$> getWord16le)
|
||||
|
||||
putAmesAddress :: Putter AmesAddress
|
||||
putAmesAddress = \case
|
||||
AAIpv4 (Ipv4 ip) (Port port) -> putWord32le ip >> putWord16le port
|
||||
|
||||
instance Serialize Packet where
|
||||
get = do
|
||||
-- header
|
||||
head <- getWord32le
|
||||
let pktVersion = head .&. 0b111 & fromIntegral
|
||||
let checksum = shiftR head 3 .&. (2 ^ 20 - 1)
|
||||
let sndrRank = shiftR head 23 .&. 0b11
|
||||
let rcvrRank = shiftR head 25 .&. 0b11
|
||||
let pktEncrypted = testBit head 27 & not -- loobean
|
||||
-- verify checksum
|
||||
-- skip first three bits
|
||||
let isAmes = testBit head 3 & not
|
||||
let pktVersion = shiftR head 4 .&. 0b111 & fromIntegral
|
||||
let sndrRank = shiftR head 7 .&. 0b11
|
||||
let rcvrRank = shiftR head 9 .&. 0b11
|
||||
let checksum = shiftR head 11 .&. (2 ^ 20 - 1)
|
||||
let isRelayed = testBit head 31 & not -- loobean
|
||||
let sndrClass = genericIndex [Lord, Planet, Moon, Comet] sndrRank
|
||||
let rcvrClass = genericIndex [Lord, Planet, Moon, Comet] rcvrRank
|
||||
guard isAmes
|
||||
|
||||
pktOrigin <- if isRelayed
|
||||
then Just <$> getAmesAddress
|
||||
else pure Nothing
|
||||
|
||||
-- body
|
||||
lookAhead $ do
|
||||
len <- remaining
|
||||
len <- remaining
|
||||
body <- getBytes len
|
||||
let chk = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
|
||||
let chk = muk body
|
||||
when (checksum /= chk) $
|
||||
fail ("checksum mismatch: expected " <> show checksum
|
||||
<> "; got " <> show chk)
|
||||
-- body
|
||||
pktSndr <- getShip sndrRank
|
||||
pktRcvr <- getShip rcvrRank
|
||||
len <- remaining
|
||||
payload <- getBytes len
|
||||
-- data ("payload")
|
||||
(pktOrigin, pktContent) <- case cueBS payload of
|
||||
Left e -> fail (show e)
|
||||
Right n -> case fromNounErr n of
|
||||
Left e -> fail (show e)
|
||||
Right c -> pure c
|
||||
pure Packet {..}
|
||||
|
||||
tick <- getWord8
|
||||
let pktSndrTick = tick .&. 0b1111
|
||||
let pktRcvrTick = shiftR tick 4
|
||||
|
||||
pktSndr <- getShip sndrClass
|
||||
pktRcvr <- getShip rcvrClass
|
||||
|
||||
len <- remaining
|
||||
pktContent <- getBytes len
|
||||
|
||||
pure Packet{..}
|
||||
where
|
||||
getShip = fmap Ship . \case
|
||||
0 -> fromIntegral <$> getWord16le -- galaxy / star
|
||||
1 -> fromIntegral <$> getWord32le -- planet
|
||||
2 -> fromIntegral <$> getWord64le -- moon
|
||||
3 -> LargeKey <$> getWord64le <*> getWord64le -- comet
|
||||
_ -> fail "impossibiru"
|
||||
Lord -> fromIntegral <$> getWord16le
|
||||
Planet -> fromIntegral <$> getWord32le
|
||||
Moon -> fromIntegral <$> getWord64le
|
||||
Comet -> LargeKey <$> getWord64le <*> getWord64le
|
||||
|
||||
put Packet {..} = do
|
||||
let load = jamBS $ toNoun (pktOrigin, pktContent)
|
||||
put Packet{..} = do
|
||||
let (sndR, putSndr) = putShipGetRank pktSndr
|
||||
let (rcvR, putRcvr) = putShipGetRank pktRcvr
|
||||
let body = runPut (putSndr <> putRcvr <> putByteString load)
|
||||
let chek = fromIntegral (mugBS body) .&. (2 ^ 20 - 1)
|
||||
let encr = pktEncrypted
|
||||
|
||||
let body = runPut $ do
|
||||
putWord8 $ (pktSndrTick .&. 0b1111)
|
||||
.|. shiftL (pktRcvrTick .&. 0b1111) 4
|
||||
putSndr
|
||||
putRcvr
|
||||
putByteString pktContent
|
||||
|
||||
let vers = fromIntegral pktVersion .&. 0b111
|
||||
let head = vers
|
||||
.|. shiftL chek 3
|
||||
.|. shiftL sndR 23
|
||||
.|. shiftL rcvR 25
|
||||
.|. if encr then 0 else bit 27
|
||||
let chek = muk body
|
||||
|
||||
-- skip first 3 bytes, set 4th to yes (0) for "is ames"
|
||||
let head = shiftL vers 4
|
||||
.|. shiftL sndR 7
|
||||
.|. shiftL rcvR 9
|
||||
.|. shiftL chek 11
|
||||
.|. if isJust pktOrigin then 0 else bit 31
|
||||
|
||||
putWord32le head
|
||||
putByteString body -- XX can we avoid copy?
|
||||
case pktOrigin of
|
||||
Just o -> putAmesAddress o
|
||||
Nothing -> pure ()
|
||||
putByteString body
|
||||
where
|
||||
putShipGetRank s@(Ship (LargeKey p q)) = case () of
|
||||
_ | s < 2 ^ 16 -> (0, putWord16le $ fromIntegral s) -- gar
|
||||
| s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s) -- pan
|
||||
| s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s) -- mon
|
||||
| otherwise -> (3, putWord64le p >> putWord64le q) -- com
|
||||
_ | s < 2 ^ 16 -> (0, putWord16le $ fromIntegral s) -- lord
|
||||
| s < 2 ^ 32 -> (1, putWord32le $ fromIntegral s) -- planet
|
||||
| s < 2 ^ 64 -> (2, putWord64le $ fromIntegral s) -- moon
|
||||
| otherwise -> (3, putWord64le p >> putWord64le q) -- comet
|
||||
|
@ -39,7 +39,7 @@ import Network.Socket
|
||||
|
||||
import Control.Monad.STM (retry)
|
||||
import Network.Socket.ByteString (recvFrom, sendTo)
|
||||
|
||||
import Urbit.Vere.Stat (AmesStat(..), bump)
|
||||
|
||||
-- Types -----------------------------------------------------------------------
|
||||
|
||||
@ -156,8 +156,9 @@ realUdpServ
|
||||
. (HasLogFunc e, HasPortControlApi e)
|
||||
=> PortNumber
|
||||
-> HostAddress
|
||||
-> AmesStat
|
||||
-> RIO e UdpServ
|
||||
realUdpServ por hos = do
|
||||
realUdpServ por hos sat = do
|
||||
logInfo $ displayShow ("AMES", "UDP", "Starting real UDP server.")
|
||||
|
||||
env <- ask
|
||||
@ -192,6 +193,7 @@ realUdpServ por hos = do
|
||||
enqueueRecvPacket p a b = do
|
||||
did <- atomically (tryWriteTBQueue qRecv (p, a, b))
|
||||
when (did == False) $ do
|
||||
bump (asUqf sat)
|
||||
logWarn $ displayShow $ ("AMES", "UDP",)
|
||||
"Dropping inbound packet because queue is full."
|
||||
|
||||
@ -232,13 +234,16 @@ realUdpServ por hos = do
|
||||
Just sk -> do
|
||||
recvPacket sk >>= \case
|
||||
Left exn -> do
|
||||
bump (asUdf sat)
|
||||
logError "AMES: UDP: Failed to receive packet"
|
||||
signalBrokenSocket sk
|
||||
Right Nothing -> do
|
||||
bump (asUi6 sat)
|
||||
logError "AMES: UDP: Dropping non-ipv4 packet"
|
||||
pure ()
|
||||
Right (Just (b, p, a)) -> do
|
||||
logDebug "AMES: UDP: Received packet."
|
||||
bump (asUdp sat)
|
||||
enqueueRecvPacket p a b
|
||||
|
||||
let shutdown = do
|
||||
|
@ -10,7 +10,7 @@ module Urbit.Vere.Behn (behn, DriverApi(..), behn') where
|
||||
|
||||
import Data.Time.Clock.System (SystemTime)
|
||||
|
||||
import Urbit.Arvo hiding (Behn)
|
||||
import Urbit.Arvo
|
||||
import Urbit.Prelude
|
||||
import Urbit.Vere.Pier.Types
|
||||
|
||||
|
@ -13,16 +13,15 @@ import Urbit.Prelude hiding (Builder)
|
||||
|
||||
import Data.ByteString.Builder
|
||||
import Urbit.King.Scry
|
||||
import Urbit.Vere.Serf.Types
|
||||
|
||||
import Data.Conduit (ConduitT, Flush(..), yield)
|
||||
import Data.Text.Encoding (encodeUtf8Builder)
|
||||
import Urbit.Vere.Stat (RenderedStat)
|
||||
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Network.HTTP.Types as H
|
||||
import qualified Network.Wai as W
|
||||
import qualified Network.Wai.Conduit as W
|
||||
import qualified Urbit.Noun.Time as Time
|
||||
|
||||
newtype KingSubsite = KS { runKingSubsite :: W.Application }
|
||||
|
||||
@ -43,10 +42,11 @@ streamSlog a = do
|
||||
|
||||
kingSubsite :: HasLogFunc e
|
||||
=> Ship
|
||||
-> (Time.Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
|
||||
-> ScryFunc
|
||||
-> IO RenderedStat
|
||||
-> TVar ((Atom, Tank) -> IO ())
|
||||
-> RAcquire e KingSubsite
|
||||
kingSubsite who scry func = do
|
||||
kingSubsite who scry stat func = do
|
||||
clients <- newTVarIO (mempty :: Map Word (SlogAction -> IO ()))
|
||||
nextId <- newTVarIO (0 :: Word)
|
||||
baton <- newTMVarIO ()
|
||||
@ -77,15 +77,29 @@ kingSubsite who scry func = do
|
||||
else
|
||||
let loop = yield Flush
|
||||
>> forever (atomically (readTQueue q) >>= streamSlog)
|
||||
in respond $ W.responseSource (H.mkStatus 200 "OK") heads loop)
|
||||
in respond $ W.responseSource (H.mkStatus 200 "OK") slogHeads loop)
|
||||
|
||||
["~_~", "stat"] -> do
|
||||
authed <- authenticated env req
|
||||
if not authed
|
||||
then respond $ emptyResponse 403 "Permission Denied"
|
||||
else do
|
||||
lines <- stat
|
||||
let msg = mconcat ((<> "\n") . encodeUtf8Builder <$> lines)
|
||||
<> "\nRefresh for more current data."
|
||||
respond $ W.responseBuilder (H.mkStatus 200 "OK") statHeads msg
|
||||
|
||||
_ -> respond $ emptyResponse 404 "Not Found"
|
||||
|
||||
where
|
||||
heads = [ ("Content-Type" , "text/event-stream")
|
||||
, ("Cache-Control", "no-cache")
|
||||
, ("Connection" , "keep-alive")
|
||||
]
|
||||
slogHeads = [ ("Content-Type", "text/event-stream")
|
||||
, ("Cache-Control", "no-cache")
|
||||
, ("Connection", "keep-alive")
|
||||
]
|
||||
|
||||
statHeads = [ ("Content-Type", "text/plain")
|
||||
, ("Cache-Control", "no-cache")
|
||||
]
|
||||
|
||||
emptyResponse cod mes = W.responseLBS (H.mkStatus cod mes) [] ""
|
||||
|
||||
@ -102,7 +116,7 @@ kingSubsite who scry func = do
|
||||
=> Text
|
||||
-> RIO e (Maybe Bool)
|
||||
scryAuth cookie =
|
||||
scryNow scry "ex" who "" ["authenticated", "cookie", textAsTa cookie]
|
||||
scryNow scry "ex" "" ["authenticated", "cookie", textAsTa cookie]
|
||||
|
||||
fourOhFourSubsite :: Ship -> KingSubsite
|
||||
fourOhFourSubsite who = KS $ \req respond ->
|
||||
|
@ -23,6 +23,7 @@ import RIO.Directory
|
||||
import Urbit.Arvo
|
||||
import Urbit.King.App
|
||||
import Urbit.Vere.Pier.Types
|
||||
import Urbit.Vere.Stat
|
||||
|
||||
import Control.Monad.STM (retry)
|
||||
import System.Environment (getExecutablePath)
|
||||
@ -31,11 +32,11 @@ import System.Posix.Files (ownerModes, setFileMode)
|
||||
import Urbit.EventLog.LMDB (EventLog)
|
||||
import Urbit.EventLog.Event (buildLogEvent)
|
||||
import Urbit.King.API (TermConn)
|
||||
import Urbit.Noun.Time (Wen)
|
||||
import Urbit.TermSize (TermSize(..), termSize)
|
||||
import Urbit.Vere.Serf (Serf)
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.List as L
|
||||
import qualified System.Entropy as Ent
|
||||
import qualified Urbit.EventLog.LMDB as Log
|
||||
import qualified Urbit.King.API as King
|
||||
@ -71,16 +72,22 @@ setupPierDirectory shipPath = do
|
||||
|
||||
-- Load pill into boot sequence. -----------------------------------------------
|
||||
|
||||
data CannotBootFromIvoryPill = CannotBootFromIvoryPill
|
||||
deriving (Show, Exception)
|
||||
|
||||
genEntropy :: MonadIO m => m Entropy
|
||||
genEntropy = Entropy . fromIntegral . bytesAtom <$> io (Ent.getEntropy 64)
|
||||
|
||||
genBootSeq :: MonadIO m => Ship -> Pill -> Bool -> LegacyBootEvent -> m BootSeq
|
||||
genBootSeq ship Pill {..} lite boot = io $ do
|
||||
ent <- genEntropy
|
||||
let ovums = preKern ent <> pKernelOvums <> postKern <> pUserspaceOvums
|
||||
pure $ BootSeq ident pBootFormulas ovums
|
||||
genBootSeq :: HasKingEnv e
|
||||
=> Ship -> Pill -> Bool -> LegacyBootEvent -> RIO e BootSeq
|
||||
genBootSeq _ PillIvory {} _ _ = throwIO CannotBootFromIvoryPill
|
||||
genBootSeq ship PillPill {..} lite boot = do
|
||||
ent <- io genEntropy
|
||||
wyr <- wyrd
|
||||
let ova = preKern ent <> [wyr] <> pKernelOva <> postKern <> pUserspaceOva
|
||||
pure $ BootSeq ident pBootFormulae ova
|
||||
where
|
||||
ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulas)
|
||||
ident = LogIdentity ship isFake (fromIntegral $ length pBootFormulae)
|
||||
preKern ent =
|
||||
[ EvBlip $ BlipEvArvo $ ArvoEvWhom () ship
|
||||
, EvBlip $ BlipEvArvo $ ArvoEvWack () ent
|
||||
@ -295,14 +302,18 @@ pier (serf, log) vSlog startedSig injected = do
|
||||
let execute = writeTQueue executeQ
|
||||
let persist = writeTQueue persistQ
|
||||
let sigint = Serf.sendSIGINT serf
|
||||
let scry = \w b g -> do
|
||||
let scry = \g r -> do
|
||||
res <- newEmptyMVar
|
||||
atomically $ writeTQueue scryQ (w, b, g, putMVar res)
|
||||
atomically $ writeTQueue scryQ (g, r, putMVar res)
|
||||
takeMVar res
|
||||
|
||||
-- Set up the runtime stat counters.
|
||||
stat <- newStat
|
||||
|
||||
-- Set up the runtime subsite server and its capability to slog
|
||||
-- and display stats.
|
||||
siteSlog <- newTVarIO (const $ pure ())
|
||||
runtimeSubsite <- Site.kingSubsite ship scry siteSlog
|
||||
runtimeSubsite <- Site.kingSubsite ship scry (renderStat stat) siteSlog
|
||||
|
||||
-- Slogs go to stderr, to the runtime subsite, and to the terminal.
|
||||
env <- ask
|
||||
@ -311,12 +322,12 @@ pier (serf, log) vSlog startedSig injected = do
|
||||
io $ readTVarIO siteSlog >>= ($ s)
|
||||
logOther "serf" (display $ T.strip $ tankToText tank)
|
||||
|
||||
let err = atomically . Term.trace muxed . (<> "\r\n")
|
||||
(bootEvents, startDrivers) <- do
|
||||
env <- ask
|
||||
let err = atomically . Term.trace muxed . (<> "\r\n")
|
||||
siz <- atomically $ Term.curDemuxSize demux
|
||||
let fak = isFake logId
|
||||
drivers env ship fak compute scry (siz, muxed) err sigint runtimeSubsite
|
||||
drivers env ship fak compute scry (siz, muxed) err sigint stat runtimeSubsite
|
||||
|
||||
let computeConfig = ComputeConfig { ccOnWork = takeTMVar computeQ
|
||||
, ccOnKill = onKill
|
||||
@ -330,6 +341,8 @@ pier (serf, log) vSlog startedSig injected = do
|
||||
|
||||
tSerf <- acquireWorker "Serf" (runCompute serf computeConfig)
|
||||
|
||||
doVersionNegotiation compute err
|
||||
|
||||
-- Run all born events and retry them until they succeed.
|
||||
wackEv <- EvBlip . BlipEvArvo . ArvoEvWack () <$> genEntropy
|
||||
rio $ for_ (wackEv : bootEvents) $ \ev -> do
|
||||
@ -341,7 +354,7 @@ pier (serf, log) vSlog startedSig injected = do
|
||||
cb :: Int -> WorkError -> IO ()
|
||||
cb n | n >= 3 = error ("boot event failed: " <> show ev)
|
||||
cb n = \case
|
||||
RunOkay _ -> putMVar okaySig ()
|
||||
RunOkay _ _ -> putMVar okaySig ()
|
||||
RunSwap _ _ _ _ _ -> putMVar okaySig ()
|
||||
RunBail _ -> inject (n + 1)
|
||||
|
||||
@ -368,7 +381,7 @@ pier (serf, log) vSlog startedSig injected = do
|
||||
let inject = atomically $ compute $ RRWork $ EvErr ev $ cb
|
||||
cb :: WorkError -> IO ()
|
||||
cb = \case
|
||||
RunOkay _ -> putMVar okaySig (Right ())
|
||||
RunOkay _ _ -> putMVar okaySig (Right ())
|
||||
RunSwap _ _ _ _ _ -> putMVar okaySig (Right ())
|
||||
RunBail goofs -> putMVar okaySig (Left goofs)
|
||||
|
||||
@ -409,6 +422,68 @@ death tag tid = do
|
||||
Left exn -> Left (tag, exn)
|
||||
Right () -> Right tag
|
||||
|
||||
-- %wyrd version negotiation ---------------------------------------------------
|
||||
|
||||
data PierVersionNegotiationFailed = PierVersionNegotiationFailed
|
||||
deriving (Show, Exception)
|
||||
|
||||
zuseVersion :: Word
|
||||
zuseVersion = 420
|
||||
|
||||
wyrd :: HasKingEnv e => RIO e Ev
|
||||
wyrd = do
|
||||
king <- tshow <$> view kingIdL
|
||||
|
||||
let k = Wynn [("zuse", zuseVersion),
|
||||
("lull", 330),
|
||||
("arvo", 240),
|
||||
("hoon", 140),
|
||||
("nock", 4)]
|
||||
sen = MkTerm king
|
||||
v = Vere sen [Cord "king-haskell", Cord "1.0"] k
|
||||
|
||||
pure $ EvBlip $ BlipEvArvo $ ArvoEvWyrd () v
|
||||
|
||||
doVersionNegotiation
|
||||
:: HasPierEnv e
|
||||
=> (RunReq -> STM ())
|
||||
-> (Text -> RIO e ())
|
||||
-> RAcquire e ()
|
||||
doVersionNegotiation compute stderr = do
|
||||
ev <- rio wyrd
|
||||
|
||||
okaySig :: MVar (Either [Goof] FX) <- newEmptyMVar
|
||||
let inject = atomically $ compute $ RRWork $ EvErr ev $ cb
|
||||
cb :: WorkError -> IO ()
|
||||
cb = \case
|
||||
RunOkay _ fx -> putMVar okaySig (Right fx)
|
||||
RunSwap _ _ _ _ fx -> putMVar okaySig (Right fx)
|
||||
RunBail goofs -> putMVar okaySig (Left goofs)
|
||||
|
||||
rio $ stderr "vere: checking version compatibility"
|
||||
io inject
|
||||
|
||||
takeMVar okaySig >>= \case
|
||||
Left goof -> do
|
||||
rio $ stderr "pier: version negotation failed"
|
||||
logError $ display @Text ("Goof in wyrd event: " <> tshow goof)
|
||||
throwIO PierVersionNegotiationFailed
|
||||
|
||||
Right fx -> do
|
||||
-- Walk through the returned fx looking for a wend effect. If we find
|
||||
-- one, check the zuse versions.
|
||||
rio $ for_ fx $ \case
|
||||
GoodParse (EfWend (Wynn xs)) -> case L.lookup "zuse" xs of
|
||||
Nothing -> pure ()
|
||||
Just zuseVerInWynn ->
|
||||
if zuseVerInWynn /= zuseVersion
|
||||
then do
|
||||
rio $ stderr "pier: pier: version negotiation failed; downgrade"
|
||||
throwIO PierVersionNegotiationFailed
|
||||
else
|
||||
pure ()
|
||||
_ -> pure ()
|
||||
|
||||
|
||||
-- Start All Drivers -----------------------------------------------------------
|
||||
|
||||
@ -427,16 +502,19 @@ drivers
|
||||
-> Ship
|
||||
-> Bool
|
||||
-> (RunReq -> STM ())
|
||||
-> (Wen -> Gang -> Path -> IO (Maybe (Term, Noun)))
|
||||
-> ScryFunc
|
||||
-> (TermSize, Term.Client)
|
||||
-> (Text -> RIO e ())
|
||||
-> IO ()
|
||||
-> Stat
|
||||
-> Site.KingSubsite
|
||||
-> RAcquire e ([Ev], RAcquire e Drivers)
|
||||
drivers env who isFake plan scry termSys stderr serfSIGINT sub = do
|
||||
drivers env who isFake plan scry termSys stderr serfSIGINT stat sub = do
|
||||
let Stat{..} = stat
|
||||
|
||||
(behnBorn, runBehn) <- rio Behn.behn'
|
||||
(termBorn, runTerm) <- rio (Term.term' termSys serfSIGINT)
|
||||
(amesBorn, runAmes) <- rio (Ames.ames' who isFake scry stderr)
|
||||
(termBorn, runTerm) <- rio (Term.term' termSys (renderStat stat) serfSIGINT)
|
||||
(amesBorn, runAmes) <- rio (Ames.ames' who isFake statAmes scry stderr)
|
||||
(httpBorn, runEyre) <- rio (Eyre.eyre' who isFake stderr sub)
|
||||
(clayBorn, runClay) <- rio Clay.clay'
|
||||
(irisBorn, runIris) <- rio Iris.client'
|
||||
@ -494,6 +572,7 @@ router slog waitFx Drivers {..} = do
|
||||
case ef of
|
||||
GoodParse (EfVega _ _ ) -> vega
|
||||
GoodParse (EfExit _ _ ) -> exit
|
||||
GoodParse (EfWend _ ) -> pure ()
|
||||
GoodParse (EfVane (VEBehn ef)) -> io (dBehn ef)
|
||||
GoodParse (EfVane (VEBoat ef)) -> io (dSync ef)
|
||||
GoodParse (EfVane (VEClay ef)) -> io (dSync ef)
|
||||
@ -529,7 +608,7 @@ data ComputeConfig = ComputeConfig
|
||||
{ ccOnWork :: STM RunReq
|
||||
, ccOnKill :: STM ()
|
||||
, ccOnSave :: STM ()
|
||||
, ccOnScry :: STM (Wen, Gang, Path, Maybe (Term, Noun) -> IO ())
|
||||
, ccOnScry :: STM (Gang, ScryReq, Maybe (Term, Noun) -> IO ())
|
||||
, ccPutResult :: (Fact, FX) -> STM ()
|
||||
, ccShowSpinner :: Maybe Text -> STM ()
|
||||
, ccHideSpinner :: STM ()
|
||||
@ -543,7 +622,7 @@ runCompute serf ComputeConfig {..} = do
|
||||
let onRR = asum [ ccOnKill <&> Serf.RRKill
|
||||
, ccOnSave <&> Serf.RRSave
|
||||
, ccOnWork
|
||||
, ccOnScry <&> \(w,g,p,k) -> Serf.RRScry w g p k
|
||||
, ccOnScry <&> \(g,r,k) -> Serf.RRScry g r k
|
||||
]
|
||||
|
||||
vEvProcessing :: TMVar Ev <- newEmptyTMVarIO
|
||||
|
@ -14,10 +14,11 @@ module Urbit.Vere.Pier.Types
|
||||
, jobId
|
||||
, jobMug
|
||||
, DriverApi(..)
|
||||
, ScryFunc
|
||||
)
|
||||
where
|
||||
|
||||
import Urbit.Prelude hiding (Term)
|
||||
import Urbit.Prelude
|
||||
|
||||
import Urbit.Arvo
|
||||
import Urbit.Noun.Time
|
||||
@ -44,11 +45,14 @@ instance Show Nock where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Pill = Pill
|
||||
{ pBootFormulas :: ![Nock]
|
||||
, pKernelOvums :: ![Ev]
|
||||
, pUserspaceOvums :: ![Ev]
|
||||
}
|
||||
data Pill
|
||||
= PillIvory [Noun]
|
||||
| PillPill
|
||||
{ pName :: Noun
|
||||
, pBootFormulae :: ![Nock] -- XX not actually nock, semantically
|
||||
, pKernelOva :: ![Ev]
|
||||
, pUserspaceOva :: ![Ev]
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data BootSeq = BootSeq !LogIdentity ![Nock] ![Ev]
|
||||
@ -87,6 +91,10 @@ data DriverApi ef = DriverApi
|
||||
}
|
||||
|
||||
|
||||
-- Scrying --------------------------------------------------------------------
|
||||
|
||||
type ScryFunc = Gang -> ScryReq -> IO (Maybe (Term, Noun))
|
||||
|
||||
-- Instances -------------------------------------------------------------------
|
||||
|
||||
instance ToNoun Work where
|
||||
|
@ -16,15 +16,16 @@
|
||||
|%
|
||||
:: +writ: from king to serf
|
||||
::
|
||||
+$ gang (unit (set ship))
|
||||
+$ writ
|
||||
$% $: %live
|
||||
$% [%cram eve=@]
|
||||
[%exit cod=@]
|
||||
[%save eve=@]
|
||||
[%meld ~]
|
||||
[%pack ~]
|
||||
== ==
|
||||
[%peek mil=@ now=@da lyc=gang pat=path]
|
||||
:: sam=[gang (each path $%([%once @tas @tas path] [beam @tas beam]))]
|
||||
[%peek mil=@ sam=*]
|
||||
[%play eve=@ lit=(list ?((pair @da ovum) *))]
|
||||
[%work mil=@ job=(pair @da ovum)]
|
||||
==
|
||||
@ -33,7 +34,8 @@
|
||||
+$ plea
|
||||
$% [%live ~]
|
||||
[%ripe [pro=%1 hon=@ nok=@] eve=@ mug=@]
|
||||
[%slog pri=@ ?(cord tank)]
|
||||
[%slog pri=@ tank]
|
||||
[%flog cord]
|
||||
$: %peek
|
||||
$% [%done dat=(unit (cask))]
|
||||
[%bail dud=goof]
|
||||
@ -48,6 +50,7 @@
|
||||
[%bail lud=(list goof)]
|
||||
== ==
|
||||
==
|
||||
--
|
||||
```
|
||||
-}
|
||||
|
||||
@ -84,7 +87,8 @@ import Foreign.Ptr (castPtr)
|
||||
import Foreign.Storable (peek, poke)
|
||||
import RIO.Prelude (decodeUtf8Lenient)
|
||||
import System.Posix.Signals (sigINT, sigKILL, signalProcess)
|
||||
import Urbit.Arvo (Ev, FX)
|
||||
import Urbit.Arvo (FX)
|
||||
import Urbit.Arvo.Event
|
||||
import Urbit.Noun.Time (Wen)
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
@ -171,9 +175,9 @@ recvPleaHandlingSlog :: Serf -> IO Plea
|
||||
recvPleaHandlingSlog serf = loop
|
||||
where
|
||||
loop = recvPlea serf >>= \case
|
||||
PSlog info -> serfSlog serf info >> loop
|
||||
other -> pure other
|
||||
|
||||
PSlog info -> serfSlog serf info >> loop
|
||||
PFlog (Cord ofni) -> serfSlog serf (0, Tank $ Leaf $ Tape $ ofni) >> loop
|
||||
other -> pure other
|
||||
|
||||
-- Higher-Level IPC Functions --------------------------------------------------
|
||||
|
||||
@ -219,9 +223,9 @@ sendCompactionRequest serf = do
|
||||
sendWrit serf (WLive $ LPack ())
|
||||
recvLive serf
|
||||
|
||||
sendScryRequest :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
|
||||
sendScryRequest serf w g p = do
|
||||
sendWrit serf (WPeek 0 w g p)
|
||||
sendScryRequest :: Serf -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
|
||||
sendScryRequest serf g r = do
|
||||
sendWrit serf (WPeek 0 g r)
|
||||
recvPeek serf
|
||||
|
||||
sendShutdownRequest :: Serf -> Atom -> IO ()
|
||||
@ -370,10 +374,9 @@ compact serf = withSerfLockIO serf $ \ss -> do
|
||||
{-|
|
||||
Peek into the serf state.
|
||||
-}
|
||||
scry :: Serf -> Wen -> Gang -> Path -> IO (Maybe (Term, Noun))
|
||||
scry serf w g p = withSerfLockIO serf $ \ss -> do
|
||||
(ss,) <$> sendScryRequest serf w g p
|
||||
|
||||
scry :: Serf -> Gang -> ScryReq -> IO (Maybe (Term, Noun))
|
||||
scry serf g r = withSerfLockIO serf $ \ss -> do
|
||||
(ss,) <$> sendScryRequest serf g r
|
||||
|
||||
{-|
|
||||
Given a list of boot events, send them to to the serf in a single
|
||||
@ -493,7 +496,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
|
||||
RRSave () -> doSave
|
||||
RRKill () -> doKill
|
||||
RRPack () -> doPack
|
||||
RRScry w g p k -> doScry w g p k
|
||||
RRScry g r k -> doScry g r k
|
||||
|
||||
doPack :: IO ()
|
||||
doPack = compact serf >> topLoop
|
||||
@ -511,8 +514,8 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
|
||||
doKill :: IO ()
|
||||
doKill = waitForLog >> snapshot serf >> pure ()
|
||||
|
||||
doScry :: Wen -> Gang -> Path -> (Maybe (Term, Noun) -> IO ()) -> IO ()
|
||||
doScry w g p k = (scry serf w g p >>= k) >> topLoop
|
||||
doScry :: Gang -> ScryReq -> (Maybe (Term, Noun) -> IO ()) -> IO ()
|
||||
doScry g r k = (scry serf g r >>= k) >> topLoop
|
||||
|
||||
doWork :: EvErr -> IO ()
|
||||
doWork firstWorkErr = do
|
||||
@ -529,13 +532,13 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
|
||||
RRKill () -> atomically (closeTBMQueue que) >> pure doKill
|
||||
RRSave () -> atomically (closeTBMQueue que) >> pure doSave
|
||||
RRPack () -> atomically (closeTBMQueue que) >> pure doPack
|
||||
RRScry w g p k -> atomically (closeTBMQueue que) >> pure (doScry w g p k)
|
||||
RRScry g r k -> atomically (closeTBMQueue que) >> pure (doScry g r k)
|
||||
RRWork workErr -> atomically (writeTBMQueue que workErr) >> workLoop que
|
||||
|
||||
onWorkResp :: Wen -> EvErr -> Work -> IO ()
|
||||
onWorkResp wen (EvErr evn err) = \case
|
||||
WDone eid hash fx -> do
|
||||
io $ err (RunOkay eid)
|
||||
io $ err (RunOkay eid fx)
|
||||
atomically $ sendOn ((Fact eid hash wen (toNoun evn)), fx)
|
||||
WSwap eid hash (wen, noun) fx -> do
|
||||
io $ err (RunSwap eid hash wen noun fx)
|
||||
@ -543,6 +546,7 @@ run serf maxBatchSize getLastEvInLog onInput sendOn spin = topLoop
|
||||
WBail goofs -> do
|
||||
io $ err (RunBail goofs)
|
||||
|
||||
|
||||
{-|
|
||||
Given:
|
||||
|
||||
|
@ -35,7 +35,7 @@ data Work
|
||||
|
||||
data Writ
|
||||
= WLive Live
|
||||
| WPeek Atom Wen Gang Path
|
||||
| WPeek Atom Gang ScryReq
|
||||
| WPlay EventId [Noun]
|
||||
| WWork Atom Wen Ev
|
||||
deriving (Show)
|
||||
@ -44,6 +44,7 @@ data Plea
|
||||
= PLive ()
|
||||
| PRipe SerfInfo
|
||||
| PSlog Slog
|
||||
| PFlog Cord
|
||||
| PPeek Scry
|
||||
| PPlay Play
|
||||
| PWork Work
|
||||
|
@ -2,7 +2,7 @@ module Urbit.Vere.Serf.Types where
|
||||
|
||||
import Urbit.Prelude
|
||||
|
||||
import Urbit.Arvo (Ev, FX)
|
||||
import Urbit.Arvo (Desk, Ev, FX)
|
||||
import Urbit.Noun.Time (Wen)
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@ data EvErr = EvErr Ev (WorkError -> IO ())
|
||||
data WorkError -- TODO Rename type and constructors
|
||||
= RunSwap EventId Mug Wen Noun FX -- TODO Maybe provide less info here?
|
||||
| RunBail [Goof]
|
||||
| RunOkay EventId
|
||||
| RunOkay EventId FX
|
||||
|
||||
{-
|
||||
- RRWork: Ask the serf to do work, will output (Fact, FX) if work
|
||||
@ -94,7 +94,19 @@ data RunReq
|
||||
| RRSave ()
|
||||
| RRKill ()
|
||||
| RRPack ()
|
||||
| RRScry Wen Gang Path (Maybe (Term, Noun) -> IO ())
|
||||
| RRScry Gang ScryReq (Maybe (Term, Noun) -> IO ())
|
||||
|
||||
type ScryReq = (Each Path Demi)
|
||||
|
||||
data Demi
|
||||
= DemiOnce Term Desk Path
|
||||
| DemiBeam Term Beam
|
||||
deriving (Show)
|
||||
|
||||
-- TODO
|
||||
type Beam = Void
|
||||
|
||||
deriveNoun ''Demi
|
||||
|
||||
|
||||
-- Exceptions ------------------------------------------------------------------
|
||||
@ -111,6 +123,8 @@ data SerfExn
|
||||
| SerfNotRunning
|
||||
| MissingBootEventsInEventLog Word Word
|
||||
| SnapshotAheadOfLog EventId EventId
|
||||
| BailDuringWyrd [Goof]
|
||||
| SwapDuringWyrd Mug (Wen, Noun) FX
|
||||
deriving (Show, Exception)
|
||||
|
||||
|
||||
|
75
pkg/hs/urbit-king/lib/Urbit/Vere/Stat.hs
Normal file
75
pkg/hs/urbit-king/lib/Urbit/Vere/Stat.hs
Normal file
@ -0,0 +1,75 @@
|
||||
module Urbit.Vere.Stat where
|
||||
|
||||
import Urbit.Prelude
|
||||
|
||||
data Stat = Stat
|
||||
{ statAmes :: AmesStat
|
||||
}
|
||||
|
||||
data AmesStat = AmesStat
|
||||
{ asUdp :: TVar Word
|
||||
, asUqf :: TVar Word
|
||||
, asUdf :: TVar Word
|
||||
, asUi6 :: TVar Word
|
||||
, asRcv :: TVar Word
|
||||
, asSup :: TVar Word
|
||||
, asSrf :: TVar Word
|
||||
, asQuf :: TVar Word
|
||||
, asFwd :: TVar Word
|
||||
, asDrt :: TVar Word
|
||||
, asDvr :: TVar Word
|
||||
, asDml :: TVar Word
|
||||
, asSwp :: TVar Word
|
||||
, asBal :: TVar Word
|
||||
, asOky :: TVar Word
|
||||
}
|
||||
|
||||
newStat :: MonadIO m => m Stat
|
||||
newStat = do
|
||||
asUdp <- newTVarIO 0
|
||||
asUqf <- newTVarIO 0
|
||||
asUdf <- newTVarIO 0
|
||||
asUi6 <- newTVarIO 0
|
||||
asRcv <- newTVarIO 0
|
||||
asSup <- newTVarIO 0
|
||||
asSrf <- newTVarIO 0
|
||||
asQuf <- newTVarIO 0
|
||||
asFwd <- newTVarIO 0
|
||||
asDrt <- newTVarIO 0
|
||||
asDvr <- newTVarIO 0
|
||||
asDml <- newTVarIO 0
|
||||
asSwp <- newTVarIO 0
|
||||
asBal <- newTVarIO 0
|
||||
asOky <- newTVarIO 0
|
||||
pure Stat{statAmes = AmesStat{..}}
|
||||
|
||||
bump :: MonadIO m => TVar Word -> m ()
|
||||
bump s = atomically $ bump' s
|
||||
|
||||
bump' :: TVar Word -> STM ()
|
||||
bump' s = modifyTVar' s (+ 1)
|
||||
|
||||
type RenderedStat = [Text]
|
||||
|
||||
renderStat :: MonadIO m => Stat -> m RenderedStat
|
||||
renderStat Stat{statAmes = AmesStat{..}} =
|
||||
sequence
|
||||
[ pure "stat:"
|
||||
, pure " ames:"
|
||||
, (" udp ingress: " <>) <$> tshow <$> readTVarIO asUdp
|
||||
, (" udp queue evict: " <>) <$> tshow <$> readTVarIO asUqf
|
||||
, (" udp recv fail: " <>) <$> tshow <$> readTVarIO asUdf
|
||||
, (" udp dropped non-ipv4: " <>) <$> tshow <$> readTVarIO asUi6
|
||||
, (" driver ingress: " <>) <$> tshow <$> readTVarIO asRcv
|
||||
, (" enqueued for serf: " <>) <$> tshow <$> readTVarIO asSup
|
||||
, (" sent to serf: " <>) <$> tshow <$> readTVarIO asSrf
|
||||
, (" serf queue evict: " <>) <$> tshow <$> readTVarIO asQuf
|
||||
, (" forwarded: " <>) <$> tshow <$> readTVarIO asFwd
|
||||
, (" dropped (unroutable): " <>) <$> tshow <$> readTVarIO asDrt
|
||||
, (" dropped (wrong version): " <>) <$> tshow <$> readTVarIO asDvr
|
||||
, (" dropped (malformed): " <>) <$> tshow <$> readTVarIO asDml
|
||||
, (" serf swapped: " <>) <$> tshow <$> readTVarIO asSwp
|
||||
, (" serf bailed: " <>) <$> tshow <$> readTVarIO asBal
|
||||
, (" serf okay: " <>) <$> tshow <$> readTVarIO asOky
|
||||
]
|
||||
|
@ -27,6 +27,7 @@ import Urbit.Vere.Pier.Types
|
||||
import Data.List ((!!))
|
||||
import RIO.Directory (createDirectoryIfMissing)
|
||||
import Urbit.King.API (readPortsFile)
|
||||
import Urbit.Vere.Stat (RenderedStat)
|
||||
import Urbit.TermSize (TermSize(TermSize))
|
||||
import Urbit.Vere.Term.API (Client(Client), ClientTake(..))
|
||||
|
||||
@ -558,7 +559,7 @@ localClient doneSignal = fst <$> mkRAcquire start stop
|
||||
loop rd
|
||||
else if w == 3 then do
|
||||
-- ETX (^C)
|
||||
logInfo $ displayShow "Ctrl-c interrupt"
|
||||
logInfo $ "Ctrl-c interrupt"
|
||||
atomically $ do
|
||||
writeTQueue wq [Term.Trace "interrupt\r\n"]
|
||||
writeTQueue rq $ Ctl $ Cord "c"
|
||||
@ -599,9 +600,10 @@ localClient doneSignal = fst <$> mkRAcquire start stop
|
||||
term'
|
||||
:: HasPierEnv e
|
||||
=> (TermSize, Client)
|
||||
-> IO RenderedStat
|
||||
-> IO ()
|
||||
-> RIO e ([Ev], RAcquire e (DriverApi TermEf))
|
||||
term' (tsize, client) serfSIGINT = do
|
||||
term' (tsize, client) stat serfSIGINT = do
|
||||
let TermSize wi hi = tsize
|
||||
initEv = [blewEvent wi hi, initialHail]
|
||||
|
||||
@ -610,7 +612,7 @@ term' (tsize, client) serfSIGINT = do
|
||||
runDriver = do
|
||||
env <- ask
|
||||
ventQ :: TQueue EvErr <- newTQueueIO
|
||||
diOnEffect <- term env (tsize, client) (writeTQueue ventQ) serfSIGINT
|
||||
diOnEffect <- term env (tsize, client) (writeTQueue ventQ) stat serfSIGINT
|
||||
|
||||
let diEventSource = fmap RRWork <$> tryReadTQueue ventQ
|
||||
|
||||
@ -623,9 +625,10 @@ term :: forall e. (HasPierEnv e)
|
||||
=> e
|
||||
-> (TermSize, Client)
|
||||
-> (EvErr -> STM ())
|
||||
-> IO RenderedStat
|
||||
-> IO ()
|
||||
-> RAcquire e (TermEf -> IO ())
|
||||
term env (tsize, Client{..}) plan serfSIGINT = runTerm
|
||||
term env (tsize, Client{..}) plan stat serfSIGINT = runTerm
|
||||
where
|
||||
runTerm :: RAcquire e (TermEf -> IO ())
|
||||
runTerm = do
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: urbit-king
|
||||
version: 0.10.8
|
||||
version: 1.1
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
data-files:
|
||||
|
@ -108,9 +108,10 @@ instance Arbitrary LogIdentity where
|
||||
instance Arbitrary Packet where
|
||||
arbitrary = do
|
||||
pktVersion <- suchThat arb (< 8)
|
||||
pktEncrypted <- arb
|
||||
pktSndr <- arb
|
||||
pktRcvr <- arb
|
||||
pktSndrTick <- suchThat arb (< 16)
|
||||
pktRcvrTick <- suchThat arb (< 16)
|
||||
pktOrigin <- arb
|
||||
pktContent <- arb
|
||||
pure Packet {..}
|
||||
|
@ -31,18 +31,6 @@ roundTrip x = Just x == fromNoun (toNoun x)
|
||||
nounEq :: (ToNoun a, ToNoun b) => a -> b -> Bool
|
||||
nounEq x y = toNoun x == toNoun y
|
||||
|
||||
data EvExample = EvEx Ev Noun
|
||||
deriving (Eq, Show)
|
||||
|
||||
eventSanity :: [EvExample] -> Bool
|
||||
eventSanity = all $ \(EvEx e n) -> toNoun e == n
|
||||
|
||||
instance Arbitrary EvExample where
|
||||
arbitrary = oneof $ fmap pure $
|
||||
[ EvEx (EvVane $ VaneVane $ VEVeer (Jael, ()) "" (Path []) "")
|
||||
(toNoun (Path ["vane", "vane", "jael"], Cord "veer", (), (), ()))
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
tests :: TestTree
|
||||
@ -51,7 +39,6 @@ tests =
|
||||
[ testProperty "Round Trip Effect" (roundTrip @Ef)
|
||||
, testProperty "Round Trip Event" (roundTrip @Ev)
|
||||
, testProperty "Round Trip AmesDest" (roundTrip @AmesDest)
|
||||
, testProperty "Basic Event Sanity" eventSanity
|
||||
]
|
||||
|
||||
|
||||
@ -131,24 +118,9 @@ instance Arbitrary BlipEv where
|
||||
]
|
||||
|
||||
instance Arbitrary Ev where
|
||||
arbitrary = oneof [ EvVane <$> arb
|
||||
, EvBlip <$> arb
|
||||
arbitrary = oneof [ EvBlip <$> arb
|
||||
]
|
||||
|
||||
instance Arbitrary Vane where
|
||||
arbitrary = oneof [ VaneVane <$> arb
|
||||
, VaneZuse <$> arb
|
||||
]
|
||||
|
||||
instance Arbitrary VaneName where
|
||||
arbitrary = oneof $ pure <$> [minBound .. maxBound]
|
||||
|
||||
instance Arbitrary VaneEv where
|
||||
arbitrary = VEVeer <$> arb <*> arb <*> arb <*> arb
|
||||
|
||||
instance Arbitrary ZuseEv where
|
||||
arbitrary = ZEVeer () <$> arb <*> arb <*> arb
|
||||
|
||||
instance Arbitrary StdMethod where
|
||||
arbitrary = oneof $ pure <$> [ minBound .. maxBound ]
|
||||
|
||||
|
@ -35,7 +35,7 @@ instance KnownSymbol name => Options.IsOption (Pill name) where
|
||||
)
|
||||
|
||||
defaultValue =
|
||||
Pill ( "../../../bin"
|
||||
Pill ( "../../../bin/"
|
||||
++ TypeLits.symbolVal (Proxy @name)
|
||||
++ ".pill"
|
||||
)
|
||||
|
@ -1 +1 @@
|
||||
2082167031
|
||||
233234490
|
@ -5,6 +5,7 @@ module Urbit.Noun.Mug where
|
||||
import ClassyPrelude
|
||||
|
||||
import Data.Bits
|
||||
import Data.ByteString.Builder
|
||||
import Urbit.Atom
|
||||
|
||||
import Data.Hash.Murmur (murmur3)
|
||||
@ -13,14 +14,7 @@ type Mug = Word32
|
||||
|
||||
{-# INLINE mugBS #-}
|
||||
mugBS :: ByteString -> Word32
|
||||
mugBS = go 0xcafebabe
|
||||
where
|
||||
go seed buf =
|
||||
let haz = murmur3 seed buf
|
||||
ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
|
||||
in if ham == 0
|
||||
then go (seed + 1) buf
|
||||
else ham
|
||||
mugBS = mum 0xcafe_babe 0x7fff
|
||||
|
||||
-- XX is there a way to do this without copy?
|
||||
{-# INLINE mugAtom #-}
|
||||
@ -29,4 +23,16 @@ mugAtom = mugBS . atomBytes
|
||||
|
||||
{-# INLINE mugBoth #-}
|
||||
mugBoth :: Word32 -> Word32 -> Word32
|
||||
mugBoth m n = mugAtom $ fromIntegral $ m `xor` 0x7fff_ffff `xor` n
|
||||
mugBoth m n = mum 0xdead_beef 0xfffe
|
||||
$ toStrict $ toLazyByteString (word32LE m <> word32LE n)
|
||||
|
||||
mum :: Word32 -> Word32 -> ByteString -> Word32
|
||||
mum syd fal key = go syd 0
|
||||
where
|
||||
go syd 8 = fal
|
||||
go syd i =
|
||||
let haz = murmur3 syd key
|
||||
ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)
|
||||
in if ham /= 0
|
||||
then ham
|
||||
else go (syd + 1) (i + 1)
|
||||
|
@ -147,7 +147,9 @@ enumFromAtom :: [(String, Name)] -> Exp
|
||||
enumFromAtom cons = LamE [VarP x] body
|
||||
where
|
||||
(x, c) = (mkName "x", mkName "c")
|
||||
getTag = BindS (VarP c) $ AppE (VarE 'parseNounUtf8Atom) (VarE x)
|
||||
getTag = BindS (VarP c)
|
||||
$ AppE (AppE (VarE 'named) matchFail)
|
||||
$ AppE (VarE 'parseNounUtf8Atom) (VarE x)
|
||||
examine = NoBindS $ CaseE (VarE c) (matches ++ [fallback])
|
||||
matches = mkMatch <$> cons
|
||||
fallback = Match WildP (NormalB $ AppE (VarE 'fail) matchFail) []
|
||||
@ -194,6 +196,7 @@ taggedFromNoun cons = LamE [VarP n] (DoE [getHead, getTag, examine])
|
||||
$ AppE (VarE 'parseNoun) (VarE n)
|
||||
|
||||
getTag = BindS (SigP (VarP c) (ConT ''Text))
|
||||
$ AppE (AppE (VarE 'named) tagFail)
|
||||
$ AppE (VarE 'parseNounUtf8Atom) (VarE h)
|
||||
|
||||
examine = NoBindS
|
||||
@ -208,6 +211,8 @@ taggedFromNoun cons = LamE [VarP n] (DoE [getHead, getTag, examine])
|
||||
fallback = Match WildP (NormalB $ AppE (VarE 'fail) matchFail) []
|
||||
matchFail = unexpectedTag (fst <$> cons) (VarE c)
|
||||
|
||||
tagFail = LitE $ StringL (intercalate " " (('%':) <$> (fst <$> cons)))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
tagString :: Int -> Name -> String
|
||||
|
BIN
pkg/interface/package-lock.json
generated
BIN
pkg/interface/package-lock.json
generated
Binary file not shown.
@ -18,7 +18,7 @@
|
||||
"codemirror": "^5.59.2",
|
||||
"css-loader": "^3.6.0",
|
||||
"file-saver": "^2.0.5",
|
||||
"formik": "^2.2.6",
|
||||
"formik": "^2.1.5",
|
||||
"immer": "^8.0.1",
|
||||
"lodash": "^4.17.20",
|
||||
"markdown-to-jsx": "^6.11.4",
|
||||
|
@ -5,74 +5,50 @@ import { Contact, ContactEdit } from '~/types/contact-update';
|
||||
import { GroupPolicy, Resource } from '~/types/group-update';
|
||||
|
||||
export default class ContactsApi extends BaseApi<StoreState> {
|
||||
create(
|
||||
name: string,
|
||||
policy: Enc<GroupPolicy>,
|
||||
title: string,
|
||||
description: string
|
||||
) {
|
||||
return this.viewAction({
|
||||
create: {
|
||||
name,
|
||||
policy,
|
||||
title,
|
||||
description,
|
||||
},
|
||||
});
|
||||
add(ship: Patp, contact: any) {
|
||||
return this.storeAction({ add: { ship, contact } });
|
||||
}
|
||||
|
||||
share(recipient: Patp, path: Patp, ship: Patp, contact: Contact) {
|
||||
return this.viewAction({
|
||||
share: {
|
||||
recipient,
|
||||
path,
|
||||
ship,
|
||||
contact,
|
||||
},
|
||||
});
|
||||
remove(ship: Patp) {
|
||||
return this.storeAction({ remove: { ship } });
|
||||
}
|
||||
|
||||
remove(path: Path, ship: Patp) {
|
||||
return this.viewAction({ remove: { path, ship } });
|
||||
}
|
||||
|
||||
edit(path: Path, ship: Patp, editField: ContactEdit) {
|
||||
edit(ship: Patp, editField: ContactEdit) {
|
||||
/* editField can be...
|
||||
{nickname: ''}
|
||||
{email: ''}
|
||||
{phone: ''}
|
||||
{website: ''}
|
||||
{notes: ''}
|
||||
{color: 'fff'} // with no 0x prefix
|
||||
{avatar: null}
|
||||
{avatar: {url: ''}}
|
||||
{avatar: ''}
|
||||
{add-group: {ship, name}}
|
||||
{remove-group: {ship, name}}
|
||||
*/
|
||||
return this.hookAction({
|
||||
console.log(ship, editField);
|
||||
return this.storeAction({
|
||||
edit: {
|
||||
path,
|
||||
ship,
|
||||
'edit-field': editField,
|
||||
},
|
||||
});
|
||||
}
|
||||
|
||||
invite(resource: Resource, ship: Patp, text = '') {
|
||||
return this.viewAction({
|
||||
invite: { resource, ship, text },
|
||||
setPublic(setPublic: any) {
|
||||
return this.storeAction({
|
||||
'set-public': setPublic
|
||||
});
|
||||
}
|
||||
|
||||
join(resource: Resource) {
|
||||
return this.viewAction({
|
||||
join: resource,
|
||||
});
|
||||
private storeAction(action: any): Promise<any> {
|
||||
return this.action('contact-store', 'contact-update', action)
|
||||
}
|
||||
|
||||
private hookAction(data) {
|
||||
return this.action('contact-hook', 'contact-action', data);
|
||||
private viewAction(threadName: string, action: any) {
|
||||
return this.spider('contact-view-action', 'json', threadName, action);
|
||||
}
|
||||
|
||||
private viewAction(data) {
|
||||
return this.action('contact-view', 'json', data);
|
||||
private hookAction(ship: Patp, action: any): Promise<any> {
|
||||
return this.action('contact-push-hook', 'contact-update', action);
|
||||
}
|
||||
}
|
||||
|
@ -8,6 +8,7 @@ import {
|
||||
Tag,
|
||||
GroupPolicyDiff,
|
||||
} from '~/types/group-update';
|
||||
import {makeResource} from '../lib/group';
|
||||
|
||||
export default class GroupsApi extends BaseApi<StoreState> {
|
||||
remove(resource: Resource, ships: Patp[]) {
|
||||
@ -34,12 +35,52 @@ export default class GroupsApi extends BaseApi<StoreState> {
|
||||
return this.proxyAction({ changePolicy: { resource, diff } });
|
||||
}
|
||||
|
||||
join(ship: string, name: string) {
|
||||
const resource = makeResource(ship, name);
|
||||
|
||||
return this.viewAction({ join: { resource, ship }});
|
||||
}
|
||||
|
||||
create(name: string, policy: Enc<GroupPolicy>, title: string, description: string) {
|
||||
return this.viewThread('group-create', {
|
||||
create: {
|
||||
name,
|
||||
policy,
|
||||
title,
|
||||
description
|
||||
}
|
||||
});
|
||||
}
|
||||
|
||||
deleteGroup(ship: string, name: string) {
|
||||
const resource = makeResource(ship, name);
|
||||
|
||||
return this.viewThread('group-delete', {
|
||||
remove: resource
|
||||
});
|
||||
}
|
||||
|
||||
leaveGroup(ship: string, name: string) {
|
||||
const resource = makeResource(ship, name);
|
||||
return this.viewThread('group-leave', {
|
||||
leave: resource
|
||||
});
|
||||
}
|
||||
|
||||
private proxyAction(action: GroupAction) {
|
||||
return this.action('group-push-hook', 'group-update', action);
|
||||
}
|
||||
|
||||
private storeAction(action: GroupAction) {
|
||||
console.log(action);
|
||||
return this.action('group-store', 'group-update', action);
|
||||
}
|
||||
|
||||
private viewThread(thread: string, action: any) {
|
||||
return this.spider('group-view-action', 'json', thread, action);
|
||||
}
|
||||
|
||||
private viewAction(action: any) {
|
||||
return this.action('group-view', 'group-view-action', action);
|
||||
|
||||
}
|
||||
}
|
||||
|
@ -196,10 +196,11 @@ export class HarkApi extends BaseApi<StoreState> {
|
||||
});
|
||||
}
|
||||
|
||||
getMore() {
|
||||
async getMore(): Promise<boolean> {
|
||||
const offset = this.store.state['notifications']?.size || 0;
|
||||
const count = 3;
|
||||
return this.getSubset(offset, count, false);
|
||||
await this.getSubset(offset, count, false);
|
||||
return offset === (this.store.state.notifications?.size || 0);
|
||||
}
|
||||
|
||||
async getSubset(offset:number, count:number, isArchive: boolean) {
|
||||
|
@ -70,7 +70,7 @@ export default class MetadataApi extends BaseApi<StoreState> {
|
||||
done = true;
|
||||
tempChannel.delete();
|
||||
reject(new Error("offline"))
|
||||
}, 30000);
|
||||
}, 15000);
|
||||
|
||||
tempChannel.subscribe(window.ship, "metadata-pull-hook", `/preview${group}`,
|
||||
(err) => {
|
||||
|
@ -1,6 +1,7 @@
|
||||
import { cite } from '~/logic/lib/util';
|
||||
|
||||
const indexes = new Map([
|
||||
['ships', []],
|
||||
['commands', []],
|
||||
['subscriptions', []],
|
||||
['groups', []],
|
||||
@ -18,6 +19,14 @@ const result = function(title, link, app, host) {
|
||||
};
|
||||
};
|
||||
|
||||
const shipIndex = function(contacts) {
|
||||
const ships = [];
|
||||
Object.keys(contacts).map((e) => {
|
||||
return ships.push(result(e, `/~profile/${e}`, 'profile', contacts[e]?.status));
|
||||
});
|
||||
return ships;
|
||||
};
|
||||
|
||||
const commandIndex = function (currentGroup) {
|
||||
// commands are special cased for default suite
|
||||
const commands = [];
|
||||
@ -62,7 +71,8 @@ const otherIndex = function() {
|
||||
return other;
|
||||
};
|
||||
|
||||
export default function index(associations, apps, currentGroup, groups) {
|
||||
export default function index(contacts, associations, apps, currentGroup, groups) {
|
||||
indexes.set('ships', shipIndex(contacts));
|
||||
// all metadata from all apps is indexed
|
||||
// into subscriptions and landscape
|
||||
const subscriptions = [];
|
||||
@ -106,7 +116,7 @@ export default function index(associations, apps, currentGroup, groups) {
|
||||
title,
|
||||
`/~landscape${group}/join/${app}${each.resource}`,
|
||||
app.charAt(0).toUpperCase() + app.slice(1),
|
||||
(associations?.contacts?.[each.group]?.metadata?.title || null)
|
||||
(associations?.groups?.[each.group]?.metadata?.title || null)
|
||||
);
|
||||
subscriptions.push(obj);
|
||||
}
|
||||
|
51
pkg/interface/src/logic/lib/useLazyScroll.ts
Normal file
51
pkg/interface/src/logic/lib/useLazyScroll.ts
Normal file
@ -0,0 +1,51 @@
|
||||
import { useEffect, RefObject, useRef, useState } from "react";
|
||||
import _ from "lodash";
|
||||
|
||||
export function distanceToBottom(el: HTMLElement) {
|
||||
const { scrollTop, scrollHeight, clientHeight } = el;
|
||||
const scrolledPercent =
|
||||
(scrollHeight - scrollTop - clientHeight) / scrollHeight;
|
||||
return _.isNaN(scrolledPercent) ? 0 : scrolledPercent;
|
||||
}
|
||||
|
||||
export function useLazyScroll(
|
||||
ref: RefObject<HTMLElement>,
|
||||
margin: number,
|
||||
loadMore: () => Promise<boolean>
|
||||
) {
|
||||
const [isDone, setIsDone] = useState(false);
|
||||
useEffect(() => {
|
||||
if (!ref.current) {
|
||||
return;
|
||||
}
|
||||
setIsDone(false);
|
||||
const scroll = ref.current;
|
||||
const loadUntil = (el: HTMLElement) => {
|
||||
if (!isDone && distanceToBottom(el) < margin) {
|
||||
return loadMore().then((done) => {
|
||||
if (done) {
|
||||
setIsDone(true);
|
||||
return Promise.resolve();
|
||||
}
|
||||
return loadUntil(el);
|
||||
});
|
||||
}
|
||||
return Promise.resolve();
|
||||
};
|
||||
|
||||
loadUntil(scroll);
|
||||
|
||||
const onScroll = (e: Event) => {
|
||||
const el = e.currentTarget! as HTMLElement;
|
||||
loadUntil(el);
|
||||
};
|
||||
|
||||
ref.current.addEventListener("scroll", onScroll);
|
||||
|
||||
return () => {
|
||||
ref.current?.removeEventListener("scroll", onScroll);
|
||||
};
|
||||
}, [ref?.current]);
|
||||
|
||||
return isDone;
|
||||
}
|
@ -376,11 +376,19 @@ export function useShowNickname(contact: Contact | null, hide?: boolean): boolea
|
||||
return !!(contact && contact.nickname && !hideNicknames);
|
||||
}
|
||||
|
||||
export function useHovering() {
|
||||
interface useHoveringInterface {
|
||||
hovering: boolean;
|
||||
bind: {
|
||||
onMouseOver: () => void,
|
||||
onMouseLeave: () => void
|
||||
}
|
||||
}
|
||||
|
||||
export const useHovering = (): useHoveringInterface => {
|
||||
const [hovering, setHovering] = useState(false);
|
||||
const bind = {
|
||||
onMouseEnter: () => setHovering(true),
|
||||
onMouseOver: () => setHovering(true),
|
||||
onMouseLeave: () => setHovering(false)
|
||||
};
|
||||
return { hovering, bind };
|
||||
}
|
||||
};
|
||||
|
@ -8,7 +8,7 @@ export function getTitleFromWorkspace(
|
||||
case "home":
|
||||
return "DMs + Drafts";
|
||||
case "group":
|
||||
const association = associations.contacts[workspace.group];
|
||||
const association = associations.groups[workspace.group];
|
||||
return association?.metadata?.title || "";
|
||||
}
|
||||
}
|
||||
|
@ -5,74 +5,60 @@ import { ContactUpdate } from '~/types/contact-update';
|
||||
|
||||
type ContactState = Pick<StoreState, 'contacts'>;
|
||||
|
||||
export default class ContactReducer<S extends ContactState> {
|
||||
reduce(json: Cage, state: S) {
|
||||
const data = _.get(json, 'contact-update', false);
|
||||
if (data) {
|
||||
this.initial(data, state);
|
||||
this.create(data, state);
|
||||
this.delete(data, state);
|
||||
this.add(data, state);
|
||||
this.remove(data, state);
|
||||
this.edit(data, state);
|
||||
}
|
||||
export const ContactReducer = (json, state) => {
|
||||
const data = _.get(json, 'contact-update', false);
|
||||
if (data) {
|
||||
initial(data, state);
|
||||
add(data, state);
|
||||
remove(data, state);
|
||||
edit(data, state);
|
||||
setPublic(data, state);
|
||||
}
|
||||
};
|
||||
|
||||
initial(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'initial', false);
|
||||
if (data) {
|
||||
state.contacts = data;
|
||||
}
|
||||
const initial = (json: ContactUpdate, state: S) => {
|
||||
const data = _.get(json, 'initial', false);
|
||||
if (data) {
|
||||
state.contacts = data.rolodex;
|
||||
state.isContactPublic = data['is-public'];
|
||||
}
|
||||
};
|
||||
|
||||
create(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'create', false);
|
||||
if (data) {
|
||||
state.contacts[data.path] = {};
|
||||
}
|
||||
const add = (json: ContactUpdate, state: S) => {
|
||||
const data = _.get(json, 'add', false);
|
||||
if (data) {
|
||||
state.contacts[data.ship] = data.contact;
|
||||
}
|
||||
};
|
||||
|
||||
delete(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'delete', false);
|
||||
if (data) {
|
||||
delete state.contacts[data.path];
|
||||
}
|
||||
const remove = (json: ContactUpdate, state: S) => {
|
||||
const data = _.get(json, 'remove', false);
|
||||
if (
|
||||
data &&
|
||||
(data.ship in state.contacts)
|
||||
) {
|
||||
delete state.contacts[data.ship];
|
||||
}
|
||||
};
|
||||
|
||||
add(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'add', false);
|
||||
if (
|
||||
data &&
|
||||
(data.path in state.contacts)
|
||||
) {
|
||||
state.contacts[data.path][data.ship] = data.contact;
|
||||
const edit = (json: ContactUpdate, state: S) => {
|
||||
const data = _.get(json, 'edit', false);
|
||||
const ship = `~${data.ship}`;
|
||||
if (
|
||||
data &&
|
||||
(ship in state.contacts)
|
||||
) {
|
||||
const edit = Object.keys(data['edit-field']);
|
||||
if (edit.length !== 1) {
|
||||
return;
|
||||
}
|
||||
state.contacts[ship][edit[0]] = data['edit-field'][edit[0]];
|
||||
}
|
||||
};
|
||||
|
||||
const setPublic = (json: ContactUpdate, state: S) => {
|
||||
const data = _.get(json, 'set-public', state.isContactPublic);
|
||||
state.isContactPublic = data;
|
||||
};
|
||||
|
||||
remove(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'remove', false);
|
||||
if (
|
||||
data &&
|
||||
(data.path in state.contacts) &&
|
||||
(data.ship in state.contacts[data.path])
|
||||
) {
|
||||
delete state.contacts[data.path][data.ship];
|
||||
}
|
||||
}
|
||||
|
||||
edit(json: ContactUpdate, state: S) {
|
||||
const data = _.get(json, 'edit', false);
|
||||
if (
|
||||
data &&
|
||||
(data.path in state.contacts) &&
|
||||
(data.ship in state.contacts[data.path])
|
||||
) {
|
||||
const edit = Object.keys(data['edit-field']);
|
||||
if (edit.length !== 1) {
|
||||
return;
|
||||
}
|
||||
state.contacts[data.path][data.ship][edit[0]] =
|
||||
data['edit-field'][edit[0]];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
30
pkg/interface/src/logic/reducers/group-view.ts
Normal file
30
pkg/interface/src/logic/reducers/group-view.ts
Normal file
@ -0,0 +1,30 @@
|
||||
import { resourceAsPath } from "~/logic/lib/util";
|
||||
|
||||
|
||||
const initial = (json: any, state: any) => {
|
||||
const data = json.initial;
|
||||
if(data) {
|
||||
state.pendingJoin = data;
|
||||
}
|
||||
}
|
||||
|
||||
const progress = (json: any, state: any) => {
|
||||
const data = json.progress;
|
||||
if(data) {
|
||||
const { progress, resource } = data;
|
||||
state.pendingJoin = {...state.pendingJoin, [resource]: progress };
|
||||
if(progress === 'done') {
|
||||
setTimeout(() => {
|
||||
delete state.pendingJoin[resource];
|
||||
}, 10000);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
export const GroupViewReducer = (json: any, state: any) => {
|
||||
const data = json['group-view-update'];
|
||||
if(data) {
|
||||
progress(data, state);
|
||||
initial(data, state);
|
||||
}
|
||||
}
|
@ -16,6 +16,15 @@ export default class MetadataReducer<S extends MetadataState> {
|
||||
this.add(data, state);
|
||||
this.update(data, state);
|
||||
this.remove(data, state);
|
||||
this.groupInitial(data, state);
|
||||
}
|
||||
}
|
||||
|
||||
groupInitial(json: MetadataUpdate, state: S) {
|
||||
const data = _.get(json, 'initial-group', false);
|
||||
console.log(data);
|
||||
if(data) {
|
||||
this.associations(data, state);
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -40,7 +40,8 @@ const useLocalState = create<LocalState>(persist((set, get) => ({
|
||||
}
|
||||
})),
|
||||
set: fn => set(produce(fn))
|
||||
}), {
|
||||
}), {
|
||||
blacklist: ['suspendedFocus', 'toggleOmnibox', 'omniboxShown'],
|
||||
name: 'localReducer'
|
||||
}));
|
||||
|
||||
@ -55,4 +56,4 @@ function withLocalState<P, S extends keyof LocalState>(Component: any, stateMemb
|
||||
});
|
||||
}
|
||||
|
||||
export { useLocalState as default, withLocalState };
|
||||
export { useLocalState as default, withLocalState };
|
||||
|
@ -1,3 +1,5 @@
|
||||
import _ from 'lodash';
|
||||
|
||||
import BaseStore from './base';
|
||||
import InviteReducer from '../reducers/invite-update';
|
||||
import MetadataReducer from '../reducers/metadata-update';
|
||||
@ -6,29 +8,41 @@ import LocalReducer from '../reducers/local';
|
||||
import { StoreState } from './type';
|
||||
import { Timebox } from '~/types';
|
||||
import { Cage } from '~/types/cage';
|
||||
import ContactReducer from '../reducers/contact-update';
|
||||
import S3Reducer from '../reducers/s3-update';
|
||||
import { GraphReducer } from '../reducers/graph-update';
|
||||
import { HarkReducer } from '../reducers/hark-update';
|
||||
import { ContactReducer } from '../reducers/contact-update';
|
||||
import GroupReducer from '../reducers/group-update';
|
||||
import LaunchReducer from '../reducers/launch-update';
|
||||
import ConnectionReducer from '../reducers/connection';
|
||||
import SettingsReducer from '../reducers/settings-update';
|
||||
import {OrderedMap} from '../lib/OrderedMap';
|
||||
import { BigIntOrderedMap } from '../lib/BigIntOrderedMap';
|
||||
import {GroupViewReducer} from '../reducers/group-view';
|
||||
|
||||
|
||||
export default class GlobalStore extends BaseStore<StoreState> {
|
||||
inviteReducer = new InviteReducer();
|
||||
metadataReducer = new MetadataReducer();
|
||||
localReducer = new LocalReducer();
|
||||
contactReducer = new ContactReducer();
|
||||
s3Reducer = new S3Reducer();
|
||||
groupReducer = new GroupReducer();
|
||||
launchReducer = new LaunchReducer();
|
||||
connReducer = new ConnectionReducer();
|
||||
settingsReducer = new SettingsReducer();
|
||||
|
||||
pastActions: Record<string, any> = {}
|
||||
|
||||
constructor() {
|
||||
super();
|
||||
(window as any).debugStore = this.debugStore.bind(this);
|
||||
}
|
||||
|
||||
debugStore(tag: string, ...stateKeys: string[]) {
|
||||
console.log(this.pastActions[tag]);
|
||||
console.log(_.pick(this.state, stateKeys));
|
||||
}
|
||||
|
||||
rehydrate() {
|
||||
this.localReducer.rehydrate(this.state);
|
||||
}
|
||||
@ -43,7 +57,7 @@ export default class GlobalStore extends BaseStore<StoreState> {
|
||||
baseHash: null,
|
||||
invites: {},
|
||||
associations: {
|
||||
contacts: {},
|
||||
groups: {},
|
||||
graph: {},
|
||||
},
|
||||
groups: {},
|
||||
@ -64,6 +78,7 @@ export default class GlobalStore extends BaseStore<StoreState> {
|
||||
},
|
||||
credentials: null
|
||||
},
|
||||
isContactPublic: false,
|
||||
contacts: {},
|
||||
notifications: new BigIntOrderedMap<Timebox>(),
|
||||
archivedNotifications: new BigIntOrderedMap<Timebox>(),
|
||||
@ -79,21 +94,28 @@ export default class GlobalStore extends BaseStore<StoreState> {
|
||||
group: {}
|
||||
},
|
||||
notificationsCount: 0,
|
||||
settings: {}
|
||||
settings: {},
|
||||
pendingJoin: {},
|
||||
};
|
||||
}
|
||||
|
||||
reduce(data: Cage, state: StoreState) {
|
||||
// debug shim
|
||||
const tag = Object.keys(data)[0];
|
||||
const oldActions = this.pastActions[tag] || [];
|
||||
this.pastActions[tag] = [data[tag], ...oldActions.slice(0,14)];
|
||||
|
||||
this.inviteReducer.reduce(data, this.state);
|
||||
this.metadataReducer.reduce(data, this.state);
|
||||
this.localReducer.reduce(data, this.state);
|
||||
this.contactReducer.reduce(data, this.state);
|
||||
this.s3Reducer.reduce(data, this.state);
|
||||
this.groupReducer.reduce(data, this.state);
|
||||
this.launchReducer.reduce(data, this.state);
|
||||
this.connReducer.reduce(data, this.state);
|
||||
GraphReducer(data, this.state);
|
||||
HarkReducer(data, this.state);
|
||||
ContactReducer(data, this.state);
|
||||
this.settingsReducer.reduce(data, this.state);
|
||||
GroupViewReducer(data, this.state);
|
||||
}
|
||||
}
|
||||
|
@ -11,7 +11,8 @@ import {
|
||||
Notifications,
|
||||
NotificationGraphConfig,
|
||||
GroupNotificationsConfig,
|
||||
Unreads
|
||||
Unreads,
|
||||
JoinRequests
|
||||
} from "~/types";
|
||||
|
||||
export interface StoreState {
|
||||
@ -46,5 +47,5 @@ export interface StoreState {
|
||||
notificationsCount: number,
|
||||
unreads: Unreads;
|
||||
doNotDisturb: boolean;
|
||||
unreads: Unreads;
|
||||
pendingJoin: JoinRequests;
|
||||
}
|
||||
|
@ -10,7 +10,6 @@ import _ from 'lodash';
|
||||
type AppSubscription = [Path, string];
|
||||
|
||||
const groupSubscriptions: AppSubscription[] = [
|
||||
['/synced', 'contact-hook']
|
||||
];
|
||||
|
||||
const graphSubscriptions: AppSubscription[] = [
|
||||
@ -37,14 +36,15 @@ export default class GlobalSubscription extends BaseSubscription<StoreState> {
|
||||
this.subscribe('/groups', 'group-store');
|
||||
this.clearQueue();
|
||||
|
||||
|
||||
this.subscribe('/primary', 'contact-view');
|
||||
// TODO: update to get /updates
|
||||
this.subscribe('/all', 'contact-store');
|
||||
this.subscribe('/all', 's3-store');
|
||||
this.subscribe('/keys', 'graph-store');
|
||||
this.subscribe('/updates', 'hark-store');
|
||||
this.subscribe('/updates', 'hark-graph-hook');
|
||||
this.subscribe('/updates', 'hark-group-hook');
|
||||
this.subscribe('/all', 'settings-store');
|
||||
this.subscribe('/all', 'group-view');
|
||||
}
|
||||
|
||||
restart() {
|
||||
|
11
pkg/interface/src/types/group-view.ts
Normal file
11
pkg/interface/src/types/group-view.ts
Normal file
@ -0,0 +1,11 @@
|
||||
export const joinError = ['no-perms', 'strange'] as const;
|
||||
export type JoinError = typeof joinError[number];
|
||||
export const joinResult = ['done', ...joinError] as const;
|
||||
export type JoinResult = typeof joinResult[number];
|
||||
|
||||
export const joinProgress = ['start', 'added', ...joinResult] as const;
|
||||
export type JoinProgress = typeof joinProgress[number];
|
||||
|
||||
export interface JoinRequests {
|
||||
[rid: string]: JoinProgress;
|
||||
}
|
@ -1,10 +1,9 @@
|
||||
export * from './cage';
|
||||
export * from './chat-hook-update';
|
||||
export * from './chat-update';
|
||||
export * from './connection';
|
||||
export * from './contact-update';
|
||||
export * from './global';
|
||||
export * from './group-update';
|
||||
export * from './group-view';
|
||||
export * from './graph-update';
|
||||
export * from './hark-update';
|
||||
export * from './invite-update';
|
||||
|
@ -1,4 +1,5 @@
|
||||
import { Serial, PatpNoSig, Path } from './noun';
|
||||
import {Resource} from './group-update';
|
||||
|
||||
export type InviteUpdate =
|
||||
InviteUpdateInitial
|
||||
@ -60,8 +61,8 @@ export type AppInvites = {
|
||||
|
||||
export interface Invite {
|
||||
app: string;
|
||||
path: Path;
|
||||
recipeint: PatpNoSig;
|
||||
recipient: PatpNoSig;
|
||||
resource: Resource;
|
||||
ship: PatpNoSig;
|
||||
text: string;
|
||||
}
|
||||
|
@ -18,7 +18,7 @@ export type Serial = string;
|
||||
export type Jug<K,V> = Map<K,Set<V>>;
|
||||
|
||||
// name of app
|
||||
export type AppName = 'chat' | 'link' | 'contacts' | 'publish' | 'graph';
|
||||
export type AppName = 'contacts' | 'groups' | 'graph';
|
||||
|
||||
export function getTagFromFrond<O>(frond: O): keyof O {
|
||||
const tags = Object.keys(frond) as Array<keyof O>;
|
||||
|
@ -138,9 +138,7 @@ class App extends React.Component {
|
||||
|
||||
const notificationsCount = state.notificationsCount || 0;
|
||||
const doNotDisturb = state.doNotDisturb || false;
|
||||
|
||||
const showBanner = localStorage.getItem("2020BreachBanner") || "flex";
|
||||
let banner = null;
|
||||
const ourContact = this.state.contacts[`~${this.ship}`] || null;
|
||||
|
||||
return (
|
||||
<ThemeProvider theme={theme}>
|
||||
@ -156,6 +154,7 @@ class App extends React.Component {
|
||||
props={this.props}
|
||||
associations={associations}
|
||||
invites={this.state.invites}
|
||||
ourContact={ourContact}
|
||||
api={this.api}
|
||||
connection={this.state.connection}
|
||||
subscription={this.subscription}
|
||||
@ -169,6 +168,7 @@ class App extends React.Component {
|
||||
associations={state.associations}
|
||||
apps={state.launch}
|
||||
api={this.api}
|
||||
contacts={state.contacts}
|
||||
notifications={state.notificationsCount}
|
||||
invites={state.invites}
|
||||
groups={state.groups}
|
||||
|
@ -9,6 +9,7 @@ import { useFileDrag } from '~/logic/lib/useDrag';
|
||||
import ChatWindow from './components/ChatWindow';
|
||||
import ChatInput from './components/ChatInput';
|
||||
import GlobalApi from '~/logic/api/global';
|
||||
import { ShareProfile } from '~/views/apps/chat/components/ShareProfile';
|
||||
import SubmitDragger from '~/views/components/SubmitDragger';
|
||||
import { useLocalStorageState } from '~/logic/lib/useLocalStorageState';
|
||||
import { Loading } from '~/views/components/Loading';
|
||||
@ -25,7 +26,7 @@ export function ChatResource(props: ChatResourceProps) {
|
||||
const station = props.association.resource;
|
||||
const groupPath = props.association.group;
|
||||
const group = props.groups[groupPath];
|
||||
const contacts = props.contacts[groupPath] || {};
|
||||
const contacts = props.contacts;
|
||||
|
||||
const graph = props.graphs[station.slice(7)];
|
||||
|
||||
@ -34,7 +35,7 @@ export function ChatResource(props: ChatResourceProps) {
|
||||
const unreadCount = props.unreads.graph?.[station]?.['/']?.unreads || 0;
|
||||
|
||||
const [,, owner, name] = station.split('/');
|
||||
const ourContact = contacts?.[window.ship];
|
||||
const ourContact = contacts?.[`~${window.ship}`];
|
||||
|
||||
const chatInput = useRef<ChatInput>();
|
||||
|
||||
@ -88,6 +89,7 @@ export function ChatResource(props: ChatResourceProps) {
|
||||
|
||||
return (
|
||||
<Col {...bind} height="100%" overflow="hidden" position="relative">
|
||||
<ShareProfile our={ourContact} />
|
||||
{dragging && <SubmitDragger />}
|
||||
<ChatWindow
|
||||
mailboxSize={5}
|
||||
|
@ -4,7 +4,7 @@ import _ from "lodash";
|
||||
import { Box, Row, Text, Rule } from "@tlon/indigo-react";
|
||||
|
||||
import OverlaySigil from '~/views/components/OverlaySigil';
|
||||
import { uxToHex, cite, writeText, useShowNickname } from '~/logic/lib/util';
|
||||
import { uxToHex, cite, writeText, useShowNickname, useHovering } from '~/logic/lib/util';
|
||||
import { Group, Association, Contacts, Post } from "~/types";
|
||||
import TextContent from './content/text';
|
||||
import CodeContent from './content/code';
|
||||
@ -134,6 +134,7 @@ export default class ChatMessage extends Component<ChatMessageProps> {
|
||||
className={containerClass}
|
||||
style={style}
|
||||
mb={1}
|
||||
position="relative"
|
||||
>
|
||||
{dayBreak && !isLastRead ? <DayBreak when={msg['time-sent']} /> : null}
|
||||
{renderSigil
|
||||
@ -177,7 +178,7 @@ export const MessageWithSigil = (props) => {
|
||||
const dark = useLocalState(state => state.dark);
|
||||
|
||||
const datestamp = moment.unix(msg['time-sent'] / 1000).format(DATESTAMP_FORMAT);
|
||||
const contact = msg.author in contacts ? contacts[msg.author] : false;
|
||||
const contact = `~${msg.author}` in contacts ? contacts[`~${msg.author}`] : false;
|
||||
const showNickname = useShowNickname(contact);
|
||||
const name = showNickname ? contact.nickname : cite(msg.author);
|
||||
const color = contact ? `#${uxToHex(contact.color)}` : dark ? '#000000' :'#FFFFFF'
|
||||
@ -194,6 +195,8 @@ export const MessageWithSigil = (props) => {
|
||||
}
|
||||
};
|
||||
|
||||
const { hovering, bind } = useHovering();
|
||||
|
||||
return (
|
||||
<>
|
||||
<OverlaySigil
|
||||
@ -206,9 +209,11 @@ export const MessageWithSigil = (props) => {
|
||||
history={history}
|
||||
api={api}
|
||||
bg="white"
|
||||
className="fl pr3 v-top pt1"
|
||||
className="fl v-top pt1"
|
||||
pr={3}
|
||||
pl={2}
|
||||
/>
|
||||
<Box flexGrow={1} display='block' className="clamp-message">
|
||||
<Box flexGrow={1} display='block' className="clamp-message" {...bind}>
|
||||
<Box
|
||||
flexShrink={0}
|
||||
className="hide-child"
|
||||
@ -231,8 +236,15 @@ export const MessageWithSigil = (props) => {
|
||||
}}
|
||||
title={`~${msg.author}`}
|
||||
>{name}</Text>
|
||||
<Text flexShrink='0' fontSize='0' gray mono className="v-mid">{timestamp}</Text>
|
||||
<Text flexShrink={0} gray mono ml={2} className="v-mid child dn-s">{datestamp}</Text>
|
||||
<Text flexShrink={0} fontSize={0} gray mono>{timestamp}</Text>
|
||||
<Text
|
||||
flexShrink={0}
|
||||
fontSize={0}
|
||||
gray
|
||||
mono
|
||||
ml={2}
|
||||
display={['none', hovering ? 'block' : 'none']}
|
||||
>{datestamp}</Text>
|
||||
</Box>
|
||||
<ContentBox flexShrink={0} fontSize={fontSize ? fontSize : '14px'}>
|
||||
{msg.contents.map(c =>
|
||||
@ -257,20 +269,40 @@ const ContentBox = styled(Box)`
|
||||
|
||||
`;
|
||||
|
||||
export const MessageWithoutSigil = ({ timestamp, contacts, msg, measure, group }) => (
|
||||
<>
|
||||
<Text flexShrink={0} mono gray display='inline-block' pt='2px' lineHeight='tall' className="child" fontSize='0'>{timestamp}</Text>
|
||||
<ContentBox flexShrink={0} fontSize='14px' className="clamp-message" style={{ flexGrow: 1 }}>
|
||||
{msg.contents.map((c, i) => (
|
||||
<MessageContent
|
||||
key={i}
|
||||
contacts={contacts}
|
||||
content={c}
|
||||
group={group}
|
||||
measure={measure}/>))}
|
||||
</ContentBox>
|
||||
</>
|
||||
);
|
||||
export const MessageWithoutSigil = ({ timestamp, contacts, msg, measure, group }) => {
|
||||
const { hovering, bind } = useHovering();
|
||||
return (
|
||||
<>
|
||||
<Text
|
||||
flexShrink={0}
|
||||
mono
|
||||
gray
|
||||
display={hovering ? 'block': 'none'}
|
||||
pt='2px'
|
||||
lineHeight='tall'
|
||||
fontSize={0}
|
||||
position="absolute"
|
||||
left={1}
|
||||
>{timestamp}</Text>
|
||||
<ContentBox
|
||||
flexShrink={0}
|
||||
fontSize='14px'
|
||||
className="clamp-message"
|
||||
style={{ flexGrow: 1 }}
|
||||
{...bind}
|
||||
pl={6}
|
||||
>
|
||||
{msg.contents.map((c, i) => (
|
||||
<MessageContent
|
||||
key={i}
|
||||
contacts={contacts}
|
||||
content={c}
|
||||
group={group}
|
||||
measure={measure}/>))}
|
||||
</ContentBox>
|
||||
</>
|
||||
)
|
||||
};
|
||||
|
||||
export const MessageContent = ({ content, contacts, measure, fontSize, group }) => {
|
||||
if ('code' in content) {
|
||||
@ -292,7 +324,8 @@ export const MessageContent = ({ content, contacts, measure, fontSize, group })
|
||||
}}
|
||||
textProps={{style: {
|
||||
fontSize: 'inherit',
|
||||
textDecoration: 'underline'
|
||||
borderBottom: '1px solid',
|
||||
textDecoration: 'none'
|
||||
}}}
|
||||
/>
|
||||
</Box>
|
||||
|
30
pkg/interface/src/views/apps/chat/components/ShareProfile.js
Normal file
30
pkg/interface/src/views/apps/chat/components/ShareProfile.js
Normal file
@ -0,0 +1,30 @@
|
||||
import React from 'react';
|
||||
import { Box, Row, Text, BaseImage } from '@tlon/indigo-react';
|
||||
import { uxToHex } from '~/logic/lib/util';
|
||||
import { Sigil } from '~/logic/lib/sigil';
|
||||
|
||||
export const ShareProfile = (props) => {
|
||||
const image = (props?.our?.avatar)
|
||||
? <BaseImage src={props.our.avatar} width='24px' height='24px' borderRadius={2} style={{ objectFit: 'cover' }} />
|
||||
: <Row p={1} alignItems="center" borderRadius={2} backgroundColor={`#${uxToHex(props?.our?.color)}` || "#000000"}>
|
||||
<Sigil ship={window.ship} size={16} icon color={`#${uxToHex(props?.our?.color)}` || "#000000"} />
|
||||
</Row>;
|
||||
|
||||
return (
|
||||
<Row
|
||||
height="48px"
|
||||
alignItems="center"
|
||||
justifyContent="space-between"
|
||||
borderBottom={1}
|
||||
borderColor="washedGray"
|
||||
>
|
||||
<Row pl={3} alignItems="center">
|
||||
{image}
|
||||
<Text verticalAlign="middle" pl={2}>Share private profile?</Text>
|
||||
</Row>
|
||||
<Box pr={2}>
|
||||
<Text color="blue" bold cursor="pointer">Share</Text>
|
||||
</Box>
|
||||
</Row>
|
||||
);
|
||||
};
|
@ -53,6 +53,9 @@ const MessageMarkdown = React.memo(props => (
|
||||
{...props}
|
||||
unwrapDisallowed={true}
|
||||
renderers={renderers}
|
||||
// shim until we uncover why RemarkBreaks and
|
||||
// RemarkDisableTokenizers can't be loaded simultaneously
|
||||
disallowedTypes={['heading', 'list', 'listItem', 'link']}
|
||||
allowNode={(node, index, parent) => {
|
||||
if (
|
||||
node.type === 'blockquote'
|
||||
@ -67,11 +70,7 @@ const MessageMarkdown = React.memo(props => (
|
||||
|
||||
return true;
|
||||
}}
|
||||
plugins={[[
|
||||
RemarkBreaks,
|
||||
RemarkDisableTokenizers,
|
||||
{ block: DISABLED_BLOCK_TOKENS, inline: DISABLED_INLINE_TOKENS }
|
||||
]]} />
|
||||
plugins={[RemarkBreaks]} />
|
||||
));
|
||||
|
||||
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user