urbit/pkg/arvo/app/chat-view.hoon
2019-10-02 18:30:50 -07:00

325 lines
7.4 KiB
Plaintext

/- *permission-store, *group-store, *permission-group-hook, *chat-hook
/+ *server, *chat-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/
::
|%
::
+$ move [bone card]
::
+$ card
$% [%http-response =http-event:http]
[%connect wire binding:eyre term]
[%peer wire dock path]
[%poke wire dock poke]
[%diff %json json]
[%quit ~]
==
::
+$ poke
$% [%launch-action [@tas path @t]]
[%chat-action chat-action]
[%group-action group-action]
[%chat-hook-action chat-hook-action]
[%permission-group-hook-action permission-group-hook-action]
==
--
::
|_ [bol=bowl:gall ?]
::
++ this .
::
++ prep
|= old=(unit ?)
^- (quip move _this)
?~ old
:_ this
:~ [ost.bol %peer / [our.bol %chat-store] /updates]
[ost.bol %connect / [~ /'~chat'] %chat-view]
(launch-poke [/configs '/~chat/js/tile.js'])
==
[~ this]
::
++ bound
|= [wir=wire success=? binding=binding:eyre]
^- (quip move _this)
[~ this]
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:eyre
^- (quip move _this)
::
=+ url=(parse-request-line url.request.inbound-request)
=/ name=@t
=+ back-path=(flop site.url)
?~ back-path
''
i.back-path
?: =(name 'tile')
[[ost.bol %http-response (js-response:app tile-js)]~ this]
?+ site.url
:_ 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)]~
::
[%'~chat' %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])
:_ this
:~
:+ ost.bol
%http-response
%- json-response:app
%- json-to-octs
%+ envelopes-update
envelopes
[start end pax]
==
::
:: inbox page
::
[%'~chat' *]
:_ this
[ost.bol %http-response (html-response:app index)]~
==
::
++ poke-json
|= jon=json
^- (quip move _this)
?. =(src.bol our.bol)
[~ this]
(poke-chat-view-action (json-to-view-action jon))
::
++ poke-chat-view-action
|= act=chat-view-action
^- (quip move _this)
?. =(src.bol our.bol)
[~ this]
?- -.act
%create
:: TODO: add invites
=/ group-read=path [%chat (weld path.act /read)]
=/ group-write=path [%chat (weld path.act /write)]
:_ this
%+ weld
:~ (chat-poke [%create path.act our.bol])
(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-hook-poke [%add-owned path.act security.act])
==
(create-security [%chat path.act] security.act)
::
%delete
=/ group-read [%chat (weld path.act /read)]
=/ group-write [%chat (weld path.act /write)]
:_ this
:~ (chat-hook-poke [%remove path.act])
(group-poke [%unbundle group-read])
(group-poke [%unbundle group-write])
(chat-poke [%delete path.act])
==
::
==
::
++ peer-initial
|= pax=path
^- (quip move _this)
?. =(src.bol our.bol) !!
:: create inbox with 100 messages max per mailbox and send that along
:: then quit the subscription
:_ this
:~ [ost.bol %diff %json (inbox-to-json (truncate-inbox all-scry))]
[ost.bol %quit ~]
==
::
++ peer-updates
|= pax=path
^- (quip move _this)
?. =(src.bol our.bol) !!
:: send along all subsequent updates
[~ this]
::
++ peer-configs
|= pax=path
^- (quip move _this)
?. =(src.bol our.bol) !!
:_ this
[ost.bol %diff %json *json]~
::
++ diff-chat-update
|= [wir=wire upd=chat-update]
^- (quip move _this)
=/ updates-json (update-to-json upd)
=/ configs-json (configs-to-json configs-scry)
:_ this
%+ weld
%+ turn (prey:pubsub:userlib /updates bol)
|= [=bone *]
[bone %diff %json updates-json]
%+ turn (prey:pubsub:userlib /configs bol)
|= [=bone *]
[bone %diff %json configs-json]
::
++ quit
|= wir=wire
^- (quip move _this)
:_ this
[ost.bol %peer / [our.bol %chat-store] /updates]~
::
:: +utilities
::
++ launch-poke
|= [=path =cord]
^- move
[ost.bol %poke / [our.bol %launch] [%launch-action %chat-view path cord]]
::
++ chat-poke
|= act=chat-action
^- move
[ost.bol %poke / [our.bol %chat-store] [%chat-action act]]
::
++ group-poke
|= act=group-action
^- move
[ost.bol %poke / [our.bol %group-store] [%group-action act]]
::
++ chat-hook-poke
|= act=chat-hook-action
^- move
[ost.bol %poke / [our.bol %chat-hook] [%chat-hook-action act]]
::
++ perm-group-hook-poke
|= act=permission-group-hook-action
^- move
=/ pok [%permission-group-hook-action act]
[ost.bol %poke / [our.bol %permission-group-hook] pok]
::
++ envelope-scry
|= pax=path
^- (list envelope)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/envelopes pax /noun)
.^((list envelope) %gx pax)
::
++ all-scry
^- inbox
.^(inbox %gx /=chat-store/(scot %da now.bol)/all/noun)
::
++ configs-scry
^- chat-configs
.^(chat-configs %gx /=chat-store/(scot %da now.bol)/configs/noun)
::
++ create-security
|= [pax=path sec=chat-security]
^- (list move)
=/ 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] ~ ~]])
==
::
==
::
++ envelopes-update
|= [envelopes=(list envelope) start=@ud end=@ud pax=path]
^- json
=, enjs:format
%+ frond %chat-update
%- pairs
:~
:- %messages
%- pairs
:~ [%path (path pax)]
[%start (numb start)]
[%end (numb end)]
[%envelopes [%a (turn envelopes enve)]]
==
==
::
++ truncate-envelopes
|= envelopes=(list envelope)
^- (list envelope)
=/ length (lent envelopes)
?: (lth length 100)
envelopes
(swag [(sub length 100) 100] envelopes)
::
++ truncate-inbox
|= box=inbox
^- inbox
%- ~(run by box)
|= mail=mailbox
^- mailbox
:- config.mail
(truncate-envelopes envelopes.mail)
::
--