channels: custom hooks

desk/app/channels.hoon

@@ -734,6 +734,9 @@
     ::
         [%x %v2 %channels full=?(~ [%full ~])]
       ``channels-2+!>((uv-channels-2:utils v-channels ?=(^ full.pole)))
+    ::
+        [%x %v3 %v-channels ~]
+      ``noun+!>(v-channels)
     ::
       [%x ?(%v0 %v1) %init ~]    ``noun+!>([unreads (uv-channels-1:utils v-channels)])
       [%x %v2 %init ~]  ``noun+!>([unreads (uv-channels-2:utils v-channels |)])

desk/gen/hooks/confirm.hoon

@@ -0,0 +1,19 @@
+/-  h=hooks, c=channels
+:-  %say
+|=  $:  [now=@da eny=@uvJ =beak]
+        [[=event:h =context:h ~] ~]
+    ==
+:-  %noun
+^-  outcome:h
+=-  &+[[[%allowed event] -] state.hook.context]
+^-  (list effect:h)
+?.  ?=(?(%delay %on-post) -.event)  ~
+?:  ?=(%delay -.event)
+  =/  =nest:c  [%chat ~bospur-davmyl-nocsyx-lassul %welcome-8458]
+  =+  !<(trigger=event:h data.event)
+  ?.  ?=([%on-post %add *] trigger)  ~
+  =*  post  post.trigger
+  =/  =c-react:c  [%add-react id.post author.post ':thumbs-up:']
+  ~[[%channels %channel nest %post c-react]]
+=/  id  (rsh [3 48] eny.context)
+~[[%delay id id.hook.context ~s30 !>(event)]]

desk/gen/hooks/truncate.hoon

@@ -0,0 +1,97 @@
+/-  h=hooks, c=channels
+:-  %say
+|=  $:  [now=@da eny=@uvJ =beak]
+        [[=event:h ~] ~]
+    ==
+:-  %noun
+^-  outcome:h
+=|  count=@ud
+=/  max  140
+=/  new-content=story:c  ~
+=*  no-op  &+[[[%allowed event] ~] !>(~)]
+?.  ?=(%on-post -.event)  no-op
+=*  on-post  +.event
+?.  ?=(?(%add %edit) -.on-post)  no-op
+=/  verses
+  ?-  -.on-post
+    %add  content.essay.post.on-post
+    %edit  content.essay.on-post
+  ==
+|^
+::  made it to the end
+=*  return
+  =-  &+[[[%allowed -] ~] !>(~)]
+  ?-  event
+    [%on-post %add *]  event(content.essay.post new-content)
+    [%on-post %edit *]  event(content.essay new-content)
+  ==
+?~  verses  return
+?:  (gte count max)  return
+=*  next   $(verses t.verses)
+=/  verse  i.verses
+::  remove blocks
+?:  ?=(%block -.verse)  next
+=/  [new-inlines=(list inline:c) new-count=@ud]
+  (run-list p.verse count)
+$(new-content (snoc new-content [%inline new-inlines]), verses t.verses, count new-count)
+++  run-list
+  |=  [inlines=(list inline:c) count=@ud]
+  ^-  [(list inline:c) @ud]
+  =/  new-inlines=(list inline:c)  ~
+  |-
+  ?~  inlines
+    ::  made it all the way through
+    [new-inlines count]
+  =*  next  $(inlines t.inlines)
+  =/  inline  i.inlines
+  ?:  (gte count max)
+    [new-inlines count]
+  ?@  inline
+    =/  new-string  (trim-cord inline count)
+    ?~  new-string  $(inlines ~)  ::done
+    $(new-inlines (snoc new-inlines u.new-string), inlines t.inlines, count (add count (met 3 u.new-string)))
+  =/  [new-inline=(unit inline:c) new-count=@ud]
+    (run-special-inlines inline count)
+  ?~  new-inline  $(inlines ~)  ::done
+  $(new-inlines (snoc new-inlines u.new-inline), inlines t.inlines, count new-count)
+++  run-special-inlines
+  |=  [=inline:c count=@ud]
+  ^-  [(unit inline:c) @ud]
+  ?+  -.inline  [~ count]
+      %break  [`inline +(count)]
+  ::
+      %ship
+    ?:  (gth (add count 14) max)  [~ count]
+    [`inline (add count 14)]
+  ::
+      %link
+    =/  new-string=(unit cord)  (trim-cord q.inline count)
+    ?~  new-string  [~ count]
+    =/  new-inline=inline:c  inline(q u.new-string)
+    [(some new-inline) (add count (met 3 u.new-string))]
+  ::
+      %inline-code
+    =/  new-string=(unit cord)  (trim-cord p.inline count)
+    ?~  new-string  [~ count]
+    [(some inline(p u.new-string)) (add count (met 3 u.new-string))]
+  ::
+      ?(%italics %bold %strike %blockquote)
+    =/  [new-inlines=(list inline:c) new-count=@ud]  (run-list p.inline count)
+    ?~  new-inlines  [~ count]
+    [(some inline(p new-inlines)) new-count]
+  ==
+++  trim-cord
+  |=  [=cord count=@ud]
+  ^-  (unit ^cord)
+  =/  string  (trip cord)
+  =/  length  (lent string)
+  =/  total  (add length count)
+  ?:  (gth total max)
+    :: truncate
+    =/  remainder  (sub total max)
+    ::  no room for anything
+    ?:  =(length remainder)  ~
+    =/  new-length  (sub length remainder)
+    `(crip (scag new-length string))
+  `cord
+--

