Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

channels: custom hooks #4165

Draft
wants to merge 4 commits into
base: develop
Choose a base branch
from
Draft

channels: custom hooks #4165

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
ca25bbd
wip: refactoring hooks
arthyn Nov 12, 2024
fb4daf2
channels-server: fix compile issue
arthyn Nov 12, 2024
724ea8c
channels-server: hooks mostly working, delay needs testing
arthyn Nov 14, 2024
938383b
wip: trying to use delay hooks
arthyn Nov 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
277 changes: 263 additions & 14 deletions desk/app/channels-server.hoon
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
::
:: this is the server-side from which /app/channels gets its data.
::
/- c=channels, g=groups
/- c=channels, g=groups, h=hooks
/+ utils=channel-utils, imp=import-aid
/+ default-agent, verb, dbug, neg=negotiate
::
Expand All @@ -16,8 +16,9 @@
|%
+$ card card:agent:gall
+$ current-state
$: %6
$: %7
=v-channels:c
hooks=(map nest:c hooks:h)
=pimp:imp
==
--
Expand Down Expand Up @@ -92,12 +93,22 @@
=? old ?=(%3 -.old) (state-3-to-4 old)
=? old ?=(%4 -.old) (state-4-to-5 old)
=? old ?=(%5 -.old) (state-5-to-6 old)
?> ?=(%6 -.old)
=? old ?=(%6 -.old) (state-6-to-7 old)
?> ?=(%7 -.old)
=. state old
inflate-io
::
+$ versioned-state $%(state-6 state-5 state-4 state-3 state-2 state-1 state-0)
+$ state-6 current-state
+$ versioned-state $%(state-7 state-6 state-5 state-4 state-3 state-2 state-1 state-0)
+$ state-7 current-state
+$ state-6
$: %6
=v-channels:c
=pimp:imp
==
++ state-6-to-7
|= state-6
^- state-7
[%7 v-channels ~ pimp]
+$ state-5
$: %5
=v-channels:v6:old:c
Expand Down Expand Up @@ -321,6 +332,10 @@
[~ %| *] ~& [dap.bowl %overwriting-pending-import]
cor(pimp `|+egg-any)
==
::
%hook-action-0
=+ !<([=nest:c =action:h] vase)
ho-abet:(ho-action:(ho-abed:ho-core nest) action)
==
::
++ run-import
Expand Down Expand Up @@ -646,16 +661,26 @@
|= =c-post:c
^- [(unit u-channel:c) _posts.channel]
?> (can-write:ca-perms src.bowl writers.perm.perm.channel)
=/ =context:h (get-context channel)
?- -.c-post
%add
?> =(src.bowl author.essay.c-post)
?> =(kind.nest -.kind-data.essay.c-post)
=^ result=(each event:h tang) cor
=/ =event:h [%on-post %add essay.c-post]
%- ho-run:(ho-abed:ho-core nest)
[event context 'post blocked']
?: ?=(%.n -.result)
((slog p.result) [~ posts.channel])
=/ =essay:c
?> ?=([%on-post %add *] p.result)
essay.p.result
=/ id=id-post:c
|-
=/ post (get:on-v-posts:c posts.channel now.bowl)
?~ post now.bowl
$(now.bowl `@da`(add now.bowl ^~((div ~s1 (bex 16)))))
=/ new=v-post:c [[id ~ ~] 0 essay.c-post]
=/ new=v-post:c [[id ~ ~] 0 essay]
:- `[%post id %set ~ new]
(put:on-v-posts:c posts.channel id ~ new)
::
Expand All @@ -666,8 +691,17 @@
?~ post `posts.channel
?~ u.post `posts.channel
?> |(=(src.bowl author.u.u.post) (is-admin:ca-perms src.bowl))
=^ result=(each event:h tang) cor
=/ =event:h [%on-post %edit u.u.post essay.c-post]
%- ho-run:(ho-abed:ho-core nest)
[event context 'edit blocked']
?: ?=(%.n -.result)
((slog p.result) [~ posts.channel])
=/ =essay:c
?> ?=([%on-post %edit *] p.result)
essay.p.result
::TODO could optimize and no-op if the edit is identical to current
=/ new=v-post:c [-.u.u.post +(rev.u.u.post) essay.c-post]
=/ new=v-post:c [-.u.u.post +(rev.u.u.post) essay]
:- `[%post id.c-post %set ~ new]
(put:on-v-posts:c posts.channel id.c-post ~ new)
::
Expand All @@ -676,14 +710,35 @@
?~ post `(put:on-v-posts:c posts.channel id.c-post ~)
?~ u.post `posts.channel
?> |(=(src.bowl author.u.u.post) (is-admin:ca-perms src.bowl))
=^ result=(each event:h tang) cor
=/ =event:h [%on-post %del u.u.post]
%- ho-run:(ho-abed:ho-core nest)
[event context 'delete blocked']
?> =(& -.result)
:- `[%post id.c-post %set ~]
(put:on-v-posts:c posts.channel id.c-post ~)
::
?(%add-react %del-react)
=/ post (get:on-v-posts:c posts.channel id.c-post)
?~ post `posts.channel
?~ u.post `posts.channel
=/ [update=? reacts=v-reacts:c] (ca-c-react reacts.u.u.post c-post)
=^ result=(each event:h tang) cor
=/ =event:h
:* %on-post %react u.u.post
?: ?=(%del-react -.c-post) [p.c-post ~]
[p `q]:c-post
==
%- ho-run:(ho-abed:ho-core nest)
[event context 'react action blocked']
?: ?=(%.n -.result)
((slog p.result) [~ posts.channel])
=/ new=c-post:c
?> ?=([%on-post %react *] p.result)
?~ react.p.result [%del-react id.c-post ship.p.result]
[%add-react id.c-post [ship u.react]:p.result]
=/ [update=? reacts=v-reacts:c]
%+ ca-c-react reacts.u.u.post
?>(?=(?(%add-react %del-react) -.new) new)
?. update `posts.channel
:- `[%post id.c-post %reacts reacts]
(put:on-v-posts:c posts.channel id.c-post ~ u.u.post(reacts reacts))
Expand All @@ -693,25 +748,35 @@
?~ post `posts.channel
?~ u.post `posts.channel
=^ update=(unit u-post:c) replies.u.u.post
(ca-c-reply replies.u.u.post c-reply.c-post)
(ca-c-reply u.u.post c-reply.c-post context)
?~ update `posts.channel
:- `[%post id.c-post u.update]
(put:on-v-posts:c posts.channel id.c-post ~ u.u.post)
==
::
++ ca-c-reply
|= [replies=v-replies:c =c-reply:c]
^- [(unit u-post:c) _replies]
|= [parent=v-post:c =c-reply:c =context:h]
^- [(unit u-post:c) v-replies:c]
=* replies replies.parent
?- -.c-reply
%add
?> =(src.bowl author.memo.c-reply)
=^ result=(each event:h tang) cor
=/ =event:h [%on-reply %add parent memo.c-reply]
%- ho-run:(ho-abed:ho-core nest)
[event context 'reply blocked']
?: ?=(%.n -.result)
((slog p.result) [~ replies])
=/ =memo:c
?> ?=([%on-reply %add *] p.result)
memo.p.result
=/ id=id-reply:c
|-
=/ reply (get:on-v-replies:c replies now.bowl)
?~ reply now.bowl
$(now.bowl `@da`(add now.bowl ^~((div ~s1 (bex 16)))))
=/ reply-seal=v-reply-seal:c [id ~]
=/ new=v-reply:c [reply-seal 0 memo.c-reply]
=/ new=v-reply:c [reply-seal 0 memo]
:- `[%reply id %set ~ new]
(put:on-v-replies:c replies id ~ new)
::
Expand All @@ -720,8 +785,17 @@
?~ reply `replies
?~ u.reply `replies
?> =(src.bowl author.u.u.reply)
=^ result=(each event:h tang) cor
=/ =event:h [%on-reply %edit parent u.u.reply memo.c-reply]
%- ho-run:(ho-abed:ho-core nest)
[event context 'edit blocked']
?: ?=(%.n -.result)
((slog p.result) [~ replies])
=/ =memo:c
?> ?=([%on-reply %edit *] p.result)
memo.p.result
::TODO could optimize and no-op if the edit is identical to current
=/ new=v-reply:c [-.u.u.reply +(rev.u.u.reply) memo.c-reply]
=/ new=v-reply:c [-.u.u.reply +(rev.u.u.reply) memo]
:- `[%reply id.c-reply %set ~ new]
(put:on-v-replies:c replies id.c-reply ~ new)
::
Expand All @@ -730,14 +804,35 @@
?~ reply `(put:on-v-replies:c replies id.c-reply ~)
?~ u.reply `replies
?> |(=(src.bowl author.u.u.reply) (is-admin:ca-perms src.bowl))
=^ result=(each event:h tang) cor
=/ =event:h [%on-reply %del parent u.u.reply]
%- ho-run:(ho-abed:ho-core nest)
[event context 'delete blocked']
?> =(& -.result)
:- `[%reply id.c-reply %set ~]
(put:on-v-replies:c replies id.c-reply ~)
::
?(%add-react %del-react)
=/ reply (get:on-v-replies:c replies id.c-reply)
?~ reply `replies
?~ u.reply `replies
=/ [update=? reacts=v-reacts:c] (ca-c-react reacts.u.u.reply c-reply)
=^ result=(each event:h tang) cor
=/ =event:h
:* %on-reply %react parent u.u.reply
?: ?=(%del-react -.c-reply) [p.c-reply ~]
[p `q]:c-reply
==
%- ho-run:(ho-abed:ho-core nest)
[event context 'delete blocked']
?: ?=(%.n -.result)
((slog p.result) [~ replies])
=/ new=c-reply:c
?> ?=([%on-reply %react *] p.result)
?~ react.p.result [%del-react id.c-reply ship.p.result]
[%add-react id.c-reply [ship u.react]:p.result]
=/ [update=? reacts=v-reacts:c]
%+ ca-c-react reacts.u.u.reply
?>(?=(?(%add-react %del-react) -.new) new)
?. update `replies
:- `[%reply id.c-reply %reacts reacts]
(put:on-v-replies:c replies id.c-reply ~ u.u.reply(reacts reacts))
Expand Down Expand Up @@ -836,4 +931,158 @@
(said:utils nest plan posts.channel)
(give %kick ~ ~)
--
++ scry-path
|= [=dude:gall =path]
%+ welp
/(scot %p our.bowl)/[dude]/(scot %da now.bowl)
path
++ get-context
|= =v-channel:c
^- context:h
=* flag group.perm.perm.v-channel
=/ =group:g
?. .^(? %gu (scry-path %groups /$)) *group:g
?. .^(? %gx (scry-path %groups /exists/(scot %p p.flag)/[q.flag]/noun))
*group:g
.^(group:g %gx (scry-path %groups /groups/(scot %p p.flag)/[q.flag]/v1/noun))
:* v-channel
v-channels
group
!>(~) :: we default this because each hook will replace with its own
[now our src eny]:bowl
==
::
++ ho-core
|_ [=nest:c hks=hooks:h ctx=context:h gone=_|]
++ ho-core .
++ emit |=(=card ho-core(cor (^emit card)))
++ emil |=(caz=(list card) ho-core(cor (^emil caz)))
++ give |=(=gift:agent:gall ho-core(cor (^give gift)))
++ ho-abet
%_ cor
hooks
?:(gone (~(del by hooks) nest) (~(put by hooks) nest hks))
==
::
++ ho-abed
|= n=nest:c
ho-core(nest n, hks (~(gut by hooks) n *hooks:h))
::
++ ho-action
|= =action:h
^+ ho-core
?> (is-admin:ca-perms:(ca-abed:ca-core nest) src.bowl)
?- -.action
%add
~& "adding hook {<action>}"
=/ =id:h (rsh [3 48] eny.bowl)
=/ src=(rev:c (unit @t)) [0 `src.action]
=/ result=(each nock tang)
~& "compiling hook"
((compile:utils args:h (return:h *)) `src.action)
~& "compilation result: {<result>}"
=/ compiled
?: ?=(%| -.result) ~
`p.result
=. order.hks
+:(next-rev:c order.hks (snoc +.order.hks id))
=. hooks.hks
%+ ~(put by hooks.hks) id
[id name.action & src compiled cron.action !>(~)]
ho-core
::
%edit
?~ old-hook=(~(get by hooks.hks) id.action) ho-core
=/ hook u.old-hook
=^ src-changed src.hook
(next-rev:c src.hook `src.action)
=/ name-changed !=(name.action name.hook)
=/ cron-changed !=(cron.action cron.hook)
?. |(src-changed name-changed cron-changed) ho-core
=. name.hook name.action
=. cron.hook cron.action
=. compiled.hook
?~ +.src.hook ~
=/ result=(each nock tang)
((compile:utils args:h return:h) +.src.hook)
?: ?=(%| -.result) ~
`p.result
=. hooks.hks (~(put by hooks.hks) id.action hook)
ho-core
::
%del
:: TODO: make more CRDT
=. hooks.hks (~(del by hooks.hks) id.action)
=/ [* new-order=_order.hks]
%+ next-rev:c order.hks
%+ skim +.order.hks
|= =id:h
!=(id id.action)
=. order.hks new-order
ho-core
::
%enable
=/ hook (~(got by hooks.hks) id.action)
=. hooks.hks (~(put by hooks.hks) id.action hook(enabled &))
ho-core
::
%disable
=/ hook (~(got by hooks.hks) id.action)
=. hooks.hks (~(put by hooks.hks) id.action hook(enabled |))
ho-core
::
%order
=^ changed order.hks
(next-rev:c order.hks seq.action)
ho-core
==
++ ho-run
|= [=event:h =context:h default=cord]
=^ [result=(each event:h tang) effects=(list effect:h)] hks
(run-hooks:utils event context default hks)
=. hooks (~(put by hooks) nest hks)
[result (ho-run-effects effects)]
++ ho-run-effects
|= effects=(list effect:h)
^+ cor
|-
?~ effects cor
=/ =effect:h i.effects
=; new-cor=_ho-core
=. ho-core new-cor
$(effects t.effects)
?- -.effect
%channels
=/ =cage channel-action+!>(a-channels.effect)
(emit [%pass /hooks/effect %agent [our.bowl %channels] %poke cage])
::
%groups
=/ =cage group-action-3+!>(action.effect)
(emit [%pass /hooks/effect %agent [our.bowl %groups] %poke cage])
::
%activity
=/ =cage activity-action+!>(action.effect)
(emit [%pass /hooks/effect %agent [our.bowl %activity] %poke cage])
::
%dm
=/ =cage chat-dm-action+!>(action.effect)
(emit [%pass /hooks/effect %agent [our.bowl %chat] %poke cage])
::
%club
=/ =cage chat-club-action+!>(action.effect)
(emit [%pass /hooks/effect %agent [our.bowl %chat] %poke cage])
::
%contacts
=/ =cage contacts-action-1+!>(action.effect)
(emit [%pass /hooks/effect %agent [our.bowl %contacts] %poke cage])
::
%delay
=/ fires-at (add now.bowl wait.effect)
=. delayed.hks
%+ ~(put by delayed.hks) id.effect
+:effect(data [data.effect fires-at])
=/ =wire /hooks/delayed/(scot %uv id.effect)
(emit [%pass wire %arvo %b %wait fires-at])
==
--
--
Loading