ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-11 08:55:23 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into arvo-errors

Browse Source 
* master: (484 commits)
  king: Slight CLI cleanup and fix test build.
  king: Add command-line flags to configure HTTP and HTTPS ports.
  groups: reduce metadata updates, removal
  chat: reducer handles metadata removal
  groups: exclude group metadata from channels list
  groups: set and surface group name metadata
  groups: remove dummy 'share' flow, 'default' group
  contacts: rename, migrate '~contacts' to '~groups'
  sh/release: rename vere release tarballs
  vere: patch version bump (v0.10.3 -> v0.10.4.rc1) [ci skip]
  pills: updated brass and solid
  chat: pull room contacts from associated group
  chat: spell 'permanent' correctly
  eyre: remove padding from 'access' input
  chat: only delete metadata for a chat if you created it
  chat: settings inputs add borders on focus
  vere: disables gc on |mass in the daemon process
  chat: remove console.log from metadataAction
  chat: style fixes during review, use metadata-hook
  chat: edit description, color settings
  ...
This commit is contained in:
Joe Bryan 2020-03-05 11:56:49 -08:00
commit 67cef638c4
380 changed files with 34642 additions and 9302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
.gitignore vendored
View File

@ -1,23 +1,46 @@
/out
/result
/result-*
/work
# nix symlink artifacts
#
result
result-*
# common dev piers
#
/zod
/bus
/fakezod*
tags
TAGS
/nec
/fakezod
# package manager caches
#
.stack-work
node_modules
# build and release artifacts
#
cross/
release/
.stack-work
dist
/out
/work
# landscape dev
#
urbitrc
*-min.js
pkg/interface/link-webext/web-ext-artifacts
# catchall editor and OS stuff
#
.tags
.etags
tags
TAGS
GPATH
GRTAGS
GTAGS
.DS_Store
*.swp
*.swo
\#*\#
s/*
**/.DS_Store
**/dist
**/node_modules
**/urbitrc
**/*.swp
**/*.swo
**/*-min.js
.stack-work
pkg/interface/link-webext/web-ext-artifacts

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:407a763f44eb91db0dd4a1ec2dbd12ed4332b48decefd3999c4313844daa2c0b
size 7226043
oid sha256:e54f9743a829b48db52afabe1cd0257d4afd3206621ec292f8142f3fb74d3634
size 10450375

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:f900509c3277b9eb194299605ce588f25dea6f92622748ced15554b7bb5914ce
size 1214375
oid sha256:8c02ad7601a4e4355cabdbf02bdcc384d3f76f50f9349979a14612c3d4b57b8f
size 1231420

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:2793797ffc7f96351aec19ab03f523792bbb856ff92cfd3abea0957b7821395f
size 9657917
oid sha256:a9f2d9c7352f07c0930b285a20622b42f193208055b21bd6ee913549d41b4178
size 12887758

15
nix/pkgs/urbit/builder.sh
View File

@ -1,15 +0,0 @@
source $stdenv/setup
cp -r $src ./src
chmod -R u+w ./src
cd src
bash ./configure
make clean
make all -j8
make test
mkdir -p $out/bin
cp ./build/urbit $out/bin/$exename
cp ./build/urbit-worker $out/bin/$exename-worker

14
nix/pkgs/urbit/default.nix
View File

@ -27,9 +27,21 @@ let
inherit name meta;
exename = name;
src = ../../../pkg/urbit;
builder = ./builder.sh;
nativeBuildInputs = deps ++ vendor;
configurePhase = ''
bash ./configure
'';
installPhase = ''
make all -j8
make test
mkdir -p $out/bin
cp ./build/urbit $out/bin/$exename
cp ./build/urbit-worker $out/bin/$exename-worker
'';
# See https://github.com/NixOS/nixpkgs/issues/18995
hardeningDisable = if debug then [ "all" ] else [];

131
pkg/arvo/app/chat-cli.hoon
View File

@ -37,6 +37,9 @@
+$ glyph char
++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?"
::
::NOTE only the "simple" modes from rw-security
+$ nu-security ?(%channel %village)
::
+$ command
$% [%target (set target)] :: set messaging target
[%say letter] :: send message
@ -44,10 +47,10 @@
::
::
:: create chat
[%create rw-security path (unit glyph) (unit ?)]
::[%create nu-security path (unit glyph) (unit ?)]
[%delete path] :: delete chat
[%invite ?(%r %w %rw) path (set ship)] :: allow
[%banish ?(%r %w %rw) path (set ship)] :: disallow
[%invite path (set ship)] :: allow
[%banish path (set ship)] :: disallow
::
[%join target (unit glyph) (unit ?)] :: join target
[%leave target] :: nuke target
@ -237,7 +240,7 @@
|= [=wire upd=chat-update]
^- (quip card state)
?+ -.upd [~ all-state]
%create (notice-create +.upd)
%create (notice-create (path-to-target path.upd))
%delete [[(show-delete:sh-out (path-to-target path.upd)) ~] all-state]
%message (read-envelope (path-to-target path.upd) envelope.upd)
%messages (read-envelopes (path-to-target path.upd) envelopes.upd)
@ -365,10 +368,10 @@
[%join leaf+";join ~ship/chat-name (glyph)"]
[%leave leaf+";leave ~ship/chat-name"]
::
[%create leaf+";create [type] /chat-name (glyph)"]
::[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite [rw | r | w] /chat-name ~ships"]
[%banish leaf+";banish [rw | r | w] /chat-name ~ships"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
::
[%bind leaf+";bind [glyph] ~ship/chat-name"]
[%unbind leaf+";unbind [glyph]"]
@ -474,18 +477,18 @@
;~ pose
(stag %target tars)
::
;~ (glue ace)
(tag %create)
security
;~ plug
path
(punt ;~(pfix ace glyph))
(punt ;~(pfix ace (fuss 'y' 'n')))
==
==
;~((glue ace) (tag %delete) path)
;~((glue ace) (tag %invite) rw path ships)
;~((glue ace) (tag %banish) rw path ships)
:: ;~ (glue ace)
:: (tag %create)
:: security
:: ;~ plug
:: path
:: (punt ;~(pfix ace glyph))
:: (punt ;~(pfix ace (fuss 'y' 'n')))
:: ==
:: ==
:: ;~((glue ace) (tag %delete) path)
:: ;~((glue ace) (tag %invite) path ships)
:: ;~((glue ace) (tag %banish) path ships)
::
;~ (glue ace)
(tag %join)
@ -583,11 +586,7 @@
:: +security: security mode
::
++ security
(perk %channel %village %journal %mailbox ~)
:: +rw: read, write, or read-write
::
++ rw
(perk %rw %r %w ~)
(perk %channel %village ~)
::
:: +glyph: shorthand character
::
@ -684,7 +683,7 @@
%say (say +.job)
%eval (eval +.job)
::
%create (create +.job)
:: %create (create +.job)
%delete (delete +.job)
%invite (change-permission & +.job)
%banish (change-permission | +.job)
@ -751,36 +750,30 @@
[[prompt:sh-out ~] all-state]
:: +create: new local mailbox
::
++ create
|= [security=rw-security =path gyf=(unit char) allow-history=(unit ?)]
^- (quip card state)
::TODO check if already exists
=/ =target [our-self path]
=. audience [target ~ ~]
=^ moz all-state
?. ?=(^ gyf) [~ all-state]
(bind-glyph u.gyf target)
=- [[- moz] all-state]
%^ act %do-create %chat-view
:- %chat-view-action
!>
:* %create
path
security
:: ensure we can read from/write to our own chats
::
:: read
?- security
?(%channel %journal) ~
?(%village %mailbox) [our-self ~ ~]
==
:: write
?- security
?(%channel %mailbox) ~
?(%village %journal) [our-self ~ ~]
==
(fall allow-history %.y)
==
::++ create
:: |= [security=nu-security =path gyf=(unit char) allow-history=(unit ?)]
:: ^- (quip card state)
:: ::TODO check if already exists
:: =/ =target [our-self path]
:: =. audience [target ~ ~]
:: =^ moz all-state
:: ?. ?=(^ gyf) [~ all-state]
:: (bind-glyph u.gyf target)
:: =- [[- moz] all-state]
:: %^ act %do-create %chat-view
:: :- %chat-view-action
:: !> ^- chat-view-action
:: :* %create
:: path
:: security
:: :: ensure we can read from/write to our own chats
:: ::
:: ?- security
:: %channel ~
:: %village [our-self ~ ~]
:: ==
:: (fall allow-history %.y)
:: ==
:: +delete: delete local chats
::
++ delete
@ -789,30 +782,20 @@
=- [[- ~] all-state]
%^ act %do-delete %chat-view
:- %chat-view-action
!>
!> ^- chat-view-action
[%delete (target-to-path our-self path)]
:: +change-permission: modify permissions on a local chat
::
++ change-permission
|= [allow=? rw=?(%r %w %rw) =path ships=(set ship)]
|= [allow=? =path ships=(set ship)]
^- (quip card state)
:_ all-state
=; cards=(list card)
?. allow cards
%+ weld cards
=; card=(unit card)
%+ weld (drop card)
?. allow ~
%+ turn ~(tap in ships)
(cury invite-card path)
%+ murn
^- (list term)
?- rw
%r [%read ~]
%w [%write ~]
%rw [%read %write ~]
==
|= =term
^- (unit card)
=. path
=- (snoc `^path`- term)
[%chat (target-to-path our-self path)]
:: whitelist: empty if no matching permission, else true if whitelist
::
@ -834,7 +817,7 @@
%- some
%^ act %do-permission %group-store
:- %group-action
!>
!> ^- group-action
?: =(u.whitelist allow)
[%add ships path]
[%remove ships path]
@ -853,7 +836,7 @@
:: gives ugly %chat-hook-reap
%^ act %do-join %chat-view
:- %chat-view-action
!>
!> ^- chat-view-action
[%join ship.target path.target (fall ask-history %.y)]
:: +leave: unsync & destroy mailbox
::
@ -866,7 +849,7 @@
"can't ;leave local chats, maybe use ;delete instead"
%^ act %do-leave %chat-hook
:- %chat-hook-action
!>
!> ^- chat-hook-action
[%remove (target-to-path target)]
:: +say: send messages
::
@ -881,7 +864,7 @@
|= =target
%^ act %out-message %chat-hook
:- %chat-action
!>
!> ^- chat-action
:+ %message (target-to-path target)
[serial *@ our-self now.bowl letter]
:: +eval: run hoon, send code and result as message

439
pkg/arvo/app/chat-hook.hoon
View File

@ -2,18 +2,21 @@
:: mirror chat data from foreign to local based on read permissions
:: allow sending chat messages to foreign paths based on write perms
::
/- *permission-store, *chat-hook, *invite-store
/+ *chat-json, default-agent, verb, dbug
/- *permission-store, *chat-hook, *invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook ::TMP for upgrade
/+ *chat-json, *chat-eval, default-agent, verb, dbug
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
$% state-0
state-1
==
::
+$ state-zero
$: %0
synced=(map path ship)
+$ state-1 [%1 state-base]
+$ state-0 [%0 state-base]
+$ state-base
$: synced=(map path ship)
invite-created=_|
allow-history=(map path ?)
==
@ -29,11 +32,11 @@
$% [%chat-update chat-update]
==
--
=| state-zero
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ bol=bowl:gall
@ -51,8 +54,154 @@
==
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
|= =old=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
[~ this(state old)]
:: path structure ugprade logic
::
:_ this(state [%1 +.old])
%- zing
%+ turn
%~ tap in
%^ scry:cc (set path)
%chat-store
/keys
|^ |= chat=path
^- (list card)
=/ host=ship (slav %p (snag 0 chat))
=/ newp=permission (unify-permissions chat)
=/ old-group=path [%chat chat]
=/ new-group=path [%'~' chat]
;: weld
:~ (delete-group host (snoc old-group %read))
(delete-group host (snoc old-group %write))
==
::
(create-group new-group who.newp)
(hookup-group new-group kind.newp)
[(record-group new-group chat)]~
::
?. &(=(our.bol host) ?=(%white kind.newp)) ~
(send-invites chat who.newp)
==
::
++ unify-permissions
|= chat=path
^- permission
=/ read=(unit permission) (get-permission chat %read)
=/ write=(unit permission) (get-permission chat %write)
?. &(?=(^ read) ?=(^ write))
~& [%missing-permission chat read=?=(~ read) write=?=(~ write)]
[%white [(slav %p (snag 0 chat)) ~ ~]]
?+ [kind.u.read kind.u.write] !!
:: village: exclusive to writers
::
[%white %white] [%white who.u.write]
::
:: channel: merge blacklists
::
[%black %black] [%black (~(uni in who.u.read) who.u.write)]
::
:: journal: exclusive to writers
::
[%black %white] [%white who.u.write]
::
:: mailbox: exclusive to readers
::
[%white %black] [%white who.u.read]
==
::
++ get-permission
|= [chat=path what=?(%read %write)]
%^ scry:cc (unit permission)
%permission-store
[%permission %chat (snoc chat what)]
::
++ make-poke
|= [app=term =mark =vase]
^- card
[%pass /on-load/[app]/[mark] %agent [our.bol app] %poke mark vase]
::
++ delete-group
|= [host=ship group=path]
^- card
:: if we host the group, delete it directly
::
?: =(our.bol host)
%^ make-poke %group-store
%group-action
!> ^- group-action
[%unbundle group]
:: else, just delete the sync in the hook
::
%^ make-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action
[%remove group]
::
++ create-group
|= [group=path who=(set ship)]
^- (list card)
:~ %^ make-poke %group-store
%group-action
!> ^- group-action
[%bundle group]
::
%^ make-poke %group-store
%group-action
!> ^- group-action
[%add who group]
==
::
++ hookup-group
|= [group=path =kind]
^- (list card)
:* %^ make-poke %permission-group-hook
%permission-group-hook-action
!> ^- permission-group-hook-action
[%associate group [group^kind ~ ~]]
::
=/ =ship (slav %p (snag 1 group))
?. =(our.bol ship) ~
:_ ~
%^ make-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action
[%add-owned group group]
==
::
++ record-group
|= [group=path chat=path]
^- card
=/ =metadata
~| [%weird-chat-path chat]
%* . *metadata
title (snag 1 chat)
date-created now.bol
creator (slav %p (snag 0 chat))
==
%^ make-poke %metadata-store
%metadata-action
!> ^- metadata-action
[%add group [%chat chat] metadata]
::
++ send-invites
|= [chat=path who=(set ship)]
^- (list card)
%+ murn ~(tap in who)
|= =ship
^- (unit card)
?: =(our.bol ship) ~
%- some
%^ make-poke %invite-hook
%invite-action
!> ^- invite-action
=/ =invite
=+ (crip "upgrade {(spud chat)} (please accept in OS1)")
[our.bol %chat-hook chat ship -]
[%invite /chat (sham chat ship eny.bol) invite]
--
::
++ on-poke
|= [=mark =vase]
@ -129,6 +278,10 @@
?: (team:title our.bol src.bol)
?. (~(has by synced) path.act)
~
=* letter letter.envelope.act
=? letter &(?=(%code -.letter) ?=(~ output.letter))
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
=/ ship (~(got by synced) path.act)
=/ appl ?:(=(ship our.bol) %chat-store %chat-hook)
[%pass / %agent [ship appl] %poke %chat-action !>(act)]~
@ -138,8 +291,8 @@
~
?. =(u.ship our.bol)
~
:: scry permissions to check if write is permitted
?. (permitted-scry [(scot %p src.bol) %chat (weld path.act /write)])
:: check if write is permitted
?. (is-permitted src.bol path.act)
~
=: author.envelope.act src.bol
when.envelope.act now.bol
@ -161,19 +314,18 @@
:_ state
%+ weld
[%pass chat-path %agent [our.bol %chat-store] %watch chat-path]~
(create-permission [%chat path.act] security.act)
(create-permission path.act security.act)
::
%add-synced
?> (team:title our.bol src.bol)
?: (~(has by synced) [(scot %p ship.act) path.act])
[~ state]
=. synced (~(put by synced) [(scot %p ship.act) path.act] ship.act)
?: (~(has by synced) path.act) [~ state]
=. synced (~(put by synced) path.act ship.act)
?. ask-history.act
=/ chat-path [%mailbox (scot %p ship.act) path.act]
=/ chat-path [%mailbox path.act]
:_ state
[%pass chat-path %agent [ship.act %chat-hook] %watch chat-path]~
:: TODO: only ask for backlog from previous point
=/ chat-history [%backlog (scot %p ship.act) (weld path.act /0)]
=/ chat-history [%backlog (weld path.act /0)]
:_ state
[%pass chat-history %agent [ship.act %chat-hook] %watch chat-history]~
::
@ -187,7 +339,7 @@
%- zing
:~ (pull-wire [%backlog (weld path.act /0)])
(pull-wire [%mailbox path.act])
(delete-permission [%chat path.act])
~[(permission-poke [%delete [%chat path.act]])]
[%give %kick [%mailbox path.act]~ ~]~
==
?. |(=(u.ship src.bol) (team:title our.bol src.bol))
@ -203,11 +355,11 @@
^- (list card)
?> ?=(^ pax)
?> (~(has by synced) pax)
:: scry permissions to check if read is permitted
?> (permitted-scry [(scot %p src.bol) %chat (weld pax /read)])
:: check if read is permitted
?> (is-permitted src.bol pax)
=/ box (chat-scry pax)
?~ box !!
[%give %fact ~ %chat-update !>([%create (slav %p i.pax) pax])]~
[%give %fact ~ %chat-update !>([%create pax])]~
::
++ watch-backlog
|= pax=path
@ -221,17 +373,13 @@
=/ pas `path`(oust [last 1] `(list @ta)`pax)
?> ?=([* ^] pas)
?> (~(has by synced) pas)
:: scry permissions to check if read is permitted
?> (permitted-scry [(scot %p src.bol) %chat (weld pas /read)])
=/ box (chat-scry pas)
?~ box !!
:- [%give %fact ~ %chat-update !>([%create (slav %p i.pas) pas])]
:: check if read is permitted
?> (is-permitted src.bol pas)
%- zing
:~
?: ?&(?=(^ backlog-start) (~(got by allow-history) pas))
(paginate-messages pas u.box u.backlog-start)
~
[%give %kick [%backlog pax]~ `src.bol]~
:~ [%give %fact ~ %chat-update !>([%create pas])]~
?. ?&(?=(^ backlog-start) (~(has by allow-history) pas)) ~
(paginate-messages pas (need (chat-scry pas)) u.backlog-start)
[%give %kick [%backlog pax]~ `src.bol]~
==
::
++ paginate-messages
@ -265,46 +413,55 @@
++ fact-invite-update
|= [wir=wire fact=invite-update]
^- (quip card _state)
?+ -.fact
[~ state]
:_ state
?+ -.fact ~
::
%accepted
=/ ask-history
?~ (chat-scry [(scot %p ship.invite.fact) path.invite.fact])
%.y
%.n
:_ state
[(chat-view-poke [%join ship.invite.fact path.invite.fact ask-history])]~
==
=/ ask-history ?~((chat-scry path.invite.fact) %.y %.n)
=* shp ship.invite.fact
=* app-path path.invite.fact
~[(chat-view-poke [%join shp app-path ask-history])]
==
::
++ fact-permission-update
|= [wir=wire fact=permission-update]
^- (quip card _state)
|^
:_ state
?- -.fact
%create ~
%delete ~
?+ -.fact ~
%add (handle-permissions [%add path.fact who.fact])
%remove (handle-permissions [%remove path.fact who.fact])
==
::
++ handle-permissions
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (list card)
?> ?=([* *] pax)
?. =(%chat i.pax) ~
:: check path to see if this is a %read permission
?. =(%read (snag (dec (lent pax)) `(list @t)`pax))
~
%- zing
%+ turn ~(tap in who)
|= =ship
?: (permitted-scry [(scot %p ship) pax])
~
:: if ship is not permitted, kick their subscription
=/ mail-path
(oust [(dec (lent t.pax)) (lent t.pax)] `(list @t)`t.pax)
[%give %kick [%mailbox mail-path]~ `ship]~
::
++ handle-permissions
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (list card)
%- zing
%+ turn
(chats-of-group pax)
|= chat=path
^- (list card)
=/ owner (~(get by synced) chat)
?~ owner ~
?. =(u.owner our.bol) ~
%- zing
%+ turn ~(tap in who)
|= =ship
?: (is-permitted ship chat)
?: ?|(=(kind %remove) =(ship our.bol)) ~
:: if ship has just been added to the permitted group,
:: send them an invite
~[(send-invite chat ship)]
:: if ship is not permitted, kick their subscription
[%give %kick [%mailbox chat]~ `ship]~
::
++ send-invite
|= [=path =ship]
^- card
=/ =invite [our.bol %chat-hook path ship '']
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
--
::
++ fact-chat-update
|= [wir=wire fact=chat-update]
@ -316,11 +473,7 @@
++ handle-local
|= fact=chat-update
^- (quip card _state)
?- -.fact
%keys [~ state]
%read [~ state]
%config [~ state]
%create [~ state]
?+ -.fact [~ state]
%delete
?. (~(has by synced) path.fact)
[~ state]
@ -339,17 +492,14 @@
++ handle-foreign
|= fact=chat-update
^- (quip card _state)
?- -.fact
%keys [~ state]
%read [~ state]
%config [~ state]
?+ -.fact [~ state]
%create
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%create ship.fact t.path.fact])]~
[(chat-poke [%create path.fact])]~
::
%delete
?> ?=([* ^] path.fact)
@ -386,7 +536,8 @@
:_ state
[%pass /permissions %agent [our.bol %permission-store] %watch /updates]~
::
?: ?=([%mailbox @ *] wir)
?+ wir !!
[%mailbox @ *]
~& mailbox-kick+wir
?. (~(has by synced) t.wir)
:: no-op
@ -396,20 +547,21 @@
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ chat-history
%+ welp backlog+t.wir
?~ mailbox
/0
/(scot %ud (lent envelopes.u.mailbox))
?~(mailbox /0 /(scot %ud (lent envelopes.u.mailbox)))
:_ state
[%pass chat-history %agent [ship %chat-hook] %watch chat-history]~
::
?: ?=([%backlog @ *] wir)
[%backlog @ @ *]
=/ pax `path`(oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
?. (~(has by synced) pax) [~ state]
=/ mailbox=(unit mailbox) (chat-scry pax)
=. pax ?~(mailbox wir [%mailbox pax])
=/ =ship
?: =('~' i.t.wir)
(slav %p i.t.t.wir)
(slav %p i.t.wir)
=. pax ?~((chat-scry pax) wir [%mailbox pax])
:_ state
[%pass pax %agent [(slav %p i.t.wir) %chat-hook] %watch pax]~
!!
[%pass pax %agent [ship %chat-hook] %watch pax]~
==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
@ -453,37 +605,9 @@
++ create-permission
|= [pax=path sec=rw-security]
^- (list card)
=/ read-perm (weld pax /read)
=/ write-perm (weld pax /write)
?- sec
%channel
:~ (permission-poke (sec-to-perm read-perm %black))
(permission-poke (sec-to-perm write-perm %black))
==
::
%village
:~ (permission-poke (sec-to-perm read-perm %white))
(permission-poke (sec-to-perm write-perm %white))
==
::
%journal
:~ (permission-poke (sec-to-perm read-perm %black))
(permission-poke (sec-to-perm write-perm %white))
==
::
%mailbox
:~ (permission-poke (sec-to-perm read-perm %white))
(permission-poke (sec-to-perm write-perm %black))
==
==
::
++ delete-permission
|= pax=path
^- (list card)
=/ read-perm (weld pax /read)
=/ write-perm (weld pax /write)
:~ (permission-poke [%delete read-perm])
(permission-poke [%delete write-perm])
?+ sec ~
%channel ~[(permission-poke (sec-to-perm pax %black))]
%village ~[(permission-poke (sec-to-perm pax %white))]
==
::
++ sec-to-perm
@ -494,19 +618,96 @@
++ chat-scry
|= pax=path
^- (unit mailbox)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
%^ scry (unit mailbox)
%chat-store
[%mailbox pax]
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax /=invite-store/(scot %da now.bol)/invite/chat/(scot %uv uid)/noun
.^((unit invite) %gx pax)
%^ scry (unit invite)
%invite-store
/invite/chat/(scot %uv uid)
::
++ permitted-scry
|= pax=path
++ chats-of-group
|= =group-path
^- (list path)
:: if metadata-store isn't running yet, we're still in the upgrade ota phase.
:: we can't get chats from the metadata-store, but can make assumptions
:: about group path shape, and the chat that would match it.
::TODO remove me at some point.
::
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~)
?: ?=([%'~' @ ^] group-path)
~& [%assuming-ported-legacy-group group-path]
[t.group-path]~
~& [%weird-group group-path]
~
%+ murn
^- (list resource)
=; resources
%~ tap in
%+ ~(gut by resources)
group-path
*(set resource)
.^ (jug path resource)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/group-indices
==
|= resource
^- (unit path)
?. =(%chat app-name) ~
`app-path
::
++ groups-of-chat
|= chat=path
^- (list group-path)
:: if metadata-store isn't running yet, we're still in the upgrade ota phase.
:: we can't get groups from the metadata-store, but can make assumptions
:: about chat path shape, and the chat that would match it.
::TODO remove me at some point.
::
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~)
?: ?=([@ ^] chat)
~& [%assuming-ported-legacy-chat chat]
[%'~' chat]~
~& [%weird-chat chat]
~
=; resources
%~ tap in
%+ ~(gut by resources)
[%chat chat]
*(set group-path)
.^ (jug resource group-path)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/resource-indices
==
::
::NOTE this assumes permission paths match group paths
++ is-permitted
|= [who=ship chat=path]
^- ?
.^(? %gx ;:(weld /=permission-store/(scot %da now.bol)/permitted pax /noun))
%+ lien (groups-of-chat chat)
|= =group-path
%^ scry ?
%permission-store
[%permitted (scot %p who) group-path]
::
++ scry
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
::
++ pull-wire
|= pax=path

19
pkg/arvo/app/chat-store.hoon
View File

@ -62,8 +62,7 @@
[%updates ~] ~
[%mailbox @ *]
?> (~(has by inbox) t.path)
=/ =ship (slav %p i.t.path)
(give %chat-update !>([%create ship t.t.path]))
(give %chat-update !>([%create t.path]))
==
[cards this]
::
@ -153,20 +152,24 @@
?- -.action
%create (handle-create action)
%delete (handle-delete action)
%message (handle-message action)
%messages (handle-messages action)
%read (handle-read action)
%messages (handle-messages action)
%message
?. =(our.bol author.envelope.action)
(handle-message action)
=^ message-moves state (handle-message action)
=^ read-moves state (handle-read [%read path.action])
[(weld message-moves read-moves) state]
==
::
++ handle-create
|= act=chat-action
^- (quip card _state)
?> ?=(%create -.act)
=/ pax [(scot %p ship.act) path.act]
?: (~(has by inbox) pax)
?: (~(has by inbox) path.act)
[~ state]
:- (send-diff pax act)
state(inbox (~(put by inbox) pax *mailbox))
:- (send-diff path.act act)
state(inbox (~(put by inbox) path.act *mailbox))
::
++ handle-delete
|= act=chat-action

255
pkg/arvo/app/chat-view.hoon
View File

@ -4,8 +4,11 @@
/- *permission-store,
*permission-hook,
*group-store,
*invite-store,
*metadata-store,
*permission-group-hook,
*chat-hook
*chat-hook,
*metadata-hook
/+ *server, *chat-json, default-agent, verb, dbug
/= index
/^ octs
@ -51,8 +54,8 @@
[%permission-group-hook-action permission-group-hook-action]
==
--
%- agent:dbug
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ bol=bowl:gall
@ -188,53 +191,205 @@
++ poke-json
|= jon=json
^- (list card)
?. =(src.bol our.bol)
~
?> (team:title our.bol src.bol)
(poke-chat-view-action (json-to-view-action jon))
::
++ poke-chat-view-action
|= act=chat-view-action
^- (list card)
?. =(src.bol our.bol)
~
|^
?> (team:title our.bol src.bol)
?- -.act
%create
=/ pax [(scot %p our.bol) path.act]
=/ group-read=path [%chat (weld pax /read)]
=/ group-write=path [%chat (weld pax /write)]
?> ?=(^ app-path.act)
?> |(=(group-path.act app-path.act) =(~(tap in members.act) ~))
?^ (chat-scry app-path.act)
~& %chat-already-exists
~
%- zing
:~ :~ (group-poke [%bundle group-read])
(group-poke [%bundle group-write])
(group-poke [%add read.act group-read])
(group-poke [%add write.act group-write])
(chat-poke [%create our.bol path.act])
(chat-hook-poke [%add-owned pax security.act allow-history.act])
==
(create-security [%chat pax] security.act)
:~ (permission-hook-poke [%add-owned group-read group-read])
(permission-hook-poke [%add-owned group-write group-read])
:~ (create-chat app-path.act security.act allow-history.act)
%- create-group
:* group-path.act
app-path.act
security.act
members.act
title.act
description.act
==
(create-metadata title.act description.act group-path.act app-path.act)
==
::
%delete
=/ group-read [%chat (weld path.act /read)]
=/ group-write [%chat (weld path.act /write)]
:~ (chat-hook-poke [%remove path.act])
(permission-hook-poke [%remove group-read])
(permission-hook-poke [%remove group-write])
(group-poke [%unbundle group-read])
(group-poke [%unbundle group-write])
(chat-poke [%delete path.act])
=/ group-path (group-from-chat app-path.act)
?> ?=(^ app-path.act)
%- zing
:~ :~ (chat-hook-poke [%remove app-path.act])
(chat-poke [%delete app-path.act])
==
::
?. (is-creator group-path %chat app-path.act) ~
[(metadata-poke [%remove group-path [%chat app-path.act]])]~
::
?: (is-managed group-path) ~
:~ (group-poke [%unbundle group-path])
(metadata-hook-poke [%remove group-path])
(metadata-store-poke [%remove group-path [%chat app-path.act]])
==
==
::
%join
=/ group-read [%chat (scot %p ship.act) (weld path.act /read)]
=/ group-write [%chat (scot %p ship.act) (weld path.act /write)]
:~ (chat-hook-poke [%add-synced ship.act path.act ask-history.act])
(permission-hook-poke [%add-synced ship.act group-write])
(permission-hook-poke [%add-synced ship.act group-read])
=/ group-path
?. (is-managed app-path.act) app-path.act
(group-from-chat app-path.act)
:~ (chat-hook-poke [%add-synced ship.act app-path.act ask-history.act])
(permission-hook-poke [%add-synced ship.act group-path])
(metadata-hook-poke [%add-synced ship.act group-path])
==
==
::
++ create-chat
|= [=path security=rw-security history=?]
^- (list card)
:~ (chat-poke [%create path])
(chat-hook-poke [%add-owned path security history])
==
::
++ create-group
|= [=path app-path=path sec=rw-security ships=(set ship) title=@t desc=@t]
^- (list card)
=/ group (group-scry path)
?^ group
%- zing
%+ turn ~(tap in u.group)
|= =ship
?: =(ship our.bol) ~
[(send-invite app-path ship)]~
:: do not create a managed group if this is a sig path or a blacklist
::
?: =(sec %channel)
:~ (group-poke [%bundle path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
?: (is-managed path)
~[(contact-view-poke [%create path ships title desc])]
:~ (group-poke [%bundle path])
(group-poke [%add ships path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
::
++ create-security
|= [pax=path sec=rw-security]
^- card
?+ sec !!
%channel
(perm-group-hook-poke [%associate pax [[pax %black] ~ ~]])
::
%village
(perm-group-hook-poke [%associate pax [[pax %white] ~ ~]])
==
::
++ create-metadata
|= [title=@t description=@t group-path=path app-path=path]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator
%+ slav %p
?: (is-managed app-path) (snag 0 app-path)
(snag 1 app-path)
==
:~ (metadata-poke [%add group-path [%chat app-path] metadata])
(metadata-hook-poke [%add-owned group-path])
==
::
++ contact-view-poke
|= act=[%create =path ships=(set ship) title=@t description=@t]
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-action !>(act)]
::
++ metadata-store-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
:* %pass / %agent
[our.bol %metadata-hook]
%poke %metadata-hook-action
!>(act)
==
::
++ send-invite
|= [=path =ship]
^- card
=/ =invite
:* our.bol %chat-hook
path ship ''
==
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ chat-scry
|= pax=path
^- (unit mailbox)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
::
++ group-from-chat
|= app-path=path
^- path
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~)
?: ?=([@ ^] app-path)
~& [%assuming-ported-legacy-chat app-path]
[%'~' app-path]
~& [%weird-chat app-path]
!!
=/ resource-indices
.^ (jug resource group-path)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/resource-indices
==
=/ groups=(set path) (~(got by resource-indices) [%chat app-path])
(snag 0 ~(tap in groups))
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
::
++ is-creator
|= [group-path=path app-name=@ta app-path=path]
^- ?
=/ =metadata
.^ metadata
%gx
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
%metadata
(scot %t (spat group-path))
app-name
(scot %t (spat app-path))
/noun
==
=(our.bol creator.metadata)
--
::
++ diff-chat-update
|= upd=chat-update
@ -257,6 +412,11 @@
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ permission-poke
|= act=permission-action
^- card
[%pass / %agent [our.bol %permission-store] %poke %permission-action !>(act)]
::
++ chat-hook-poke
|= act=chat-hook-action
^- card
@ -286,30 +446,9 @@
^- chat-configs
.^(chat-configs %gx /=chat-store/(scot %da now.bol)/configs/noun)
::
++ create-security
|= [pax=path sec=rw-security]
^- (list card)
=/ read (weld pax /read)
=/ write (weld pax /write)
?- sec
%channel
:~ (perm-group-hook-poke [%associate read [[read %black] ~ ~]])
(perm-group-hook-poke [%associate write [[write %black] ~ ~]])
==
::
%village
:~ (perm-group-hook-poke [%associate read [[read %white] ~ ~]])
(perm-group-hook-poke [%associate write [[write %white] ~ ~]])
==
::
%journal
:~ (perm-group-hook-poke [%associate read [[read %black] ~ ~]])
(perm-group-hook-poke [%associate write [[write %white] ~ ~]])
==
::
%mailbox
:~ (perm-group-hook-poke [%associate read [[read %white] ~ ~]])
(perm-group-hook-poke [%associate write [[write %black] ~ ~]])
==
==
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
::
--

2
pkg/arvo/app/chat/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/chat/img/ChatSwitcherClosed.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 866 B

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/chat/img/ChatSwitcherLink.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 861 B

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/chat/img/Home.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 255 B

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/chat/img/Tile.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

BIN
pkg/arvo/app/chat/img/popout.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 854 B

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
pkg/arvo/app/chat/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

2
pkg/arvo/app/chat/index.html
View File

@ -22,7 +22,7 @@
</head>
<body>
<div id="root" />
<div id="root"/>
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~chat/js/index.js"></script>

2
pkg/arvo/app/chat/js/index.js
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/chat/js/tile.js
View File

File diff suppressed because one or more lines are too long

27
pkg/arvo/app/clock.hoon
View File

@ -8,7 +8,17 @@
==
=, format
::
|%
::
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
+$ state-zero [%0 data=json]
--
%+ verb |
=| state-zero
=* state -
^- agent:gall
|_ =bowl:gall
+* this .
@ -17,7 +27,7 @@
++ on-init
^- (quip card:agent:gall _this)
=/ launcha
[%launch-action !>([%clock /tile '/~clock/js/tile.js'])]
[%launch-action !>([%clock /clocktile '/~clock/js/tile.js'])]
:_ this
:~ [%pass / %arvo %e %connect [~ /'~clock'] %clock]
[%pass /clock %agent [our.bowl %launch] %poke launcha]
@ -39,6 +49,9 @@
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
|^
?: ?=(%json mark)
(poke-json !<(json vase))
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
@ -59,15 +72,23 @@
?: =(name 'tile')
(js-response:gen tile-js)
not-found:gen
::
++ poke-json
|= jon=json
^- (quip card:agent:gall _this)
=. data.state jon
:_ this
[%give %fact ~[/clocktile] %json !>(jon)]~
--
::
++ on-watch
|= =path
^- (quip card:agent:gall _this)
?: ?=([%http-response *] path)
`this
?. =(/tile path)
?. =(/clocktile path)
(on-watch:def path)
[[%give %fact ~ %json !>(*json)]~ this]
[[%give %fact ~ %json !>(data.state)]~ this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def

2
pkg/arvo/app/clock/js/tile.js
View File

File diff suppressed because one or more lines are too long

427
pkg/arvo/app/contact-hook.hoon Normal file
View File

@ -0,0 +1,427 @@
:: contact-hook:
::
/- *group-store,
*group-hook,
*contact-hook,
*invite-store,
*metadata-hook,
*metadata-store
/+ *contact-json, default-agent
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
synced=(map path ship)
invite-created=_|
==
--
=| state-zero
=* state -
^- 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 /updates]
==
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
++ 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))
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%contacts *] [(watch-contacts: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 !<(group-update q.cage.sign))
[cards this]
::
%invite-update
=^ cards state
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
[cards this]
==
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
++ poke-json
|= jon=json
^- (quip card _state)
(poke-contact-action (json-to-action jon))
::
++ 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)
=/ 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 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]~
::
%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]~
::
%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]] ~]~
==
?. |(=(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
:- (pull-wire [%contacts path.act])
state(synced (~(del by synced) path.act))
==
::
++ 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 group) src.bol)
=/ contacts (need (contacts-scry pax))
:~ :*
%give %fact ~ %contact-update
!>([%contacts pax contacts])
== ==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?~ saw
[~ state]
?> ?=(^ wir)
[~ state(synced (~(del by synced) t.wir))]
::
++ kick
|= wir=wire
^- (list card)
?+ wir !!
[%inv ~]
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]~
::
[%group ~]
[%pass /group %agent [our.bol %group-store] %watch /updates]~
::
[%contacts @ *]
?. (~(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])
::
%remove
:_ state
~[(group-poke [%remove [ship.fact ~ ~] path.fact])]
::
%delete
=. synced (~(del by synced) path.fact)
:_ state
:~ (group-poke [%unbundle path.fact])
(metadata-hook-poke [%remove path.fact])
(metadata-poke [%remove path.fact [%contacts path.fact]])
==
==
::
++ foreign
|= fact=contact-update
^- (list card)
?+ -.fact ~
%contacts
=/ owner (~(got by synced) path.fact)
?> =(owner src.bol)
%+ weld
:~ (contact-poke [%delete path.fact])
(contact-poke [%create path.fact])
==
%+ turn ~(tap by contacts.fact)
|= [=ship =contact]
(contact-poke [%add path.fact ship contact])
::
%add
=/ owner (~(got by synced) path.fact)
?> |(=(owner src.bol) =(src.bol ship.fact))
~[(contact-poke [%add path.fact ship.fact contact.fact])]
::
%remove
=/ owner (~(got by synced) path.fact)
?> |(=(owner src.bol) =(src.bol ship.fact))
%+ welp
:~ (group-poke [%remove [ship.fact ~ ~] path.fact])
(contact-poke [%remove path.fact ship.fact])
==
?. =(ship.fact our.bol) ~
~[(group-poke [%unbundle path.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=group-update]
^- (quip card _state)
|^
?+ -.fact [~ state]
%add (add +.fact)
%remove (remove +.fact)
%unbundle (unbundle +.fact)
==
++ add
|= [ships=(set ship) =path]
^- (quip card _state)
=/ owner (~(get by synced) path)
?~ owner [~ state]
?. =(u.owner our.bol) [~ state]
:_ state
%+ turn ~(tap in (~(del in ships) our.bol))
|= =ship
(send-invite-poke path ship)
::
++ unbundle
|= =path
^- (quip card _state)
?. (~(has by synced) path)
[~ state]
:_ state(synced (~(del by synced) path))
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
[(contact-poke [%delete path])]
==
::
++ remove
|= [members=group =path]
^- (quip card _state)
:: if pax is synced, remove member from contacts and kick their sub
=/ owner=(unit ship) (~(get by synced) path)
?~ owner
:_ state
%+ turn ~(tap in members)
|= =ship
(contact-poke [%remove path ship])
:_ state
%- zing
%+ turn ~(tap in members)
|= =ship
:~ [%give %kick ~[[%contacts path]] `ship]
?: =(ship our.bol)
(contact-poke [%delete path])
(contact-poke [%remove path ship])
==
::
++ send-invite-poke
|= [=path =ship]
^- card
=/ =invite
:* our.bol %contact-hook
path ship ''
==
=/ act=invite-action [%invite /contacts (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
--
::
++ fact-invite-update
|= [wir=wire fact=invite-update]
^- (quip card _state)
?+ -.fact [~ state]
%accepted
=/ changes
(poke-hook-action [%add-synced ship.invite.fact path.invite.fact])
:-
%+ welp
:~ (group-hook-poke [%add ship.invite.fact path.invite.fact])
(metadata-hook-poke [%add-synced ship.invite.fact path.invite.fact])
==
-.changes
+.changes
==
::
++ group-hook-poke
|= act=group-hook-action
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
::
++ invite-poke
|= act=invite-action
^- 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)]
::
++ group-poke
|= act=group-action
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-hook-action !>(act)]
::
++ contacts-scry
|= pax=path
^- (unit contacts)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contacts pax /noun)
.^((unit contacts) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax
/=invite-store/(scot %da now.bol)/invite/contacts/(scot %uv uid)/noun
.^((unit invite) %gx pax)
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) 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 %chat-store] %leave ~]~
[%pass pax %agent [u.shp %chat-hook] %leave ~]~
--

180
pkg/arvo/app/contact-store.hoon Normal file
View File

@ -0,0 +1,180 @@
:: contact-store: data store that holds group-based contact data
::
/+ *contact-json, default-agent
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
=rolodex
==
+$ diff
$% [%contact-update contact-update]
==
--
::
=| state-zero
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
++ 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))
==
[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 !>([%rolodex rolodex]))
[%updates ~] ~
[%contacts @ *]
%+ give %contact-update
!>([%contacts t.path (~(got by rolodex) t.path)])
==
[cards this]
::
++ 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))
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
::
|_ 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)
==
::
++ 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)
=. 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)
== ==
--

288
pkg/arvo/app/contact-view.hoon Normal file
View File

@ -0,0 +1,288 @@
:: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/- *group-store,
*group-hook,
*invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
*permission-group-hook,
*permission-hook
/+ *server, *contact-json, base64, default-agent
/= index
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/index
/| /html/
/~ ~
==
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/js/tile
/| /js/
/~ ~
==
/= script
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/js/index
/| /js/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/css/index
/| /css/
/~ ~
==
/= contact-png
/^ (map knot @)
/: /===/app/contacts/img /_ /png/
::
|%
+$ card card:agent:gall
--
::
^- 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]
[%pass / %arvo %e %connect [~ /'~groups'] %contact-view]
(launch-poke:cc [%contact-view /primary '/~groups/js/tile.js'])
(contact-poke:cc [%create /~/default])
(group-poke:cc [%bundle /~/default])
(contact-poke:cc [%add /~/default our.bowl *contact])
(group-poke:cc [%add [our.bowl ~ ~] /~/default])
==
::
++ on-save on-save:def
++ on-load on-load:def
++ 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 !>((rolodex-to-json all-scry:cc))]~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%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
++ poke-json
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-contact-view-action (json-to-view-action jon))
::
++ poke-contact-view-action
|= act=contact-view-action
^- (list card)
?- -.act
%create
?> ?=([@ *] path.act)
%+ weld
:~ (group-poke [%bundle path.act])
(contact-poke [%create path.act])
(contact-hook-poke [%add-owned path.act])
(group-hook-poke [%add our.bol path.act])
(group-poke [%add (~(put in ships.act) our.bol) path.act])
(perm-group-hook-poke [%associate path.act [[path.act %white] ~ ~]])
(permission-hook-poke [%add-owned path.act path.act])
==
(create-metadata path.act title.act description.act)
::
%delete
%+ weld
:~ (group-poke [%unbundle path.act])
(contact-poke [%delete path.act])
(contact-hook-poke [%remove path.act])
==
(delete-metadata path.act)
::
%remove
:~ (group-poke [%remove [ship.act ~ ~] path.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])]~
==
++ 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
[%'~groups' %css %index ~] (css-response:gen style)
[%'~groups' %js %index ~] (js-response:gen script)
[%'~groups' %js %tile ~] (js-response:gen tile-js)
[%'~groups' %img *]
(png-response:gen (as-octs:mimes:html (~(got by contact-png) `@ta`name)))
::
:: avatar images
::
[%'~groups' %avatar @ *]
=/ pax=path `path`t.t.site.url
?~ pax not-found:gen
=/ pas `path`(flop pax)
?~ pas not-found:gen
=/ pav `path`(flop t.pas)
~& pav+pav
~& name+name
=/ contact (contact-scry `path`(weld pav [name]~))
?~ contact not-found:gen
?~ avatar.u.contact not-found:gen
=* avatar u.avatar.u.contact
=/ decoded (de:base64 q.octs.avatar)
?~ decoded not-found:gen
[[200 ['content-type' content-type.avatar]~] `u.decoded]
::
[%'~groups' *] (html-response:gen index)
==
::
:: +utilities
::
++ 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)]
::
++ launch-poke
|= act=[@tas path @t]
^- card
[%pass / %agent [our.bol %launch] %poke %launch-action !>(act)]
::
++ group-poke
|= act=group-action
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ group-hook-poke
|= act=group-hook-action
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-hook-action !>(act)]
::
++ perm-group-hook-poke
|= act=permission-group-hook-action
^- card
:* %pass / %agent [our.bol %permission-group-hook]
%poke %permission-group-hook-action !>(act)
==
::
++ permission-hook-poke
|= act=permission-hook-action
^- card
:* %pass / %agent [our.bol %permission-hook]
%poke %permission-hook-action !>(act)
==
::
++ create-metadata
|= [=path title=@t description=@t]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator our.bol
==
:~ (metadata-poke [%add path [%contacts path] metadata])
(metadata-hook-poke [%add-owned path])
==
::
++ delete-metadata
|= =path
^- (list card)
:~ (metadata-poke [%remove path [%contacts path]])
(metadata-hook-poke [%remove path])
==
::
++ all-scry
^- rolodex
.^(rolodex %gx /=contact-store/(scot %da now.bol)/all/noun)
::
++ contact-scry
|= pax=path
^- (unit contact)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contact pax /noun)
.^((unit contact) %gx pax)
--

1
pkg/arvo/app/contacts/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/contacts/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/contacts/img/Tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.1 KiB

BIN
pkg/arvo/app/contacts/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

17
pkg/arvo/app/contacts/index.html Normal file
View File

@ -0,0 +1,17 @@
<!doctype html>
<html>
<head>
<title>Groups</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~groups/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body>
<div id="root" />
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~groups/js/index.js"></script>
</body>
</html>

1
pkg/arvo/app/contacts/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

1
pkg/arvo/app/contacts/js/tile.js Normal file
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/group-store.hoon
View File

@ -57,6 +57,7 @@
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %group-initial !>(groups))
[%updates ~] ~
[%keys ~] (give %group-update !>([%keys ~(key by groups)]))
[%group *]
(give %group-update !>([%path (~(got by groups) t.path) t.path]))
@ -158,6 +159,7 @@
^- (list card)
%- zing
:~ (update-subscribers /all act)
(update-subscribers /updates act)
(update-subscribers [%group pax] act)
?. |(=(%bundle -.act) =(%unbundle -.act))
~

14
pkg/arvo/app/hood.hoon
View File

@ -43,9 +43,9 @@
!:
=> |% ::
++ hood-old :: unified old-state
{?($1 $2) lac/(map @tas hood-part-old)} ::
{?($1 $2 $3) lac/(map @tas hood-part-old)} ::
++ hood-1 :: unified state
{$2 lac/(map @tas hood-part)} ::
{$3 lac/(map @tas hood-part)} ::
++ hood-good :: extract specific
=+ hed=$:hood-head
|@ ++ $
@ -140,16 +140,18 @@
`..on-init
::
++ on-save
!>([%2 lac])
!>([%3 lac])
::
++ on-load
|= =old-state=vase
=/ old-state !<(hood-old old-state-vase)
=^ cards lac
=. lac lac.old-state
?. ?=(%1 -.old-state)
`lac
((wrap on-load):from-drum:(help hid) %1)
?- -.old-state
%1 ((wrap on-load):from-drum:(help hid) %1)
%2 ((wrap on-load):from-drum:(help hid) %2)
%3 `lac
==
[cards ..on-init]
::
++ on-poke

4
pkg/arvo/app/invite-hook.hoon
View File

@ -49,12 +49,10 @@
%invite-action
=/ act=invite-action !<(invite-action vase)
?. ?=(%invite -.act) ~
:: if the sender is us,
::
?: (team:title our.bowl src.bowl)
:: outgoing. we must be inviting another ship. send them the invite.
::
?> !(team:title our.bowl recipient.invite.act)
?< (team:title our.bowl recipient.invite.act)
[(invite-hook-poke:do recipient.invite.act act)]~
:: else incoming. ensure invitatory exists and invite is not a duplicate.
::

3
pkg/arvo/app/launch/css/index.css
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/launch/js/index.js
View File

File diff suppressed because one or more lines are too long

259
pkg/arvo/app/link-listen-hook.hoon
View File

@ -1,30 +1,46 @@
:: link-listen-hook: get your friends' bookmarks
::
:: on-init, subscribes to all groups on this ship.
:: for every ship in a group, we subscribe to their link's local-pages
:: on-init, subscribes to all groups on this ship. for every ship in a group,
:: we subscribe to their link's local-pages and annotations
:: at the group path (through link-proxy-hook),
:: and forwards all entries into our link as submissions.
:: and forwards all entries into our link as submissions and comments.
::
:: if a subscription to a group member fails, we assume it's because their
:: group definition hasn't been updated to include us yet.
:: we retry with exponential backoff, maxing out at one hour timeouts.
::
/- *link, group-store
/+ default-agent, verb
/+ default-agent, verb, dbug
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
retry-timers=(map target @dr)
==
::
+$ what-target ?(%local-pages %annotations)
+$ target
$: what=what-target
who=ship
where=path
==
++ wire-to-target
|= =wire
^- target
?> ?=([what-target @ ^] wire)
[i.wire (slav %p i.t.wire) t.t.wire]
++ target-to-wire
|= target
^- wire
[what (scot %p who) where]
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -51,28 +67,53 @@
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%links @ ^] wire)
?: ?=([%links ?(%local-pages %annotations) @ ^] wire)
=^ cards state
(take-links-sign:do (slav %p i.t.wire) t.t.wire sign)
(take-link-sign:do (wire-to-target t.wire) sign)
[cards this]
?: ?=([%forward ^] wire)
=^ cards state
(take-forward-sign:do t.wire sign)
[cards this]
?: ?=([%prod *] wire)
~| [%weird-sign -.sign]
?> ?=(%poke-ack -.sign)
?~ p.sign [~ this]
%- (slog [leaf+"failed to prod" u.p.sign])
[~ this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-poke
|= [=mark =vase]
?. ?=(%link-listen-poke mark)
(on-poke:def mark vase)
=/ =path !<(path vase)
:_ this
%+ weld
(take-retry:do %local-pages src.bowl path)
(take-retry:do %annotations src.bowl path)
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%g %done *] sign-arvo)
(on-arvo:def wire sign-arvo)
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ this]
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%g %done *]
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ this]
::
[%b %wake *]
?> ?=([%retry @ @ ^] wire)
?^ error.sign-arvo
=/ =tank leaf+"wake on {(spud wire)} went wrong!"
%- (slog tank u.error.sign-arvo)
[~ this]
:_ this
(take-retry:do (wire-to-target t.wire))
==
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
@ -106,7 +147,6 @@
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial (handle-group-initial !<(groups:group-store vase))
%group-update (handle-group-update !<(group-update:group-store vase))
@ -139,78 +179,183 @@
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
%. [i.whos pax.upd]
?: ?=(%remove -.upd)
end-link-subscription
start-link-subscription
%+ weld
$(whos t.whos)
(end-link-subscriptions i.whos pax.upd)
:^ (start-link-subscription %local-pages i.whos pax.upd)
(start-link-subscription %annotations i.whos pax.upd)
(prod-other-listener i.whos pax.upd)
$(whos t.whos)
==
::
:: link subscriptions
::
++ start-link-subscription
|= [who=ship where=path]
|= =target
^- card
:* %pass
[%links (scot %p who) where]
[%links (target-to-wire target)]
%agent
[who %link-proxy-hook]
[who.target %link-proxy-hook]
%watch
[%local-pages where]
?- what.target
%local-pages [what where]:target
%annotations [what %$ where]:target
==
==
::
++ end-link-subscription
++ end-link-subscriptions
|= [who=ship where=path]
^- (list card)
|^ ~[(end %local-pages) (end %annotations)]
::
++ end
|= what=what-target
:* %pass
[%links (target-to-wire what who where)]
%agent
[who %link-proxy-hook]
%leave
~
==
--
::
++ prod-other-listener
|= [who=ship where=path]
^- card
:* %pass
[%links (scot %p who) where]
[%prod (scot %p who) where]
%agent
[who %link-proxy-hook]
%leave
~
[who %link-listen-hook]
%poke
%link-listen-poke
!>(where)
==
::
++ take-links-sign
|= [who=ship where=path =sign:agent:gall]
++ take-link-sign
|= [=target =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links who where] !!)
%kick [[(start-link-subscription who where)]~ state]
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links target] !!)
%kick [[(start-link-subscription target)]~ state]
::
%watch-ack
?~ p.sign [~ state]
:: our subscription request got rejected for whatever reason,
:: (most likely difference in group membership,)
:: so we don't try again.
::TODO but now the only way to retry is to remove from group and re-add...
:: this is a problem because our and their group may not update
:: simultaneously...
[~ state]
?~ p.sign
=. retry-timers (~(del by retry-timers) target)
[~ state]
:: our subscription request got rejected,
:: most likely because our group definition is out of sync with theirs.
:: set timer for retry.
::
(start-retry target)
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-update (handle-link-update who where !<(update vase))
%link-initial
%- handle-link-initial
[who.target where.target !<(initial vase)]
::
%link-update
%- handle-link-update
[who.target where.target !<(update vase)]
==
==
::
++ start-retry
|= =target
^- (quip card _state)
=/ timer=@dr
%+ min ~h1
%+ mul 2
(~(gut by retry-timers) target ~s15)
=. retry-timers
(~(put by retry-timers) target timer)
:_ state
:_ ~
:* %pass
[%retry (target-to-wire target)]
[%arvo %b %wait (add now.bowl timer)]
==
::
++ take-retry
|= =target
^- (list card)
:: relevant: whether :who is still in group :where
::
=; relevant=?
?. relevant ~
[(start-link-subscription target)]~
?: %- ~(has by wex.bowl)
[[%links (target-to-wire target)] who.target %link-proxy-hook]
|
%. who.target
%~ has in
=- (fall - *group:group-store)
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc where.target %noun)
==
::
++ do-link-action
|= [=wire =action]
^- card
:* %pass
wire
%agent
[our.bowl %link-store]
%poke
%link-action
!>(action)
==
::
++ handle-link-initial
|= [who=ship where=path =initial]
^- (quip card _state)
?> =(src.bowl who)
?+ -.initial ~|([dap.bowl %unexpected-initial -.initial] !!)
%local-pages
=/ =pages (~(got by pages.initial) where)
(handle-link-update who where [%local-pages where pages])
::
%annotations
=/ urls=(list [=url =notes])
~(tap by (~(got by notes.initial) where))
=| cards=(list card)
|- ^- (quip card _state)
?~ urls [cards state]
=^ caz state
^- (quip card _state)
=, i.urls
(handle-link-update who where [%annotations where url notes])
$(urls t.urls, cards (weld cards caz))
==
::
++ handle-link-update
|= [who=ship where=path =update]
^- (quip card _state)
?> ?=(%local-pages -.update)
?> =(src.bowl who)
:_ state
%+ turn pages.update
|= =page
^- card
:* %pass
[%forward (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%hear where src.bowl page])
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%local-pages
%+ turn pages.update
|= =page
%+ do-link-action
[%forward %local-page (scot %p who) where]
[%hear where who page]
::
%annotations
%+ turn notes.update
|= =note
^- card
%+ do-link-action
[%forward %annotation (scot %p who) where]
[%read where url.update who note]
==
::
++ take-forward-sign

78
pkg/arvo/app/link-proxy-hook.hoon
View File

@ -17,8 +17,11 @@
:: whatever's returned by the scry at that path, but perhaps that should
:: become part of the stores standard anyway.
::
/- *link, group-store
/+ default-agent, verb
:: when adding support for new paths, the only things you'll likely want
:: to touch are +permitted, +initial-response, & maybe +handle-group-update.
::
/- group-store
/+ *link, default-agent, verb, dbug
|%
+$ state-0
$: %0
@ -33,6 +36,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -95,20 +99,23 @@
++ permitted
|= [who=ship =path]
^- ?
:: we only expose /local-pages, and only to ships in the relevant group
:: we only expose group-specific /local-pages and /annotations,
:: and only to ships in the relevant group.
:: (no url-specific annotations subscriptions, either.)
::
?. ?=([%local-pages ^] path) |
=/ target=(unit ^path)
?: ?=([%local-pages ^] path)
`t.path
?: ?=([%annotations ~ ^] path)
`t.t.path
~
?~ target |
=; group
?& ?=(^ group)
(~(has in u.group) who)
==
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc t.path %noun)
==
%+ scry-for (unit group:group-store)
[%group-store u.target]
::
:: groups subscription
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
@ -135,7 +142,6 @@
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state]
%group-update (handle-group-update !<(group-update:group-store vase))
@ -156,24 +162,28 @@
$(whos t.whos)
:_ $(whos t.whos)
::NOTE this depends kind of unfortunately on the fact that we only accept
:: subscriptions to /local-pages/* paths. it'd be more correct if we
:: subscriptions to /local-pages//* paths. it'd be more correct if we
:: "just" looked at all paths in the map, and found the matching ones.
(kick-proxy i.whos [%local-pages pax.upd])
::TODO what exactly did i mean by this?
%+ kick-proxies i.whos
:~ [%local-pages pax.upd]
[%annotations '' pax.upd]
==
::
:: proxy subscriptions
::
++ kick-proxy
|= [who=ship =path]
++ kick-proxies
|= [who=ship paths=(list path)]
^- card
[%give %kick ~[path] `who]
[%give %kick paths `who]
::
++ handle-proxy-sign
|= [=path =sign:agent:gall]
|= [=wire =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack path] !!)
%fact [[%give %fact ~[path] cage.sign]~ state]
%kick [[(proxy-pass-link-store path %watch path)]~ state]
%poke-ack ~|([dap.bowl %unexpected-poke-ack wire] !!)
%fact [[%give %fact ~[wire] cage.sign]~ state]
%kick [[(proxy-pass-link-store wire %watch wire)]~ state]
::
%watch-ack
?~ p.sign [~ state]
@ -197,9 +207,19 @@
++ initial-response
|= =path
^- card
=/ initial=update
[%local-pages path .^(pages %gx path)]
[%give %fact ~ %link-update !>(initial)]
=; =initial
[%give %fact ~ %link-initial !>(initial)]
?+ path !!
[%local-pages ^]
:- %local-pages
%+ scry-for (map ^path pages)
[%link-store path]
::
[%annotations %$ ^]
:- %annotations
%+ scry-for (per-path-url notes)
[%link-store path]
==
::
++ start-proxy
|= [who=ship =path]
@ -228,4 +248,14 @@
:: else, close the local subscription.
::
[(proxy-pass-link-store path %leave ~)]~
::
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bowl)
app
(scot %da now.bowl)
(snoc `^path`path %noun)
==
--

228
pkg/arvo/app/link-server-hook.hoon
View File

@ -1,228 +0,0 @@
:: link-server: accessing link-store via eyre
::
:: only accepts requests authenticated as the host ship.
::
:: GET requests:
:: /~link/local-pages/[some-path].json?p=0
:: our submissions on path, with optional pagination
::
:: POST requests:
:: /~link/add/[some-path]
:: send {title url} json, will save link at path
::
/+ *link, *server, default-agent, verb
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[start-serving:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
?: ?=([%http-response *] path)
[~ this]
(on-watch:def path)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
:_ this
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
(handle-http-request:do eyre-id inbound-request)
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=(%poke-ack -.sign)
(on-agent:def wire sign)
?~ p.sign [~ this]
=/ =tank
leaf+"{(trip dap.bowl)} failed writing to %link-store"
%- (slog tank u.p.sign)
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
++ start-serving
^- card
[%pass / %arvo %e %connect [~ /'~link'] dap.bowl]
::
++ do-action
|= =action
^- card
[%pass / %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ do-add
|= [=path title=@t =url]
^- card
(do-action %add path title url)
::
++ handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (list card)
::NOTE we don't use +require-authorization because it's too restrictive
:: on the flow we want here.
::
?. ?& authenticated.inbound-request
=(src.bowl our.bowl)
==
::TODO `*octs -> ~ everywhere once no-data bug is fixed
(give-simple-payload:app eyre-id [[403 ~] `*octs])
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
=; [cards=(list card) =simple-payload:http]
%+ weld cards
(give-simple-payload:app eyre-id simple-payload)
?+ method.request.inbound-request [~ not-found:gen]
%'OPTIONS'
[~ (include-cors-headers req-head [[200 ~] `*octs])]
::
%'GET'
[~ (handle-get req-head request-line)]
::
%'POST'
(handle-post req-head request-line body.request.inbound-request)
==
::
++ handle-post
|= [request-headers=header-list:http =request-line body=(unit octs)]
^- [(list card) simple-payload:http]
=; [success=? cards=(list card)]
:- cards
%+ include-cors-headers
request-headers
::TODO it would be more correct to wait for the %poke-ack instead of
:: sending this response right away... but link-store pokes can't
:: actually fail right now, so it's fine.
[[?:(success 200 400) ~] `*octs]
?~ body [| ~]
?+ request-line [| ~]
[[~ [%'~link' %add ^]] ~]
^- [? (list card)]
=/ jon=(unit json) (de-json:html q.u.body)
?~ jon [| ~]
=/ page=(unit [title=@t =url])
%. u.jon
(ot title+so url+so ~):dejs-soft:format
?~ page [| ~]
[& [(do-add t.t.site.request-line [title url]:u.page) ~]]
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
%+ include-cors-headers
request-headers
^- simple-payload:http
:: args: map of params
:: p: pagination index
::
=/ args
%- ~(gas by *(map @t @t))
args.request-line
=/ p=(unit @ud)
%+ biff (~(get by args) 'p')
(curr rush dim:ag)
?+ request-line not-found:gen
::TODO expose submissions, other data
:: local links by recency as json
::
[[[~ %json] [%'~link' %local-pages ^]] *]
%- json-response:gen
%- json-to-octs ::TODO include in +json-response:gen
^- json
:- %a
%+ turn
`pages`(get-pages t.t.site.request-line p)
`$-(page json)`page:en-json
==
::
++ include-cors-headers
|= [request-headers=header-list:http =simple-payload:http]
^+ simple-payload
=* out-heads headers.response-header.simple-payload
=; =header-list:http
|-
?~ header-list simple-payload
=* new-head i.header-list
=. out-heads
(set-header:http key.new-head value.new-head out-heads)
$(header-list t.header-list)
=/ origin=@t
=/ headers=(map @t @t)
(~(gas by *(map @t @t)) request-headers)
(~(gut by headers) 'origin' '*')
:~ 'Access-Control-Allow-Origin'^origin
'Access-Control-Allow-Credentials'^'true'
'Access-Control-Request-Method'^'OPTIONS, GET, POST'
'Access-Control-Allow-Methods'^'OPTIONS, GET, POST'
'Access-Control-Allow-Headers'^'content-type'
==
::
++ page-size 25
++ get-pages
|= [=path p=(unit @ud)]
^- pages
=; =pages
?~ p pages
%+ scag page-size
%+ slag (mul u.p page-size)
pages
.^ pages
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
%local-pages
(snoc path %noun)
==
--

356
pkg/arvo/app/link-store.hoon
View File

@ -5,24 +5,71 @@
:: links, arbitrary paths are probably fair game, but could trip up
:: primitive ui implementations.
::
:: urls in paths are expected to be encoded using +wood, for @ta sanity.
:: generally, use /lib/link's +build-discussion-path.
::
:: see link-listen-hook to see what's synced in, and similarly
:: see link-proxy-hook to see what's exposed.
::
:: scry and subscription paths:
::
:: /local-pages/[some-group] all pages we saved by recency
:: /submissions/[some-group] all submissions by recency
:: (map path pages) %local-pages
:: /local-pages our saved pages
:: /local-pages/some-path our saved pages on path
::
/+ *link, default-agent, verb
:: (map path submissions) %submissions
:: /submissions all submissions we've seen
:: /submissions/some-path all submissions we've seen on path
::
:: (map path (map url notes)) %annotations
:: /annotations our comments
:: /annotations/wood-url our comments on url
:: /annotations/wood-url/some-path our comments on url on path
:: /annotations//some-path our comments on path
::
:: (map path (map url comments)) %discussions
:: /discussions all comments
:: /discussions/wood-url all comments on url
:: /discussions/wood-url/some-path all comments on url on path
:: /discussions//some-path all comments on path
::
:: subscription-only paths:
::
:: [path url] %observation
:: /seen updates whenever an item is seen
::
:: scry-only paths:
::
::
:: (map path (set url))
:: /unseen the ones we haven't seen yet
::
:: (set url)
:: /unseen/some-path the ones we haven't seen here yet
::
:: ?
:: /seen/wood-url/some-path have we seen this here
::
/+ *link, default-agent, verb, dbug
::
|%
+$ state-0
$: %0
by-group=(map path links)
by-site=(map site (list [path submission]))
discussions=(per-path-url discussion)
==
::
+$ links
$: ::NOTE all lists by recency
=submissions
ours=pages
seen=(set url)
==
::
+$ discussion
$: =comments
ours=notes
==
::
+$ card card:agent:gall
@ -31,6 +78,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -64,12 +112,58 @@
?+ path (on-peek:def path)
[%y ?(%local-pages %submissions) ~]
``noun+!>(~(key by by-group))
::
[%x %local-pages ^]
::
[%x %local-pages *]
``noun+!>((get-local-pages:do t.t.path))
::
[%x %submissions ^]
::
[%x %submissions *]
``noun+!>((get-submissions:do t.t.path))
::
[%y ?(%annotations %discussions) *]
=/ [spath=^path surl=url]
(break-discussion-path t.t.path)
=- ``noun+!>(-)
::
?: =(~ surl)
:: no url, provide urls that have comments
::
^- (set url)
?~ spath
:: no path, find urls accross all paths
::
%- ~(rep by discussions)
|= [[* discussions=(map url discussion)] urls=(set url)]
%- ~(uni in urls)
~(key by discussions)
:: specified path, find urls for that specific path
::
%~ key by
(~(gut by discussions) spath *(map url *))
:: specified url and path, nothing to list here
::
?^ spath !!
:: no path, find paths with comments for this url
::
^- (set ^path)
%- ~(rep by discussions)
|= [[=^path urls=(map url discussion)] paths=(set ^path)]
?. (~(has by urls) surl) paths
(~(put in paths) path)
::
[%x %annotations *]
``noun+!>((get-annotations:do t.t.path))
::
[%x %discussions *]
``noun+!>((get-discussions:do t.t.path))
::
[%x %seen @ ^]
``noun+!>((is-seen:do t.t.path))
::
[%x %unseen ~]
``noun+!>(get-all-unseen:do)
::
[%x %unseen ^]
``noun+!>((get-unseen:do t.t.path))
==
::
++ on-watch
@ -78,19 +172,39 @@
?> (team:title [our src]:bowl) ::TODO /lib/store
:_ this
|^ ?+ path (on-watch:def path)
[%local-pages ^]
%+ give %link-update
[%local-pages t.path (get-local-pages:do t.path)]
[%local-pages *]
%+ give %link-initial
^- initial
[%local-pages (get-local-pages:do t.path)]
::
[%submissions ^]
%+ give %link-update
[%submissions t.path (get-submissions:do t.path)]
[%submissions *]
%+ give %link-initial
^- initial
[%submissions (get-submissions:do t.path)]
::
[%annotations *]
%+ give %link-initial
^- initial
[%annotations (get-annotations:do t.path)]
::
[%discussions *]
%+ give %link-initial
^- initial
[%discussions (get-discussions:do t.path)]
::
[%seen ~]
~
==
::
++ give
|* [=mark =noun]
^- (list card)
[%give %fact ~ mark !>(noun)]~
::
++ give-single
|* [=mark =noun]
^- card
[%give %fact ~ mark !>(noun)]
--
::
++ on-leave on-leave:def
@ -107,15 +221,19 @@
|= =action
^- (quip card _state)
?- -.action
%add (add-page +.action)
%save (save-page +.action)
%note (note-note +.action)
%seen (seen-submission +.action)
::
%hear (hear-submission +.action)
%read (read-comment +.action)
==
:: +add-page: save a page ourselves
:: +save-page: save a page ourselves
::
++ add-page
++ save-page
|= [=path title=@t =url]
^- (quip card _state)
?< =(~ path)
?< |(=(~ path) =(~ title) =(~ url))
:: add page to group ours
::
=/ =links (~(gut by by-group) path *links)
@ -124,16 +242,75 @@
=. by-group (~(put by by-group) path links)
:: do generic submission logic
::
=^ cards state
=^ submission-cards state
(hear-submission path [our.bowl page])
:: mark page as seen (because we submitted it ourselves)
::
=^ seen-cards state
(seen-submission path `url)
:: send updates to subscribers
::
:_ state
:_ cards
:_ (weld submission-cards seen-cards)
:+ %give %fact
:+ [%local-pages path]~
:+ :~ /local-pages
[%local-pages path]
==
%link-update
!>([%local-pages path [page]~])
:: +note-note: save a note for a url
::
++ note-note
|= [=path =url udon=@t]
^- (quip card _state)
?< |(=(~ path) =(~ url) =(~ udon))
:: add note to discussion ours
::
=/ urls (~(gut by discussions) path *(map ^url discussion))
=/ =discussion (~(gut by urls) url *discussion)
=/ =note [now.bowl udon]
=. ours.discussion [note ours.discussion]
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: do generic comment logic
::
=^ cards state
(read-comment path url [our.bowl note])
:: send updates to subscribers
::
:_ state
^- (list card)
:_ cards
:+ %give %fact
:+ :~ /annotations
[%annotations %$ path]
[%annotations (build-discussion-path url)]
[%annotations (build-discussion-path path url)]
==
%link-update
!>([%annotations path url [note]~])
:: +seen-submission: mark url as seen/read
::
:: if no url specified, all under path are marked as read
::
++ seen-submission
|= [=path murl=(unit url)]
^- (quip card _state)
=/ =links (~(gut by by-group) path *links)
:: new: urls we want to, but haven't yet, marked as seen
::
=/ new=(set url)
%. seen.links
%~ dif in
^- (set url)
?^ murl (sy ~[u.murl])
%- ~(gas in *(set url))
%+ turn submissions.links
|=(submission url)
?: =(~ new) [~ state]
=. seen.links (~(uni in seen.links) new)
:_ state(by-group (~(put by by-group) path links))
[%give %fact ~[/seen] %link-update !>([%observation path new])]~
:: +hear-submission: record page someone else saved
::
++ hear-submission
@ -143,7 +320,8 @@
:: add link to group submissions
::
=/ =links (~(gut by by-group) path *links)
=. submissions.links [submission submissions.links]
=. submissions.links
(submissions:merge submissions.links ~[submission])
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
@ -154,19 +332,149 @@
:_ state
:_ ~
:+ %give %fact
:+ [%submissions path]~
:+ :~ /submissions
[%submissions path]
==
%link-update
!>([%submissions path [submission]~])
:: +read-comment: record a comment someone else made
::
++ read-comment
|= [=path =url =comment]
^- (quip card _state)
:: add comment to url's discussion
::
=/ urls (~(gut by discussions) path *(map ^url discussion))
=/ =discussion (~(gut by urls) url *discussion)
=. comments.discussion
(comments:merge comments.discussion ~[comment])
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: send updates to subscribers
::
:_ state
:_ ~
:+ %give %fact
:+ :~ /discussions
[%discussions '' path]
[%discussions (build-discussion-path url)]
[%discussions (build-discussion-path path url)]
==
%link-update
!>([%discussions path url [comment]~])
::
:: reading
::
++ get-local-pages
|= =path
^- pages
^- (map ^path pages)
?~ path
:: all paths
::
%- ~(run by by-group)
|=(links ours)
:: specific path
::
%+ ~(put by *(map ^path pages)) path
ours:(~(gut by by-group) path *links)
::
++ get-submissions
|= =path
^- submissions
^- (map ^path submissions)
?~ path
:: all paths
::
%- ~(run by by-group)
|=(links submissions)
:: specific path
::
%+ ~(put by *(map ^path submissions)) path
submissions:(~(gut by by-group) path *links)
::
++ get-all-unseen
^- (jug path url)
%- ~(rut by by-group)
|= [=path *]
(get-unseen path)
::
++ get-unseen
|= =path
^- (set url)
=/ =links
(~(gut by by-group) path *links)
%- ~(gas in *(set url))
%+ murn submissions.links
|= submission
?: (~(has in seen.links) url) ~
(some url)
::
++ is-seen
|= =path
^- ?
=/ [=^path =url]
(break-discussion-path path)
%. url
%~ has in
seen:(~(gut by by-group) path *links)
::
::
++ get-annotations
|= =path
^- (per-path-url notes)
=/ args=[=^path =url]
(break-discussion-path path)
|^ ?~ path
:: all paths
::
(~(run by discussions) get-ours)
:: specific path
::
%+ ~(put by *(per-path-url notes)) path.args
%- get-ours
%+ ~(gut by discussions) path.args
*(map url discussion)
::
++ get-ours
|= m=(map url discussion)
^- (map url notes)
?: =(~ url.args)
:: all urls
::
%- ~(run by m)
|=(discussion ours)
:: specific url
::
%+ ~(put by *(map url notes)) url.args
ours:(~(gut by m) url.args *discussion)
--
::
++ get-discussions
|= =path
^- (per-path-url comments)
=/ args=[=^path =url]
(break-discussion-path path)
|^ ?~ path
:: all paths
::
(~(run by discussions) get-comments)
:: specific path
::
%+ ~(put by *(per-path-url comments)) path.args
%- get-comments
%+ ~(gut by discussions) path.args
*(map url discussion)
::
++ get-comments
|= m=(map url discussion)
^- (map url comments)
?: =(~ url.args)
:: all urls
::
%- ~(run by m)
|=(discussion comments)
:: specific url
::
%+ ~(put by *(map url comments)) url.args
comments:(~(gut by m) url.args *discussion)
--
--

386
pkg/arvo/app/link-view.hoon Normal file
View File

@ -0,0 +1,386 @@
:: link-view: frontend endpoints
::
:: endpoints, mapping onto link-store's paths. p is for page as in pagination.
:: updates only work for page 0.
:: as with link-store, urls are expected to use +wood encoding.
::
:: /json/[p]/submissions pages for all groups
:: /json/[p]/submissions/[some-group] page for one group
:: /json/[p]/discussions/[wood-url]/[some-group] page for url in group
:: /json/[n]/submission/[wood-url]/[some-group] nth matching submission
:: /json/seen mark-as-read updates
::
/+ *link, *server, default-agent, verb
::
|%
+$ state-0
$: %0
~
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /connect %arvo %e %connect [~ /'~link'] dap.bowl]
[%pass /submissions %agent [our.bowl %link-store] %watch /submissions]
[%pass /discussions %agent [our.bowl %link-store] %watch /discussions]
[%pass /seen %agent [our.bowl %link-store] %watch /seen]
::
=+ [dap.bowl /tile '/~link/js/tile.js']
[%pass /launch %agent [our.bowl %launch] %poke %launch-action !>(-)]
==
::
++ on-save !>(state)
::
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
:_ this
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
handle-http-request:do
::
%link-action
[(handle-action:do !<(action vase)) ~]
==
::
++ on-watch
|= =path
^- (quip card _this)
?: ?| ?=([%http-response *] path)
?=([%json %seen ~] path)
==
[~ this]
?: ?=([%tile ~] path)
:_ this
~[give-tile-data:do]
?. ?=([%json @ @ *] path)
(on-watch:def path)
=/ p=@ud (slav %ud i.t.path)
?+ t.t.path (on-watch:def path)
[%submissions ~]
:_ this
(give-initial-submissions:do p ~)
::
[%submissions ^]
:_ this
(give-initial-submissions:do p t.t.t.path)
::
[%submission @ ^]
:_ this
(give-specific-submission:do p (break-discussion-path t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path t.t.t.path))
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
[%pass wire %agent [our.bowl %link-store] %watch wire]~
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark (on-agent:def wire sign)
%link-initial [~ this]
::
%link-update
:_ this
:- (send-update:do !<(update vase))
?: =(/discussions wire) ~
~[give-tile-data:do]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%e %bound *] sign-arvo)
(on-arvo:def wire sign-arvo)
~? !accepted.sign-arvo
[dap.bowl "bind rejected!" binding.sign-arvo]
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ page-size 25
++ get-paginated
|* [p=(unit @ud) l=(list)]
^- [total=@ud pages=@ud page=_l]
:+ (lent l)
%+ add (div (lent l) page-size)
(min 1 (mod (lent l) page-size))
?~ p l
%+ scag page-size
%+ slag (mul u.p page-size)
l
::
++ page-to-json
=, enjs:format
|* $: page-number=@ud
[total-items=@ud total-pages=@ud page=(list)]
item-to-json=$-(* json)
==
^- json
%- pairs
:~ 'totalItems'^(numb total-items)
'totalPages'^(numb total-pages)
'pageNumber'^(numb page-number)
'page'^a+(turn page item-to-json)
==
::
++ handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
?. =(src.bowl our.bowl)
[[403 ~] ~]
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
?+ method.request.inbound-request not-found:gen
%'GET'
(handle-get req-head request-line)
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
^- simple-payload:http
:: try to load file from clay
::
?~ ext.request-line
:: for extension-less requests, always just serve the index.html.
:: that way the js can load and figure out how to deal with that route.
::
$(request-line [[`%html ~[%'~link' 'index']] args.request-line])
=/ file=(unit octs)
?. ?=([%'~link' *] site.request-line) ~
(get-file-at /app/link [t.site u.ext]:request-line)
?~ file not-found:gen
?+ u.ext.request-line not-found:gen
%html (html-response:gen u.file)
%js (js-response:gen u.file)
%css (css-response:gen u.file)
%png (png-response:gen u.file)
==
::
++ get-file-at
|= [base=path file=path ext=@ta]
^- (unit octs)
:: only expose html, css and js files for now
::
?. ?=(?(%html %css %js %png) ext)
~
=/ =path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
(snoc (weld base file) ext)
==
?. .^(? %cu path)
~
%- some
%- as-octs:mimes:html
.^(@ %cx path)
::
++ handle-action
|= =action
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
:: +give-tile-data: total unread count as json object
::
::NOTE the full recalc of totals here probably isn't the end of the world.
:: but in case it is, well, here it is.
::
++ give-tile-data
^- card
=; =json
[%give %fact ~[/tile] %json !>(json)]
%+ frond:enjs:format 'unseen'
%- numb:enjs:format
%- %~ rep in
(scry-for (jug path url) /unseen)
|= [[=path unseen=(set url)] total=@ud]
%+ add total
~(wyt in unseen)
::
:: +give-initial-submissions: page of submissions on path
::
:: for the / path, give page for every path
::
:: result is in the shape of: {
:: "/some/path": {
:: totalItems: 1,
:: totalPages: 1,
:: pageNumber: 0,
:: page: [
:: { commentCount: 1, ...restOfTheSubmission }
:: ]
:: },
:: "/maybe/more": { etc }
:: }
::
++ give-initial-submissions
|= [p=@ud =path]
^- (list card)
:_ ?: =(0 p) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'initial-submissions'
%- pairs:enjs:format
%+ turn
%~ tap by
%+ scry-for (map ^path submissions)
[%submissions path]
|= [=^path =submissions]
^- [@t json]
:- (spat path)
=; =json
:: add unseen count
::
?> ?=(%o -.json)
:- %o
%+ ~(put by p.json) 'unseenCount'
%- numb:enjs:format
%~ wyt in
%+ scry-for (set url)
[%unseen path]
%^ page-to-json p
%+ get-paginated `p
submissions
|= =submission
^- json
=/ =json (submission:en-json submission)
?> ?=([%o *] json)
:: add in seen status
::
=. p.json
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path path url.submission)]
:: add in comment count
::
=; comment-count=@ud
:- %o
%+ ~(put by p.json) 'commentCount'
(numb:enjs:format comment-count)
%- lent
~| [path url.submission]
^- comments
=- (~(got by (~(got by -) path)) url.submission)
%+ scry-for (per-path-url comments)
:- %discussions
(build-discussion-path path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:en-json u.sub)
=/ =submissions
=- (~(got by -) path)
%+ scry-for (map ^path submissions)
[%submissions path]
|-
?~ submissions ~
=* sub i.submissions
?. =(url.sub url)
$(submissions t.submissions)
?: =(0 n) `sub
$(n (dec n), submissions t.submissions)
::
++ give-initial-discussions
|= [p=@ud =path =url]
^- (list card)
:_ ?: =(0 p) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'initial-discussions'
%^ page-to-json p
%+ get-paginated `p
=- (~(got by (~(got by -) path)) url)
%+ scry-for (per-path-url comments)
[%discussions (build-discussion-path path url)]
comment:en-json
::
++ send-update
|= =update
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
(update:en-json update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
(update:en-json update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path [path url]:update)
::
%observation
%+ give-json
(update:en-json update)
~[/json/seen]
==
::
++ give-json
|= [=json paths=(list path)]
^- card
[%give %fact paths %json !>(json)]
::
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
--

1
pkg/arvo/app/link/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/link/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/link/img/SwitcherClosed.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/link/img/SwitcherOpen.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/link/img/Tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
pkg/arvo/app/link/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

20
pkg/arvo/app/link/index.html Normal file
View File

@ -0,0 +1,20 @@
<!doctype html>
<html>
<head>
<title>Links</title>
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no" />
<link rel="stylesheet" href="/~link/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~link/js/index.js"></script>
</body>
</html>

1
pkg/arvo/app/link/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

1
pkg/arvo/app/link/js/tile.js Normal file
View File

File diff suppressed because one or more lines are too long

246
pkg/arvo/app/metadata-hook.hoon Normal file
View File

@ -0,0 +1,246 @@
:: metadata-hook: allow syncing foreign metadata
::
:: watch paths:
:: /group/%group-path all updates related to this group
::
/- *metadata-store, *metadata-hook
/+ default-agent
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
synced=(map group-path ship)
==
--
=| state-zero
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
[[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~ this]
::
++ on-save !>(state)
++ on-load |=(=vase `this(state !<(state-zero vase)))
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%metadata-hook-action
=^ cards state
(poke-hook-action:hc !<(metadata-hook-action vase))
[cards this]
::
%metadata-action
[(poke-action:hc !<(metadata-action vase)) this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%group *] [(watch-group:hc t.path) this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick =^(cards state (kick:hc wire) [cards this])
%watch-ack =^(cards state (watch-ack:hc wire p.sign) [cards this])
%fact
?+ p.cage.sign (on-agent:def wire sign)
%metadata-update
=^ cards state
(fact-metadata-update:hc wire !<(metadata-update q.cage.sign))
[cards this]
==
==
--
::
|_ =bowl:gall
++ poke-hook-action
|= act=metadata-hook-action
^- (quip card _state)
|^
?- -.act
%add-owned
?> (team:title our.bowl src.bowl)
:- ~
?: (~(has by synced) path.act) state
state(synced (~(put by synced) path.act our.bowl))
::
%add-synced
?> (team:title our.bowl src.bowl)
=/ =path [%group path.act]
?: (~(has by synced) path.act) [~ state]
:_ state(synced (~(put by synced) path.act ship.act))
[%pass path %agent [ship.act %metadata-hook] %watch path]~
::
%remove
=/ ship (~(get by synced) path.act)
?~ ship [~ state]
?: &(!=(u.ship src.bowl) ?!((team:title our.bowl src.bowl)))
[~ state]
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (unsubscribe [%group path.act] u.ship)
[%give %kick ~[[%group path.act]] ~]~
==
==
::
++ unsubscribe
|= [=path =ship]
^- (list card)
?: =(ship our.bowl)
[%pass path %agent [our.bowl %metadata-store] %leave ~]~
[%pass path %agent [ship %metadata-hook] %leave ~]~
--
::
++ poke-action
|= act=metadata-action
^- (list card)
|^
?: (team:title our.bowl src.bowl)
?- -.act
%add (send group-path.act)
%remove (send group-path.act)
==
?> (is-permitted src.bowl group-path.act)
?- -.act
%add (metadata-poke our.bowl %metadata-store)
%remove (metadata-poke our.bowl %metadata-store)
==
::
++ send
|= =group-path
^- (list card)
=/ =ship
%+ slav %p
?: (is-managed group-path) (snag 0 group-path)
(snag 1 group-path)
=/ app ?:(=(ship our.bowl) %metadata-store %metadata-hook)
(metadata-poke ship app)
::
++ metadata-poke
|= [=ship app=@tas]
^- (list card)
[%pass / %agent [ship app] %poke %metadata-action !>(act)]~
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
--
::
++ watch-group
|= =path
^- (list card)
|^
?> =(our.bowl (~(got by synced) path))
?> (is-permitted src.bowl path)
%+ turn ~(tap by (metadata-scry path))
|= [[=group-path =resource] =metadata]
^- card
[%give %fact ~ %metadata-update !>([%add group-path resource metadata])]
::
++ metadata-scry
|= pax=^path
^- associations
=. pax ;:(weld /=metadata-store/(scot %da now.bowl)/group pax /noun)
.^(associations %gx pax)
--
::
++ fact-metadata-update
|= [wir=wire fact=metadata-update]
^- (quip card _state)
|^
[?:((team:title our.bowl src.bowl) handle-local handle-foreign) state]
::
++ handle-local
?+ -.fact ~
%add
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%update-metadata
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%remove
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
==
::
++ handle-foreign
?+ -.fact ~
%add
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
::
%update-metadata
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke [%add +.fact])
::
%remove
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
==
::
++ give
|= [=path upd=metadata-update]
^- (list card)
[%give %fact ~[[%group path]] %metadata-update !>(upd)]~
::
++ poke
|= act=metadata-action
^- (list card)
[%pass / %agent [our.bowl %metadata-store] %poke %metadata-action !>(act)]~
--
::
++ kick
|= wir=wire
^- (quip card _state)
:_ state
?+ wir !!
[%updates ~]
[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~
::
[%group @ *]
?. (~(has by synced) t.wir) ~
=/ =ship (~(got by synced) t.wir)
?: =(ship our.bowl)
[%pass wir %agent [our.bowl %metadata-store] %watch wir]~
[%pass wir %agent [ship %metadata-hook] %watch wir]~
==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?> ?=(^ wir)
[~ ?~(saw state state(synced (~(del by synced) t.wir)))]
::
++ is-permitted
|= [=ship pax=path]
^- ?
=. pax
;: weld
/=permission-store/(scot %da now.bowl)/permitted
[(scot %p ship) pax]
/noun
==
.^(? %gx pax)
--

205
pkg/arvo/app/metadata-store.hoon Normal file
View File

@ -0,0 +1,205 @@
:: metadata-store: data store for application metadata and mappings
:: between groups and resources within applications
::
:: group-paths are expected to be an existing group path
:: resources are expected to correspond to existing app paths
::
:: note: when scrying for metadata, to make the arguments safe in paths,
:: encode group-path and app-path using (scot %t (spat group-path))
::
:: +watch paths:
:: /all assocations + updates
:: /updates just updates
:: /app-name/%app-name specific app's associations + updates
::
:: +peek paths:
:: /associations all associations
:: /group-indices all group indices
:: /app-indices all app indices
:: /resource-indices all resource indices
:: /metadata/%group-path/%app-name/%app-path specific metadatum
:: /app-name/%app-name associations for app
:: /group/%group-path associations for group
::
/+ *metadata-json, default-agent, verb, dbug
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
=associations
group-indices=(jug group-path resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug resource group-path)
==
--
::
=| state-zero
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
metadata-core +>
mc ~(. metadata-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%metadata-action mark)
(poke-metadata-action:mc !<(metadata-action vase))
(on-poke:def mark 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 %metadata-update !>([%associations associations]))
[%updates ~] ~
[%app-name @ ~]
=/ =app-name i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update !>([%associations app-indices]))
==
[cards this]
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %group-indices ~] ``noun+!>(group-indices)
[%y %app-indices ~] ``noun+!>(app-indices)
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%x %app-name @ ~]
=/ =app-name i.t.t.path
``noun+!>((metadata-for-app:mc app-name))
::
[%x %group *]
=/ =group-path t.t.path
``noun+!>((metadata-for-group:mc group-path))
::
[%x %metadata @ @ @ ~]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =resource [`@tas`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
``noun+!>((~(got by associations) [group-path resource]))
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ poke-metadata-action
|= act=metadata-action
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%add
(handle-add group-path.act resource.act metadata.act)
::
%remove
(handle-remove group-path.act resource.act)
==
::
++ handle-add
|= [=group-path =resource =metadata]
^- (quip card _state)
:- %+ send-diff app-name.resource
?. (~(has by resource-indices) resource)
[%add group-path resource metadata]
[%update-metadata group-path resource metadata]
%= state
associations
(~(put by associations) [group-path resource] metadata)
::
group-indices
(~(put ju group-indices) group-path resource)
::
app-indices
(~(put ju app-indices) app-name.resource [group-path app-path.resource])
::
resource-indices
(~(put ju resource-indices) resource group-path)
==
::
++ handle-remove
|= [=group-path =resource]
^- (quip card _state)
:- (send-diff app-name.resource [%remove group-path resource])
%= state
associations
(~(del by associations) [group-path resource])
::
group-indices
(~(del ju group-indices) group-path resource)
::
app-indices
(~(del ju app-indices) app-name.resource [group-path app-path.resource])
::
resource-indices
(~(del ju resource-indices) resource group-path)
==
::
++ metadata-for-app
|= =app-name
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by app-indices) app-name ~))
|= [=group-path =app-path]
:- [group-path [app-name app-path]]
(~(got by associations) [group-path [app-name app-path]])
::
++ metadata-for-group
|= =group-path
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(got by group-indices) group-path))
|= =resource
:- [group-path resource]
(~(got by associations) [group-path resource])
::
++ send-diff
|= [=app-name upd=metadata-update]
^- (list card)
|^
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%app-name app-name ~] upd)
==
::
++ update-subscribers
|= [pax=path upd=metadata-update]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(upd)]~
--
--

3
pkg/arvo/app/permission-group-hook.hoon
View File

@ -3,7 +3,7 @@
:: mirror the ships in specified groups to specified permission paths
::
/- *group-store, *permission-group-hook
/+ *permission-json, default-agent, verb
/+ *permission-json, default-agent, verb, dbug
::
|%
+$ state
@ -25,6 +25,7 @@
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall

3001
pkg/arvo/app/publish.hoon
View File

File diff suppressed because it is too large Load Diff

3
pkg/arvo/app/publish/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/publish/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/publish/img/SwitcherClosed.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/publish/img/SwitcherOpen.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/publish/img/arrow.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 245 B

BIN
pkg/arvo/app/publish/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/publish/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

BIN
pkg/arvo/app/publish/img/tile.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.1 KiB

After

Width:  |  Height:  |  Size: 4.3 KiB

2
pkg/arvo/app/publish/index.hoon
View File

@ -16,7 +16,7 @@
==
::
;body
;div#root;
;div#root.w-100.h-100;
;script@"/~publish/index.js";
==
==

2
pkg/arvo/app/publish/js/index.js
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/publish/js/tile.js
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/soto/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/soto/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/soto/img/Tile.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 6.4 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
pkg/arvo/app/soto/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

6
pkg/arvo/app/soto/index.html
View File

@ -6,9 +6,11 @@
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~dojo/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body class="bg-black">
<div id="root" />
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~dojo/js/index.js"></script>

2
pkg/arvo/app/soto/js/index.js
View File

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/soto/js/tile.js
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/weather/img/chancerain.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 549 B

BIN
pkg/arvo/app/weather/img/clear-day.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.1 KiB

BIN
pkg/arvo/app/weather/img/clear-night.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.1 KiB

BIN
pkg/arvo/app/weather/img/cloudy.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/weather/img/fog.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 411 B

BIN
pkg/arvo/app/weather/img/high.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 960 B

BIN
pkg/arvo/app/weather/img/low.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 897 B

BIN
pkg/arvo/app/weather/img/partly-cloudy-day.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.3 KiB

BIN
pkg/arvo/app/weather/img/partly-cloudy-night.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.8 KiB

BIN
pkg/arvo/app/weather/img/rain.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.9 KiB

BIN
pkg/arvo/app/weather/img/sleet.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 593 B

BIN
pkg/arvo/app/weather/img/snow.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.5 KiB

BIN
pkg/arvo/app/weather/img/sunset.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 589 B

BIN
pkg/arvo/app/weather/img/wind.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.0 KiB

BIN
pkg/arvo/app/weather/img/winddirection.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 512 B

BIN
pkg/arvo/app/weather/img/windspeed.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 521 B

2
pkg/arvo/app/weather/js/tile.js
View File

File diff suppressed because one or more lines are too long

15
pkg/arvo/gen/hood/autocommit.hoon Normal file
View File

@ -0,0 +1,15 @@
:: Kiln: Commit from mount
::
:::: /hoon/commit/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{mon/term ~}
~
==
:- %kiln-commit
[mon &]

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

@ -0,0 +1,10 @@
:: link-store|note: write a note on a link in a path
::
/- *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path =url note=@t ~] ~]
==
:- %link-action
^- action
[%note path url note]

4
pkg/arvo/gen/link-store/add.hoon → pkg/arvo/gen/link-store/save.hoon
View File

@ -1,4 +1,4 @@
:: link-store|add: save a link to a path
:: link-store|save: save a link to a path
::
/- *link
:- %say
@ -7,4 +7,4 @@
==
:- %link-action
^- action
[%add path title url]
[%save path title url]

8
pkg/arvo/lib/base64.hoon
View File

@ -60,7 +60,7 @@
::
|^ |= bs=octs ^- cord
=/ [padding=@ blocks=(list word24)]
(octs-to-blocks bs)
(octs-to-blocks bs)
(crip (flop (unpad padding (encode-blocks blocks))))
::
++ octs-to-blocks
@ -127,10 +127,6 @@
=/ len (sub (mul 3 (div (add lat dif) 4)) dif)
:+ ~ len
%+ swp 3
:: %+ base 64
%+ roll
(weld dat (reap dif 0))
|=([p=@ q=@] (add p (mul 64 q)))
(repn 6 (flop (weld dat (reap dif 0))))
--
--

2
pkg/arvo/lib/bip32.hoon
View File

@ -212,5 +212,5 @@
::
++ hash160
|= d=@
(ripemd-160:ripemd:crypto 256 (sha-256:sha d))
(ripemd-160:ripemd:crypto 32 (sha-256:sha d))
--

23
pkg/arvo/lib/chat-json.hoon
View File

@ -142,11 +142,7 @@
?: ?=(%read -.upd)
[%read (pairs [%path (path path.upd)]~)]
?: ?=(%create -.upd)
:- %create
%- pairs
:~ [%ship (ship ship.upd)]
[%path (path path.upd)]
==
[%create (pairs [%path (path path.upd)]~)]
?: ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
?: ?=(%config -.upd)
@ -174,10 +170,7 @@
==
::
++ create
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%path pa]
==
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
@ -231,20 +224,22 @@
::
++ create
%- ot
:~ [%path pa]
:~ [%title so]
[%description so]
[%app-path pa]
[%group-path pa]
[%security sec]
[%read (as (su ;~(pfix sig fed:ag)))]
[%write (as (su ;~(pfix sig fed:ag)))]
[%members (as (su ;~(pfix sig fed:ag)))]
[%allow-history bo]
==
::
++ delete
(ot [%path pa]~)
(ot [%app-path pa]~)
::
++ join
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%path pa]
[%app-path pa]
[%ask-history bo]
==
::

208
pkg/arvo/lib/contact-json.hoon Normal file
View File

@ -0,0 +1,208 @@
/- *contact-view
|%
++ nu :: parse number as hex
|= jon/json
?> ?=({$s *} jon)
(rash p.jon hex)
::
++ rolodex-to-json
|= rolo=rolodex
=, enjs:format
^- json
%+ frond %contact-initial
%- pairs
%+ turn ~(tap by rolo)
|= [pax=^path =contacts]
^- [cord json]
:- (spat pax)
(contacts-to-json contacts)
::
++ contacts-to-json
|= con=contacts
^- json
=, enjs:format
%- pairs
%+ turn ~(tap by con)
|= [shp=^ship =contact]
^- [cord json]
:- (crip (slag 1 (scow %p shp)))
(contact-to-json contact)
::
++ contact-to-json
|= con=contact
^- json
=, enjs:format
%- pairs
:~ [%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 s+'TODO']
==
::
++ edit-to-json
|= edit=edit-field
^- json
=, enjs:format
%+ frond -.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 s+'TODO'
==
::
++ update-to-json
|= upd=contact-update
=, enjs:format
^- json
%+ frond %contact-update
%- pairs
:~
?: ?=(%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 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 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]
[%remove remove]
[%share share]
==
::
++ create
%- ot
:~ [%path pa]
[%ships (as (su ;~(pfix sig fed:ag)))]
[%title so]
[%description 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
%- ot:dejs:format
:~ [%content-type so:dejs:format]
[%octs octet]
==
::
++ 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)]
==
--

37
pkg/arvo/lib/hood/drum.hoon
View File

@ -109,6 +109,15 @@
%chat-view
%chat-cli
%soto
%contact-store
%contact-hook
%contact-view
%link-store
%link-proxy-hook
%link-listen-hook
%link-view
%metadata-store
%metadata-hook
==
::
++ deft-fish :: default connects
@ -214,9 +223,31 @@
==
::
++ on-load
|= %1
=< se-abet =< se-view
(se-born %home %goad)
|= ver=?(%1 %2)
?- ver
%1
=< se-abet =< se-view
=< (se-born %home %goad)
=< (se-born %home %metadata-store)
=< (se-born %home %contact-store)
=< (se-born %home %contact-hook)
=< (se-born %home %contact-view)
=< (se-born %home %link-store)
=< (se-born %home %link-proxy-hook)
=< (se-born %home %link-listen-hook)
(se-born %home %link-view)
::
%2
=< se-abet =< se-view
=< (se-born %home %metadata-store)
=< (se-born %home %contact-store)
=< (se-born %home %contact-hook)
=< (se-born %home %contact-view)
=< (se-born %home %link-store)
=< (se-born %home %link-proxy-hook)
=< (se-born %home %link-listen-hook)
(se-born %home %link-view)
==
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}

12
pkg/arvo/lib/hood/kiln.hoon
View File

@ -78,6 +78,17 @@
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
::
++ poke-commit
|= [mon/kiln-commit auto=?]
=< abet
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
::
++ poke-autocommit
|= [mon/kiln-commit auto=?]
=< abet
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
@ -185,6 +196,7 @@
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)

158
pkg/arvo/lib/link.hoon
View File

@ -22,28 +22,176 @@
%| (rsh 3 1 (scot %if p.host))
==
::
++ build-discussion-path
|= args=$@(url [=path =url])
|^ ^- path
?@ args ~[(encode-url-for-path args)]
:_ path.args
(encode-url-for-path url.args)
::
++ encode-url-for-path
|= =url
(scot %ta (wood url))
--
::
++ break-discussion-path
|= =path
^- [=^path =url]
?~ path [/ '']
:- t.path
?: =(~ i.path) ''
~| path
(woad (slav %ta i.path))
::
:: zip sorted a into sorted b, maintaining sort order
::TODO stdlib
++ merge-sorted
|* [sort=$-([* *] ?) a=(list) b=(list)]
|- ^- ?(_a _b)
?~ a b
?~ b a
?: (sort i.a i.b)
[i.a $(a t.a)]
[i.b $(b t.b)]
::
++ merge
|%
++ pages
::TODO we would just use +cury here but it don't work
|= [a=^pages b=^pages]
^+ a
%+ merge-sorted
|= [a=page b=page]
(gth time.a time.b)
[a b]
::
++ submissions
|= [a=^submissions b=^submissions]
^+ a
%+ merge-sorted
|= [a=submission b=submission]
(gth time.a time.b)
[a b]
::
++ notes
|= [a=^notes b=^notes]
^+ a
%+ merge-sorted
|= [a=note b=note]
(gth time.a time.b)
[a b]
::
++ comments
|= [a=^comments b=^comments]
^+ a
%+ merge-sorted
|= [a=comment b=comment]
(gth time.a time.b)
[a b]
--
::
++ en-json
=, enjs:format
|%
++ update
|= upd=^update
^- json
%- frond
:- -.upd
?- -.upd
%local-pages
%- pairs
:~ 'path'^(path path.upd)
'pages'^a+(turn pages.upd page)
==
::
%submissions
%- pairs
:~ 'path'^(path path.upd)
'pages'^a+(turn submissions.upd submission)
==
::
%annotations
%- pairs
:~ 'path'^(path path.upd)
'url'^s+url.upd
'notes'^a+(turn notes.upd note)
==
::
%discussions
%- pairs
:~ 'path'^(path path.upd)
'url'^s+url.upd
'comments'^a+(turn comments.upd comment)
==
::
%observation
%- pairs
:~ 'path'^(path path.upd)
'urls'^a+(turn ~(tap in urls.upd) |=(=url s+url))
==
==
::
++ submission
|= sub=^submission
^- json
=+ p=(page +.sub)
?> ?=([%o *] p)
o+(~(put by p.p) 'ship' (ship ship.sub))
::
++ page
|= =^page
^- json
%- pairs
:~ 'title'^s+title.page
'url'^s+url.page
'timestamp'^(time time.page)
'time'^(time time.page)
==
::
++ comment
|= =^comment
^- json
=+ n=(note +.comment)
?> ?=([%o *] n)
o+(~(put by p.n) 'ship' (ship ship.comment))
::
++ note
|= =^note
^- json
%- pairs
:~ 'time'^(time time.note)
'udon'^s+udon.note ::TODO convert?
==
--
::
++ de-json
=, dejs:format
|%
:: +action: json into action
::
:: formats:
:: {save: {path: '/path', title: 'title', url: 'url'}}
:: {note: {path: '/path', url: 'url', udon: 'text, maybe udon'}}
::
++ action
|= =json
^- ^action
?> ?=([%o [%add *] ~ ~] json)
:- %add ::TODO +of doesn't please type system?
%. q.n.p.json
(ot 'path'^pa 'title'^so 'url'^so ~)
::TODO the type system doesn't like +of here?
?+ json ~|(json !!)
[%o [%save *] ~ ~]
:- %save
%. q.n.p.json
(ot 'path'^pa 'title'^so 'url'^so ~)
::
[%o [%note *] ~ ~]
:- %note
%. q.n.p.json
(ot 'path'^pa 'url'^so 'udon'^so ~)
::
[%o [%seen *] ~ ~]
:- %seen
%. q.n.p.json
(ot 'path'^pa 'url'^(mu so) ~)
==
--
--

Some files were not shown because too many files have changed in this diff Show More