desk/lib/channel-utils.hoon

@@ -1,4 +1,4 @@
-/-  c=channels, g=groups, ci=cite
+/-  c=channels, g=groups, ci=cite, h=hooks
 ::  convert a post to a preview for a "said" response
 ::
 |%
@@ -676,4 +676,37 @@
       ;br;
     ==
   --
+++  subject  ^~(!>(..compile))
+++  compile
+  |=  src=@t
+  ^-  (each vase tang)
+  ~&  %a
+  =/  tonk=(each vase tang)
+    ~&  %b
+    =/  vex=(like hoon)  ((full vest) [0 0] (trip src))
+    ~&  %c
+    ?~  q.vex  |+~[leaf+"\{{<p.p.vex>} {<q.p.vex>}}" 'syntax error']
+    ~&  %d
+    %-  mule
+    |.((slap subject p.u.q.vex))
+  ~&  %e
+  ~&  "parsed hoon: {<-.tonk>}"
+  ~&  %f
+  ?:  ?=(%| -.tonk)
+    %-  (slog 'returning error' p.tonk)
+    tonk
+  &+p.tonk
+++  run-hook
+  |=  [=args:h =hook:h]
+  ^-  (unit return:h)
+  ~&  "running hook: {<name.hook>} {<id.hook>}"
+  ?~  compiled.hook
+    ~&("hook not compiled" ~)
+  :: ~&  "nock: {<compiled.hook>}"
+  =+  !<(=outcome:h (slam u.compiled.hook !>(args)))
+  ~&  "{(trip name.hook)} hook run:"
+  ~&  outcome
+  ?:  ?=(%.y -.outcome)  `p.outcome
+  ~&  "hook failed:"
+  ((slog p.outcome) ~)
 --

desk/mar/hook/action-0.hoon

@@ -0,0 +1,12 @@
+/-  h=hooks, c=channels
+|_  =action:h
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  action
+  --
+++  grab
+  |%
+  ++  noun  action:h
+  --
+--

desk/mar/hook/response-0.hoon

@@ -0,0 +1,12 @@
+/-  h=hooks, c=channels
+|_  =response:h
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  response
+  --
+++  grab
+  |%
+  ++  noun  response:h
+  --
+--

desk/sur/hooks.hoon

@@ -0,0 +1,171 @@
+/-  *channels, g=groups, a=activity, ch=chat, co=contacts
+|%
+::  $id: a unique identifier for a hook
++$  id  @uv
+::
+::  $hook: a pure function that runs on triggers in a channel
+::
+::    $id: a unique identifier for the hook
+::    $name: a human-readable name for the hook
+::    $version: the version the hook was compiled with
+::    $src: the source code of the hook
+::    $compiled: the compiled version of the hook
+::    $state: the current state of the hook
+::    $config: any configuration data for the hook
+::
+++  hook
+  $:  =id
+      name=@t
+      version=%0
+      src=@t
+      compiled=(unit vase)
+      state=vase
+      config=(map nest config)
+  ==
+::  $hooks: collection of hooks, the order they should be run in, and
+::  any delayed hooks that need to be run
+++  hooks
+  $:  hooks=(map id hook)
+      order=(map nest (list id))
+      crons=(map id (map origin cron))
+      delayed=(map delay-id [=origin delayed-hook])
+  ==
++$  origin  $@(~ nest)
++$  delay-id  id
++$  cron
+  $:  =delay-id
+      schedule=@dr
+      =config
+  ==
+::  $delayed-hook: metadata for when a delayed hook fires from the timer
++$  delayed-hook
+  $:  id=delay-id
+      hook=id
+      data=vase
+      fires-at=time
+  ==
+::
++$  config  (map @t vase)
++$  action
+  $%  [%add name=@t src=@t]
+      [%edit =id name=@t src=@t]
+      [%del =id]
+      [%order =nest seq=(list id)]
+      [%configure =id =nest =config]
+      [%wait =id =origin schedule=@dr =config]
+      [%rest =id =origin]
+  ==
++$  response
+  $%  [%set =id name=@t src=@t error=(unit tang)]
+      [%gone =id]
+      [%order =nest seq=(list id)]
+      [%configure =id =nest =config]
+      [%wait =id =origin schedule=@dr =config]
+      [%rest =id =origin]
+  ==
+::  $context: ambient state that a hook should know about not
+::  necessarily tied to a specific event
+::
+::    $channel: the channel that the hook is operating on
+::    $channels: all the channels in the group
+::    $group: the group that the channel belongs to
+::    $hook: the hook that's running
+::    $config: the configuration data for this instance of the hook
+::    $now: the current time
+::    $our: the ship that the hook is running on
+::    $src: the ship that triggered the hook
+::    $eny: entropy for random number generation or key derivation
+::
++$  context
+  $:  channel=(unit [=nest v-channel])
+      group=(unit group-ui:g)
+      channels=v-channels
+      =hook
+      =config
+      now=time
+      our=ship
+      src=ship
+      eny=@
+  ==
+::
+::  $on-post: a hook event that fires when posts are interacted with
++$  on-post
+  $%  [%add post=v-post]
+      [%edit original=v-post =essay]
+      [%del original=v-post]
+      [%react post=v-post =ship react=(unit react)]
+  ==
+::
+::  $on-reply: a hook event that fires when replies are interacted with
++$  on-reply
+  $%  [%add parent=v-post reply=v-reply]
+      [%edit parent=v-post original=v-reply =memo]
+      [%del parent=v-post original=v-reply]
+      [%react parent=v-post reply=v-reply =ship react=(unit react)]
+  ==
+::  $event-type: the type of event that triggers a hook
++$  event-type  ?(%on-post %on-reply %cron %delay)
+::
+::  $event: the data associated with the trigger of a hook
+::
+::    $on-post: a post was added, edited, deleted, or reacted to
+::    $on-reply: a reply was added, edited, deleted, or reacted to
+::    $cron: a scheduled wake-up
+::    $wake: a delayed invocation of the hook called with metadata about
+::    when it fired, its id, and the event it should run with
+::
++$  event
+  $%  [%on-post on-post]
+      [%on-reply on-reply]
+      [%cron ~]
+      [%wake delayed-hook]
+  ==
+::
+::  $args: the arguments passed to a hook
++$  args
+  $:  =event
+      =context
+  ==
+::
+::  $result: the result of a hook running
+::
+::    $allowed: represents the action being allowed to go through, and the
+::    new value of the action
+::    $denied: represents the action being denied along with the reason
+::    that the action was denied
+::    $error: represents an error that occurred while running the hook
+::
++$  result
+  $%  [%allowed new=event]
+      [%denied msg=(unit cord)]
+  ==
+::
+::  $effect: an effect that a hook can have, limited to agents in
+::  the %groups desk. $delay is a special effect that will wake up the
+::  same hook at a later time.
++$  effect
+  $%  [%channels =a-channels]
+      [%groups =action:g]
+      [%activity =action:a]
+      [%dm =action:dm:ch]
+      [%club =action:club:ch]
+      [%contacts =action:co]
+      [%wait delayed-hook]
+  ==
+::
+::  $return: the data returned from a hook
+::
+::    $result: whether the action was allowed or denied, any new values,
+::    or an error message if something went wrong
+::    $actions: any actions that should be taken on other agents or delay
+::    $new-state: the new state of the hook after running
+::
++$  return
+  $:  $:  =result
+          effects=(list effect)
+      ==
+      new-state=vase
+  ==
+::
++$  outcome  (each return tang)
+--

desk/ted/hooks/add.hoon

@@ -0,0 +1,21 @@
+/-  spider, h=hooks
+/+  s=strandio
+=,  strand=strand:spider
+^-  thread:spider
+|=  arg=vase
+=/  m  (strand ,vase)
+^-  form:m
+=+  !<([~ name=@t src=@t] arg)
+;<  our=@p  bind:m  get-our:s
+;<  ~  bind:m  (watch:s /responses [our %channels-server] /hooks/v0)
+=/  =cage  hook-action-0+!>(`action:h`[%add name src])
+;<  ~  bind:m  (poke-our:s %channels-server cage)
+;<  =^cage  bind:m  (take-fact:s /responses)
+?>  ?=(%hook-response-0 p.cage)
+=+  !<(=response:h q.cage)
+?>  ?=(%set -.response)
+~&  "hook {<name.response>} added with id {<id.response>}"
+?~  error.response  (pure:m !>(~))
+~&  "compilation error:"
+%-  (slog u.error.response)
+(pure:m !>(~))