Merge branch 'os1-rc' (#2365)
* origin/os1-rc: (439 commits) 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 chat: remove console.log from metadataAction chat: style fixes during review, use metadata-hook chat: edit description, color settings chat: add update-metadata to metadata reducer chat: revise api.js to match data structures metadata-json: add json to action parsers chat: construct settings page for metadata chat: correct bottom border on join links chat: copy shortcodes chat: linkify unmanaged chats metadata-hook: support group members other than host creating shared resources contacts: add bg-gray0 to root page chat + contact views: updated for style and to assert that group-path must be equal to app-path if there are ships in the members set contacts: changed color + copy of "add to group" button ...
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:4de6eed9c7702cc0f07ab01fc4f970a59f394a9b632ad4c20d4c544b93199f0f
|
||||
size 7225555
|
||||
oid sha256:e54f9743a829b48db52afabe1cd0257d4afd3206621ec292f8142f3fb74d3634
|
||||
size 10450375
|
||||
|
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:a027859d4d4d322fc90ae72b5cd04747d806894051cb60426f35dc5a0dea5216
|
||||
size 1231117
|
||||
oid sha256:8c02ad7601a4e4355cabdbf02bdcc384d3f76f50f9349979a14612c3d4b57b8f
|
||||
size 1231420
|
||||
|
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:9211b21328ab202e35ade5e1c94d74b45d06a5a05d5814bd1c9d88200e5c7987
|
||||
size 9694669
|
||||
oid sha256:a9f2d9c7352f07c0930b285a20622b42f193208055b21bd6ee913549d41b4178
|
||||
size 12887758
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
::
|
||||
--
|
||||
|
Before Width: | Height: | Size: 866 B After Width: | Height: | Size: 1.3 KiB |
Before Width: | Height: | Size: 861 B After Width: | Height: | Size: 1.4 KiB |
Before Width: | Height: | Size: 255 B After Width: | Height: | Size: 679 B |
Before Width: | Height: | Size: 1.7 KiB After Width: | Height: | Size: 4.7 KiB |
Before Width: | Height: | Size: 854 B After Width: | Height: | Size: 1.5 KiB |
BIN
pkg/arvo/app/chat/img/search.png
Normal file
After Width: | Height: | Size: 951 B |
@ -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>
|
||||
|
@ -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
|
||||
|
427
pkg/arvo/app/contact-hook.hoon
Normal 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
@ -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
@ -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 [~ /'~contacts'] %contact-view]
|
||||
(launch-poke:cc [%contact-view /primary '/~contacts/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
|
||||
[%'~contacts' %css %index ~] (css-response:gen style)
|
||||
[%'~contacts' %js %index ~] (js-response:gen script)
|
||||
[%'~contacts' %js %tile ~] (js-response:gen tile-js)
|
||||
[%'~contacts' %img *]
|
||||
(png-response:gen (as-octs:mimes:html (~(got by contact-png) `@ta`name)))
|
||||
::
|
||||
:: avatar images
|
||||
::
|
||||
[%'~contacts' %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]
|
||||
::
|
||||
[%'~contacts' *] (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
BIN
pkg/arvo/app/contacts/img/Home.png
Normal file
After Width: | Height: | Size: 679 B |
BIN
pkg/arvo/app/contacts/img/Tile.png
Normal file
After Width: | Height: | Size: 5.1 KiB |
BIN
pkg/arvo/app/contacts/img/search.png
Normal file
After Width: | Height: | Size: 951 B |
17
pkg/arvo/app/contacts/index.html
Normal file
@ -0,0 +1,17 @@
|
||||
<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<title>Contacts</title>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="viewport"
|
||||
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
|
||||
<link rel="stylesheet" href="/~contacts/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="/~contacts/js/index.js"></script>
|
||||
</body>
|
||||
</html>
|
1
pkg/arvo/app/contacts/js/index.js
Normal file
1
pkg/arvo/app/contacts/js/tile.js
Normal 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))
|
||||
~
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
::
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
==
|
||||
--
|
||||
|
@ -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)
|
||||
==
|
||||
--
|
@ -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
@ -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
BIN
pkg/arvo/app/link/img/Home.png
Normal file
After Width: | Height: | Size: 679 B |
BIN
pkg/arvo/app/link/img/SwitcherClosed.png
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
pkg/arvo/app/link/img/SwitcherOpen.png
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
pkg/arvo/app/link/img/Tile.png
Normal file
After Width: | Height: | Size: 3.3 KiB |
BIN
pkg/arvo/app/link/img/popout.png
Normal file
After Width: | Height: | Size: 1.4 KiB |
20
pkg/arvo/app/link/index.html
Normal 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
1
pkg/arvo/app/link/js/tile.js
Normal file
246
pkg/arvo/app/metadata-hook.hoon
Normal 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
@ -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,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
|
||||
|
BIN
pkg/arvo/app/publish/img/Home.png
Normal file
After Width: | Height: | Size: 679 B |
BIN
pkg/arvo/app/publish/img/SwitcherClosed.png
Normal file
After Width: | Height: | Size: 1.3 KiB |
BIN
pkg/arvo/app/publish/img/SwitcherOpen.png
Normal file
After Width: | Height: | Size: 1.4 KiB |
Before Width: | Height: | Size: 245 B |
BIN
pkg/arvo/app/publish/img/popout.png
Normal file
After Width: | Height: | Size: 1.4 KiB |
BIN
pkg/arvo/app/publish/img/search.png
Normal file
After Width: | Height: | Size: 951 B |
Before Width: | Height: | Size: 1.1 KiB After Width: | Height: | Size: 4.3 KiB |
@ -16,7 +16,7 @@
|
||||
==
|
||||
::
|
||||
;body
|
||||
;div#root;
|
||||
;div#root.w-100.h-100;
|
||||
;script@"/~publish/index.js";
|
||||
==
|
||||
==
|
||||
|
BIN
pkg/arvo/app/soto/img/Home.png
Normal file
After Width: | Height: | Size: 679 B |
Before Width: | Height: | Size: 6.4 KiB After Width: | Height: | Size: 2.2 KiB |
BIN
pkg/arvo/app/soto/img/popout.png
Normal file
After Width: | Height: | Size: 1.5 KiB |
@ -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>
|
||||
|
Before Width: | Height: | Size: 549 B |
Before Width: | Height: | Size: 2.1 KiB |
Before Width: | Height: | Size: 2.1 KiB |
Before Width: | Height: | Size: 1.4 KiB |
Before Width: | Height: | Size: 411 B |
Before Width: | Height: | Size: 960 B |
Before Width: | Height: | Size: 897 B |
Before Width: | Height: | Size: 2.3 KiB |
Before Width: | Height: | Size: 1.8 KiB |
Before Width: | Height: | Size: 1.9 KiB |
Before Width: | Height: | Size: 593 B |
Before Width: | Height: | Size: 1.5 KiB |
Before Width: | Height: | Size: 589 B |
Before Width: | Height: | Size: 1.0 KiB |
Before Width: | Height: | Size: 512 B |
Before Width: | Height: | Size: 521 B |
15
pkg/arvo/gen/hood/autocommit.hoon
Normal 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
@ -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]
|
@ -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]
|
@ -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))))
|
||||
--
|
||||
--
|
||||
|
||||
|
@ -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
@ -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)]
|
||||
==
|
||||
--
|
@ -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)}
|
||||
|
@ -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)
|
||||
|
@ -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) ~)
|
||||
==
|
||||
--
|
||||
--
|
||||
|
117
pkg/arvo/lib/metadata-json.hoon
Normal file
@ -0,0 +1,117 @@
|
||||
/- *metadata-store
|
||||
|%
|
||||
++ associations-to-json
|
||||
|= =associations
|
||||
=, enjs:format
|
||||
^- json
|
||||
%- pairs
|
||||
%+ turn ~(tap by associations)
|
||||
|= [[=group-path =resource] =metadata]
|
||||
^- [cord json]
|
||||
:-
|
||||
%- crip
|
||||
;: weld
|
||||
(trip (spat group-path))
|
||||
(weld "/" (trip app-name.resource))
|
||||
(trip (spat app-path.resource))
|
||||
==
|
||||
%- pairs
|
||||
:~ [%group-path (path group-path)]
|
||||
[%app-name s+app-name.resource]
|
||||
[%app-path (path app-path.resource)]
|
||||
[%metadata (metadata-to-json metadata)]
|
||||
==
|
||||
::
|
||||
++ json-to-action
|
||||
|= jon=json
|
||||
^- metadata-action
|
||||
=, dejs:format
|
||||
=< (parse-json jon)
|
||||
|%
|
||||
++ parse-json
|
||||
%- of
|
||||
:~ [%add add]
|
||||
[%remove remove]
|
||||
==
|
||||
::
|
||||
++ add
|
||||
%- ot
|
||||
:~ [%group-path pa]
|
||||
[%resource resource]
|
||||
[%metadata metadata]
|
||||
==
|
||||
++ remove
|
||||
%- ot
|
||||
:~ [%group-path pa]
|
||||
[%resource resource]
|
||||
==
|
||||
::
|
||||
++ nu
|
||||
|= jon=json
|
||||
?> ?=({$s *} jon)
|
||||
(rash p.jon hex)
|
||||
::
|
||||
++ metadata
|
||||
%- ot
|
||||
:~ [%title so]
|
||||
[%description so]
|
||||
[%color nu]
|
||||
[%date-created (se %da)]
|
||||
[%creator (su ;~(pfix sig fed:ag))]
|
||||
==
|
||||
++ resource
|
||||
%- ot
|
||||
:~ [%app-name so]
|
||||
[%app-path pa]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ metadata-to-json
|
||||
|= met=metadata
|
||||
^- json
|
||||
=, enjs:format
|
||||
%- pairs
|
||||
:~ [%title s+title.met]
|
||||
[%description s+description.met]
|
||||
[%color s+(scot %ux color.met)]
|
||||
[%date-created s+(scot %da date-created.met)]
|
||||
[%creator s+(scot %p creator.met)]
|
||||
==
|
||||
::
|
||||
++ update-to-json
|
||||
|= upd=metadata-update
|
||||
=, enjs:format
|
||||
^- json
|
||||
%+ frond %metadata-update
|
||||
%- pairs
|
||||
:~ ?- -.upd
|
||||
%add
|
||||
:- %add
|
||||
%- pairs
|
||||
:~ [%group-path (path group-path.upd)]
|
||||
[%app-name s+app-name.resource.upd]
|
||||
[%app-path (path app-path.resource.upd)]
|
||||
[%metadata (metadata-to-json metadata.upd)]
|
||||
==
|
||||
::
|
||||
%update-metadata
|
||||
:- %update-metadata
|
||||
%- pairs
|
||||
:~ [%group-path (path group-path.upd)]
|
||||
[%app-name s+app-name.resource.upd]
|
||||
[%app-path (path app-path.resource.upd)]
|
||||
[%metadata (metadata-to-json metadata.upd)]
|
||||
==
|
||||
::
|
||||
%remove
|
||||
:- %remove
|
||||
%- pairs
|
||||
:~ [%group-path (path group-path.upd)]
|
||||
[%app-name s+app-name.resource.upd]
|
||||
[%app-path (path app-path.resource.upd)]
|
||||
==
|
||||
::
|
||||
%associations
|
||||
[%associations (associations-to-json associations.upd)]
|
||||
== ==
|
||||
--
|
@ -2,71 +2,6 @@
|
||||
/+ elem-to-react-json
|
||||
|%
|
||||
::
|
||||
++ front-to-post-info
|
||||
|= fro=(map knot cord)
|
||||
^- post-info
|
||||
=/ got ~(got by fro)
|
||||
~| %invalid-frontmatter
|
||||
:* (slav %p (got %creator))
|
||||
(got %title)
|
||||
(got %collection)
|
||||
(got %filename)
|
||||
(comment-config (got %comments))
|
||||
(slav %da (got %date-created))
|
||||
(slav %da (got %last-modified))
|
||||
(rash (got %pinned) (fuss %true %false))
|
||||
==
|
||||
::
|
||||
++ front-to-comment-info
|
||||
|= fro=(map knot cord)
|
||||
^- comment-info
|
||||
=/ got ~(got by fro)
|
||||
~| %invalid-frontmatter
|
||||
:* (slav %p (got %creator))
|
||||
(got %collection)
|
||||
(got %post)
|
||||
(slav %da (got %date-created))
|
||||
(slav %da (got %last-modified))
|
||||
==
|
||||
::
|
||||
++ collection-info-to-json
|
||||
|= con=collection-info
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ :- %owner [%s (scot %p owner.con)]
|
||||
:- %title [%s title.con]
|
||||
:- %comments [%s comments.con]
|
||||
:- %allow-edit [%s allow-edit.con]
|
||||
:- %date-created (time:enjs:format date-created.con)
|
||||
:- %last-modified (time:enjs:format last-modified.con)
|
||||
:- %filename [%s filename.con]
|
||||
==
|
||||
::
|
||||
++ post-info-to-json
|
||||
|= info=post-info
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ :- %creator [%s (scot %p creator.info)]
|
||||
:- %title [%s title.info]
|
||||
:- %comments [%s comments.info]
|
||||
:- %date-created (time:enjs:format date-created.info)
|
||||
:- %last-modified (time:enjs:format last-modified.info)
|
||||
:- %pinned [%b pinned.info]
|
||||
:- %filename [%s filename.info]
|
||||
:- %collection [%s collection.info]
|
||||
==
|
||||
::
|
||||
++ comment-info-to-json
|
||||
|= info=comment-info
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ :- %creator [%s (scot %p creator.info)]
|
||||
:- %date-created (time:enjs:format date-created.info)
|
||||
:- %last-modified (time:enjs:format last-modified.info)
|
||||
:- %post [%s post.info]
|
||||
:- %collection [%s collection.info]
|
||||
==
|
||||
::
|
||||
++ tang-to-json
|
||||
|= tan=tang
|
||||
%- wall:enjs:format
|
||||
@ -89,81 +24,227 @@
|
||||
(add 32 a)
|
||||
'-'
|
||||
::
|
||||
++ collection-build-to-json
|
||||
|= bud=(each collection-info tang)
|
||||
++ note-build-to-json
|
||||
|= build=(each manx tang)
|
||||
^- json
|
||||
?: ?=(%.y -.bud)
|
||||
(collection-info-to-json +.bud)
|
||||
(tang-to-json +.bud)
|
||||
::
|
||||
++ post-build-to-json
|
||||
|= bud=(each [post-info manx @t] tang)
|
||||
^- json
|
||||
?: ?=(%.y -.bud)
|
||||
?: ?=(%.y -.build)
|
||||
%- pairs:enjs:format
|
||||
:~ info+(post-info-to-json +<.bud)
|
||||
body+(elem-to-react-json +>-.bud)
|
||||
raw+[%s +>+.bud]
|
||||
:~ success+b+%.y
|
||||
result+(elem-to-react-json p.build)
|
||||
==
|
||||
(tang-to-json +.bud)
|
||||
::
|
||||
++ comment-build-to-json
|
||||
|= bud=(each (list [comment-info @t]) tang)
|
||||
^- json
|
||||
?: ?=(%.y -.bud)
|
||||
:- %a
|
||||
%+ turn p.bud
|
||||
|= [com=comment-info bod=@t]
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ info+(comment-info-to-json com)
|
||||
body+s+bod
|
||||
==
|
||||
(tang-to-json +.bud)
|
||||
::
|
||||
++ total-build-to-json
|
||||
|= col=collection
|
||||
^- json
|
||||
%- pairs:enjs:format
|
||||
:~ info+(collection-build-to-json col.col)
|
||||
::
|
||||
:+ %posts
|
||||
%o
|
||||
%+ roll ~(tap in ~(key by pos.col))
|
||||
|= [post=@tas out=(map @t json)]
|
||||
=/ post-build (~(got by pos.col) post)
|
||||
=/ comm-build (~(got by com.col) post)
|
||||
|
||||
%+ ~(put by out)
|
||||
post
|
||||
%- pairs:enjs:format
|
||||
:~ post+(post-build-to-json post-build)
|
||||
comments+(comment-build-to-json comm-build)
|
||||
==
|
||||
::
|
||||
:- %order
|
||||
%- pairs:enjs:format
|
||||
:~ pin+a+(turn pin.order.col |=(s=@tas [%s s]))
|
||||
unpin+a+(turn unpin.order.col |=(s=@tas [%s s]))
|
||||
==
|
||||
::
|
||||
:- %contributors
|
||||
%- pairs:enjs:format
|
||||
:~ mod+s+mod.contributors.col
|
||||
:+ %who
|
||||
%a
|
||||
%+ turn ~(tap in who.contributors.col)
|
||||
|= who=@p
|
||||
(ship:enjs:format who)
|
||||
==
|
||||
::
|
||||
:+ %subscribers
|
||||
%a
|
||||
%+ turn ~(tap in subscribers.col)
|
||||
|= who=@p
|
||||
:~ success+b+%.n
|
||||
result+(tang-to-json p.build)
|
||||
==
|
||||
::
|
||||
++ count-unread
|
||||
|= notes=(map @tas note)
|
||||
^- @ud
|
||||
%- ~(rep by notes)
|
||||
|= [[key=@tas val=note] count=@ud]
|
||||
?: read.val
|
||||
count
|
||||
+(count)
|
||||
::
|
||||
++ notebooks-list-json
|
||||
|= [our=@p books=(map @tas notebook) subs=(map [@p @tas] notebook)]
|
||||
^- json
|
||||
=, enjs:format
|
||||
:- %a
|
||||
%+ weld
|
||||
%+ turn ~(tap by books)
|
||||
|= [name=@tas book=notebook]
|
||||
(notebook-short-json book)
|
||||
%+ turn ~(tap by subs)
|
||||
|= [[host=@p name=@tas] book=notebook]
|
||||
(notebook-short-json book)
|
||||
::
|
||||
++ notebooks-map-json
|
||||
|= [our=@p books=(map @tas notebook) subs=(map [@p @tas] notebook)]
|
||||
^- json
|
||||
=, enjs:format
|
||||
=/ subs-notebooks-map=json
|
||||
%- ~(rep by subs)
|
||||
|= [[[host=@p book-name=@tas] book=notebook] out=json]
|
||||
^- json
|
||||
(ship:enjs:format who)
|
||||
::
|
||||
[%last-update (time:enjs:format last-update.col)]
|
||||
=/ host-ta (scot %p host)
|
||||
?~ out
|
||||
(frond host-ta (frond book-name (notebook-short-json book)))
|
||||
?> ?=(%o -.out)
|
||||
=/ books (~(get by p.out) host-ta)
|
||||
?~ books
|
||||
:- %o
|
||||
(~(put by p.out) host-ta (frond book-name (notebook-short-json book)))
|
||||
?> ?=(%o -.u.books)
|
||||
=. p.u.books (~(put by p.u.books) book-name (notebook-short-json book))
|
||||
:- %o
|
||||
(~(put by p.out) host-ta u.books)
|
||||
=? subs-notebooks-map ?=(~ subs-notebooks-map)
|
||||
[%o ~]
|
||||
=/ our-notebooks-map=json
|
||||
%- ~(rep by books)
|
||||
|= [[book-name=@tas book=notebook] out=json]
|
||||
^- json
|
||||
?~ out
|
||||
(frond book-name (notebook-short-json book))
|
||||
?> ?=(%o -.out)
|
||||
:- %o
|
||||
(~(put by p.out) book-name (notebook-short-json book))
|
||||
?~ our-notebooks-map
|
||||
subs-notebooks-map
|
||||
?> ?=(%o -.subs-notebooks-map)
|
||||
:- %o
|
||||
(~(put by p.subs-notebooks-map) (scot %p our) our-notebooks-map)
|
||||
::
|
||||
++ notebook-short-json
|
||||
|= book=notebook
|
||||
^- json
|
||||
=, enjs:format
|
||||
%- pairs
|
||||
:~ title+s+title.book
|
||||
date-created+(time date-created.book)
|
||||
about+s+description.book
|
||||
num-notes+(numb ~(wyt by notes.book))
|
||||
num-unread+(numb (count-unread notes.book))
|
||||
comments+b+comments.book
|
||||
writers-group-path+s+(spat writers.book)
|
||||
subscribers-group-path+s+(spat subscribers.book)
|
||||
==
|
||||
::
|
||||
++ notebook-full-json
|
||||
|= [host=@p book-name=@tas book=notebook]
|
||||
^- json
|
||||
=, enjs:format
|
||||
%- pairs
|
||||
:~ title+s+title.book
|
||||
about+s+description.book
|
||||
date-created+(time date-created.book)
|
||||
num-notes+(numb ~(wyt by notes.book))
|
||||
num-unread+(numb (count-unread notes.book))
|
||||
notes-by-date+(notes-by-date notes.book)
|
||||
comments+b+comments.book
|
||||
writers-group-path+s+(spat writers.book)
|
||||
subscribers-group-path+s+(spat subscribers.book)
|
||||
==
|
||||
::
|
||||
++ note-presentation-json
|
||||
|= [book=notebook note-name=@tas not=note]
|
||||
^- (map @t json)
|
||||
=, enjs:format
|
||||
=/ notes-list=(list [@tas note])
|
||||
%+ sort ~(tap by notes.book)
|
||||
|= [[@tas n1=note] [@tas n2=note]]
|
||||
(gte date-created.n1 date-created.n2)
|
||||
=/ idx=@ (need (find [note-name not]~ notes-list))
|
||||
=/ next=(unit [name=@tas not=note])
|
||||
?: =(idx 0) ~
|
||||
`(snag (dec idx) notes-list)
|
||||
=/ prev=(unit [name=@tas not=note])
|
||||
?: =(+(idx) (lent notes-list)) ~
|
||||
`(snag +(idx) notes-list)
|
||||
=/ current=json (note-full-json note-name not)
|
||||
?> ?=(%o -.current)
|
||||
=. p.current (~(put by p.current) %prev-note ?~(prev ~ s+name.u.prev))
|
||||
=. p.current (~(put by p.current) %next-note ?~(next ~ s+name.u.next))
|
||||
=/ notes=(list [@t json]) [note-name current]~
|
||||
=? notes ?=(^ prev)
|
||||
[[name.u.prev (note-short-json name.u.prev not.u.prev)] notes]
|
||||
=? notes ?=(^ next)
|
||||
[[name.u.next (note-short-json name.u.next not.u.next)] notes]
|
||||
%- my
|
||||
:~ notes+(pairs notes)
|
||||
notes-by-date+a+(turn notes-list |=([name=@tas *] s+name))
|
||||
==
|
||||
::
|
||||
++ note-full-json
|
||||
|= [note-name=@tas =note]
|
||||
^- json
|
||||
=, enjs:format
|
||||
%- pairs
|
||||
:~ note-id+s+note-name
|
||||
author+s+(scot %p author.note)
|
||||
title+s+title.note
|
||||
date-created+(time date-created.note)
|
||||
snippet+s+snippet.note
|
||||
file+s+file.note
|
||||
num-comments+(numb ~(wyt by comments.note))
|
||||
comments+(comments-page comments.note 0 50)
|
||||
read+b+read.note
|
||||
==
|
||||
::
|
||||
++ notes-by-date
|
||||
|= notes=(map @tas note)
|
||||
^- json
|
||||
=/ notes-list=(list [@tas note])
|
||||
%+ sort ~(tap by notes)
|
||||
|= [[@tas n1=note] [@tas n2=note]]
|
||||
(gte date-created.n1 date-created.n2)
|
||||
:- %a
|
||||
%+ turn notes-list
|
||||
|= [name=@tas note]
|
||||
^- json
|
||||
[%s name]
|
||||
::
|
||||
++ note-short-json
|
||||
|= [note-name=@tas =note]
|
||||
^- json
|
||||
=, enjs:format
|
||||
%- pairs
|
||||
:~ note-id+s+note-name
|
||||
author+s+(scot %p author.note)
|
||||
title+s+title.note
|
||||
date-created+(time date-created.note)
|
||||
num-comments+(numb ~(wyt by comments.note))
|
||||
read+b+read.note
|
||||
snippet+s+snippet.note
|
||||
==
|
||||
::
|
||||
++ notes-page
|
||||
|= [notes=(map @tas note) start=@ud length=@ud]
|
||||
^- (map @t json)
|
||||
=/ notes-list=(list [@tas note])
|
||||
%+ sort ~(tap by notes)
|
||||
|= [[@tas n1=note] [@tas n2=note]]
|
||||
(gte date-created.n1 date-created.n2)
|
||||
%- my
|
||||
:~ notes-by-date+a+(turn notes-list |=([name=@tas *] s+name))
|
||||
notes+o+(notes-list-json (scag length (slag start notes-list)))
|
||||
==
|
||||
::
|
||||
++ notes-list-json
|
||||
|= notes=(list [@tas note])
|
||||
^- (map @t json)
|
||||
%+ roll notes
|
||||
|= [[name=@tas not=note] out-map=(map @t json)]
|
||||
^- (map @t json)
|
||||
(~(put by out-map) name (note-short-json name not))
|
||||
::
|
||||
++ comments-page
|
||||
|= [comments=(map @da comment) start=@ud end=@ud]
|
||||
^- json
|
||||
=/ coms=(list [@da comment])
|
||||
%+ sort ~(tap by comments)
|
||||
|= [[d1=@da comment] [d2=@da comment]]
|
||||
(gte d1 d2)
|
||||
%- comments-list-json
|
||||
(scag end (slag start coms))
|
||||
::
|
||||
++ comments-list-json
|
||||
|= comments=(list [@da comment])
|
||||
^- json
|
||||
=, enjs:format
|
||||
:- %a
|
||||
(turn comments comment-json)
|
||||
::
|
||||
++ comment-json
|
||||
|= [date=@da com=comment]
|
||||
^- json
|
||||
=, enjs:format
|
||||
%+ frond:enjs:format
|
||||
(scot %da date)
|
||||
%- pairs
|
||||
:~ author+s+(scot %p author.com)
|
||||
date-created+(time date-created.com)
|
||||
content+s+content.com
|
||||
==
|
||||
--
|
||||
|
10
pkg/arvo/mar/contact/action.hoon
Normal file
@ -0,0 +1,10 @@
|
||||
/+ *contact-json
|
||||
|_ act=contact-action
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact-action
|
||||
++ json
|
||||
|= jon=^json
|
||||
(json-to-action jon)
|
||||
--
|
||||
--
|
14
pkg/arvo/mar/contact/initial.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
/+ *contact-json
|
||||
|_ rolo=rolodex
|
||||
::
|
||||
++ grow
|
||||
|%
|
||||
++ json (rolodex-to-json rolo)
|
||||
--
|
||||
::
|
||||
++ grab
|
||||
|%
|
||||
++ noun rolodex
|
||||
--
|
||||
::
|
||||
--
|