init

4 files changed, 2385 insertions, 0 deletions

diff --git a/desk/app/boke.hoon b/desk/app/boke.hoon
new file mode 100644
index 0000000..5b3231a
--- /dev/null
+++ b/desk/app/boke.hoon
@@ -0,0 +1,1145 @@
+/-  *boke, tp=trill-post, c=tlon-channels, ch=tlon-chat, cnt=contact, pols=polls
+/+  dbug, js=json, plib=trill-utils, kaji, lib=boke, ui=trill-ui, mm=mmast, sr=sortug, const=constants, wall
+/=  nav        /web/layout/nav
+/=  router     /web/router
+|%
+++  page-size  10
++$  read-post
+$:  title=@t
+    =path
+    contents=content-list:tp
+    date=@da
+    tags=(set @t)
+    id=@ud
+==
++$  read-comment
+$:  author=@t
+    date=@da
+    contents=content-list:tp
+    pa=@t
+    parent=@da
+    post=@da
+    title=@t
+==
++$  read-boardpost
+$:  author=@t
+    op=@t
+    thread=@da
+    date=@da
+    title=@t
+    content=content-list:tp
+    id=@ud
+    tid=@ud
+==
++$  versioned-state
+$%  state-0
+==
++$  card  card:agent:gall
+--
+%-  agent:dbug
+=|  state-0
+=*  state  -
+^-  agent:gall
+=<
+|_  =bowl:gall
++*  this      .
+    hd   ~(. +> bowl)
+    kaj  (init:kaji bowl _state kaji-req)
+::
+++  on-fail   |~(* `this)
+++  on-leave  |~(* `this)
+++  on-save   !>(state)
+++  on-init  
+^-  (quip card _this)
+=.  state  init-state:hd
+:_  this  init-cards:hd
+
+++  on-load   |=  old=vase 
+:_  this(state !<(versioned-state old))  ~
+++  on-watch  
+|=  =(pole knot)
+~&  >>  on-watch=pole
+  ?+  pole  !!
+  [%ui ~]  `this
+  [%http-response id=@ ~]    `this
+  [%tv type=@t author=@t ~]  `this
+  [%chat host=@t name=@t ~]  `this
+  [%sse tab=@t ~]         `this 
+  ==
+++  on-poke
+|=  [=mark =vase]
+?:  (~(has in banned-ships:const) src.bowl)  `this  
+|^
+?+  mark  `this
+%handle-http-request  serve
+%noun  (on-poke-noun !<(* vase))
+%kaji  run:handle-ui
+==
+  ++  handle-ui
+  =/  fd  !<(form-data:kaji vase)
+  =/  i  input.fd
+  =/  tab-id  (~(got by input.fd) 'tab')
+  =/  ui-card  ~(. ui:kaji tab-id)
+  =/  origin     (~(got by input.fd) 'origin')
+  |%
+    ++  run
+    ?+  action.fd  `this
+    ::  polls
+    %vote-poll
+    =/  soption  (~(got by input.fd) 'option')
+    =/  uoption  (dec:kaji soption ,[p=@p time=@da index=@ud])
+    ?~  uoption  (send-error 'format error')
+    =/  =pid:tp  [p.u.uoption time.u.uoption]
+    =/  index    index.u.uoption
+    =.  polls    (vote-poll:hd pid index)
+    :_  this
+    %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
+    ::  radio
+    %add-radio-chat
+      =/  input  (~(got by input.fd) 'input')
+      ?:  .=('' input)  (send-error 'no input')
+      =/  stype  (~(got by input.fd) 'type')
+      ?:  .=(stype 'urb')  
+        =/  sowner  (~(got by input.fd) 'owner')
+        =/  sip  (slaw %p sowner)
+        ?~  sip  ~&  "error-parsing-radio-owner"  `this
+        (radio-chat u.sip input)   
+      ?:  .=(stype 'our')  
+        =/  station  (~(got by input.fd) 'name')
+        (bstv-chat station input)
+      `this
+          
+    %change-radio
+      =/  jon=json
+      [%s 'lol']
+      
+      :_  this  :_  ~  
+      %+  ui-fact:kaji  tab-id  :_  ~
+      [%custom *manx jon]
+    %add-chat  
+      :_  this  :_  ~
+      =/  input  (~(get by input.fd) 'input')
+      ?~  input  (alert:ui-card "No input, please report to site@spandrell.ch or ~docteg-mothep")
+      =/  parsed  (text-to-content:hd u.input)
+      ?~  parsed  (alert:ui-card "Text parsing failed, please report to site@spandrel.ch or ~docteg-mothep")  
+      (send-message:hd u.parsed)
+    %add-thread
+        =/  is-blog  ?=  ^  (~(get by input.fd) 'is-blog')
+        =/  is-edit  ?=  ^  (~(get by input.fd) 'editing')
+        =/  try-title  ?:  is-blog  validate-blog  validate-thread
+        ?:  ?=(%err -.try-title)  (send-error +.try-title)
+        =/  [title=@t tags=(set @t)]  +.try-title
+        =/  try-post  (post-or-edit tags)
+        ?:  ?=(%err -.try-post)  
+          (send-error +.try-post)
+          (go-save-thread title +.try-post is-blog is-edit)
+      %add-reply
+        =/  is-blog  ?=  ^  (~(get by input.fd) 'is-blog')
+        =/  parents  (dec-i:kaji i 'parents' ,[pid:tp pid:tp])
+        ?~  parents  (send-error 'parent cue error, please report to ~docteg-mothep or site@spandrell.ch')
+        =/  try-post  (post-or-edit ~)
+        ?:  ?=(%err -.try-post)  
+          (send-error +.try-post)
+          (go-save-reply +.try-post -.u.parents +.u.parents is-blog)
+
+      %del-thread
+        =/  is-blog  ?=  %~  (~(get by input.fd) 'is-blog')
+        =/  pid  (dec-i:kaji input.fd 'pid' pid:tp)
+        ?~  pid  (send-error 'no id to delete')
+        =/  ted  (get:torm:tp threads u.pid)
+        ?~  ted  (send-error 'thread-not-found')
+        =.  feed     +:(del:gorm:tp feed u.pid)
+        =.  threads  +:(del:torm:tp threads u.pid)
+        =/  last-reply  ?~  replies.u.ted  u.pid  i.replies.u.ted
+        =.  active-threads  
+          +:(del:porm:tp active-threads last-reply)
+        =.  feed  +:(del:gorm:tp feed u.pid)
+        =.  paths  (~(del by paths) path.u.ted)
+        =.  tags  (del-in-tags:hd tags.u.ted u.pid)
+        :_  this
+        ?:  is-blog
+        %-  route:kaj  [route:router [%kaji tab-id %redi '/'] state]
+        %-  route:kaj  [route:router [%kaji tab-id %redi '/board'] state]
+    
+      %del-reply
+        =/  pid  (dec-i:kaji input.fd 'pid' pid:tp)
+        ?~  pid  (send-error 'no id to delete')
+        =/  p  (get:gorm:tp feed u.pid)
+        ?~  p  (send-error 'post-not-found')
+        ?~  parent.u.p  (send-error 'comment parent not set')
+        =.  feed  +:(del:gorm:tp feed u.pid)
+        =/  par  (get:gorm:tp feed u.parent.u.p)
+        =.  feed  ?~  par  feed
+          =/  nc  (~(del in children.u.par) u.pid)
+          =/  np  u.par(children nc)
+          (put:gorm:tp feed u.parent.u.p np)
+        ::  branch whether it's the last reply or not as it affects the active-threads
+        =/  ted  (get:torm:tp threads thread.u.p)
+        ?~  ted  (send-error 'thread-not-found')
+        =/  nr  %+  skip  replies.u.ted  |=  p=pid:tp  .=(u.pid p)
+        ?~  replies.u.ted  (send-error 'weird')
+        =/  last  i.replies.u.ted
+        =/  is-last=?  .=(last u.pid)
+        ?.  is-last
+          =/  nted  u.ted(replies nr)
+          =.  threads  (put:torm:tp threads thread.u.p nted)
+          :_  this
+          %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
+        ::
+          =/  nr  t.replies.u.ted
+          =/  nted  u.ted(replies nr)
+          =/  penultimo  ?~  nr  thread.u.p  i.nr
+          =.  threads  (put:torm:tp threads thread.u.p nted)
+          =.  active-threads  +:(del:porm:tp active-threads u.pid)
+          =.  active-threads  (put:porm:tp active-threads penultimo thread.u.p)
+          :_  this
+          %-  route:kaj  [route:router [%kaji tab-id %redi (~(got by input.fd) 'origin')] state]
+    ==
+      ++  validate-blog
+        =/  stitle  (~(get by input.fd) 'title')
+        ?~  stitle  :-  %err  'Please enter a title for the thread'
+        ?:  .=('' u.stitle)  :-  %err  'Please enter a title for the thread'
+        =/  stags  (~(get by input.fd) 'tags')
+        ?~  stags  :-  %err  'No tags, please report to ~docteg-mothep or site@spandrell.ch'  
+        =/  ntags  (parse-tags:ui u.stags)  
+        ?~  ntags  :-  %err  'Error parsing tags, please report'
+        =/  ttags  (~(put in u.ntags) 'blog')  
+        =.  ttags  (~(del in ttags) '')
+       [%ok u.stitle ttags]
+      
+      ++  validate-thread
+        =/  stitle  (~(get by input.fd) 'title')
+        ?~  stitle  :-  %err  'Please enter a title for the thread'
+        ?:  .=('' u.stitle)  :-  %err  'Please enter a title for the thread'
+        =/  sboard  (~(get by input.fd) 'board')
+        ?~  sboard  :-  %err  'No board, please report'
+        =/  stags  (~(get by input.fd) 'tags')
+        ?~  stags  :-  %err  'No tags, please report to ~docteg-mothep or site@spandrell.ch'  
+        =/  ntags  (parse-tags:ui u.stags)  
+        ?~  ntags  :-  %err  'Error parsing tags, please report'
+        =/  board  (~(get by categories:const) u.sboard)
+        ?~  board  :-  %err  'No category, please report'
+        =/  ttags  (~(put in u.ntags) u.sboard)  
+        =.  ttags  (~(del in ttags) '')
+       [%ok u.stitle ttags]
+
+      ++  post-or-edit
+      |=  ntags=(set @t)
+        =/  stext      (~(get by input.fd) 'text')
+        =/  upoll     find-poll
+        =/  cl  (build-content stext upoll)
+        ?:  ?=(%err -.cl)  cl
+        =/  sedit   (~(get by input.fd) 'editing')
+        ?~  sedit  :-  %ok  
+          :: TODO title!
+          (build-post:lib +.cl ntags [src.bowl now.bowl])
+
+        =/  edit-pid  (dec:kaji u.sedit pid:tp)
+        ?~  edit-pid  :-  %err  'Edit cue error, please report to ~docteg-mothep or site@spandrell.ch'
+        =/  pedit  (get:gorm:tp feed u.edit-pid)
+        ?~  pedit  :-  %err  'Post to edit not found, please report to ~docteg-mothep or site@spandrell.ch'
+          :-  %ok  (edit-post:lib u.pedit +.cl ntags now.bowl)
+        ::
+        ++  build-content
+          |=  [text=(unit @t) poll=(unit poll:pols)]  ^-  (maybe:sr content-list:tp)
+            ?~  text
+              ?~  poll  [%err 'no content!']
+              ::  only poll
+              =/  cl=content-list:tp  (insert-poll:hd ~ u.poll)  [%ok cl]
+            ?:  .=(u.text '')  ?~  poll  [%err 'no content!']
+              =/  cl=content-list:tp  (insert-poll:hd ~ u.poll)  [%ok cl]
+              ::  have text
+              =/  contents   (tokenize:ui u.text)
+              ?~  contents   :-  %err  'Parsing error, please report to ~docteg-mothep or site@spandrell.ch'
+              ?~  poll  [%ok contents]
+                =/  cl=content-list:tp  
+                (insert-poll:hd contents u.poll)  [%ok cl]
+          
+        ++  send-error
+        |=  [text=@t]
+          :_  this  :_  ~
+          =/  =manx  ;span:"{(trip text)}"
+          %+  ui-fact:kaji  tab-id
+
+          =/  div  (~(get by input.fd) 'error-div')
+          :_  ~  
+          ?~  div
+            [%alert manx 1.000]
+            [%swap manx u.div .y]
+        ::
+        ++  go-save-thread
+        |=  [title=@t p=post:tp is-blog=? is-edit=?]
+          =/  s  (save-thread:hd title p is-blog is-edit)
+          ?:  ?=(%err -.s)  (send-error +.s)
+          =.  state  +.s
+          =/  upoll  find-poll
+          =.  polls  ?~  upoll  polls  (save-poll:hd u.upoll)
+          :_  this  
+          %-  route:kaj  [route:router [%kaji tab-id %board-redi p] state]
+          ::  TODO notify mentions
+          ::  would need an agent for remote hark tho
+        ++  go-save-reply
+        |=  [p=post:tp thread=pid:tp parent=pid:tp is-blog=?]
+          =.  p  (set-parents:lib p thread parent)
+          =/  s  (save-reply:hd p thread parent is-blog)
+          ?:  ?=(%err -.s)  (send-error +.s)
+          =.  state  +.s
+          =/  upoll  find-poll
+          =.  polls  ?~  upoll  polls  (save-poll:hd u.upoll)
+          :_  this  
+          ?:  is-blog
+          %-  route:kaj  [route:router [%kaji tab-id %blog-redi p] state]
+          %-  route:kaj  [route:router [%kaji tab-id %board-redi p] state]
+        :: TODO  notify ships of their replies
+        ::
+        ++  bstv-chat
+        |=  [name=@t input=@t]
+          =/  tower  (~(get by here.tv) name)
+          ?~  tower  `this
+          =/  contents   (tokenize:ui input)
+          =/  post  (build-post:lib contents ~ [src.bowl now.bowl])
+          =/  station  (~(get by schedule.u.tower) started.current.u.tower)
+          ?~  station  `this
+          =.  chat.u.station  [post chat.u.station]
+          =.  schedule.u.tower  (~(put by schedule.u.tower) started.current.u.tower u.station)
+          =.  here.tv  (~(put by here.tv) name u.tower)
+          :_  this
+          %-  route:kaj  [route:router [%kaji tab-id %tv-chat name post] state]
+        ++  radio-chat
+        |=  [p=@p t=@t]
+          =/  tower  (~(get by urbit.tv) p)
+          ?~  tower  `this
+          `this
+
+        ::
+        ++  find-poll  ^-  (unit poll:pols)
+          :: =/  wal  ~(. wall src.bowl)
+          :: ?~  (subscription-type:wal now.bowl)  ~
+        =/  stitle  (~(get by input.fd) 'poll-title')
+        ?~  stitle  ~
+        ?:  .=('' u.stitle)  ~
+        =/  opts=(list @t)  
+          =|  acc=(list @t)  =|  i=@ud
+          |-
+            =/  key  %-  crip  "poll-opt-{(scow %ud i)}"
+            =/  opt  (~(get by input.fd) key)
+            ?~  opt  (flop acc) 
+            =/  nacc  [u.opt acc]
+            $(i +(i), acc nacc)
+        ?~  opts  ~
+        =/  smin-bet  (~(get by input.fd) 'poll-min-bet')
+        ?~  smin-bet  ~
+        :: =/  min-bet  ~
+        :: TODO parse this
+        =/  sexpiry  (~(get by input.fd) 'poll-expiry')
+        :: ?~  sexpiry  ~
+        =/  expiry   ?~  sexpiry  (add now.bowl ~d1)
+          =/  parsed  (rush u.sexpiry html-datetime:parsing:sr)
+          ?~  parsed  ~&  "some weird html fuckery"  (add now.bowl ~d1)
+          u.parsed
+          
+        =/  multiple=?
+          =/  smultiple  (~(get by input.fd) 'poll-multiple')
+          ::  actually this doesn't get sent at all if unchecked?
+          ?~  smultiple  .n  ?:  .=(u.smultiple 'on')  .y  .n  
+
+        %-  some  %-  new-poll:pols  :*  [src.bowl now.bowl]  u.stitle  expiry  opts  multiple  ==
+        
+    --
+  
+    
+    
+  ::
+  ++  on-poke-noun
+  |=  a=*
+  ?:  ?=([%data-dump *] a)     (sync-dump +.a)
+  ?:  ?=(%gib a)     give-batdev
+  ?>  .=(src.bowl our.bowl)
+  :: ?:  ?=(%sync a)    poke-tasdev
+  ?:  ?=(%tv-fix a)  tv-fix
+  ?:  ?=(%backup a)  :_  this  :_  ~  dump-state:hd
+  ?:  ?=(%restore a)  :-  ~  this(state restore:hd)
+  ?:  ?=(%sync-last a)  :-  ~  this(state read-last:hd)
+  ?:  ?=(%kaji a)  print-kaji
+  ?:  ?=(%kick a)  kick-kaji
+  ::  loading blog data
+  ?:  ?=(%rblog a)    %-  wrap  load-blog:hd
+  ?:  ?=(%rblog2 a)   %-  wrap  load-blog-comments:hd 
+  ::  loading tianming data
+  ?:  ?=(%rboard a)   %-  wrap  load-tianming
+  ?:  ?=(%rboard2 a)  %-  wrap  load-tianming-replies
+  :: ?:  ?=(%count a)  log
+  ?:  ?=(%check a)  check
+  ?:  ?=(%threads a)  check-threads
+  ?:  ?=(%athreads a)  check-athreads
+  ?:  ?=(%tags a)  check-tags
+  ?:  ?=([%tag tag=@t] a)  (check-tag tag.a)
+  :: ?:  ?=(%chcom a)  check-comment
+  :: ?:  ?=(%sample a)  sample
+  ?:  ?=(%pats a)  pats
+  ?:  ?=(%feed a)  check-feed
+  ?:  ?=(%radio a)  get-radio
+  ?:  ?=(%tw a)       try-tw
+  ?:  ?=([%check-thread *] a)  (check-thread +.a)
+  ::  fixes
+  ?:  ?=([%fix-thread *] a)  (fix-thread +.a)
+  ?:  ?=([%dedup *] a)       (dedup +.a)
+  ?:  ?=([%scrub-ded *] a)   (scrub +.a)
+  ?:  ?=([%fix-active *] a)  (fix-active +.a)
+
+  ?:  ?=(%sqlite a)  dump-to-sqlite
+  ?:  ?=(%licki a)   init-lick
+  ?:  ?=(%slick a)   stop-lick
+  ?:  ?=([%lick *] a)  (send-lick +.a)
+  `this
+  ::
+  ++  init-lick
+    ~&  "init lick"
+    :_  this  :_  ~
+    =/  note=note-arvo  [%l %spin /'licker.sock']
+    [%pass /lick/init %arvo note]
+  ++  stop-lick
+    :_  this  :_  ~
+    =/  note=note-arvo  [%l %shut /'licker.sock']
+    [%pass /lick/init %arvo note]
+  ++  send-lick
+  |=  a=*
+    :_  this  :_  ~
+    =/  note=note-arvo  [%l %spit /'licker.sock' %noun a]
+    [%pass /lick/init %arvo note]
+
+  :: ++  insert-sql
+  :: """
+  :: INSERT INTO posts(ts,author_id, title, content, snippet,  url)
+  :: VALUES({tsn}, {author-idn}, {title}, {content}, {snippet}, {url});
+  :: """
+  :: ++  insert-sql2
+  :: """
+  :: INSERT INTO comments(ts,user_id, content, approved, comment_type, post_id, parent_id)
+  :: VALUES({tsn}, {user-idn}, {content}, {approved-n}, {type}, {post-idn}, {parent-idn});
+  :: """
+  :: ++  insert-sql3
+  :: """
+  :: INSERT INTO tags(tag)
+  :: VALUES({tsn}, {user-idn}, {content}, {approved-n}, {type}, {post-idn}, {parent-idn});
+  :: """
+  ++  dump-to-sqlite
+    :: posts
+    =/  count  0
+    :: =/  l  (tap:gorm:tp feed)
+    :: =/  res
+    ::   |-
+    ::   ?~  l  ~  
+    ::   ?:  (gte count 20)  ~
+    ::   =/  entry  i.l
+    ::   =/  poast  val.entry
+    ::   =/  is-blog  (~(has in tags.poast) 'blog')
+    ::   ?:  is-blog
+    ::     ~&  >>  poast=poast
+    ::     =.  count  +(count)
+    ::     $(l t.l)
+    ::     $(l t.l)
+    ::  threads
+    =/  l  (tap:torm:tp threads)
+    =/  res
+      |-
+      ?~  l  ~  
+      ?:  (gte count 20)  ~
+      =/  entry  i.l
+      =/  ted  val.entry
+      =/  is-blog  (~(has in tags.ted) 'blog')
+      ?:  is-blog
+        ~&  >>  ted=ted
+        =.  count  +(count)
+        $(l t.l)
+        $(l t.l)
+    :: TODO prov
+    :: =/  tv-chat  
+    ::   =/  tvs  (~(got by here.tv) 'spandrell-tv')
+    ::   =/  sta  (~(got by schedule.tvs) started.current.tvs)
+    ::   chat.sta 
+    :: =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
+    :: =/  vase  !>((jam data))
+    :: =/  =soba:clay  :_  ~  [/data/site-dump/(scot %da now.bowl)/jam %ins %noun vase]
+    :: =/  =nori:clay  [%& soba]
+    :: =/  =task:clay  [%info %blog nori]
+    :: init
+    :: =/  note=note-arvo  [%l %spit /'licker.sock' %noun 'ligma']
+
+    :: [%pass /lick/spit %arvo note]
+    `this
+  :: 
+  ++  sync-dump
+  |=  a=*
+  ~&  dump-received=src.bowl
+  ?>  .=(our.bowl ~batdev-docteg-mothep)
+  =/  data=dump-type  (dump-type a)
+  =.  feed     (gas:gorm:tp *gfeed:tp feed.data)
+  =.  threads  (gas:torm:tp *threadsf threads.data)
+  =.  active-threads  at.data
+  =.  paths           paths.data
+  =.  tags            tt.data
+  `this
+  ++  give-batdev
+  ~&  sync-req-received=src.bowl
+  ?>  .=(our.bowl ~tasdev-docteg-mothep)
+  ?>  .=(src.bowl ~batdev-docteg-mothep)
+  ~&  sync-req-received=src.bowl
+  =/  tv-chat  
+    =/  tvs  (~(got by here.tv) 'spandrell-tv')
+    =/  sta  (~(got by schedule.tvs) started.current.tvs)
+    chat.sta 
+  ~&  "tv"
+  =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
+  :_  this  :_  ~  
+  [%pass /gib %agent [~batdev-docteg-mothep %boke] %poke %noun !>([%data-dump data])]
+  ++  poke-tasdev
+  ~&  "poking tasdev"
+  :_  this  :_  ~
+  [%pass /gib %agent [~tasdev-docteg-mothep %boke] %poke %noun !>(%gib)]
+  ++  tv-fix
+  =/  muh  (~(got by here.tv) 'Spandrell TV')
+  =.  here.tv  (~(del by here.tv) 'Spandrell TV')
+  =.  here.tv  (~(put by here.tv) 'spandrell-tv' muh)
+  `this
+  ++  fix-thread  |=  a=*
+  =/  =pid:tp  ;;  pid:tp  a
+  =/  thread  (got:torm:tp threads pid)
+  =/  post    (got:gorm:tp feed pid)
+  =/  fn=full-node:tp  (node-to-full:plib post feed)
+  =/  flat  (flatten-fn:plib fn)
+  =/  pids  %+  turn  flat  |=  p=post:tp  [author.p id.p]
+  =/  ordered  %+  sort  pids  |=  [a=pid:tp b=pid:tp]  (gth id.a id.b)
+  =.  replies.thread  ordered
+  =.  threads  (put:torm:tp threads pid thread)
+  `this
+  ++  fix-active  |=  a=*
+  =/  =pid:tp  ;;  pid:tp  a
+  =.  active-threads  +:(del:porm:tp active-threads pid)
+  `this
+  ++  check-thread  |=  a=*
+  =/  =pid:tp  ;;  pid:tp  a
+  =/  ted  (get:torm:tp threads pid)
+  ~&  >>  ted=ted
+  `this
+  ++  scrub  |=  a=*
+  =/  =pid:tp  ;;  pid:tp  a
+  =/  ted  (got:torm:tp threads pid)
+  ~&  >>  ted=ted
+  =.  replies.ted  
+    =/  l  replies.ted
+    =|  nl=(list pid:tp)
+    |-  
+    ?~  l  (flop nl)
+    =/  muh  i.l
+    =/  pst  (get:gorm:tp feed muh)
+    ?~  pst  $(l t.l)
+    $(l t.l, nl [muh nl])
+  =.  threads  (put:torm:tp threads pid ted)
+  `this
+  ++  dedup  |=  a=*
+  =/  =pid:tp  ;;  pid:tp  a
+  =/  ted  (got:torm:tp threads pid)
+  ~&  >>  ted=ted
+  =.  replies.ted  
+    =/  l  replies.ted
+    =|  nl=(list pid:tp)
+    |-  
+    ?~  l  (flop nl)
+    =/  muh  i.l
+    =/  pidset  (silt t.l)
+    ?:  (~(has in pidset) muh)  $(l t.l)
+    $(l t.l, nl [muh nl])
+  ~&  new=replies.ted
+  `this
+++  try-tw
+  :_  this  :_  ~
+    [%pass /tw-test %arvo %k %fard q.byk.bowl %tw %noun !>([%user 'spandrell4'])]
+  ++  get-radio
+  :_  this  :_  ~  watch-radio-card:hd
+  ++  print-kaji
+  =/  a  %+  turn  ~(tap by sup.bowl)
+  |=  [=duct [=ship =path]]
+  ~&  >  duct
+  ~&  >>>  ship
+  ~&  >>  path
+  duct
+  `this
+  ++  wrap
+  |=  s=_state  =.  state  s  `this
+  ++  kick-kaji
+  :: =/  cards  %+  turn  ~(tap by sup.bowl)
+
+  :: |=  [=duct [=ship =path]]
+  :: ~&  >  duct
+  :: ~&  >>>  ship
+  :: ~&  >>  path
+  =/  paths=(list path)  ~[/ui /sse/(scot %p our.bowl)]
+  =/  cards  :_  ~  [%give %kick paths ~]
+  ~&  kicking=cards
+  [cards this]
+  ++  check-feed
+  ~&  %+  roll  (tap:gorm:tp feed)  |=  [[=pid:tp =post:tp] a=(list pid:tp)]
+  ?.  (~(has in tags.post) 'blog')  a  [pid a]
+  `this
+  ++  pats
+  ~&  >  paths
+  `this
+  ++  check-tags
+  ~&  tags=tags
+  `this
+  ++  check-tag
+  |=  t=@t
+  :: ~&  (~(get by tags) t)
+  =/  pids  (~(get by tags) t)
+  ?~  pids  ~&  "not found"  `this
+  =/  a  %+  turn  (tap:porm:tp u.pids)  |=  [=pid:tp p=pid:tp]
+    =/  ted  (get:torm:tp threads pid)
+    ?~  ted  ~&  ted-not-found=pid  ~
+    ~&  >  thread=[title.u.ted]
+    ~
+  `this
+  ++  check
+  =/  last  (pry:gorm:tp feed)
+  ~&  >  last=last
+  `this
+  ++  check-threads
+    =/  t  %+  turn  (scag 10 (tap:torm:tp threads))  |=  [pid:tp thread:tp]
+    ~&  >  thread=[title path (lent replies)]  ~
+    `this
+  ++  check-athreads
+    =/  t  %+  turn  (scag 2 (tap:torm:tp threads))  |=  [pid:tp thread:tp]
+    ~&  >  thread=[title (lent replies)]  ~
+    `this
+  ++  check-comment
+  :: =/  last  (pry:orm:tp blog)
+  :: ?~  last  `this
+  :: ?~  parent.val.u.last  `this
+  :: =/  parent  (get:orm:tp blog u.parent.val.u.last)
+  :: ~&  >  last=last
+  :: ~&  >>  parent=parent
+  `this
+  ++  sample
+  :: ~&  >>  %+  scag  3  %+  skim  (tap:orm:tp blog)
+  :: |=  [=id:tp =post:tp]  ?=(%~ parent.post)
+  `this
+  ++  log
+    :: ~&  %-  lent  (tap:orm:tp blog)
+    `this
+  ++  load-tianming
+    =/  j  .^(json %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/threads/json)
+    =/  jjj  (boardpost:de:js j)
+    |-
+      ?~  jjj  state
+      =/  a=read-boardpost  i.jjj
+      =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
+        (add (bex 64) author.a)
+      =/  pid  [author date.a]
+      =/  c  (put:corm:tp *content-map:tp date.a content.a)
+      =|  p=post:tp
+      =.  p  %=  p
+      id  date.a
+      author  -.pid
+      thread  pid
+      parent  ~
+      contents  c
+      tags  (silt `(list @t)`~['oldtianming'])
+      ==
+      =/  s  (save-thread:hd title.a p .n .n)
+      =.  state  ?:  ?=(%err -.s)  state  +.s
+      $(jjj t.jjj)
+    
+  ++  load-tianming-replies
+    =/  j  .^(json %cx /(scot %p our.bowl)/boke/(scot %da now.bowl)/data/replies/json)
+    =/  jjj  (boardpost:de:js j)
+    |-
+      ?~  jjj  state
+      =/  a=read-boardpost  i.jjj
+      =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
+        (add (bex 64) author.a)
+      =/  pid  [author date.a]
+      =/  thread-author  ?:  .=((cass (trip op.a)) "spandrell")  ~docteg-mothep  
+        (add (bex 64) op.a)
+      =/  thread-pid  [thread-author thread.a]
+      =/  c  (put:corm:tp *content-map:tp date.a content.a)
+      =|  p=post:tp
+      =.  p  %=  p
+      id  date.a
+      author  author
+      thread  thread-pid
+      parent  `thread-pid
+      contents  c
+      ==
+      =.  state  
+        =/  s  (save-reply:hd p thread-pid thread-pid .y)
+        ?:  ?=(%err -.s)  state  +.s
+      $(jjj t.jjj)
+  ::
+      
+      :: =/  one  (put:gorm:tp feed pid p)
+      :: =.  feed  ?~  parent-post  one
+      :: =/  parent-pid  [author.u.parent-post parent.a]
+      :: =/  full-parent  (get:gorm:tp feed parent-pid)
+      :: ?~  full-parent  one
+      ::   =/  oc  children.u.full-parent
+      ::   =/  nc  (~(put in oc) pid)
+      ::   =/  np  u.full-parent(children nc)
+      ::   (put:gorm:tp one parent-pid np)
+      :: =.  tags  =/  curr  (~(get by tags) 'blog-comment')
+      ::   =/  nl  ?~  curr  ~[pid]  (snoc u.curr pid)
+      ::   (~(put by tags) 'blog-comment' nl)
+    :: =/  l  (tap:torm:tp threads)
+    :: |-
+    :: ?~  l  `this
+    :: =/  t=thread:tp  +.i.l
+    :: ?~  replies.t  $(l t.l)
+    :: =/  del  (del:torm:tp active-threads -.i.l)
+    :: =.  active-threads  ?~  -.del  threads
+    :: (put:torm:tp +.del -.replies.t t)
+    :: $(l t.l)
+
+
+  ++  serve
+  ^-  (quip card _this)
+  =/  order  !<(eyre-order:kaji vase)
+  =/  address  address.req.order
+  ~&  >>  address=address
+  ~&  >  req=url.request.req.order
+  ?:  (~(has in banned-ips:const) address)  `this  
+  :: ~&  >>>  malicious-request-alert=req.order  `this
+  :_  this
+  %-  route:kaj
+  [route:router [%eyre order] state]
+--
+++  on-peek   
+|=  =(pole knot)
+?+  pole  ~
+  [%x %manx %nav sip=@t ~]
+    =/  sip  (slav %p sip.pole)
+    =.  bowl  bowl(src sip)
+    :-  ~  :-  ~  :-  %noun  !>
+      =/  nv  nav(bowl bowl)  ext:nv
+  [%x %chads sip=@t ~]
+    :-  ~  :-  ~  :-  %noun  !>
+    =/  sip  (slav %p sip.pole)
+    =/  wal  ~(. wall sip)
+    ?~  (subscription-type:wal now.bowl)  .n  .y
+==
+:: ~&  on-peek=pole
+:: =/  blog  (~(got by feeds) %blog)
+:: ?+  pole  ~
+:: [%x %index ~]
+::   =/  posts=(list full-node:tp)
+::   %+  scag  page-size  
+::   %-  flop
+::   %+  roll  (tap:orm:tp blog)
+::   |=  [i=[=id:tp =post:tp] a=(list full-node:tp)]
+::   ?~  parent.post.i  [(node-to-full:plib post.i blog) a]  a
+::   ``[%noun !>(posts)]
+:: [%x %post rest=*]
+::   ~&  >  rest=rest.pole
+::   =/  p  (~(get by paths) rest.pole)
+::   ?~  p  ~
+::   =/  poast  (got:orm:tp blog id.u.p)
+::   =/  fn  (node-to-full:plib poast blog)
+::   ``[%noun !>(fn)]
+:: :: [%x %search query=@ comments=@]
+:: ::   =/  with-comments  .=(comments '1')
+:: ::   ~
+:: ==
+++  on-agent
+|=  [=wire =sign:agent:gall]
+|^
+  ?:  ?=(%kick -.sign)  resub
+  ?:  ?=([%radio ~] wire)  handle-radio
+  ?.  ?=(%fact -.sign)  `this
+  ?:  ?=(%dm p.cage.sign)  (handle-dm !<(memo:c q.cage.sign))
+  ?.  ?=(%channel-response p.cage.sign)  `this
+  =/  res  !<(r-channels:c q.cage.sign)
+  ?.  ?=(%post +<.res)  `this
+  =/  =flag:tlonc  ->.res
+  :_  this
+  =/  r  r-post.r-channel.res
+  ?-  -.r
+  %set  ?~  post.r  ~  (route:kaj [route:router [%kaji '' %chat-msg flag +<.u.post.r] state])
+  %reply  ~  :: reply-count.reply-meta.r  id-reply.r
+  %reacts  ~  ::  reacts.r  ::  map
+  %essay  ~  :: wtf
+  ==
+    ++  handle-dm
+    |=  m=memo:c
+    ::  validate TOTP and set cookie if so
+    `this
+    ++  handle-radio
+      ?.  ?=(%fact -.sign)  `this
+      =/  e  !<(radio-event q.cage.sign)
+      ?.  ?=(%response -.e)  `this
+      =.  urbit.tv  minitowers.e  `this
+      
+    ++  resub
+    :_  this
+    ?+  wire  ~
+      [%radio ~]  :~(watch-radio-card:hd)
+      [%chat %updates ~]  :~(watch-chat-card:hd)
+    ==
+    
+
+--
+++  on-arvo
+  |=  [=(pole knot) =sign-arvo]
+  |^
+  ?:  ?=([%lick %soak *] sign-arvo)
+    ?+  [mark noun]:sign-arvo  `this
+    [%connect ~]  ((slog 'socket connected' ~) `this)
+    [%disconnected ~]  ((slog 'socket disconnected' ~) `this)
+    [%error *]  ((slog leaf+"socket error {(trip ;;(@t noun.sign-arvo))}" ~) `this)
+    [%noun *]  ((slog leaf+"socket noun {(trip ;;(@t noun.sign-arvo))}" ~) `this)
+  ==
+  ::
+  ?:  ?=([%arow *] +.sign-arvo)  (handle-thread +>.sign-arvo)
+  ?.  ?=([%behn %wake *] sign-arvo)  `this
+  ?.  ?=([%backup ~] pole)           `this
+    :_  this  :_  ~  dump-state:hd
+  ::
+  ++  handle-thread
+  |=  s=(avow:khan cage)
+  ?:  ?=(%| -.s)  ~&  "thread failed"  `this
+  =/  devase  !<(* +>.s)
+  :: ?:  ?=(%& -.p.sign-arvo)  `this
+  `this
+  --
+--
+|_  =bowl:gall
+::  saving to state
++$  save-res
+$%  [%err err=@t]
+    [%ok p=_state]
+==
+++  save-thread
+|=  [title=@t p=post:tp is-blog=? is-edit=?]   ^-  save-res
+  =/  post-pid  [author.p id.p]
+  =.  feed   (put:gorm:tp feed post-pid p)
+  =/  pat  ?:  is-blog  
+    (make-blogpost-path:lib id.p title)
+    (make-board-path:lib paths title tags.p)
+  =/  t  ?.  is-edit  *thread:tp  (got:torm:tp threads post-pid)
+  =/  snip-size  ?:  is-blog  500  200
+  =/  snip  (abbreviate-post:plib contents.p snip-size)
+  =.  t  t(title title, path pat, pid post-pid, tags tags.p, snip snip)  :: TODO remove titles from posts
+  =.  threads   (put:torm:tp threads post-pid t)
+  =.  active-threads   (put:porm:tp active-threads post-pid post-pid)
+  =.  tags   (save-tags tags.p post-pid)  
+  =.  paths   (~(put by paths) pat post-pid)
+  :-  %ok  state
+++  save-reply
+|=  [p=post:tp thread=pid:tp parent=pid:tp blog=?]  ^-  save-res
+  =.  p  (set-parents:lib p thread parent)
+  =/  post-pid  [author.p id.p]
+  =/  pop   (get:torm:tp threads thread)
+  ?~  pop  [%err 'thread op not found please report to ~docteg-mothep or site@spandrell.ch']
+  =/  ppar  (get:gorm:tp feed parent)
+  ?~  ppar  [%err 'parent not found, please report to ~docteg-mothep or site@spandrell.ch']
+  =.  feed   (put:gorm:tp feed post-pid p)
+  =/  npar  u.ppar(children (~(put in children.u.ppar) post-pid))
+  =.  feed  (put:gorm:tp feed parent npar)
+  =/  has-reply  (~(has in (silt replies.u.pop)) post-pid)
+  =/  nr  ?:  has-reply  replies.u.pop  [post-pid replies.u.pop]
+  =/  npop     u.pop(replies nr)
+  =.  threads  (put:torm:tp threads thread npop)
+  =/  replies  replies.u.pop
+  =/  last-reply  ?~  replies  thread  i.replies
+  =/  delt  (del:porm:tp active-threads last-reply)
+  =/  mmm  ?~  -.delt  ~&  >>>  thread-not-found-under-last-reply=post-pid  ~  ~
+  =.  active-threads  +:delt
+  =.  active-threads  (put:porm:tp active-threads post-pid thread)
+  :-  %ok  state
+::
+++  save-tags
+|=  [ntags=(set @t) =pid:tp]  ^-  tags-table
+  =/  tag-list  ~(tap in ntags)
+  |-  ^-  tags-table
+  ?~  tag-list  tags
+  =/  curr  (~(get by tags) i.tag-list)
+  =/  npids  ?~  curr  
+    (put:porm:tp *pidmap pid pid)
+    (put:porm:tp u.curr pid pid)
+  =/  nmap  (~(put by tags) i.tag-list npids)
+  $(tag-list t.tag-list, tags nmap)
+
+++  del-in-tags
+|=  [ntags=(set @t) =pid:tp]  ^+  tags
+  =/  tag-list  ~(tap in ntags)
+  |-  ^+  tags
+  ?~  tag-list  tags
+  =/  curr  (~(get by tags) i.tag-list)
+  =/  npids  ?~  curr  ~  +:(del:porm:tp u.curr pid)
+  =/  nmap  (~(put by tags) i.tag-list npids)
+  $(tag-list t.tag-list, tags nmap)
+
+::  polls
+
+++  save-poll
+  |=  p=poll:pols  ^+  polls
+    (~(put by polls) [author.p time.p] p)
+
+++  insert-poll
+  |=  [c=content-list:tp =poll:pols]  ^+  c
+  =/  ref=block:tp  :-  %ref  :+  %polls  src.bowl  
+    /(scot %p author.poll)/(scot %da time.poll)
+    (snoc c ref)
+
+++  vote-poll
+  |=  [=pid:tp option=@ud]  
+  =/  upoll  (~(get by polls) pid)
+  ?~  upoll  polls  
+  =/  =poll:pols  (add-vote u.upoll option)
+  (~(put by polls) pid poll)
+++  add-vote
+  |=  [=poll:pols option=@ud]  ^+  poll
+  ?:  ?=(%exc -.votes.poll)
+    =.  p.votes.poll
+      (~(put by p.votes.poll) src.bowl option)
+      poll
+    ::
+    =.  p.votes.poll
+      =/  curr  (~(get by p.votes.poll) option)
+        =/  nmap=(map @p (set @ud))  
+        ?~  curr
+          %-  malt  ~[[src.bowl (silt ~[option])]]
+          ::
+          =/  my-votes=(unit (set @ud))  (~(get by u.curr) src.bowl)
+          ?~  my-votes  
+            (~(put by u.curr) src.bowl `(set @ud)`(silt ~[option]))
+            (~(put by u.curr) src.bowl `(set @ud)`(~(put in u.my-votes) option))
+
+        (~(put by p.votes.poll) option nmap)
+        poll
+        ::
+
+::  
+++  dump-state  ^-  card
+  :: TODO prov
+  =/  tv-chat  
+    =/  tvs  (~(got by here.tv) 'spandrell-tv')
+    =/  sta  (~(got by schedule.tvs) started.current.tvs)
+    chat.sta 
+  =/  data=dump-type  [(tap:gorm:tp feed) (tap:torm:tp threads) active-threads paths tags tv-chat]
+  =/  vase  !>((jam data))
+  =/  =soba:clay  :_  ~  [/data/site-dump/(scot %da now.bowl)/jam %ins %noun vase]
+  =/  =nori:clay  [%& soba]
+  =/  =task:clay  [%info %blog nori]
+  =/  note=note-arvo  [%c task]
+  [%pass /dump/[dap.bowl] %arvo note]
++$  dump-type
+  $:  feed=(list feed-pair)
+      threads=(list thread-pair)
+      at=pidmap
+      paths=pathmap
+      tt=tags-table
+      tv-chat=(list post:tp)
+  ==
+
++$  feed-pair    [pid:tp post:tp]
++$  thread-pair  [pid:tp thread:tp]
+++  read-last  ^+  state
+  ~&  >  "restoring"
+  =/  bp  /(scot %p our.bowl)/blog/(scot %da now.bowl)
+  =/  f  .^((list path) %ct (weld bp /data/site-dump))  
+  ?~  f  state
+  =/  filename  (rear f)
+  ~&  [f filename]
+  =/  j  .^(@ %cx (weld bp filename))
+  ~&  read-file=(end [0 100] j)
+  =/  cued  (cue j)
+  =/  data  ;;(dump-type cued)
+  ~&  >>>  lengths=[(lent feed.data) (lent threads.data)] 
+  =/  tvs  (~(got by here.tv) 'spandrell-tv')
+  =/  sta  (~(got by schedule.tvs) started.current.tvs)
+  =.  chat.sta  tv-chat.data
+  =.  schedule.tvs  (~(put by schedule.tvs) started.current.tvs sta)
+  =.  here.tv  (~(put by here.tv) 'spandrell-tv' tvs)
+  %=  state
+    feed  (gas:gorm:tp *gfeed:tp feed.data)
+    threads  (gas:torm:tp *threadsf threads.data)
+    active-threads  at.data
+    paths  paths.data
+    tags  tt.data
+  ==
+++  restore  ^+  state
+  ~&  >  "restoring"
+  =/  j  .^(@ %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/site-dump/jam)
+  ~&  read-file=(end [0 100] j)
+  =/  cued  (cue j)
+  =/  data  ;;(dump-type cued)
+  ~&  >>>  lengths=[(lent feed.data) (lent threads.data)] 
+  =/  tvs  (~(got by here.tv) 'spandrell-tv')
+  =/  sta  (~(got by schedule.tvs) started.current.tvs)
+  =.  chat.sta  tv-chat.data
+  =.  schedule.tvs  (~(put by schedule.tvs) started.current.tvs sta)
+  =.  here.tv  (~(put by here.tv) 'spandrell-tv' tvs)
+  %=  state
+    feed  (gas:gorm:tp *gfeed:tp feed.data)
+    threads  (gas:torm:tp *threadsf threads.data)
+    active-threads  at.data
+    paths  paths.data
+    tags  tt.data
+  ==
+:: Cards
+++  watch-radio-card  ^-  card
+[%pass /radio %agent [~docteg-mothep %tower] %watch /towers]
+++  watch-chat-card  ^-  card
+[%pass /chat/updates %agent [our.bowl %channels] %watch /chat/(scot %p our.bowl)/chat]
+++  watch-dms-card  ^-  card
+[%pass /dm-root %agent [our.bowl %chat] %watch /]
+++  watch-cards  ^-  (list card)
+:~  watch-radio-card
+    watch-chat-card
+==
+++  root-path-card  ^-  card
+  [%pass /mmm %arvo %e %connect [~ /] dap.bowl]
+++  init-cards  ^-  (list card)
+:~  watch-radio-card
+    watch-chat-card
+    watch-dms-card
+    root-path-card
+    schedule-backup-card
+==
+++  schedule-backup-card  ^-  card
+  [%pass /backup %arvo %b %wait (add now.bowl ~h6)]
+
+++  init-state  ^+  state
+=.  tv  init-tv
+:: =.  state  load-blog
+:: =.  state  load-blog-comments
+state
+++  init-tv  ^+  tv
+=/  starting=@da  now.bowl
+=/  sta=tv-station  :*
+  'Dune Month!'
+  'https://hydrogen.finnem.net/hls/live.m3u8'
+  starting
+  ~
+  ~
+  chat-welcome-post^~
+  ~
+==
+=/  schedule  %-  malt  :_  ~  [starting sta]
+=/  =bstv  ['Spandrell TV' ~docteg-mothep ['Dune Month!' starting] schedule]
+=.  here.tv  (~(put by here.tv) 'spandrell-tv' bstv)
+tv
+
+++  chat-welcome-post  ^-  post:tp
+=/  contents   (tokenize:ui 'Welcome to Spandrell TV! Make yourself cozy')
+(build-post:lib contents ~ [~docteg-mothep now.bowl])
+++  load-blog
+  =/  j  .^(json %cx /(scot %p our.bowl)/blog/(scot %da now.bowl)/data/posts/json)
+  =/  jjj  (poast:de:js j)
+  |-
+    ?~  jjj  state
+    =/  a=read-post  i.jjj
+    =/  pid  [~docteg-mothep date.a]
+    =/  c  (put:corm:tp *content-map:tp date.a contents.a)
+    =/  tgs  (~(put in tags.a) 'blog')
+    =|  p=post:tp
+    =.  p  %=  p
+    id  date.a
+    author  -.pid
+    thread  pid
+    contents  c
+    tags  tgs
+    ==
+    =/  s  (save-thread title.a p .y .n)
+    =.  state  ?:  ?=(%err -.s)  state  +.s
+    $(jjj t.jjj)
+
+++  load-blog-comments
+  =/  j  .^(json %cx /(scot %p our.bowl)/boke/(scot %da now.bowl)/data/comments/json)
+  =/  jj  %+  sort  (comment:de:js j)  |=  [a=read-comment b=read-comment]
+  (lth date.a date.b)
+  |-
+    ?~  jj  state
+    =/  a=read-comment  i.jj
+    =/  c  (put:corm:tp *content-map:tp date.a contents.a)
+    =/  author  ?:  .=((cass (trip author.a)) "spandrell")  ~docteg-mothep  
+      (add (bex 64) author.a)
+    =/  pa  ?:  .=((cass (trip pa.a)) "spandrell")  ~docteg-mothep  
+      (add (bex 64) pa.a)
+    =/  pid  [author date.a]
+    =/  ppid  [pa parent.a]
+    =/  parent-post  (get:gorm:tp feed ppid)  
+    =/  parent=(unit pid:tp)  ?~  parent-post  ~&  >  no-parent=[author.a date.a pa.a parent.a title.a]  ~
+      `ppid
+    =/  op  [~docteg-mothep post.a]
+    =|  p=post:tp
+    =.  p  %=  p
+    id  date.a
+    author  `@p`author
+    contents  c
+    tags  (sy ~['blog-comment'])
+    ==
+    =.  state  ?~  parent  state  
+    =/  s  (save-reply p op u.parent .y)
+     ?:  ?=(%err -.s)  state  +.s
+    $(jj t.jj)
+
+
+++  hi  bowl
+::  cards
+:: ++  send-dm
+:: |=  who=@p
+:: =/  input  %-  crip  "Show me what you got"
+:: =/  parsed  (text-to-content input)
+::   ~&  parsed=parsed
+::   ?~  parsed  (alert-card:kaj "Text parsing failed")  
+:: =/  content=story:c
+:: :_  ~  :-  %inline  :_  ~  u.parsed
+:: =/  id      [our.bowl now.bowl]
+:: =/  =memo:c    [content our.bowl now.bowl]
+:: =/  delta   [%add memo ~ ~]
+:: =/  diff    [id delta]
+:: =/  a  [who diff]
+:: :*  %pass
+::     /send
+::     %agent
+::     [our.bowl %chat]
+::     %poke
+::     %chat-dm-action
+::     !>  a
+:: ==
+
+++  send-message
+|=  input=inline:c
+=/  content=story:c
+:_  ~  :-  %inline  :_  ~  input
+=/  =memo:c  [content src.bowl now.bowl]
+=/  =kind-data:c  [%chat ~]
+=/  =essay:c  [memo kind-data]
+=/  cp=c-post:c  [%add essay]
+=/  cc=c-channel:c  [%post cp]
+=/  =nest:c  [%chat our.bowl %chat]
+=/  a=c-channels:c  [%channel nest cc]
+:*  %pass
+    /send
+    %agent
+    [our.bowl %channels]
+    %poke
+    %channel-action
+    !>  a
+==
+  ++  text-to-content
+  %+  curr  rush
+  |^  ;~  pose
+        (cook |=(=@t [%link t t]) turl)
+        text
+      ==
+  ++  turl
+    =-  (sear - text)
+    |=  t=cord
+    ^-  (unit cord)
+    ?~((rush t aurf:de-purl:html) ~ `t)
+  ::  +text: text message body
+  ::
+  ++  text
+    (cook crip (plus next))
+  --
+--
diff --git a/desk/app/chat.hoon b/desk/app/chat.hoon
new file mode 100644
index 0000000..1dcfadd
--- /dev/null
+++ b/desk/app/chat.hoon
@@ -0,0 +1,497 @@
+::  chat-stream: chat proxy for earthlings
+::
+::    makes specified chats accessible over unauthenticated http requests.
+::    GET at /stream/chat-name.json to receive json updates as messages happen.
+::    POST at /stream/chat-name with a body to send a chat message.
+::
+::    hands out temporary identities (using fakeid) using which stream viewers
+::    can post to exposed chats.
+::    NOTE that the cookie it gives out is marked Secure and SameSite=None!
+::
+::    when streaming a chat, any messages sent into it (by real identities)
+::    of the form "!ban ~ship" will result in an ip ban for that ship,
+::    denying them posting privileges in all local streams.
+::
+::    usage: poke with an action. ie :chat-stream [%stream %urbit-help]
+::
+/-  chat
+/+  chat-json,
+    default-agent, verb, dbug,
+    fid=fakeid, *server
+::
+|%
++$  state-0
+  $:  %0
+      streams=(set source)
+      viewers=(jug source eyre-id)
+      ::TODO  we need to expire these to avoid a space-leak
+      ::      probably clean up expired ids every +identity-duration
+      ::TODO  shouldn't this live in fakeid-store instead? but how update?
+      guests=(map ship (set address:eyre))
+      banned=(set address:eyre)
+  ==
+::
+::NOTE  we could support _streaming_ foreign chats fairly easily,
+::      but posting to them is a way different story,
+::      so we just go full local-only for now.
++$  source  term
+::
++$  eyre-id  @ta
+::
++$  action
+  $%  [%stream =source]
+      [%stop =source]
+      [%ban name=@p]
+      [%unban =address:eyre]
+  ==
+::
++$  card  card:agent:gall
+--
+::
+=|  state-0
+=*  state  -
+::
+%-  agent:dbug
+%+  verb  |
+::
+^-  agent:gall
+=<
+  |_  =bowl:gall
+  +*  this  .
+      do    ~(. +> bowl)
+      def   ~(. (default-agent this %|) bowl)
+  ::
+  ++  on-init
+    ^-  (quip card _this)
+    ::NOTE  careful! install currently proceeds fine if this crashes.
+    ::      you'll need to |uninstall the desk and |nuke the app.
+    |^  =+  (check-dependency %fakeid-store)
+        =+  (check-dependency %chat)
+        :_  this
+        :~  [%pass /connect %arvo %e %connect [~ /stream] dap.bowl]
+            kick-heartbeat:do
+        ==
+    ::
+    ++  check-dependency
+      |=  app=dude:gall
+      ~|  [%missing-dependency %app app]
+      ?>  .^(? %gu /(scot %p our.bowl)/[app]/(scot %da now.bowl)/$)
+      ~
+    --
+  ::
+  ++  on-save  !>(state)
+  ::
+  ++  on-load
+    |=  old=vase
+    ^-  (quip card _this)
+    [~ this(state !<(state-0 old))]
+  ::
+  ++  on-poke
+    |=  [=mark =vase]
+    ^-  (quip card _this)
+    ?+  mark  (on-poke:def mark vase)
+      %noun  $(mark %stream-action)
+    ::
+        %stream-action
+      =/  =action  !<(action vase)
+      =^  cards  state
+        ?-  -.action
+          %stream  (start-stream:do +.action)
+          %stop    (stop-stream:do +.action)
+          %ban     (ban-comet:do +.action)
+          %unban   (unban-ip:do +.action)
+        ==
+      [cards this]
+    ::
+        %handle-http-request
+      =^  cards  state
+        %-  handle-http-request:do
+        !<([=eyre-id =inbound-request:eyre] vase)
+      [cards this]
+    ==
+  ::
+  ++  on-watch
+    |=  =path
+    ?:  ?=([%http-response @ ~] path)
+      [~ this]
+    (on-watch:def path)
+  ::
+  ++  on-leave
+    |=  =path
+    ^-  (quip card _this)
+    ?.  ?=([%http-response @ ~] path)
+      (on-leave:def path)
+    =/  who=eyre-id  i.t.path
+    :-  ~
+    =-  this(viewers -)
+    ::NOTE  we really only delete from one, but we don't want to keep a
+    ::      reverse lookup just for that optimization.
+    %-  ~(run by viewers)
+    |=  v=(set eyre-id)
+    (~(del in v) who)
+  ::
+  ++  on-agent
+    |=  [=wire =sign:agent:gall]
+    ^-  (quip card _this)
+    ?:  ?=(%poke-ack -.sign)
+      ?~  p.sign  [~ this]
+      %-  (slog leaf+"failed poke on {(spud wire)}" u.p.sign)
+      [~ this]
+    ?.  ?=([%listen @ ~] wire)  (on-agent:def wire sign)
+    =*  source  i.t.wire
+    ?+  -.sign  (on-agent:def wire sign)
+        %kick
+      [[(watch-chat:do our.bowl source)]~ this]
+    ::
+        %fact
+      =*  mark  p.cage.sign
+      =*  vase  q.cage.sign
+      ?+  mark  (on-agent:def wire sign)
+          %writ-diff
+        =^  cards  state
+          (handle-chat-update:do source !<(diff:writs:chat vase))
+        [cards this]
+      ==
+    ==
+  ::
+  ++  on-arvo
+    |=  [=wire =sign-arvo]
+    ^-  (quip card _this)
+    ?+  sign-arvo  (on-arvo:def wire sign-arvo)
+        [%eyre %bound *]
+      ~?  !accepted.sign-arvo
+        [dap.bowl 'bind rejected!' binding.sign-arvo]
+      [~ this]
+    ::
+        [%behn %wake *]
+      ?.  ?=([%heartbeat ~] wire)  (on-arvo:def wire sign-arvo)
+      [send-heartbeat:do this]
+    ==
+  ::
+  ++  on-peek   on-peek:def
+  ++  on-fail   on-fail:def
+  --
+::
+|_  =bowl:gall
++*  fakeid  ~(. fid bowl)
+::
+::  config
+::
+++  identity-duration   ~d7
+++  initial-messages    25
+++  max-message-length  280
+++  heartbeat-timer     ~s30
+::
+::  card builders
+::
+++  kick-heartbeat
+  ^-  card
+  [%pass /heartbeat %arvo %b %wait (add now.bowl heartbeat-timer)]
+::
+++  send-heartbeat
+  ^-  (list card)
+  :-  kick-heartbeat
+  =/  viewers=(list eyre-id)
+    %~  tap  in
+    %+  roll  ~(val by viewers)
+    |=  [s=(set eyre-id) o=(set eyre-id)]
+    (~(uni in o) s)
+  ?:  =(0 (lent viewers))  ~
+  :_  ~
+  :*  %give
+      %fact
+    ::
+      %+  turn  viewers
+      |=  =eyre-id
+      /http-response/[eyre-id]
+    ::
+      %http-response-data
+      !>  ^-  (unit octs)
+      `[1 '\0a']  ::TODO  prefix with : ?
+  ==
+::
+++  watch-chat
+  |=  [our=ship =term]
+  ^-  card
+  :*  %pass
+      /listen/[term]
+      %agent
+      [our %chat]
+      %watch
+      /chat/(scot %p our)/[term]/ui/writs
+  ==
+::
+++  leave-chat
+  |=  [our=ship =term]
+  ^-  card
+  [%pass /listen/[term] %agent [our %chat] %leave ~]
+::
+++  send-to-viewers
+  |=  [=source =json]
+  ^-  (list card)
+  =/  ids=(set eyre-id)
+    (~(get ju viewers) source)
+  ?:  =(~ ids)  ~
+  :_  ~
+  :*  %give
+      %fact
+    ::
+      %+  turn  ~(tap in ids)
+      |=  =eyre-id
+      /http-response/[eyre-id]
+    ::
+      %http-response-data
+      !>  ^-  (unit octs)
+      %-  some
+      (make-stream-data json)
+  ==
+::
+++  make-stream-data
+  |=  =json
+  ^-  octs
+  %-  as-octs:mimes:html
+  (rap 3 'data:' (en:json:html json) '\0a\0a' ~)
+::
+::  actions
+::
+++  start-stream
+  |=  =source
+  ^-  (quip card _state)
+  ?:  ?|  ?=(~ source)
+          (~(has in streams) source)
+      ==
+    [~ state]
+  :-  [(watch-chat our.bowl source)]~
+  state(streams (~(put in streams) source))
+::
+++  stop-stream
+  |=  =source
+  ^-  (quip card _state)
+  ?.  (~(has in streams) source)
+    [~ state]
+  :-  [(leave-chat our.bowl source)]~
+  %_  state
+    streams  (~(del in streams) source)
+    viewers  (~(del by viewers) source)
+  ==
+::
+++  ban-comet
+  |=  who=ship
+  ^-  (quip card _state)
+  :-  ~
+  %_  state
+    guests  (~(del by guests) who)
+    banned  (~(uni in banned) (~(get ju guests) who))
+  ==
+::
+++  unban-ip
+  |=  =address:eyre
+  ^-  (quip card _state)
+  :-  ~
+  %_  state
+    banned  (~(del in banned) address.action)
+  ==
+::
+::  outgoing flows
+::
+++  handle-chat-update
+  |=  [=source =diff:writs:chat]
+  ^-  (quip card _state)
+  ?.  ?=(%add -.q.diff)
+    [~ state]
+  ?.  (~(has in streams) source)
+    ~&  [dap.bowl %unexpected-diff-for source]
+    [~ state]
+  ::  accept !ban commands from real identites,
+  ::  as plaintext "!ban " followed by a mention
+  ::
+  =/  banning=(unit @p)
+    ?.  (lte (met 3 author.p.q.diff) 8)  ~
+    =/  body=(list inline:chat)
+      ?+  -.content.p.q.diff  ~
+        %story  q.p.content.p.q.diff
+      ==
+    ?.  ?=([%'!ban ' [%ship @] *] body)  ~
+    `p.i.t.body
+  =^  caz  state
+    ?~  banning  [~ state]
+    (ban-comet u.banning)
+  :_  state
+  ::  forward posts to all viewers
+  ::
+  %+  send-to-viewers  source
+  (memo:enjs:chat-json p.q.diff)
+::
+::  incoming flows
+::
+++  handle-http-request
+  |=  [=eyre-id =inbound-request:eyre]
+  ^-  (quip card _state)
+  ?+  method.request.inbound-request
+    [(give-simple-payload:app eyre-id not-found:gen) state]
+  ::
+    %'GET'   (handle-get eyre-id inbound-request)
+    %'POST'  (handle-post eyre-id inbound-request)
+  ==
+::
+::TODO  find a better way to structure this logic
+++  handle-get
+  |=  [=eyre-id =inbound-request:eyre]
+  ^-  (quip card _state)
+  =-  =^  [card=(unit card) simple-payload:http]  state
+        -
+      =.  headers.response-header
+        :*  'Content-Type'^'text/event-stream'
+            'Cache-Control'^'no-cache'
+            'Connection'^'keep-alive'
+            headers.response-header
+        ==
+      :_  state
+      =/  header=cage  [%http-response-header !>(response-header)]
+      =/  data=cage    [%http-response-data !>(data)]
+      =/  =path        /http-response/[eyre-id]
+      :*  [%give %fact ~[path] header]
+          [%give %fact ~[path] data]
+        ::
+          %+  weld  (drop card)
+          ^-  (list ^card)
+          ?:  =(200 status-code.response-header)  ~
+          [%give %kick ~[path] ~]~
+      ==
+  ^-  [[(unit card) simple-payload:http] _state]
+  =/  [[ext=(unit @ta) site=(list @t)] *]
+    %-  parse-request-line
+    url.request.inbound-request
+  ::  ignore requests that point to unsupported resources
+  ::
+  ?.  &(?=([%stream @ ~] site) ?=([~ %json] ext))
+    [[~ not-found:gen] state]
+  =/  =source  i.t.site
+  ?.  (~(has in streams) source)
+    [[~ not-found:gen] state]
+  ::  add eyre-id as viewer for requested source
+  ::
+  =.  viewers
+    (~(put ju viewers) source eyre-id)
+  ::  find or create session for request
+  ::
+  =/  who=(unit session:fakeid)
+    (session-from-request:fakeid inbound-request)
+  =/  [out=(unit card) =session-key:fakeid =session:fakeid]
+    ?^  who  [~ *session-key:fakeid u.who]
+    =<  [`card session-key session]
+    (new-session:fakeid identity-duration)
+  =/  =header-list:http
+    ?^  who  ~
+    ::TODO  don't need samesite=none in some contexts, but how can we tell?
+    (set-session-cookie:fakeid session-key until.session &)
+  ::  keep track of all addresses this session has connected from,
+  ::  but never track localhost requests
+  ::
+  =?  guests  !=(.127.0.0.1 address.inbound-request)
+    %+  ~(put ju guests)
+      name.session
+    address.inbound-request
+  :_  state
+  :-  out
+  ::  build response from some recent messages
+  ::
+  ^-  simple-payload:http
+  :-  [200 header-list]
+  %-  some
+  %-  make-stream-data
+  :-  %a
+  =-  (turn - |=([* * m=memo:chat] (memo:enjs:chat-json m)))
+  ^-  (list [time writ:chat])
+  %-  tap:((on time writ:chat) lte)
+  .^  ((mop time writ:chat) lte)
+    %gx
+    (scot %p our.bowl)
+    %chat
+    (scot %da now.bowl)
+    %chat
+    (scot %p our.bowl)
+    source
+    /writs/newest/(scot %ud initial-messages)/chat-writs
+  ==
+::
+++  handle-post
+  |=  [=eyre-id =inbound-request]
+  ^-  (quip card _state)
+  :_  state
+  =;  [out=(unit card) =simple-payload:http]
+    %+  weld  (drop out)
+    (give-simple-payload:app eyre-id simple-payload)
+  ::  request must have sane target
+  ::
+  =/  [[ext=(unit @ta) site=(list @t)] *]
+    %-  parse-request-line
+    url.request.inbound-request
+  ?.  &(?=([%stream @ ~] site) ?=(~ ext))
+    `not-found:gen
+  =/  =source  i.t.site
+  ::  request must have some content
+  ::
+  =/  body=@t
+    q:(fall body.request.inbound-request *octs)
+  ?:  =(~ body)
+    `[[400 ~] ~]
+  ::  reject requests from banned addresses
+  ::
+  ?:  (~(has in banned) address.inbound-request)
+    `[[403 ~] `(as-octs:mimes:html 'ur banned, fool!')]
+  ::  reject requests without fakeid sessions
+  ::
+  =/  who=(unit ship)
+    (identity-from-request:fakeid inbound-request)
+  ?~  who
+    `[[403 ~] `(as-octs:mimes:html 'no session cookie')]
+  ::
+  :_  [[200 ~] ~]
+  %-  some
+  %^  send-message
+      source
+    u.who
+  :+  %story  ~
+  :_  ~
+  %-  text-to-content
+  (end 3^max-message-length body)
+::
+++  text-to-content
+  %+  curr  rash
+  ::NOTE  we intentionally don't do #expression parsing
+  |^  ;~  pose
+        (cook |=(=@t [%link t t]) turl)
+        text
+      ==
+  ::  +turl: url parser
+  ::
+  ++  turl
+    =-  (sear - text)
+    |=  t=cord
+    ^-  (unit cord)
+    ?~((rush t aurf:de-purl:html) ~ `t)
+  ::  +text: text message body
+  ::
+  ++  text
+    (cook crip (plus next))
+  --
+::
+++  send-message
+  |=  [=source as=ship =content:chat]
+  ^-  card
+  :*  %pass
+      /send/[source]
+      %agent
+      [our.bowl %chat]
+      %poke
+      %chat-action-0
+    ::
+      !>  ^-  action:chat
+      :-  [our.bowl source]
+      :+  now.bowl  %writs
+      ^-  diff:writs:chat
+      ::TODO  as in place of our for msg id?
+      [[our.bowl now.bowl] %add [~ as now.bowl content]]
+  ==
+--
diff --git a/desk/app/pals.hoon b/desk/app/pals.hoon
new file mode 100644
index 0000000..5a50743
--- /dev/null
+++ b/desk/app/pals.hoon
@@ -0,0 +1,385 @@
+::  pals: manual peer discovery
+::
+::    acts as a "friendlist" of sorts, letting one add arbitrary ships to
+::    arbitrary lists. upon doing so, the other party is informed of this.
+::    this lets the app expose "friend requests" and mutuals, in addition
+::    to user-defined sets of friends.
+::
+::    intended use case is as simple, bare-bones peer discovery and
+::    permissioning for truly peer-to-peer applications, in place of
+::    (or as supplement to) group-based peer discovery.
+::    for example, a game wanting to stay abreast of high scores,
+::    or filesharing service giving selective access.
+::
+::    "leeches" are ships who added us.
+::    "targets" are ships we have added.
+::    "mutuals" is the intersection of "leeches" and "targets".
+::
+::      reading
+::    external applications likely want to read from this via scries or
+::    watches, both of which are outlined below.
+::    finding interaction targets or mutuals to poke or subscribe to, using
+::    mutual status as permission check, etc.
+::    to scry data out of this app, please use /lib/pals.
+::    one might be tempted to use list names for namespacing (ie %yourapp
+::    would only retrieve targets from the ~.yourapp list), but beware that
+::    this overlaps with user-facing organizational purposes. if lists feel
+::    opaque or inaccessible, it's to discourage this. but the right balance
+::    might not have been found yet...
+::
+::      writing
+::    poke this app with a $command.
+::    %meet adds a ship. it is also added to any list names specified.
+::    %part removes a ship from either all or the specified lists.
+::    the ~. list name is reserved and cannot be added to.
+::    managing pals without an interface that lets users control that behavior
+::    is bad manners. managing pals without informing the user is evil.
+::
+::      scry endpoints (all %noun marks)
+::NOTE  %y at / doesn't actually work because gall eats it ):
+::    y  /                       arch        [%leeches %targets %mutuals ~]
+::    y  /[status]               arch        non-empty lists listing
+::
+::    x  /                       records     full pals state
+::    x  /leeches                (set ship)  foreign one-sided friendships
+::    x  /targets(/[list])       (set ship)  local one-sided friendships
+::    x  /mutuals(/[list])       (set ship)  mutual friendships
+::
+::    x  /leeches/[ship]         ?  is ship a leeche?
+::    x  /targets/[list]/[ship]  ?  is ship a target? list may be ~. for all
+::    x  /mutuals/[list]/[ship]  ?  is ship a mutual? list may be ~. for all
+::
+::      subscription endpoints (local ship only, all %pals-effect marks)
+::    /targets   target-effect   effect for every addition/removal
+::    /leeches   leeche-effect   effect for every addition/removal
+::
+/-  *pals
+/+  rudder, dbug, verb, default-agent
+::
+/~  pages  (page:rudder records command)  /app/pals/webui
+::
+|%
++$  state-1  [%1 records]
+::
++$  card  card:agent:gall
+--
+::
+=|  state-1
+=*  state  -
+::
+%-  agent:dbug
+%+  verb  |
+^-  agent:gall
+::
+|_  =bowl:gall
++*  this  .
+    def   ~(. (default-agent this %|) bowl)
+::
+++  on-init
+  ^-  (quip card _this)
+  =^  cards  this
+    (on-poke %pals-command !>(`command`[%meet ~paldev ~]))
+  :_  this
+  :+  [%pass /jael/pubs %arvo %j %public-keys ~]
+    [%pass /eyre/connect %arvo %e %connect [~ /[dap.bowl]] dap.bowl]
+  cards
+::
+++  on-save  !>(state)
+::
+++  on-load
+  |=  ole=vase
+  |^  ^-  (quip card _this)
+      =/  old=state-n  !<(state-n ole)
+      =^  caz=(list card)  old
+        ?.  ?=(%0 -.old)  [~ old]
+        =.  state  [%1 +.old]
+        =^  caz    this
+          ::TODO  run this again some time in the future, to solve for
+          ::      the "breached & never re-added you" case, where they
+          ::      might not know you need to hear a %bye.
+          (on-poke %noun !>(%resend))
+        [[[%pass /jael/pubs %arvo %j %public-keys ~] caz] state]
+      ?>  ?=(%1 -.old)
+      [caz this(state old)]
+  ::
+  +$  state-n  $%(state-1 state-0)
+  +$  state-0  [%0 records]
+  --
+::
+++  on-poke
+  |=  [=mark =vase]
+  ^-  (quip card _this)
+  ?+  mark  (on-poke:def mark vase)
+      %noun
+    ?+  q.vase  $(mark %pals-command)
+        %resend
+      =/  out=(set ship)  ~(key by outgoing)
+      =.  receipts
+        =/  out=(list ship)  ~(tap in out)
+        |-
+        ?~  out  receipts
+        =.  receipts  (~(del by receipts) i.out)
+        $(out t.out)
+      :_  this
+      %+  weld
+        %+  turn  ~(tap in out)
+        |=  o=ship
+        [%pass /hey %agent [o dap.bowl] %poke %pals-gesture !>([%hey ~])]
+      %+  turn  ~(tap in (~(dif in incoming) out))
+      |=  i=ship
+      [%pass /bye %agent [i dap.bowl] %poke %pals-gesture !>([%bye ~])]
+    ==
+  ::
+    ::  %pals-command: local app control
+    ::
+      %pals-command
+    ?>  =(our src):bowl
+    =+  !<(cmd=command vase)
+    ?:  (~(has in in.cmd) ~.)
+      ~|  [%illegal-empty-list-name in=-.cmd]
+      !!
+    ?:  =(our.bowl ship.cmd)
+      [~ this]
+    ::
+    =/  known=?  (~(has by outgoing) ship.cmd)
+    =;  [yow=? =_outgoing]
+      ^-  (quip card _this)
+      =?  receipts  yow
+        ::  if we're sending a new %hey, clear any existing receipt.
+        ::  if we're sending a %bye, no need to track the old receipt.
+        ::
+        (~(del by receipts) ship.cmd)
+      :_  this(outgoing.state outgoing)
+      ?.  yow  ~
+      :~  =/  =gesture  ?-(-.cmd %meet [%hey ~], %part [%bye ~])
+          =/  =cage     [%pals-gesture !>(gesture)]
+          [%pass /[-.gesture] %agent [ship.cmd dap.bowl] %poke cage]
+        ::
+          =/  =effect   ?-(-.cmd %meet [- ship]:cmd, %part [- ship]:cmd)
+          =/  =cage     [%pals-effect !>(effect)]
+          [%give %fact [/targets]~ cage]
+      ==
+    ::
+    ?-  -.cmd
+        %meet
+      :-  !known
+      %+  ~(put by outgoing)  ship.cmd
+      %-  ~(uni in in.cmd)
+      (~(gut by outgoing) ship.cmd ~)
+    ::
+        %part
+      ?:  =(~ in.cmd)
+        ::  remove target entirely
+        ::
+        [known (~(del by outgoing) ship.cmd)]
+      ::  remove from specified lists
+      ::
+      :-  |
+      =.  outgoing
+        =/  liz=(list @ta)  ~(tap in in.cmd)
+        |-  ^+  outgoing
+        ?~  liz  outgoing
+        $(liz t.liz, outgoing (~(del ju outgoing) ship.cmd i.liz))
+      ::NOTE  we could account for this above, but +del:ju is just easier there
+      =?  outgoing  !(~(has by outgoing) ship.cmd)
+        (~(put by outgoing) ship.cmd ~)
+      outgoing
+    ==
+  ::
+    ::  %pals-gesture: foreign %pals signals
+    ::
+      %pals-gesture
+    ?<  =(our src):bowl
+    =*  ship  src.bowl
+    =+  !<(=gesture vase)
+    =/  [yow=? =_incoming]
+      =*  has  (~(has in incoming) ship)
+      ?-  -.gesture
+        %hey  :-  !has  (~(put in incoming) ship)
+        %bye  :-   has  (~(del in incoming) ship)
+      ==
+    :_  this(incoming.state incoming)
+    ^-  (list card)
+    ?.  yow  ~
+    :*  =/  =effect  ?-(-.gesture %hey [%near ship], %bye [%away ship])
+        =/  =cage    [%pals-effect !>(effect)]
+        [%give %fact [/leeches]~ cage]
+      ::
+        ?.  .^(? %gu /(scot %p our.bowl)/hark/(scot %da now.bowl)/$)  ~
+        =/  body
+          =-  [ship+ship - ~]
+          ?-  -.gesture
+            %hey  ' added you as a pal.'
+            %bye  ' no longer considers you a pal.'
+          ==
+        =/  id      (end 7 (shas %pals-notification eny.bowl))
+        =/  rope    [~ ~ q.byk.bowl /(scot %p ship)/[-.gesture]]
+        =/  action  [%add-yarn & & id rope now.bowl body /pals ~]
+        =/  =cage   [%hark-action !>(action)]
+        [%pass /hark %agent [our.bowl %hark] %poke cage]~
+    ==
+  ::
+    ::  %handle-http-request: incoming from eyre
+    ::
+      %handle-http-request
+    =;  out=(quip card _+.state)
+      [-.out this(+.state +.out)]
+    %.  [bowl !<(order:rudder vase) +.state]
+    %-  (steer:rudder _+.state command)
+    :^    pages
+        (point:rudder /[dap.bowl] & ~(key by pages))
+      (fours:rudder +.state)
+    |=  cmd=command
+    ^-  $@  brief:rudder
+        [brief:rudder (list card) _+.state]
+    =^  caz  this
+      (on-poke %pals-command !>(cmd))
+    ['Processed succesfully.' caz +.state]
+  ==
+::
+++  on-watch
+  |=  =path
+  ^-  (quip card _this)
+  ?>  =(our.bowl src.bowl)
+  ?+  path  (on-watch:def path)
+    [%http-response *]  [~ this]
+  ::
+      [%targets ~]
+    :_  this
+    %+  turn  ~(tap in ~(key by outgoing))
+    |=(=@p [%give %fact ~ %pals-effect !>(`effect`[%meet p])])
+  ::
+      [%leeches ~]
+    :_  this
+    %+  turn  ~(tap in incoming)
+    |=(=@p [%give %fact ~ %pals-effect !>(`effect`[%near p])])
+  ::
+    ::TODO  consider adding a subscription endpoint that includes tags?
+    ::      shouldn't become too legible to applications though...
+  ==
+::
+++  on-agent
+  |=  [=wire =sign:agent:gall]
+  ^-  (quip card _this)
+  ?+  wire  ~&([dap.bowl %strange-wire wire] [~ this])
+      [%hark ~]
+    ?.  ?=(%poke-ack -.sign)  (on-agent:def wire sign)
+    ?~  p.sign  [~ this]
+    ((slog 'pals: failed to notify' u.p.sign) [~ this])
+  ::
+      [%bye ~]  [~ this]  ::TODO  also retry if nack?
+      [%hey ~]
+    ::  for %pals-gesture pokes, record the result
+    ::TODO  should we slowly retry for nacks?
+    ::
+    =-  [~ this(receipts -)]
+    ?+  -.sign  ~|([%unexpected-agent-sign wire -.sign] !!)
+      %poke-ack  (~(put by receipts) src.bowl ?=(~ p.sign))
+    ==
+  ==
+::
+++  on-arvo
+  |=  [=wire =sign-arvo]
+  ^-  (quip card _this)
+  ?+  wire  ~|([dap.bowl %strange-wire wire] !!)
+      [%eyre %connect ~]
+    ?.  ?=([%eyre %bound *] sign-arvo)
+      (on-arvo:def wire sign-arvo)
+    ~?  !accepted.sign-arvo
+      [dap.bowl 'eyre bind rejected!' binding.sign-arvo]
+    [~ this]
+  ::
+      [%jael %pubs ~]
+    ?.  ?=([%jael %public-keys *] sign-arvo)
+      (on-arvo:def wire sign-arvo)
+    =/  who=(unit ship)
+      =*  pkr  public-keys-result.sign-arvo
+      ?+  -.public-keys-result.sign-arvo  ~
+        %breach  `who.pkr
+      ==
+    ?~  who  [~ this]
+    :_  %_  this
+          incoming  (~(del in incoming) u.who)
+          receipts  (~(del by receipts) u.who)
+        ==
+    =;  caz=(list (unit card))
+      (murn caz same)
+    :~  ::  if they liked us, for now that's no longer true
+        ::
+        ?.  (~(has in incoming) u.who)  ~
+        =/  =cage  [%pals-effect !>(`effect`[%away u.who])]
+        `[%give %fact [/leeches]~ cage]
+      ::
+        ::  if we liked them, assume they come back and remind them
+        ::
+        ?.  (~(has by outgoing) u.who)  ~
+        =/  =cage  [%pals-gesture !>(`gesture`[%hey ~])]
+        `[%pass /hey %agent [u.who dap.bowl] %poke cage]
+    ==
+  ==
+::
+++  on-peek
+  |=  =path
+  ^-  (unit (unit cage))
+  ?>  =(our src):bowl
+  |^  ?+  path  [~ ~]
+        [%x ~]                 ``noun+!>(`records`+.state)
+        [%y ~]                 (arc %leeches %targets %mutuals ~)
+        [%y %leeches ~]        (arc ~)
+        [%y %targets ~]        (arc (las targets))
+        [%y %mutuals ~]        (arc (las mutuals))
+        [%x %leeches ~]        (alp leeches)
+        [%x %leeches @ ~]      (ask (bind (slaw %p i.t.t.path) (sin leeches)))
+        [%x %targets ~]        (alp targets)
+        [%x %targets ~ ~]      [~ ~]
+        [%x %targets @ta ~]    (alp (lap targets i.t.t.path))
+        [%x %targets @ta @ ~]  (ask (bind (wat t.t.path) (hal targets)))
+        [%x %mutuals ~]        (alp mutuals)
+        [%x %mutuals ~ ~]      [~ ~]
+        [%x %mutuals @ta ~]    (alp (lap mutuals i.t.t.path))
+        [%x %mutuals @ta @ ~]  (ask (bind (wat t.t.path) (hal mutuals)))
+      ::
+          [%x %json ~]  ::NOTE  dumb hack, subject to change
+        =;  =json  ``json+!>(json)
+        =,  enjs:format
+        %-  pairs
+        :~  :-  'outgoing'
+            %-  pairs
+            %+  turn  ~(tap by outgoing)
+            |=  [=^ship lists=(set @ta)]
+            :-  (rsh 3 (scot %p ship))
+            %-  pairs
+            :~  'lists'^a+(turn ~(tap in lists) (lead %s))
+                'ack'^(fall (bind (~(get by receipts) ship) (lead %b)) ~)
+            ==
+          ::
+            :-  'incoming'
+            %-  pairs
+            %+  turn  ~(tap in incoming)
+            |=(=^^ship [(rsh 3 (scot %p ship)) b+&])
+        ==
+      ==
+  ::  scry results
+  ++  arc  |=  l=(list @ta)  ``noun+!>(`arch`~^(malt (turn l (late ~))))
+  ++  alp  |=  s=(set @p)    ``noun+!>(s)
+  ++  alf  |=  f=?           ``noun+!>(f)
+  ++  ask  |=  u=(unit ?)  ?^(u (alf u.u) [~ ~])
+  ::  data wrestling
+  ++  wat  |=([l=@ta p=@ta ~] ?~(p=(slaw %p p) ~ (some [l u.p])))
+  ++  nab  ~(got by outgoing)
+  ++  las  |=(s=(set @p) (zing (turn (sit s) |=(=@p (sit (nab p))))))
+  ++  lap  |=([s=(set @p) l=@ta] (ski s |=(=@p ((sin (nab p)) l))))
+  ++  hal  |=(s=(set @p) |=([l=@ta =@p] ((sin ?~(l s (lap s l))) p)))
+  ::  set shorthands
+  ++  sin  |*(s=(set) ~(has in s))
+  ++  sit  |*(s=(set) ~(tap in s))
+  ++  ski  |*([s=(set) f=$-(* ?)] (sy (skim (sit s) f)))
+  ::  pals
+  ++  leeches  incoming
+  ++  targets  ~(key by outgoing)
+  ++  mutuals  (~(int in targets) leeches)
+  --
+::
+++  on-leave  on-leave:def
+++  on-fail   on-fail:def
+--
diff --git a/desk/app/polls.hoon b/desk/app/polls.hoon
new file mode 100644
index 0000000..433de58
--- /dev/null
+++ b/desk/app/polls.hoon
@@ -0,0 +1,358 @@
+/-  *polls
+/+  dbug
+|%
++$  versioned-state
+  $%  state-0
+  ==
++$  state-0
+  $:  %0
+      polls=(map pid poll)
+  ==
+::
++$  card  card:agent:gall
+::
+--
+%-  agent:dbug
+=|  versioned-state
+=*  state  -
+^-  agent:gall
+=<
+|_  =bowl:gall
++*  this  .
+    hd    ~(. +> bowl)
+++  on-fail   |~(* `this)
+++  on-leave  |~(* `this)
+::
+++  on-init
+:_  this  `this
+++  on-save  !>(state)
+++  on-load
+|=  old-state=vase
+^-  (quip card _this)
+=/  prev  !<(versioned-state old-state)  
+:-  ~
+%=  this  state  prev  ==
+++  on-agent
+|=  [=wire =sign:agent:gall]
+^-  (quip card _this)
+|^  
+?:  ?=([%tracking-polls @ ~] wire)  
+?:  ?=(%kick -.sign)
+=/  id  (slaw %ud i.t.wire)  
+?~  id  `this
+=/  pol  (~(get by polls) [src.bowl u.id])
+?~  pol  `this
+=/  exp  expiry.u.pol
+?:  (gth now.bowl exp)  `this
+:_  this  (track-card:hd [src.bowl u.id])^~
+?.  ?=(%fact -.sign)  `this
+(handle-update (update +.q.cage.sign))
+?.  ?=([%poll-watch @ ~] wire)  `this
+?:  ?=(%kick -.sign)  :_  this  :_  ~  watch-card:hd
+?.  ?=(%fact -.sign)  `this
+=/  u=pull-agent:comms  (pull-agent:comms +.q.cage.sign)
+?.  ?=(%post -.u)  `this
+?.  ?=(%poll +<.u)  `this
+(handle-update +>.u)
+++  handle-update
+|=  u=update
+^-  (quip card _this)
+:_  %=  this  state
+?+  -.u  state
+%new-poll  (save-new-poll:hd +.u)
+%ded-poll  (save-del-poll:hd p.u)
+%old-poll  (handle-poll-update +.u)
+==  ==
+:_  ~  (ui-card:hd u)
+++  handle-poll-update 
+|=  [p=poll u=upd]
+%=  state  polls
+(~(put by polls) [host.p time.p] p)
+==
+--
+++  on-poke
+|=  =cage
+^-  (quip card _this)
+|^
+?+  p.cage  `this
+%trill  (handle-ui !<(action:ui q.cage))
+%noun   (poke-noun !<(* q.cage))
+==
+++  poke-noun
+|=  arg=*
+^-  (quip card _this)
+?:  ?=([%cli *] arg)  
+(handle-terminal +.arg)
+(handle-poke arg)
+++  handle-terminal
+|=  arg=*
+^-  (quip card _this)
+?.  .=(src.bowl our.bowl)  `this
+?+  arg  `this
+[%new @]  `this
+==
+++  handle-poke
+|=  arg=*
+^-  (quip card _this)
+=/  a=action  (action arg)
+?-  -.a
+%vote  (handle-vote +.a)
+%peek  (handle-peek +.a)
+%res   (handle-res +.a)
+==
+++  handle-res
+|=  [=pid pr=peek-res]
+?.  ?=(%peek-ok -.pr)  :_  this  :_  ~
+(ui-card:hd [%peek-res pid pr])
+:-  :~  
+(ui-card:hd [%peek-res pid pr])
+(track-card:hd pid)
+==
+%=  this  state
+=/  nps  (~(put by polls) [host.poll.pr time.poll.pr] poll.pr)
+state(polls nps)
+==
+++  handle-peek
+|=  =id
+=/  pid  [our.bowl id]
+:_  this  :_  ~
+=/  pol  (~(get by polls) pid)
+:: TODO check lock
+=/  pr=peek-res
+?~  pol  [%no-poll ~]  :-  %peek-ok
+?.  private.u.pol  u.pol
+u.pol(votes (mask-votes votes.u.pol))  :: TODO check this when it moves around
+(peek-res-card:hd src.bowl pid pr)
+++  is-valid
+|=  [s=signature hsh=@uvH comment=@t]  ^-  ?
+?:  %+  gte  (lent (trip comment))  100  .n
+?.  (is-signature-valid:signatures our.bowl s hsh now.bowl)  
+~&  >>>  fraudulent-vote-by=src.bowl
+.n
+?.  .=(src.bowl q.s)
+~&  >>>  impersonation-attempt-by=src.bowl
+.n  .y
+++  handle-vote
+|=  [=pid option=@ s=signature comment=@t]
+^-  (quip card _this)
+?.  (is-valid s (sham [pid option]) comment)  `this
+=^  cards  state  (save-new-vote:hd pid option s comment)
+[cards this]
+++  handle-ui
+|=  u=action:ui
+^-  (quip card _this)
+?.  ?=(%poll -.u)  `this
+=/  a=ui-action  +.u
+?.  .=(our.bowl src.bowl)  `this
+?-  -.a
+::  our polls
+%propose        (propose +.a)
+%cancel         (cancel +.a)
+%change-expiry  (change-expiry +.a)
+:: other people's
+%vote           (go-vote +.a)
+%peek           (peek +.a)
+==
+++  propose
+|=  [id=@ text=@t expiry=@da options=(list @t) hidden=? private=? exc=?]
+^-  (quip card _this)
+=/  hid   ?:  hidden  (some eny.bowl)  ~
+=/  =pid  [our.bowl id]
+=/  =poll  (new-poll pid text expiry options hid private exc)
+:_  this(state (save-new-poll:hd poll))
+::  mask the entropy when sending it to people?
+=/  =update  [%new-poll poll]
+?.  ?=(%hid -.votes.poll)
+(spread-cards:hd update)
+:-  (wipe-eny-card:hd id expiry)
+    (spread-cards:hd update)
+++  cancel
+|=  =id
+^-  (quip card _this)
+:_  this(state (save-del-poll:hd [our.bowl id]))
+=/  update  [%ded-poll [our.bowl id]]
+(spread-cards:hd update)
+++  change-expiry
+|=  [=id expiry=@da]
+^-  (quip card _this)
+=/  pol  (~(get by polls) [our.bowl id])
+?~  pol  `this
+=^  np  state  (save-exp-change u.pol expiry)
+:_  this
+=/  update  [%old-poll np %expiry-changed expiry]
+(spread-cards:hd update)
+::
+++  go-vote
+|=  [=pid option=@ comment=@t]
+^-  (quip card _this)
+::  we sign and poke the guy
+:_  this  :_  ~
+=/  s=signature  (sign:signatures our.bowl now.bowl (sham [pid option]))
+=/  vot  [option s comment]
+=/  =action  [%vote pid vot]
+(action-card:hd -.pid action)
+++  peek
+|=  =pid
+=/  a=action  [%peek +.pid]
+:_  this
+(action-card:hd -.pid a)^~
+--
+++  on-watch 
+|=  =(pole knot)
+?+  pole  `this
+[%ui ~]  ?>  .=(our.bowl src.bowl)  `this
+[%poll-sub id=@ ~]  `this
+==
+++  on-peek
+|=  p=(pole knot)  ^-  (unit (unit cage))
+|^
+?+  p  ~
+[%x %j rest=*]
+``[%trill !>([%scry %poll (scry rest.p)])]
+[%x %n rest=*]
+``[%noun !>((scry rest.p))]
+==
+++  scry
+|=  =(pole knot)  ^-  poll-scry:scry:ui
+?+  pole  [%ng ~]
+[%poll ship=@ id=@ ~]  
+=/  ship  (slav %p ship.pole)
+=/  id  (rush id.pole dem)
+?~  id  [%ng ~]
+=/  p  (~(get by polls) [ship `@da`u.id])
+?~  p  [%ng ~]
+[%poll u.p]
+[%done ~]
+=/  d  %+  roll  ~(tap by polls)
+|=  [i=[=pid =poll] acc=(set poll)]  
+?:  (gte now.bowl expiry.poll.i)  acc 
+(~(put in acc) poll.i)
+[%done d]
+[%cur ~]
+=/  d  %+  roll  ~(tap by polls)
+|=  [i=[=pid =poll] acc=(set poll)]  
+?.  (gte now.bowl expiry.poll.i)  acc 
+(~(put in acc) poll.i)
+[%cur d]
+==
+--
+++  on-arvo  |~(* `this)
+--
+|_  =bowl:gall
+:::: savers
+++  save-new-poll
+|=  =poll  ^-  _state
+=/  nps  (~(put by polls) [host.poll time.poll] poll)
+state(polls nps)
+++  save-del-poll
+|=  =pid  ^-  _state
+=/  np  (~(del by polls) pid)
+state(polls np)
+++  save-exp-change
+|=  [p=poll expiry=@da]  ^-  [poll _state]
+=/  np  p(expiry expiry)
+=/  nps  (~(put by polls) [host.p time.p] np)
+:-  np
+state(polls nps)
+++  handle-exc-vote
+|=  [vot=vote v=excl]  ^-  [upd excl]
+=/  crr  (~(get by p.v) q.p.q.vot)
+?~  crr  
+:_  [%exc (~(put by p.v) q.p.q.vot vot)]
+    [%new-vote vot]
+?:  .=(p.u.crr p.vot)
+:_  [%exc (~(del by p.v) q.p.q.vot)]
+    [%vote-canceled q.p.q.vot p.vot]
+:_  [%exc (~(put by p.v) q.p.q.vot vot)]
+    [%vote-changed q.p.q.vot p.u.crr p.vot]
+++  handle-inc-vote
+|=  [vot=vote v=incl]  ^-  [upd incl]
+=/  crr  (~(get by p.v) p.vot)
+?~  crr
+=/  b  *(map @p comv)
+=/  nc  (~(put by b) q.p.q.vot q.vot)
+:-  [%new-vote vot]
+[%inc (~(put by p.v) p.vot nc)]
+::
+?:  (~(has by u.crr) q.p.q.vot)
+=/  nc  (~(del by u.crr) q.p.q.vot)
+:-  
+[%vote-canceled q.p.q.vot p.vot]
+[%inc (~(put by p.v) p.vot nc)]
+::
+=/  nc  (~(put by u.crr) q.p.q.vot q.vot)
+:-  [%new-vote vot]
+[%inc (~(put by p.v) p.vot nc)]
+++  handle-hid-vote
+|=  [vot=vote v=hidd]  ^-  [upd hidd]
+::  we hash the vote first
+=/  hsh  (hash-vote q.p.q.vot eny.v)
+::  find 
+=/  same-votes  (~(get by p.v) p.vot)
+=/  nsv  ?~  same-votes  (sy ~[hsh])  (~(put in u.same-votes) hsh)
+::  check our votes at present. could be many (if inc)
+=/  zji=(set @)  %+  roll  ~(tap by p.v)
+|=  [i=[o=@ud s=(set @uw)] acc=(set @)]
+?:  (~(has in s.i) hsh)  (~(put in acc) o.i)  acc
+::  if current vote is same as before, means cancelation
+?:  (~(has in zji) p.vot)
+=/  dlt  (~(del in nsv) hsh)
+=/  nm  (~(put by p.v) p.vot dlt)
+:_  v(p nm)  [%vote-canceled q.p.q.vot p.vot]
+?:  exc.v
+::  exclusive and has previous post, must delete the previous one first
+=/  ov  -:~(tap in zji)
+=/  current-set  (~(got by p.v) ov)  :: mmm
+=/  ncr  (~(del in current-set) hsh)
+=+  (~(put by p.v) ov ncr)
+=/  nm  (~(put by -) p.vot nsv)
+:_  v(p nm)
+[%vote-changed q.p.q.vot ov p.vot]
+::  inclusive and has previous post
+=/  nm  (~(put by p.v) p.vot nsv)
+:_  v(p nm)
+[%new-vote vot]
+++  save-new-vote
+|=  [=pid vot=vote]  ^-  [(list card) _state]
+=/  pol=(unit poll)  (~(get by polls) pid)
+?~  pol  `state
+?:  (gth now.bowl expiry.u.pol)  `state
+=/  v=votes  votes.u.pol
+=^  u=upd  v
+?-  -.v
+%exc  (handle-exc-vote vot v)
+%inc  (handle-inc-vote vot v)
+%hid  (handle-hid-vote vot v)
+==
+=/  np=poll  u.pol(votes v)
+:-  (spread-cards [%old-poll np u])
+state(polls (~(put by polls) pid np))
+::  cards
+++  watch-card
+[%pass /poll-watch/(scot %p our.bowl) %agent [our.bowl %feed-push-hook] %watch /trill-sub]
+++  track-card
+|=  =pid
+[%pass /tracking-polls/(scot %ud id.pid) %agent [ship.pid %trill-polls] %watch /poll-sub/(scot %ud id.pid)]
+++  peek-res-card
+|=  [target=@p =pid p=peek-res]  ^-  card
+[%pass /poll/peek-res %agent [target %trill-polls] %poke [%noun !>([%res pid p])]]
+++  action-card
+|=  [target=@p =action]  ^-  card
+[%pass [%poll -.action ~] %agent [target %trill-polls] %poke [%noun !>(action)]]
+++  spread-cards
+|=  =update  ^-  (list card)
+:~  (spread-card update)
+    (ui-card update)
+    (fact-card update)
+==
+++  fact-card
+|=  u=update  ^-  card
+=/  id  ?-  -.u
+%new-poll  time.poll.u
+%old-poll  time.p.u
+%ded-poll  id.p.u
+%peek-res  id.p.u
+==
+[%give %fact ~[/poll-sub/(scot %ud id)] [%noun !>(u)]]
+--
+