Bark and growl agents & marks

desk/app/bark.hoon

@@ -1,3 +1,4 @@
+/-  hark
 /+  default-agent, verb, dbug
 ::
 |%
@@ -5,7 +6,7 @@
 +$  versioned-state
   $%  state-0
   ==
-+$  state-0  [%0 mailchimp-api-key=cord]
++$  state-0  [%0 mailchimp-api-key=cord hosting-api-key=cord recipients=(set ship)]
 --
 ::
 =|  state-0
@@ -23,6 +24,35 @@
   ?+  mark  (on-poke:def mark vase)
       %set-api-key
     `this(mailchimp-api-key !<(cord vase))
+    ::
+      %bark-add-recipient
+    =+  !<(=ship vase)
+    ?>  =(src.bowl ship)
+    `this(recipients (~(put in recipients) ship))
+    ::
+      %bark-remove-recipient
+    =+  !<(=ship vase)
+    ?>  =(src.bowl ship)
+    `this(recipients (~(del in recipients) ship))
+    ::
+      %bark-generate-summaries
+    ?>  =(src.bowl our.bowl)
+    :_  this
+    =-  ~(tap in -)
+    ^-  (set card)
+    %-  ~(run in recipients)
+      |=  =ship
+      ^-  card
+      [%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)]
+    ::
+      %bark-receive-summary
+    =/  result  !<((unit [requested=time =carpet:hark]) vase)
+    ?~  result
+      `this(recipients (~(del in recipients) src.bowl))
+    ~&  >>>  carpet.u.result
+    ::  TODO create thread that calls the "get email address" thread (to be written)
+    ::  and the "send email" thread and call it here
+    `this
   ==
 ++  on-watch  on-watch:def
 ++  on-agent  on-agent:def

desk/app/growl.hoon

@@ -1,3 +1,4 @@
+/-  hark
 /+  default-agent, verb, dbug
 ::
 |%
@@ -5,7 +6,7 @@
 +$  versioned-state
   $%  state-0
   ==
-+$  state-0  [%0 enabled=?]
++$  state-0  [%0 enabled=? bark-host=ship]
 --
 ::
 ::  This agent should eventually go into landscape
@@ -25,28 +26,30 @@
   |=  [=mark =vase]
   ^-  (quip card _this)
   ?+  mark  (on-poke:def mark vase)
+      %set-host
+    ?>  =(src.bowl our.bowl)
+    `this(bark-host !<(ship vase))
+      ::
       %enable
