mirror of
https://github.com/urbit/shrub.git
synced 2024-12-15 21:03:10 +03:00
642 lines
16 KiB
Plaintext
642 lines
16 KiB
Plaintext
/- hall
|
|
/+ *server, chat, hall-json
|
|
/= index
|
|
/^ octs
|
|
/; as-octs:mimes:html
|
|
/: /===/app/chat/index
|
|
/| /html/
|
|
/~ ~
|
|
==
|
|
/= tile-js
|
|
/^ octs
|
|
/; as-octs:mimes:html
|
|
/: /===/app/chat/js/tile
|
|
/| /js/
|
|
/~ ~
|
|
==
|
|
/= script
|
|
/^ octs
|
|
/; as-octs:mimes:html
|
|
/: /===/app/chat/js/index
|
|
/| /js/
|
|
/~ ~
|
|
==
|
|
/= style
|
|
/^ octs
|
|
/; as-octs:mimes:html
|
|
/: /===/app/chat/css/index
|
|
/| /css/
|
|
/~ ~
|
|
==
|
|
/= chat-png
|
|
/^ (map knot @)
|
|
/: /===/app/chat/img /_ /png/
|
|
::
|
|
=, chat
|
|
::
|
|
|%
|
|
::
|
|
+$ state
|
|
$% [%0 str=streams]
|
|
==
|
|
::
|
|
+$ move [bone card]
|
|
::
|
|
+$ card
|
|
$% [%http-response =http-event:http]
|
|
[%connect wire binding:eyre term]
|
|
[%peer wire dock path]
|
|
[%quit ~]
|
|
[%poke wire dock poke]
|
|
[%peer wire dock path]
|
|
[%pull wire dock ~]
|
|
[%diff diff]
|
|
==
|
|
::
|
|
--
|
|
::
|
|
|_ [bol=bowl:gall state]
|
|
::
|
|
++ this .
|
|
::
|
|
:: +prep: set up the app, migrate the state
|
|
::
|
|
++ prep
|
|
|= old=(unit state)
|
|
^- (quip move _this)
|
|
=/ launcha (launch-poke [/chattile '/~chat/js/tile.js'])
|
|
?~ old
|
|
=/ peer-inbox
|
|
%+ hall-peer
|
|
/circle/[(scot %p our.bol)]/inbox/config/group
|
|
/circle/inbox/config/group
|
|
=/ circlespat /circles/[(scot %p our.bol)]
|
|
=/ sourceannounce (hall-source [~marzod %announcements])
|
|
::
|
|
=/ hall-actions=(list move)
|
|
?: =((clan:title our.bol) %czar)
|
|
~
|
|
?: =(our.bol ~marzod)
|
|
:- (hall-create %announcements 'Announcements from Tlon' %journal)
|
|
[sourceannounce]~
|
|
?: =(our.bol ~dopzod)
|
|
:- (hall-create %urbit-dev 'Chat about developing on Urbit' %channel)
|
|
[(hall-create %urbit-help 'Help about Urbit' %channel)]~
|
|
:~ (hall-create %hall-internal-announcements '' %village)
|
|
(hall-source [our.bol %hall-internal-announcements])
|
|
sourceannounce
|
|
==
|
|
::
|
|
=/ actions=(list move)
|
|
:~ [ost.bol %connect / [~ /'~chat'] %chat]
|
|
launcha
|
|
peer-inbox
|
|
(hall-peer circlespat circlespat)
|
|
(hall-source [our.bol %i])
|
|
==
|
|
:_ this
|
|
(weld actions hall-actions)
|
|
::
|
|
:_ this(+<+ u.old)
|
|
[launcha]~
|
|
::
|
|
++ peer-chattile
|
|
|= wir=wire
|
|
^- (quip move _this)
|
|
:_ this
|
|
[ost.bol %diff %json (construct-tile-json str)]~
|
|
::
|
|
:: +peer-messages: subscribe to subset of messages and updates
|
|
::
|
|
::
|
|
++ peer-primary
|
|
|= wir=wire
|
|
^- (quip move _this)
|
|
=* messages messages.str
|
|
=/ lismov=(list move)
|
|
%+ murn ~(tap by messages)
|
|
|= [cir=circle:hall lis=(list envelope:hall)]
|
|
^- (unit move)
|
|
=/ envs=(unit (list envelope:hall)) (~(get by messages) cir)
|
|
?~ envs
|
|
~
|
|
=/ length/@ (lent u.envs)
|
|
=/ start/@
|
|
?: (gte length 100)
|
|
(sub length 100)
|
|
0
|
|
=/ end/@ length
|
|
=/ offset/@ (sub end start)
|
|
:- ~
|
|
:* ost.bol
|
|
%diff
|
|
%chat-update
|
|
[%messages cir start end (swag [start offset] u.envs)]
|
|
==
|
|
:_ this
|
|
[[ost.bol %diff %chat-config str] lismov]
|
|
::
|
|
:: +poke-chat: send us an action
|
|
::
|
|
++ poke-chat-action
|
|
|= act=action:chat
|
|
^- (quip move _this)
|
|
:_ this
|
|
%+ turn lis.act
|
|
|= hac=action:hall
|
|
^- move
|
|
:* ost.bol
|
|
%poke
|
|
/p/[(scot %da now.bol)]
|
|
[our.bol %hall]
|
|
[%hall-action hac]
|
|
==
|
|
::
|
|
::
|
|
:: +hall arms
|
|
::
|
|
::
|
|
:: +diff-hall-prize: handle full state initially handed to us by hall
|
|
::
|
|
++ diff-hall-prize
|
|
|= [wir=wire piz=prize:hall]
|
|
^- (quip move _this)
|
|
?~ wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
?+ i.wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
::
|
|
:: %circles wire
|
|
::
|
|
%circles
|
|
?> ?=(%circles -.piz)
|
|
:_ this(circles.str cis.piz)
|
|
(send-chat-update [[%circles cis.piz] sta])
|
|
::
|
|
:: %circle wire
|
|
::
|
|
%circle
|
|
?> ?=(%circle -.piz)
|
|
=/ circle/circle:hall [our.bol &3:wir]
|
|
::
|
|
:: fill inbox config and remote configs with prize data
|
|
::
|
|
?: =(circle [our.bol %inbox])
|
|
=/ configs
|
|
%- ~(uni in configs.str)
|
|
^- (map circle:hall (unit config:hall))
|
|
(~(run by rem.cos.piz) |=(a=config:hall `a))
|
|
::
|
|
=/ circles=(list circle:hall)
|
|
(turn ~(tap in src.loc.cos.piz) head)
|
|
::
|
|
=/ meslis=(list [circle:hall (list envelope:hall)])
|
|
%+ turn circles
|
|
|= cir=circle:hall
|
|
^- [circle:hall (list envelope:hall)]
|
|
[cir ~]
|
|
::
|
|
=/ localpeers=(set @p)
|
|
(silt (turn ~(tap by loc.pes.piz) head))
|
|
::
|
|
=/ peers=(map circle:hall (set @p))
|
|
%- ~(rep by rem.pes.piz)
|
|
|= [[cir=circle:hall grp=group:hall] acc=(map circle:hall (set @p))]
|
|
^- (map circle:hall (set @p))
|
|
(~(put by acc) cir (silt (turn ~(tap by grp) head)))
|
|
::
|
|
:-
|
|
%+ turn ~(tap in (~(del in (silt circles)) [our.bol %inbox]))
|
|
|= cir=circle:hall
|
|
^- move
|
|
=/ wir/wire /circle/[(scot %p our.bol)]/[nom.cir]/config/group
|
|
=/ pat/path /circle/[nom.cir]/config/group
|
|
[ost.bol %peer wir [our.bol %hall] pat]
|
|
%= this
|
|
inbox.str loc.cos.piz
|
|
configs.str configs
|
|
messages.str (molt meslis)
|
|
peers.str (~(put by peers) [our.bol %inbox] localpeers)
|
|
==
|
|
::
|
|
:: fill remote configs with message data
|
|
::
|
|
=* messages messages.str
|
|
=/ circle=circle:hall [`@p`(slav %p &2:wir) &3:wir]
|
|
=/ localpeers=(set @p) (silt (turn ~(tap by loc.pes.piz) head))
|
|
::
|
|
=/ peers=(map circle:hall (set @p))
|
|
%- ~(rep by rem.pes.piz)
|
|
|= [[cir=circle:hall grp=group:hall] acc=(map circle:hall (set @p))]
|
|
^- (map circle:hall (set @p))
|
|
(~(put by acc) cir (silt (turn ~(tap by grp) head)))
|
|
=/ sta
|
|
%= str
|
|
messages (~(put by messages) circle nes.piz)
|
|
peers (~(uni by peers.str) (~(put by peers) circle localpeers))
|
|
==
|
|
=/ messageupdate=update [%messages circle 0 (lent messages) nes.piz]
|
|
:- (send-chat-update [messageupdate sta])
|
|
this(str sta)
|
|
==
|
|
::
|
|
:: +diff-hall-rumor: handle updates to hall state
|
|
::
|
|
++ diff-hall-rumor
|
|
|= [wir=wire rum=rumor:hall]
|
|
^- (quip move _this)
|
|
?~ wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
?+ i.wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
::
|
|
:: %circles
|
|
::
|
|
%circles
|
|
?> ?=(%circles -.rum)
|
|
=/ cis
|
|
?: add.rum
|
|
(~(put in circles.str) cir.rum)
|
|
(~(del in circles.str) cir.rum)
|
|
=/ sta
|
|
%= str
|
|
circles cis
|
|
peers
|
|
?: add.rum
|
|
(~(put by peers.str) [our.bol cir.rum] ~)
|
|
(~(del by peers.str) [our.bol cir.rum])
|
|
==
|
|
:_ this(str sta)
|
|
(send-chat-update [[%circles cis] sta])
|
|
::
|
|
::
|
|
:: %circle: fill remote configs with message data
|
|
::
|
|
%circle
|
|
?> ?=(%circle -.rum)
|
|
=* sto rum.rum
|
|
?+ -.sto
|
|
[~ this]
|
|
::
|
|
:: %gram:
|
|
::
|
|
%gram
|
|
?> ?=(%gram -.sto)
|
|
=* messages messages.str
|
|
=/ circle=circle:hall [`@p`(slav %p &2:wir) &3:wir]
|
|
=/ nes=(unit (list envelope:hall)) (~(get by messages) circle)
|
|
?~ nes
|
|
[~ this]
|
|
=/ sta
|
|
%= str
|
|
messages (~(put by messages) circle (snoc u.nes nev.sto))
|
|
==
|
|
:_ this(str sta)
|
|
(send-chat-update [[%message circle nev.sto] sta])
|
|
::
|
|
:: status:
|
|
::
|
|
%status
|
|
?> ?=(%status -.sto)
|
|
=/ upeers=(unit (set @p)) (~(get by peers.str) cir.sto)
|
|
?~ upeers
|
|
[~ this]
|
|
=/ peers=(set @p)
|
|
?: =(%remove -.dif.sto)
|
|
(~(del in u.upeers) who.sto)
|
|
(~(put in u.upeers) who.sto)
|
|
=/ sta
|
|
%= str
|
|
peers (~(put by peers.str) cir.sto peers)
|
|
==
|
|
:_ this(str sta)
|
|
(send-chat-update [[%peers cir.sto peers] sta])
|
|
::
|
|
:: %config: config has changed
|
|
::
|
|
%config
|
|
=* circ cir.sto
|
|
::
|
|
?+ -.dif.sto
|
|
[~ this]
|
|
::
|
|
:: %full: set all of config without side effects
|
|
::
|
|
%full
|
|
=* conf cof.dif.sto
|
|
=/ sta
|
|
%= str
|
|
configs (~(put by configs.str) circ `conf)
|
|
==
|
|
:_ this(str sta)
|
|
(send-chat-update [[%config circ conf] sta])
|
|
::
|
|
:: %read: the read count of one of our configs has changed
|
|
::
|
|
%read
|
|
?: =(circ [our.bol %inbox])
|
|
:: ignore when circ is inbox
|
|
[~ this]
|
|
=/ uconf/(unit config:hall) (~(got by configs.str) circ)
|
|
?~ uconf
|
|
[~ this]
|
|
=/ conf/config:hall
|
|
%= u.uconf
|
|
red red.dif.sto
|
|
==
|
|
=/ sta
|
|
%= str
|
|
configs (~(put by configs.str) circ `conf)
|
|
==
|
|
:_ this(str sta)
|
|
(send-chat-update [[%config circ conf] sta])
|
|
::
|
|
:: %source: the sources of our inbox have changed
|
|
::
|
|
%source
|
|
?. =(circ [our.bol %inbox])
|
|
:: ignore when circ is not inbox
|
|
[~ this]
|
|
=* affectedcir cir.src.dif.sto
|
|
=/ newwir/wire
|
|
/circle/(scot %p hos.affectedcir)/[nom.affectedcir]/grams/0/config/group
|
|
=/ pat/path /circle/[nom.affectedcir]/grams/0/config/group
|
|
:: we've added a source to our inbox
|
|
::
|
|
?: add.dif.sto
|
|
=/ newinbox %= inbox.str
|
|
src (~(put in src.inbox.str) src.dif.sto)
|
|
==
|
|
=/ sta
|
|
%= str
|
|
inbox newinbox
|
|
::
|
|
configs
|
|
?: (~(has by configs.str) affectedcir)
|
|
configs.str
|
|
(~(put by configs.str) affectedcir ~)
|
|
==
|
|
::
|
|
:_ this(str sta)
|
|
%+ weld
|
|
[ost.bol %peer newwir [hos.affectedcir %hall] pat]~
|
|
(send-chat-update [[%inbox newinbox] sta])
|
|
::
|
|
=/ newinbox %= inbox.str
|
|
src (~(del in src.inbox.str) src.dif.sto)
|
|
==
|
|
:: we've removed a source from our inbox
|
|
::
|
|
=/ sta
|
|
%= str
|
|
inbox newinbox
|
|
::
|
|
configs (~(del by configs.str) affectedcir)
|
|
messages (~(del by messages.str) affectedcir)
|
|
peers (~(del by peers.str) affectedcir)
|
|
==
|
|
=/ fakecir=circle:hall
|
|
:- our.bol
|
|
(crip (weld (trip 'hall-internal-') (trip nom.affectedcir)))
|
|
::
|
|
?~ (~(get by configs.str) fakecir)
|
|
:: just forward the delete to our clients
|
|
::
|
|
:_ this(str sta)
|
|
:- [ost.bol %pull newwir [hos.affectedcir %hall] ~]
|
|
%+ weld
|
|
(send-chat-update [[%inbox newinbox] sta])
|
|
(send-chat-update [[%delete affectedcir] sta])
|
|
:: if we get a delete from another ship, delete our fake circle copy
|
|
::
|
|
=/ deletefake [%hall-action [%delete nom.fakecir ~]]
|
|
:_ this(str sta)
|
|
:- [ost.bol %pull newwir [hos.affectedcir %hall] ~]
|
|
:- [ost.bol %poke /fake [our.bol %hall] deletefake]
|
|
%+ weld
|
|
(send-chat-update [[%inbox newinbox] sta])
|
|
(send-chat-update [[%delete affectedcir] sta])
|
|
::
|
|
:: %remove: remove a circle
|
|
::
|
|
%remove
|
|
=/ sta
|
|
%= str
|
|
configs (~(del by configs.str) circ)
|
|
messages (~(del by messages.str) circ)
|
|
peers (~(del by peers.str) circ)
|
|
==
|
|
:- (send-chat-update [[%delete circ] sta])
|
|
this(str sta)
|
|
::
|
|
==
|
|
:: end of branching on dif.sto type
|
|
==
|
|
:: end of branching on sto type
|
|
==
|
|
:: end of i.wir branching
|
|
::
|
|
:: +lient arms
|
|
::
|
|
::
|
|
:: +bound: lient tells us we successfully bound our server to the ~chat url
|
|
::
|
|
++ bound
|
|
|= [wir=wire success=? binding=binding:eyre]
|
|
^- (quip move _this)
|
|
[~ this]
|
|
::
|
|
:: +poke-handle-http-request: serve pages from file system based on URl path
|
|
::
|
|
++ poke-handle-http-request
|
|
%- (require-authorization:app ost.bol move this)
|
|
|= =inbound-request:eyre
|
|
^- (quip move _this)
|
|
::
|
|
=+ request-line=(parse-request-line url.request.inbound-request)
|
|
=/ name=@t
|
|
=+ back-path=(flop site.request-line)
|
|
?~ back-path
|
|
''
|
|
i.back-path
|
|
?: =(name 'tile')
|
|
[[ost.bol %http-response (js-response:app tile-js)]~ this]
|
|
?+ site.request-line
|
|
:_ this
|
|
[ost.bol %http-response not-found:app]~
|
|
::
|
|
:: styling
|
|
::
|
|
[%'~chat' %css %index ~]
|
|
:_ this
|
|
[ost.bol %http-response (css-response:app style)]~
|
|
::
|
|
:: javascript
|
|
::
|
|
[%'~chat' %js %index ~]
|
|
:_ this
|
|
[ost.bol %http-response (js-response:app script)]~
|
|
::
|
|
:: images
|
|
::
|
|
[%'~chat' %img *]
|
|
=/ img (as-octs:mimes:html (~(got by chat-png) `@ta`name))
|
|
:_ this
|
|
[ost.bol %http-response (png-response:app img)]~
|
|
::
|
|
:: paginated message data
|
|
::
|
|
[%'~chat' %scroll @t @t @t @t ~]
|
|
=/ cir=circle:hall [(slav %p &3:site.request-line) &4:site.request-line]
|
|
=/ start=@ud (need (rush &5:site.request-line dem))
|
|
=/ parsedend=@ud (need (rush &6:site.request-line dem))
|
|
=* messages messages.str
|
|
=/ envs/(unit (list envelope:hall)) (~(get by messages) cir)
|
|
?~ envs
|
|
[~ this]
|
|
?: (gte start (lent u.envs))
|
|
[~ this]
|
|
=/ end=@
|
|
?: (gte parsedend (lent u.envs))
|
|
(dec (lent u.envs))
|
|
parsedend
|
|
=/ offset (sub end start)
|
|
=/ jon=json %- msg-to-json
|
|
:* %messages
|
|
cir
|
|
start
|
|
end
|
|
(swag [start offset] u.envs)
|
|
==
|
|
:_ this
|
|
[ost.bol %http-response (json-response:app (json-to-octs jon))]~
|
|
::
|
|
::
|
|
:: inbox page
|
|
::
|
|
[%'~chat' *]
|
|
:_ this
|
|
[ost.bol %http-response (html-response:app index)]~
|
|
==
|
|
::
|
|
::
|
|
:: +subscription-retry arms
|
|
::
|
|
::
|
|
:: +reap: recieve acknowledgement for peer, retry on failure
|
|
::
|
|
++ reap
|
|
|= [wir=wire err=(unit tang)]
|
|
^- (quip move _this)
|
|
?~ err
|
|
[~ this]
|
|
?~ wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
?+ i.wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
::
|
|
%circle
|
|
=/ shp=@p (slav %p &2:wir)
|
|
=/ pat /circle/[&3:wir]/config/group
|
|
?: =(&3:wir 'inbox')
|
|
:_ this
|
|
[ost.bol %peer wir [shp %hall] pat]~
|
|
?: (~(has in src.inbox.str) [[shp &3:wir] ~])
|
|
:_ this
|
|
[ost.bol %peer wir [shp %hall] pat]~
|
|
[~ this]
|
|
::
|
|
%circles
|
|
:_ this
|
|
[ost.bol %peer wir [our.bol %hall] wir]~
|
|
==
|
|
::
|
|
:: +quit: subscription failed/quit at some point, retry
|
|
::
|
|
++ quit
|
|
|= wir=wire
|
|
^- (quip move _this)
|
|
?~ wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
?+ i.wir
|
|
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
|
|
::
|
|
%circle
|
|
=/ shp=@p (slav %p &2:wir)
|
|
=/ pat /circle/[&3:wir]/config/group
|
|
?: =(&3:wir 'inbox')
|
|
:_ this
|
|
[ost.bol %peer wir [shp %hall] pat]~
|
|
?: (~(has in src.inbox.str) [[shp &3:wir] ~])
|
|
:_ this
|
|
[ost.bol %peer wir [shp %hall] pat]~
|
|
[~ this]
|
|
::
|
|
%circles
|
|
:_ this
|
|
[ost.bol %peer wir [our.bol %hall] wir]~
|
|
==
|
|
::
|
|
:: +utilities
|
|
::
|
|
::
|
|
:: +send-chat-update: utility func for sending updates to all our subscribers
|
|
::
|
|
++ send-chat-update
|
|
|= [upd=update str=streams]
|
|
^- (list move)
|
|
=/ updates=(list move)
|
|
%+ turn (prey:pubsub:userlib /primary bol)
|
|
|= [=bone *]
|
|
[bone %diff %chat-update upd]
|
|
::
|
|
=/ jon (construct-tile-json str)
|
|
=/ tile-updates=(list move)
|
|
%+ turn (prey:pubsub:userlib /chattile bol)
|
|
|= [=bone *]
|
|
[bone %diff %json jon]
|
|
::
|
|
(weld updates tile-updates)
|
|
::
|
|
++ construct-tile-json
|
|
|= str=streams
|
|
^- json
|
|
=/ numbers/(list [circle:hall @ud])
|
|
%+ turn ~(tap by messages.str)
|
|
|= [cir=circle:hall lis=(list envelope:hall)]
|
|
^- [circle:hall @ud]
|
|
?~ lis
|
|
[cir 0]
|
|
=/ last (snag (dec (lent lis)) `(list envelope:hall)`lis)
|
|
[cir (add num.last 1)]
|
|
=/ maptjson=(map @t json)
|
|
%- my
|
|
:~ ['config' (config-to-json str)]
|
|
['numbers' (numbers-to-json numbers)]
|
|
==
|
|
[%o maptjson]
|
|
::
|
|
++ launch-poke
|
|
|= [=path =cord]
|
|
^- move
|
|
[ost.bol %poke /chat [our.bol %launch] [%launch-action %chat path cord]]
|
|
::
|
|
++ hall-peer
|
|
|= [wir=wire pat=path]
|
|
^- move
|
|
[ost.bol %peer wir [our.bol %hall] pat]
|
|
::
|
|
++ hall-create
|
|
|= [name=@tas description=@t =security:hall]
|
|
^- move
|
|
=/ poke [%hall-action [%create name description security]]
|
|
[ost.bol %poke /chat [our.bol %hall] poke]
|
|
::
|
|
++ hall-source
|
|
|= cir=circle:hall
|
|
^- move
|
|
=/ poke [%hall-action [%source %inbox %.y (silt [cir ~]~)]]
|
|
[ost.bol %poke /chat [our.bol %hall] poke]
|
|
::
|
|
--
|