mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 22:55:03 +03:00
546 lines
14 KiB
Plaintext
546 lines
14 KiB
Plaintext
:: chat-view [landscape]:
|
|
::
|
|
:: sets up chat JS client, paginates data, and combines commands
|
|
:: into semantic actions for the UI
|
|
::
|
|
/- *group,
|
|
inv=invite-store,
|
|
*metadata-store,
|
|
*chat-hook,
|
|
*metadata-hook,
|
|
hook=chat-hook,
|
|
contact-view,
|
|
pull-hook
|
|
/+ *server, default-agent, verb, dbug,
|
|
store=chat-store,
|
|
view=chat-view,
|
|
group-store,
|
|
grpl=group,
|
|
resource,
|
|
mdl=metadata
|
|
::
|
|
~% %chat-view-top ..part ~
|
|
|%
|
|
+$ versioned-state
|
|
$% state-0
|
|
==
|
|
::
|
|
+$ state-0
|
|
$: %0
|
|
~
|
|
==
|
|
+$ poke
|
|
$% [%chat-action action:store]
|
|
[%group-action action:group-store]
|
|
[%chat-hook-action action:hook]
|
|
==
|
|
::
|
|
+$ card card:agent:gall
|
|
--
|
|
::
|
|
=| state-0
|
|
=* state -
|
|
::
|
|
%+ verb |
|
|
%- agent:dbug
|
|
^- agent:gall
|
|
=<
|
|
~% %chat-view-agent-core ..poke-handle-http-request ~
|
|
|_ bol=bowl:gall
|
|
+* this .
|
|
chat-core +>
|
|
cc ~(. chat-core bol)
|
|
def ~(. (default-agent this %|) bol)
|
|
::
|
|
++ on-init
|
|
^- (quip card _this)
|
|
:_ this
|
|
:~ :* %pass /srv %agent [our.bol %file-server]
|
|
%poke %file-server-action
|
|
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
|
|
==
|
|
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
|
|
[%pass /updates %agent [our.bol %chat-store] %watch /updates]
|
|
==
|
|
::
|
|
++ on-poke
|
|
~/ %chat-view-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
?> (team:title our.bol src.bol)
|
|
?+ mark (on-poke:def mark vase)
|
|
%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
|
|
::
|
|
%json
|
|
:_ this
|
|
(poke-chat-view-action:cc (action:dejs:view !<(json vase)))
|
|
::
|
|
%chat-view-action
|
|
:_ this
|
|
(poke-chat-view-action:cc !<(action:view vase))
|
|
==
|
|
::
|
|
++ on-watch
|
|
~/ %chat-view-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?> (team:title our.bol src.bol)
|
|
|^
|
|
?: ?=([%http-response *] path)
|
|
[~ this]
|
|
?: =(/primary path)
|
|
:: create inbox with 20 messages max per mailbox and send that along
|
|
:: then quit the subscription
|
|
:_ this
|
|
[%give %fact ~ %json !>((update:enjs:store [%initial truncated-inbox]))]~
|
|
(on-watch:def path)
|
|
::
|
|
++ message-limit 20
|
|
::
|
|
++ truncated-inbox
|
|
^- inbox:store
|
|
=/ =inbox:store
|
|
=/ our (scot %p our.bol)
|
|
=/ now (scot %da now.bol)
|
|
.^(inbox:store %gx /[our]/chat-store/[now]/all/noun)
|
|
%- ~(run by inbox)
|
|
|= =mailbox:store
|
|
^- mailbox:store
|
|
[config.mailbox (scag message-limit envelopes.mailbox)]
|
|
--
|
|
::
|
|
++ on-agent
|
|
~/ %chat-view-agent
|
|
|= [=wire =sign:agent:gall]
|
|
^- (quip card _this)
|
|
?+ -.sign (on-agent:def wire sign)
|
|
%poke-ack
|
|
?. ?=([%join-group @ @ @ @ @ ~] wire)
|
|
(on-agent:def wire sign)
|
|
?^ p.sign
|
|
(on-agent:def wire sign)
|
|
=/ =ship
|
|
(slav %p i.t.wire)
|
|
=/ ask-history=?
|
|
=('y' i.t.t.wire)
|
|
=/ rid=resource
|
|
(de-path:resource t.t.t.wire)
|
|
:_ this
|
|
(joined-group:cc rid ship ask-history)
|
|
::
|
|
%kick
|
|
:_ this
|
|
[%pass / %agent [our.bol %chat-store] %watch /updates]~
|
|
::
|
|
%fact
|
|
?+ p.cage.sign (on-agent:def wire sign)
|
|
%chat-update
|
|
:_ this
|
|
(diff-chat-update:cc !<(update:store q.cage.sign))
|
|
==
|
|
==
|
|
::
|
|
++ on-arvo
|
|
~/ %chat-view-arvo
|
|
|= [=wire =sign-arvo]
|
|
^- (quip card _this)
|
|
?: ?=(%bound +<.sign-arvo) [~ this]
|
|
(on-arvo:def wire sign-arvo)
|
|
::
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old-vase=vase
|
|
^- (quip card _this)
|
|
=/ old ((soft state-0) q.old-vase)
|
|
?^ old [~ this]
|
|
:_ this(state [%0 ~])
|
|
:~ [%pass / %arvo %e %disconnect [~ /'~chat']]
|
|
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
|
|
:* %pass /srv %agent [our.bol %file-server]
|
|
%poke %file-server-action
|
|
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
|
|
==
|
|
==
|
|
::
|
|
++ on-leave on-leave:def
|
|
++ on-peek on-peek:def
|
|
++ on-fail on-fail:def
|
|
--
|
|
::
|
|
::
|
|
~% %chat-view-library ..card ~
|
|
|_ bol=bowl:gall
|
|
++ grp ~(. grpl bol)
|
|
++ md ~(. mdl bol)
|
|
::
|
|
++ poke-handle-http-request
|
|
|= =inbound-request:eyre
|
|
^- simple-payload:http
|
|
=+ url=(parse-request-line url.request.inbound-request)
|
|
?+ site.url not-found:gen
|
|
[%'chat-view' %paginate @t @t *]
|
|
=/ start (need (rush i.t.t.site.url dem))
|
|
=/ end (need (rush i.t.t.t.site.url dem))
|
|
=/ pax t.t.t.t.site.url
|
|
=/ envelopes (envelope-scry [(scot %ud start) (scot %ud end) pax])
|
|
%- json-response:gen
|
|
%- update:enjs:store
|
|
[%messages pax start end envelopes]
|
|
==
|
|
::
|
|
++ poke-json
|
|
|= jon=json
|
|
^- (list card)
|
|
?> (team:title our.bol src.bol)
|
|
(poke-chat-view-action (action:dejs:view jon))
|
|
::
|
|
++ poke-chat-view-action
|
|
|= act=action:view
|
|
^- (list card)
|
|
|^
|
|
?> (team:title our.bol src.bol)
|
|
?- -.act
|
|
%create
|
|
?> ?=(^ app-path.act)
|
|
?> ?| =(+:group-path.act app-path.act)
|
|
=(~(tap in members.act) ~)
|
|
==
|
|
?^ (chat-scry app-path.act)
|
|
~& %chat-already-exists
|
|
~
|
|
%- zing
|
|
:~ %- create-group
|
|
:* group-path.act
|
|
app-path.act
|
|
policy.act
|
|
members.act
|
|
title.act
|
|
description.act
|
|
managed.act
|
|
==
|
|
(create-metadata title.act description.act group-path.act app-path.act)
|
|
(create-chat app-path.act allow-history.act)
|
|
==
|
|
::
|
|
%delete
|
|
?> ?=(^ app-path.act)
|
|
:: always just delete the chat from chat-store
|
|
::
|
|
:+ (chat-hook-poke [%remove app-path.act])
|
|
(chat-poke [%delete app-path.act])
|
|
:: if we still have metadata for the chat, remove it, and the associated
|
|
:: group if it's unmanaged.
|
|
::
|
|
:: we aren't guaranteed to have metadata: the chat might have been
|
|
:: deleted by the host, which pushes metadata deletion down to us.
|
|
::
|
|
=/ maybe-group-path
|
|
(maybe-group-from-chat app-path.act)
|
|
?~ maybe-group-path
|
|
~
|
|
=* group-path u.maybe-group-path
|
|
=/ rid=resource
|
|
(de-path:resource group-path)
|
|
=/ maybe-group
|
|
(scry-group:grp rid)
|
|
=/ hidden
|
|
?~ maybe-group
|
|
%.n
|
|
hidden.u.maybe-group
|
|
%- zing
|
|
:~ ?. (is-creator group-path %chat app-path.act)
|
|
~
|
|
[(metadata-poke [%remove group-path [%chat app-path.act]])]~
|
|
::
|
|
?. hidden
|
|
~
|
|
:~ (group-proxy-poke %remove-members rid (sy our.bol ~))
|
|
(group-poke [%remove-group rid ~])
|
|
(metadata-hook-poke [%remove group-path])
|
|
(metadata-store-poke [%remove group-path [%chat app-path.act]])
|
|
==
|
|
==
|
|
::
|
|
%invite
|
|
=/ =group-path
|
|
(need (maybe-group-from-chat app-path.act))
|
|
=/ rid=resource
|
|
(de-path:resource group-path)
|
|
=/ =group
|
|
(need (scry-group:grp rid))
|
|
?> ?=(%invite -.policy.group)
|
|
:- (group-poke %change-policy rid %invite %add-invites ships.act)
|
|
%+ turn
|
|
~(tap in ships.act)
|
|
|= =ship
|
|
(send-invite group-path app-path.act ship)
|
|
::
|
|
%join
|
|
=/ group-path
|
|
(maybe-group-from-chat app-path.act)
|
|
=/ group
|
|
?~ group-path
|
|
~
|
|
(scry-group-path:grp u.group-path)
|
|
?: &(?=(^ group) =(hidden.u.group %.n))
|
|
~[(chat-hook-poke %add-synced ship.act app-path.act ask-history.act)]
|
|
=/ rid=resource
|
|
(de-path:resource ship+app-path.act)
|
|
?: =(our.bol entity.rid) ~
|
|
=/ =cage
|
|
:- %group-update
|
|
!> ^- action:group-store
|
|
[%add-members rid (sy our.bol ~)]
|
|
:: we need this info in the wire to continue the flow after the
|
|
:: poke ack
|
|
=/ =wire
|
|
:- %join-group
|
|
[(scot %p ship.act) ?:(ask-history.act %y %n) ship+app-path.act]
|
|
[%pass wire %agent [entity.rid %group-push-hook] %poke cage]~
|
|
::
|
|
%groupify
|
|
=* app-path app-path.act
|
|
=/ group-path
|
|
(snag 0 (groups-from-resource:md %chat app-path))
|
|
=/ scry-pax=path
|
|
/metadata/[(scot %t (spat group-path))]/chat/[(scot %t (spat app-path))]
|
|
=/ =metadata
|
|
(need (scry-for (unit metadata) %metadata-store scry-pax))
|
|
=/ old-rid=resource
|
|
(de-path:resource group-path)
|
|
?< (is-managed:grp old-rid)
|
|
?~ existing.act
|
|
:: just create contacts object for group
|
|
~[(contact-view-poke %groupify old-rid title.metadata description.metadata)]
|
|
:: change associations
|
|
=* group-path group-path.u.existing.act
|
|
=/ rid=resource
|
|
(de-path:resource group-path)
|
|
=/ old-group=group
|
|
(need (scry-group:grp old-rid))
|
|
=/ =group
|
|
(need (scry-group:grp rid))
|
|
=/ ships=(set ship)
|
|
(~(dif in members.old-group) members.group)
|
|
:* (metadata-store-poke %remove ship+app-path %chat app-path)
|
|
(metadata-store-poke %add group-path [%chat app-path] metadata)
|
|
(group-poke %remove-group old-rid ~)
|
|
?. inclusive.u.existing.act
|
|
~
|
|
:- (group-poke %add-members rid ships)
|
|
%+ turn
|
|
~(tap in ships)
|
|
|= =ship
|
|
(send-invite group-path app-path ship)
|
|
==
|
|
==
|
|
::
|
|
++ create-chat
|
|
|= [=path history=?]
|
|
^- (list card)
|
|
:~ (chat-poke [%create path])
|
|
(chat-hook-poke [%add-owned path history])
|
|
==
|
|
::
|
|
++ create-group
|
|
|= [=path app-path=path =policy ships=(set ship) title=@t desc=@t managed=?]
|
|
^- (list card)
|
|
?^ (scry-group-path:grp path) ~
|
|
=/ rid=resource
|
|
(de-path:resource path)
|
|
?> =(our.bol entity.rid)
|
|
:: do not create a contacts object if this is unmanaged
|
|
::
|
|
:-
|
|
?. managed
|
|
(group-poke %add-group rid policy %.y)
|
|
(contact-view-poke %create name.rid policy title desc)
|
|
%+ murn ~(tap in ships)
|
|
|= =ship
|
|
^- (unit card)
|
|
?: =(ship our.bol) ~
|
|
`(send-invite path app-path ship)
|
|
::
|
|
++ 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 (snag 0 app-path))
|
|
==
|
|
:~ (metadata-poke [%add group-path [%chat app-path] metadata])
|
|
(metadata-hook-poke [%add-owned group-path])
|
|
==
|
|
::
|
|
++ contact-view-poke
|
|
|= act=contact-view-action:contact-view
|
|
^- 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)]
|
|
::
|
|
++ send-invite
|
|
|= [group-path=path app-path=path =ship]
|
|
^- card
|
|
=/ managed=?
|
|
!=(ship+app-path group-path)
|
|
=/ =invite:inv
|
|
:* our.bol
|
|
?:(managed %contact-hook %chat-hook)
|
|
(de-path:resource ?:(managed group-path ship+app-path))
|
|
ship ''
|
|
==
|
|
=/ act=action:inv
|
|
[%invite ?:(managed %contacts %chat) (shaf %msg-uid eny.bol) invite]
|
|
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
|
|
::
|
|
++ chat-scry
|
|
|= pax=path
|
|
^- (unit mailbox:store)
|
|
=. pax
|
|
;: weld
|
|
/(scot %p our.bol)/chat-store/(scot %da now.bol)/mailbox
|
|
pax
|
|
/noun
|
|
==
|
|
.^((unit mailbox:store) %gx pax)
|
|
::
|
|
++ maybe-group-from-chat
|
|
|= app-path=path
|
|
^- (unit 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 md-resource group-path)
|
|
%gy
|
|
(scot %p our.bol)
|
|
%metadata-store
|
|
(scot %da now.bol)
|
|
/resource-indices
|
|
==
|
|
=/ groups=(set path)
|
|
%+ fall
|
|
(~(get by resource-indices) [%chat app-path])
|
|
*(set path)
|
|
?~ groups ~
|
|
`n.groups
|
|
::
|
|
++ group-from-chat
|
|
(cork maybe-group-from-chat need)
|
|
::
|
|
++ is-managed
|
|
|= =path
|
|
^- ?
|
|
?> ?=(^ path)
|
|
!=(i.path '~')
|
|
::
|
|
++ is-creator
|
|
|= [group-path=path app-name=@ta app-path=path]
|
|
^- ?
|
|
=/ meta=(unit metadata)
|
|
.^ (unit 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
|
|
==
|
|
?~ meta !!
|
|
=(our.bol creator.u.meta)
|
|
--
|
|
:: +joined-group: Successfully joined unmanaged group, continue flow
|
|
::
|
|
++ joined-group
|
|
|= [rid=resource =ship ask-history=?]
|
|
^- (list card)
|
|
=/ =path
|
|
(en-path:resource rid)
|
|
?> ?=(^ path)
|
|
:~ (group-pull-hook-poke %add ship rid)
|
|
(metadata-hook-poke %add-synced ship path)
|
|
(chat-hook-poke %add-synced ship t.path ask-history)
|
|
==
|
|
::
|
|
++ diff-chat-update
|
|
|= upd=update:store
|
|
^- (list card)
|
|
[%give %fact ~[/primary] %json !>((update:enjs:store upd))]~
|
|
::
|
|
:: +utilities
|
|
::
|
|
++ chat-poke
|
|
|= act=action:store
|
|
^- card
|
|
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
|
|
::
|
|
++ group-poke
|
|
|= upd=update:group-store
|
|
^- card
|
|
[%pass / %agent [our.bol %group-store] %poke %group-update !>(upd)]
|
|
++ group-pull-hook-poke
|
|
|= act=action:pull-hook
|
|
^- card
|
|
[%pass / %agent [our.bol %group-pull-hook] %poke %pull-hook-action !>(act)]
|
|
::
|
|
++ group-proxy-poke
|
|
|= act=action:group-store
|
|
^- card
|
|
[%pass / %agent [entity.resource.act %group-push-hook] %poke %group-update !>(act)]
|
|
::
|
|
++ chat-hook-poke
|
|
|= act=action:hook
|
|
^- card
|
|
[%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action !>(act)]
|
|
::
|
|
++ metadata-hook-poke
|
|
|= act=metadata-hook-action
|
|
^- card
|
|
:* %pass / %agent
|
|
[our.bol %metadata-hook]
|
|
%poke %metadata-hook-action
|
|
!>(act)
|
|
==
|
|
::
|
|
++ envelope-scry
|
|
|= pax=path
|
|
^- (list envelope:store)
|
|
(scry-for (list envelope:store) %chat-store [%envelopes pax])
|
|
::
|
|
|
|
::
|
|
++ scry-for
|
|
|* [=mold app=term =path]
|
|
.^ mold
|
|
%gx
|
|
(scot %p our.bol)
|
|
app
|
|
(scot %da now.bol)
|
|
(snoc `^path`path %noun)
|
|
==
|
|
--
|