urbit/pkg/arvo/app/chat-store.hoon

313 lines
8.0 KiB
Plaintext
Raw Normal View History

2019-11-05 22:30:58 +03:00
:: chat-store: data store that holds linear sequences of chat messages
::
2020-04-30 02:04:29 +03:00
/+ store=chat-store, default-agent, verb, dbug
2020-04-03 00:43:03 +03:00
~% %chat-store-top ..is ~
2019-11-05 22:30:58 +03:00
|%
+$ card card:agent:gall
2019-11-06 02:50:56 +03:00
+$ versioned-state
$% state-0
state-1
state-2
2019-11-05 22:30:58 +03:00
==
::
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ admin-action
$% [%trim ~]
==
2019-11-05 22:30:58 +03:00
--
::
=| state-2
2019-11-07 09:19:32 +03:00
=* state -
::
%- agent:dbug
%+ verb |
2019-11-19 07:36:21 +03:00
^- agent:gall
2019-11-06 05:52:27 +03:00
=<
2020-04-03 00:43:03 +03:00
~% %chat-store-agent-core ..peek-x-envelopes ~
2019-11-19 07:36:21 +03:00
|_ =bowl:gall
2019-11-07 09:19:32 +03:00
+* this .
2019-11-06 05:52:27 +03:00
chat-core +>
2019-11-07 09:19:32 +03:00
cc ~(. chat-core bowl)
def ~(. (default-agent this %|) bowl)
2019-11-05 22:30:58 +03:00
::
2019-11-07 09:19:32 +03:00
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
=? old ?=(%0 -.old)
(old-to-2 inbox.old)
=? old ?=(%1 -.old)
(old-to-2 inbox.old)
[~ this(state [%2 inbox.old])]
::
++ old-to-2
|= =inbox:store
^- state-2
:- %2
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
--
2019-11-05 22:30:58 +03:00
::
2019-11-07 09:19:32 +03:00
++ on-poke
2020-04-03 00:43:03 +03:00
~/ %chat-store-poke
2019-11-05 22:30:58 +03:00
|= [=mark =vase]
^- (quip card _this)
2019-11-06 02:50:56 +03:00
?> (team:title our.bowl src.bowl)
2019-11-05 22:30:58 +03:00
=^ cards state
2019-11-07 09:19:32 +03:00
?+ mark (on-poke:def mark vase)
2019-11-06 05:52:27 +03:00
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun [~ (poke-noun:cc !<(admin-action vase))]
2019-11-05 22:30:58 +03:00
==
[cards this]
::
2019-11-07 09:19:32 +03:00
++ on-watch
2020-04-03 00:43:03 +03:00
~/ %chat-store-watch
2019-11-05 22:30:58 +03:00
|= =path
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
2019-11-05 22:30:58 +03:00
=/ cards=(list card)
2019-11-07 09:19:32 +03:00
?+ path (on-watch:def path)
2019-11-06 05:52:27 +03:00
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
[%all ~] (give %chat-update !>([%initial inbox]))
2019-11-05 22:30:58 +03:00
[%updates ~] ~
[%mailbox @ *]
2019-11-06 05:52:27 +03:00
?> (~(has by inbox) t.path)
(give %chat-update !>([%create t.path]))
2019-11-05 22:30:58 +03:00
==
[cards this]
::
++ give
|= =cage
^- (list card)
2019-11-07 09:19:32 +03:00
[%give %fact ~ cage]~
2019-11-05 22:30:58 +03:00
--
::
2019-11-07 09:19:32 +03:00
++ on-leave on-leave:def
++ on-peek
2020-04-03 00:43:03 +03:00
~/ %chat-store-peek
2019-11-05 22:30:58 +03:00
|= =path
^- (unit (unit cage))
2019-11-07 09:19:32 +03:00
?+ path (on-peek:def path)
2019-11-06 05:52:27 +03:00
[%x %all ~] ``noun+!>(inbox)
[%x %keys ~] ``noun+!>(~(key by inbox))
[%x %envelopes *] (peek-x-envelopes:cc t.t.path)
2019-11-05 22:30:58 +03:00
[%x %mailbox *]
?~ t.t.path
~
2019-11-06 05:52:27 +03:00
``noun+!>((~(get by inbox) t.t.path))
2019-11-05 22:30:58 +03:00
::
[%x %config *]
?~ t.t.path
~
2019-11-06 05:52:27 +03:00
=/ mailbox (~(get by inbox) t.t.path)
2019-11-05 22:30:58 +03:00
?~ mailbox
~
``noun+!>(config.u.mailbox)
==
::
2019-11-07 09:19:32 +03:00
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
2019-11-05 22:30:58 +03:00
--
::
::
2020-04-03 00:43:03 +03:00
~% %chat-store-library ..card ~
2019-11-19 07:36:21 +03:00
|_ bol=bowl:gall
2019-11-05 22:30:58 +03:00
::
++ peek-x-envelopes
|= pax=path
^- (unit (unit [%noun vase]))
?+ pax ~
[@ @ *]
=/ mail-path t.t.pax
=/ mailbox (~(get by inbox) mail-path)
?~ mailbox
[~ ~ %noun !>(~)]
=* envelopes envelopes.u.mailbox
=/ sign-test=[?(%neg %pos) @]
%- need
%+ rush i.pax
;~ pose
%+ cook
|= n=@
[%neg n]
;~(pfix hep dem:ag)
::
%+ cook
|= n=@
[%pos n]
dem:ag
==
=* length length.config.u.mailbox
=* start +.sign-test
?: =(-.sign-test %neg)
?: (gth start length)
[~ ~ %noun !>(envelopes)]
[~ ~ %noun !>((swag [(sub length start) start] envelopes))]
::
=/ end (slav %ud i.t.pax)
?. (lte start end)
~
=. end ?:((lth end length) end length)
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
==
::
++ poke-noun
|= nou=admin-action
^- _state
~& %trimming-chat-store
%_ state
inbox
%- ~(urn by inbox)
|= [=path mailbox:store]
^- mailbox:store
=/ [a=* out=(list envelope:store)]
%+ roll envelopes
|= $: =envelope:store
o=[[hav=(set serial:store) curr=@] out=(list envelope:store)]
==
?: (~(has in hav.o) uid.envelope)
[[hav.o curr.o] out.o]
:-
^- [(set serial:store) @]
[(~(put in hav.o) uid.envelope) +(curr.o)]
^- (list envelope:store)
[envelope(number curr.o) out.o]
=/ len (lent out)
2020-06-30 00:30:33 +03:00
~? !=(len (lent envelopes)) [path [%old (lent envelopes)] [%new len]]
[[len len] (flop out)]
==
::
2019-11-05 22:30:58 +03:00
++ poke-json
|= jon=json
2019-11-06 02:50:56 +03:00
^- (quip card _state)
2020-04-30 02:04:29 +03:00
(poke-chat-action (action:dejs:store jon))
2019-11-05 22:30:58 +03:00
::
++ poke-chat-action
|= =action:store
2019-11-06 02:50:56 +03:00
^- (quip card _state)
2019-11-05 22:30:58 +03:00
?- -.action
%create (handle-create action)
%delete (handle-delete 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]
2019-11-05 22:30:58 +03:00
==
::
++ handle-create
|= =action:store
2019-11-06 02:50:56 +03:00
^- (quip card _state)
?> ?=(%create -.action)
?: (~(has by inbox) path.action) [~ state]
:- (send-diff path.action action)
state(inbox (~(put by inbox) path.action *mailbox:store))
2019-11-05 22:30:58 +03:00
::
++ handle-delete
|= =action:store
2019-11-06 02:50:56 +03:00
^- (quip card _state)
?> ?=(%delete -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox [~ state]
:- (send-diff path.action action)
state(inbox (~(del by inbox) path.action))
2019-11-05 22:30:58 +03:00
::
++ handle-message
|= =action:store
2019-11-06 02:50:56 +03:00
^- (quip card _state)
?> ?=(%message -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
2019-11-05 22:30:58 +03:00
?~ mailbox
[~ state]
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:_ state(inbox (~(put by inbox) path.action u.mailbox))
(send-diff path.action action(envelope envelope))
2019-11-05 22:30:58 +03:00
::
++ handle-messages
|= act=action:store
^- (quip card _state)
?> ?=(%messages -.act)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.act)
?~ mailbox
[~ state]
=. envelopes.act (flop envelopes.act)
=| evaluated-envelopes=(list envelope:store)
|- ^- (quip card _state)
?~ envelopes.act
:_ state(inbox (~(put by inbox) path.act u.mailbox))
%+ send-diff path.act
[%messages path.act 0 (lent evaluated-envelopes) evaluated-envelopes]
=. letter.i.envelopes.act (evaluate-letter [author letter]:i.envelopes.act)
=^ envelope u.mailbox (prepend-envelope u.mailbox i.envelopes.act)
=. evaluated-envelopes [envelope evaluated-envelopes]
$(envelopes.act t.envelopes.act)
::
2019-11-05 22:30:58 +03:00
++ handle-read
|= act=action:store
2019-11-06 02:50:56 +03:00
^- (quip card _state)
2019-11-05 22:30:58 +03:00
?> ?=(%read -.act)
=/ mailbox=(unit mailbox:store) (~(get by inbox) path.act)
2019-11-05 22:30:58 +03:00
?~ mailbox
2019-11-06 02:50:56 +03:00
[~ state]
2019-11-05 22:30:58 +03:00
=. read.config.u.mailbox length.config.u.mailbox
:- (send-diff path.act act)
2019-11-06 02:50:56 +03:00
state(inbox (~(put by inbox) path.act u.mailbox))
2019-11-05 22:30:58 +03:00
::
++ evaluate-letter
|= [author=ship =letter:store]
^- letter:store
=? letter
?& ?=(%code -.letter)
?=(~ output.letter)
(team:title our.bol author)
==
=/ =hoon (ream expression.letter)
2020-04-30 02:04:29 +03:00
letter(output (eval:store bol hoon))
letter
::
++ prepend-envelope
|= [=mailbox:store =envelope:store]
^+ [envelope mailbox]
=. number.envelope +(length.config.mailbox)
=: length.config.mailbox +(length.config.mailbox)
envelopes.mailbox [envelope envelopes.mailbox]
==
[envelope mailbox]
::
2019-11-05 22:30:58 +03:00
++ update-subscribers
|= [pax=path =update:store]
2019-11-05 22:30:58 +03:00
^- (list card)
[%give %fact ~[pax] %chat-update !>(update)]~
2019-11-05 22:30:58 +03:00
::
++ send-diff
|= [pax=path upd=update:store]
2019-11-05 22:30:58 +03:00
^- (list card)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%mailbox pax] upd)
?. |(|(=(%read -.upd) =(%message -.upd)) =(%messages -.upd))
2019-11-05 22:30:58 +03:00
~
?. |(=(%create -.upd) =(%delete -.upd))
2019-11-05 22:30:58 +03:00
~
(update-subscribers /keys upd)
2019-11-05 22:30:58 +03:00
==
--