-    `this(enabled %.y)
+    :_  this(enabled %.y)
+    ~[[%pass /add-recipient %agent [bark-host %bark] %poke %bark-add-recipient !>(our.bowl)]]
+      ::
       %disable
-    `this(enabled %.n)
+    :_  this(enabled %.n)
+    ~[[%pass /remove-recipient %agent [bark-host %bark] %poke %bark-remove-recipient !>(our.bowl)]]
+      ::
+      %growl-summarize
+    ?.  enabled
+      :_  this
+      ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(~)]]
+    =/  requested  !<(time vase)
+    =/  scry-path  [(scot %p our.bowl) %hark (scot %da now.bowl) %all %latest %hark-carpet ~]
+    =/  =carpet:hark  .^(carpet:hark %gx scry-path)
+    :_  this
+    ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(`[requested carpet])]]
   ==
 ++  on-watch  on-watch:def
-++  on-agent
-  |=  [=wire =sign:agent:gall]
-  ^-  (quip card _this)
-  ?+  wire  (on-agent:def wire sign)
-      [%hark ~]
-    ?-  -.sign
-        %poke-ack   `this
-        %watch-ack  `this
-        %kick
-      :_  this
-      ~[[%pass /hark %agent [our.bowl %hark] %watch /ui]]
-        %fact
-      ::  TODO
-      `this
-    ==
-  ==
+++  on-agent  on-agent:def
 ++  on-fail
   |=  [=term =tang]
   (mean ':sub +on-fail' term tang)

desk/mar/bark/add-recipient.hoon

@@ -0,0 +1,11 @@
+|_  rec=ship
+++  grad  %noun
+++  grab
+  |%
+  ++  noun  ship
+  --
+++  grow
+  |%
+  ++  noun  rec
+  --
+--

desk/mar/bark/receive-summary.hoon

@@ -0,0 +1,12 @@
+/-  hark
+|_  result=(unit [requested=time =carpet:hark])
+++  grad  %noun
+++  grab
+  |%
+  ++  noun  (unit (pair time carpet:hark))
+  --
+++  grow
+  |%
+  ++  noun  result
+  --
+--

desk/mar/bark/remove-recipient.hoon

@@ -0,0 +1,11 @@
+|_  rec=ship
+++  grad  %noun
+++  grab
+  |%
+  ++  noun  ship
+  --
+++  grow
+  |%
+  ++  noun  rec
+  --
+--

desk/mar/growl/summarize.hoon

@@ -0,0 +1,11 @@
+|_  requested=time
+++  grad  %noun
+++  grab
+  |%
+  ++  noun  time
+  --
+++  grow
+  |%
+  ++  noun  requested
+  --
+--

desk/sur/epic.hoon

@@ -0,0 +1,15 @@
+|%
+::  $saga: version synchronisation state
+::    %dex: publisher is ahead
+::    %lev: we are ahead
+::    %chi: full sync
+::
++$  saga
+  $%  [%dex ver=@ud]
+      [%lev ~]
+      [%chi ~]
+  ==
+
++$  epic  @ud
+::
+--

desk/sur/group-store.hoon

@@ -0,0 +1,39 @@
+/-  *group, *resource
+^?
+|%
+::
+::  $action: request to change group-store state
+::
+::    %add-group: add a group
+::    %add-members: add members to a group
+::    %remove-members: remove members from a group
+::    %add-tag: add a tag to a set of ships
+::    %remove-tag: remove a tag from a set of ships
+::    %change-policy: change a group's policy
+::    %remove-group: remove a group from the store
+::    %expose: unset .hidden flag
+::
++$  action
+  $%  [%add-group =resource =policy hidden=?]
+      [%add-members =resource ships=(set ship)]
+      [%remove-members =resource ships=(set ship)]
+      [%add-tag =resource =tag ships=(set ship)]
+      [%remove-tag =resource =tag ships=(set ship)]
+      [%change-policy =resource =diff:policy]
+      [%remove-group =resource ~]
+      [%expose =resource ~]
+  ==
+::  $update: a description of a processed state change
+::
+::    %initial: describe groups upon new subscription
+::
++$  update
+  $%  initial
+      action
+  ==
++$  initial
+  $%  [%initial-group =resource =group]
+      [%initial =groups]
+  ==
+--
+

desk/sur/group.hoon

@@ -0,0 +1,109 @@
+/-  *resource
+::
+^?
+|%
+::
+++  groups-state-one
+  |%
+  +$  groups  (map resource group)
+  ::
+  +$  tag  $@(group-tag [app=term tag=term])
+  ::
+  +$  tags  (jug tag ship)
+  ::
+  +$  group
+    $:  members=(set ship)
+        =tags
+        =policy
+        hidden=?
+    ==
+  --
+::  $groups: a mapping from group-ids to groups
+::
++$  groups  (map resource group)
+::  $group-tag: an identifier used by groups
+::
+::    These tags should have precise semantics, as they are shared across all
+::    apps.
+::
++$  group-tag  ?(role-tag)
+::  $tag: an identifier used to identify a subset of members
+::
+::   Tags may be used and recognised differently across apps.
+::   for example, you could use tags like `%author`, `%bot`, `%flagged`...
+::
++$  tag  $@(group-tag [app=term =resource tag=term])
+::  $role-tag: a kind of $group-tag that identifies a privileged user
+::
+::    These roles are
+::    %admin: Administrator, can do everything except delete the group
+::    %moderator: Moderator, can add/remove/ban users
+::    %janitor: Has no special meaning inside group-store,
+::    but may be given additional privileges in other apps.
+::
++$  role-tag
+  ?(%admin %moderator %janitor)
+::  $tags: a mapping from a $tag to the members it identifies
+::
++$  tags  (jug tag ship)
+::  $group: description of a group of users
+::
+::    .members: members of the group
+::    .tag-queries: a map of tags to subsets of members
+::    .policy: permissions for the group
+::    .hidden: is group unmanaged
++$  group
+  $:  members=(set ship)
+      =tags
+      =policy
+      hidden=?
+  ==
+::  $policy: access control for a group
+::
+++  policy
+  =<  policy
+  |%
+  ::
+  +$  policy
+    $%  invite
+        open
+    ==
+  ::  $diff: change group policy
+  +$  diff
+    $%  [%invite diff:invite]
+        [%open diff:open]
+        [%replace =policy]
+    ==
+  ::  $invite: allow only invited ships
+  ++  invite
+    =<  invite-policy
+    |%
+    ::
+    +$  invite-policy
+      [%invite pending=(set ship)]
+    ::  $diff: add or remove invites
+    ::
+    +$  diff
+      $%  [%add-invites invitees=(set ship)]
+          [%remove-invites invitees=(set ship)]
+      ==
+    --
+  ::  $open: allow all unbanned ships of approriate rank
+  ::
+  ++  open
+    =<  open-policy
+    |%
+    ::
+    +$  open-policy
+      [%open ban-ranks=(set rank:title) banned=(set ship)]
+    :: $diff: ban or allow ranks and ships
+    ::
+    +$  diff
+      $%  [%allow-ranks ranks=(set rank:title)]
+          [%ban-ranks ranks=(set rank:title)]
+          [%ban-ships ships=(set ship)]
+          [%allow-ships ships=(set ship)]
+      ==
+    --
+  --
+--

desk/sur/groups.hoon

@@ -0,0 +1,351 @@
+/-  meta, e=epic
+/-  old=group
+/-  grp=group-store
+/-  metadata-store
+|%
+::  $flag: ID for a group
+::
++$  flag  (pair ship term)
+::
+::  $nest: ID for a channel, {app}/{ship}/{name}
+::
++$  nest  (pair dude:gall flag)
+::
+::  $sect: ID for cabal, similar to a role
+::
++$  sect  term
+::
+::  $zone: channel grouping
+::
+::    includes its own metadata for display and keeps the order of 
+::    channels within.
+::
+::    zone: the term that represents the ID of a zone
+::    realm: the metadata representing the zone and the order of channels
+::    delta: the set of actions that can be taken on a zone
+::      %add: create a zone
+::      %del: delete the zone
+::      %edit: modify the zone metadata
+::      %mov: reorders the zone in the group
+::      %mov-nest: reorders a channel within the zone
+::  
+++  zone
+  =<  zone
+  |%
+  +$  zone  @tas
+  +$  realm
+    $:  met=data:meta
+        ord=(list nest)
+    ==
+  +$  diff  (pair zone delta)
+  +$  delta
+    $%  [%add meta=data:meta]
+        [%del ~]
+        [%edit meta=data:meta]
+        [%mov idx=@ud]            
+        [%mov-nest =nest idx=@ud]
+    ==
+  --
+::
+::  $fleet: group members and their associated metadata
+::
+::    vessel: a user's set of sects or roles and the time that they joined
+::    @da default represents an admin added member that has yet to join
+::
+++  fleet
+  =<  fleet
+  |%
+  +$  fleet  (map ship vessel)
+  +$  vessel
+    $:  sects=(set sect)
+        joined=time
+    ==
+  +$  diff
+    $%  [%add ~]
+        [%del ~]
+        [%add-sects sects=(set sect)]
+        [%del-sects sects=(set sect)]
+    ==
+  --
+::
+::  $channel: a medium for interaction
+::
+++  channel
+  =<  channel
+  |%
+  +$  preview
+    $:  =nest
+        meta=data:meta
+        group=^preview
+    ==
+  ::
+  +$  channels  (map nest channel)
+  ::
+  ::  $channel: a collection of metadata about a specific agent integration
+  ::
+  ::    meta: title, description, image, cover
+  ::    added: when the channel was created
+  ::    zone: what zone or section to bucket in
+  ::    join: should the channel be joined by new members
+  ::    readers: what sects can see the channel, empty means anyone
+  ::
+  +$  channel
+    $:  meta=data:meta
+        added=time
+        =zone
+        join=?
+        readers=(set sect)
+    ==
+  ::
+  ::  $diff: represents the set of actions you can take on a channel
+  ::  
+  ::    add: create a channel
+  ::    edit: edit a channel
+  ::    del: delete a channel
+  ::    add-sects: add sects to readers
+  ::    del-sects: delete sects from readers
+  ::    zone: change the zone of the channel
+  ::    join: toggle default join
+  ::
+  +$  diff
+    $%  [%add =channel]
+        [%edit =channel]
+        [%del ~]
+      ::
+        [%add-sects sects=(set sect)]   
+        [%del-sects sects=(set sect)]
+      ::
+        [%zone =zone]
+      ::
+        [%join join=_|]
+    ==
+  --
+::
+::  $group: collection of people and the pathways in which they interact
+::
+::    group holds all data around members, permissions, channel
+::    organization, and its own metadata to represent the group
+::
++$  group
+  $:  =fleet
+      cabals=(map sect cabal)
+      zones=(map zone realm:zone)
+      zone-ord=(list zone)
+      =bloc
+      =channels:channel
+      imported=(set nest)
+      =cordon
+      secret=?
+      meta=data:meta
+  ==
+::
+::  $cabal: metadata representing a $sect or role
+::
+++  cabal
+  =<  cabal
+  |%
+  ::
+  +$  cabal
+    [meta=data:meta ~]
+  ::
+  +$  diff
+    $%  [%add meta=data:meta]
+        [%del ~]
+    ==
+  --
+::
+::  $cordon: group entry and visibility permissions
+::
+++  cordon
+  =<  cordon
+  |%
+  ::
+  ::  $open: a group with open entry, only bans are barred entry
+  ::
+  ++  open
+    |%
+    ::  $ban: set of ships and ranks/classes that are not allowed entry
+    ::
+    ::    bans can either be done at the individual ship level or by the
+    ::    rank level (comet/moon/etc.)
+    ::
+    +$  ban  [ships=(set ship) ranks=(set rank:title)]
+    +$  diff
+      $%  [%add-ships p=(set ship)]
+          [%del-ships p=(set ship)]
+        ::
+          [%add-ranks p=(set rank:title)]
+          [%del-ranks p=(set rank:title)]
+      ==
+    --
+  ::
+  ::  $shut: a group with closed entry, everyone barred entry
+  ::
+  ::    a shut cordon means that the group is closed, but still visible.
+  ::    people may request entry and either be accepted or denied or
+  ::    they may be invited directly
+  ::
+  ::    ask: represents those requesting entry
+  ::    pending: represents those who've been invited
+  ::
+  ++  shut
+    |%
+    +$  state  [pend=(set ship) ask=(set ship)]
+    +$  kind  ?(%ask %pending)
+    +$  diff
+      $%  [%add-ships p=kind q=(set ship)]
+          [%del-ships p=kind q=(set ship)]
+      ==
+    --
+  ::
+  ::  $cordon: a set of metadata to represent the entry policy for a group
+  ::
+  ::    open: a group with open entry, only bans barred entry
+  ::    shut: a group with closed entry, everyone barred entry
+  ::    afar: a custom entry policy defined by another agent
+  ::
+  +$  cordon
+    $%  [%shut state:shut]
+        [%afar =flag =path desc=@t]
+        [%open =ban:open]
+    ==
+  ::
+  ::  $diff: the actions you can take on a cordon
+  ::
+  +$  diff
+    $%  [%shut p=diff:shut]
+        [%open p=diff:open]
+        [%swap p=cordon]
+    ==
+  --
+::
+::  $bloc: superuser sects
+::
+::    sects in the bloc set are allowed to make modifications to the group
+::    and its various metadata and permissions
+::
+++  bloc
+  =<  bloc
+  |%
+  +$  bloc  (set sect)
+  +$  diff
+    $%  [%add p=(set sect)]
+        [%del p=(set sect)]
+    ==
+  --
+::
+::  $diff: the general set of changes that can be made to a group
+::
++$  diff
+  $%  [%fleet p=(set ship) q=diff:fleet]
+      [%cabal p=sect q=diff:cabal]
+      [%channel p=nest q=diff:channel]
+      [%bloc p=diff:bloc]
+      [%cordon p=diff:cordon]
+      [%zone p=diff:zone]
+      [%meta p=data:meta]
+      [%secret p=?]
+      [%create p=group]
+      [%del ~]
+  ==
+::
+::  $action: the complete set of data required to edit a group
+::
++$  action
+  (pair flag update)
+::
+::  $update: a representation in time of a modification of a group
+::
++$  update
+  (pair time diff)
+::
+::  $create: a request to make a group
+::
++$  create
+  $:  name=term
+      title=cord
+      description=cord
+      image=cord  
+      cover=cord
+      =cordon
+      members=(jug ship sect)
+      secret=?
+  ==
+::
++$  init  [=time =group]
+::
++$  groups
+  (map flag group)
++$  net-groups
+  (map flag [net group])
+::
+::  $log: a time ordered map of all modifications to groups
+::
++$  log
+  ((mop time diff) lte)
+::
+++  log-on
+  ((on time diff) lte)
+::
+::  $net: an indicator of whether I'm a host or subscriber
+::
++$  net
+  $~  [%pub ~]
+  $%  [%pub p=log]
+      [%sub p=time load=_| =saga:e]
+  ==
+::
+::  $join: a join request, can elect to join all channels
+::
++$  join
+  $:  =flag
+      join-all=?
+  ==
+::
+::  $knock: a request to enter a closed group
+::
++$  knock  flag
+::
+::  $progress: the state of a group join 
+::
++$  progress
+  ?(%knocking %adding %watching %done %error)
+::
+::  $claim: a mark for gangs to represent a join in progress
+::
++$  claim
+  $:  join-all=?
+      =progress
+  ==
+::
+::  $preview: the metadata and entry policy for a group
+::
++$  preview  
+  $:  =flag
+      meta=data:meta
+      =cordon
+      =time
+      secret=?
+  ==
+::
++$  previews  (map flag preview)
+::
+::  $invite: a marker to show you've been invited to a group
+::
++$  invite  (pair flag ship)
+::
+::  $gang: view of foreign group
+::
++$  gang
+  $:  cam=(unit claim)
+      pev=(unit preview)
+      vit=(unit invite)
+  ==
+::
++$  gangs  (map flag gang)
+++  met     metadata-store
+::
++$  import  [self=association:met chan=(map flag =association:met) roles=(set flag) =group:old]
+::
++$  imports  (map flag import)
+--

desk/sur/hark.hoon

@@ -0,0 +1,95 @@
+/-  g=groups
+|%
+::  $rope: notification origin
+::    
+::    Shows where a notification has come from. Used to group
+::    notifications into threads
++$  rope
+  $:  gop=(unit flag)                 :: originating group
+      can=(unit nest:g)               :: originating channel
+      des=desk                        :: originating desk
+      ted=path                        :: threading identifer
+  ==
+::  $thread: notification group
+::
++$  thread  (set id)
+::  $id: notification identifier
++$  id   @uvH
+::  $yarn: notification
++$  yarn
+  $:  =id
+      rop=rope                       :: origin
+      tim=time                       :: time sent
+      con=(list content)             :: content of notification
+      wer=path                       :: where to link to in FE
+      but=(unit button)              :: action, if any
+  ==
+::
++$  button
+  $:  title=cord
+      handler=path
+  ==
++$  flag  (pair ship term)
+::  $content: notification text to be rendered
++$  content
+  $@  @t
+  $%  [%ship p=ship]
+      [%emph p=cord]
+  ==
+::  $action: Actions for hark
+::  
+::    %add-yarn adds a notification to the relevant inboxes, indicated
+::    by the loobs in the type
+::    %saw-seam marks all notifications in an inbox as unread
+::    %saw-rope marks a particular rope as read in all inboxes
+::
++$  action
+  $%  [%add-yarn all=? desk=? =yarn] 
+      [%saw-seam =seam]
+      [%saw-rope =rope]
+  ==
+::
++$  update
+  $:  yarns=(map id yarn)
+      =seam
+      threads=(map time thread)
+  ==
+::
++$  carpet
+  $:  =seam
+      yarns=(map id yarn)
+      cable=(map rope thread)
+      stitch=@ud
+  ==
++$  blanket
+  $:  =seam
+      yarns=(map id yarn)
+      =quilt
+  ==
+::  $seam: inbox identifier
+::
+::    All notifications end up in one of these inboxes
++$  seam
+  $%  [%group =flag]
+      [%desk =desk]
+      [%all ~]
+  ==
+::  $rug: notifications inbox
+::  
+::    .new contains all "unread" notifications, grouped by $rope
+::    .qul is an archive
+::
++$  rug
+  [new=(map rope thread) qul=quilt]
+++  quilt
+  =<  quilt
+  |%
+  ::  $quilt: inbox archive
+  ::  
+  ::    Threads are keyed by an autoincrementing counter that starts at
+  ::    0
+  ::
+  +$  quilt  ((mop @ud thread) lte)
+  ++  on  ((^on @ud thread) lte)
+  --
+--

desk/sur/meta.hoon

@@ -0,0 +1,21 @@
+|%
+::  $data: generic metadata for various entities
+::
+::    title: the pretty text representing what something is called
+::    description: a longer text entry giving a detailed summary
+::    image: an image URL or color string used as an icon/avatar
+::    cover: an image URL or color string, used as a header
+::
++$  data
+  $:  title=cord
+      description=cord
+      image=cord
+      cover=cord
+  ==
++$  diff
+  $%  [%title =cord]
+      [%description =cord]
+      [%image =cord]
+      [%cover =cord]
+  ==
+--

desk/ted/mailchimp/send.hoon

@@ -44,6 +44,7 @@
         body=tape
     ==
   =/  args  !<((unit arg-mold) arg)
+  ~&  args
   ?~  args
     (pure:m !>(~))
   ;<  ~  bind:m  (api-post api-key.u.args to-email.u.args subject.u.args body.u.args)
@@ -52,6 +53,7 @@
   ?>  ?=(%finished -.rep)
   ?~  full-file.rep  !!
   =/  body=cord  q.data.u.full-file.rep
+  ~&  rep
   %-  pure:m
   !>  [body ~]
 --