urbit/main/app/rodeo/core.hook

::
::::  /hook/core/rodeo/app
  ::
/?  314
/-  *radio
/+  twitter
::
::::
  ::
!:
=>  |%                                                  ::  data structures
    ++  house  ,[%0 house-0]                            ::  full state
    ++  house-any                                       ::  app history
      $%  [%0 house-0]                                  ::  0: initial version
      ==                                                ::
    ++  house-0                                         ::
      $:  parties=(map span party)                      ::  conversations
          general=(set bone)                            ::  meta-subscribe
          outbox=(pair ,@ud (map ,@ud thought))         ::  urbit outbox
      ==                                                ::
    ++  party                                           ::  a conversation
      $:  count=@ud                                     ::  (lent grams)
          grams=(list telegram)                         ::  all history
          present=(map ship status)                     ::  presence state
          sequence=(map station ,@ud)                   ::  stations heard
          shape=config                                  ::  configuration
          known=(map serial ,@ud)                       ::  messages heard
          guests=(map bone river)                       ::  message followers
          viewers=(set bone)                            ::  presence followers
          owners=(set bone)                             ::  config followers
      ==                                                ::
    ++  river  (pair point point)                       ::  stream definition
    ++  point                                           ::  stream endpoint
      $%  [%ud p=@ud]                                   ::  by number
          [%da p=@da]                                   ::  by date
      ==                                                ::
    ++  gift                                            ::  result
      $%  [%rust %radio-report report]                  ::  refresh
          [%mean ares]                                  ::  cancel
          [%nice ~]                                     ::  accept
      ==                                                ::
    ++  sign                                            ::  response
      $%  $:  %e                                        ::  from %eyre
      $%  [%thou p=httr]                                ::  HTTP response
          ==  ==                                        ::
          $:  %g                                        ::  application
      $%  [%mean p=ares]                                ::  cancel
          [%nice ~]                                     ::  acknowledge
          [%rust %radio-report report]                  ::  refresh
      ==  ==  ==                                        ::
    ++  move  ,[p=bone q=(mold note gift)]              ::  all actions
    ++  hapt  ,[p=ship q=path]                          ::  app instance
    ++  note                                            ::  requests
      $%  $:  %e                                        ::  through %eyre
      $%  [%them p=(unit hiss)]                         ::  HTTP request
          ==  ==                                        ::
          $:  %g                                        ::  network
      $%  [%mess p=hapt q=ship r=cage]                  ::  message
          [%nuke p=hapt q=ship]                         ::  cancel
          [%show p=hapt q=ship r=path]                  ::  subscribe
      ==  ==  ==                                        ::
    --
|_  [hid=hide house]
++  ti
  =+  ^=  key
      :*  :-  'AP3G1t8ki6rPzeeAqdWCTw03F'
              'VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD'
          :-  '2821727326-RZGXSeTn7hCFQfJqR0ViivM3YYpu2O1M71gelBl'
              'jW9VygFPOTsEK0WmrJDHYSoEnofOPdCE1oQRzueemVTl8'
      ==
  |%
  ++  post
    |=  txt=cord  ^-  hiss
    (~(stat-upda twit key lat.hid `@`eny.hid) [%status txt]~ ~)
  --
::
++  ra                                                  ::  transaction core
  |_  [ost=bone moves=(list move)]
  ++  ra-abet                                           ::  resolve core
    ^-  [(list move) _+>]
    [(flop moves) +>]
  ::
  ++  ra-emil                                           ::  ra-emit move list
    |=  mol=(list move)  
    %_(+> moves (welp (flop mol) moves))
  ::
  ++  ra-emit                                           ::  emit a move
    |=  mov=move  
    %_(+> moves [mov moves])
  ::
  ++  ra-ever                                           ::  emit success
    (ra-emit ost %give %nice ~)
  ::
  ++  ra-evil                                           ::  emit error
    |=  msg=cord
    ~&  [%ra-evil msg]
    (ra-emit ost %give %mean ~ msg ~)
  ::
  ++  ra-house                                          ::  emit stations
    %+  ra-emit  ost
    :^  %give  %rust  %radio-report
    :-  %house
    %-  ~(gas in *(set span))
    ^-  (list span)
    (turn (~(tap by parties) ~) |=([a=span *] a))
  ::
  ++  ra-homes                                          ::  update stations
    =+  gel=general
    |-  ^+  +>
    ?~  gel  +>
    =.  +>  $(gel l.gel)
    =.  +>  $(gel r.gel)
    ra-house(ost n.gel)
  ::
  ++  ra-apply                                          ::  apply command
    |=  [her=ship cod=command]
    ^+  +>
    ~&  [%ra-apply cod]
    ?-    -.cod
        %design
      ?.  =(her our.hid)
        (ra-evil %radio-no-owner)
      =+  pur=(~(get by parties) p.cod)
      ?~  q.cod
        ?~  pur
          (ra-evil %radio-no-party)
        =.  +>.$  pa-abet:(~(pa-reform pa p.cod u.pur) *config)
        =.  +>.$  ra-homes
        ra-ever(parties (~(del by parties) p.cod))
      =+  poy=`(pair ,? party)`?~(pur [| *party] [& u.pur])
      =.  +>.$  pa-abet:(~(pa-reform pa p.cod q.poy) u.q.cod)
      =.  +>.$  ?:(p.poy +>.$ ra-homes)
      ra-ever
    ::
        %review   ra-ever:(ra-think | her +.cod)
        %publish  ra-ever:(ra-think & her +.cod)
        %ping
      =+  pur=(~(get by parties) p.cod)
      ?~  pur
        (ra-evil %radio-no-party)
      =<  ra-ever  =<  pa-abet
      (~(pa-notify pa p.cod u.pur) her q.cod)
    ==
  ::
  ++  ra-friend                                         ::  %friend response
    |=  [man=span sih=sign]
    ^+  +>
    =+  pur=(~(get by parties) man)
    ?~  pur  ~&  [%ra-friend-none man]  +>.$
    pa-abet:(~(pa-friend pa man u.pur) sih)
  ::
  ++  ra-repeat                                         ::  %repeat response
    |=  [num=@ud her=ship man=span sih=sign]
    =+  oot=(~(get by q.outbox) num)
    ?~  oot  ~&  [%ra-repeat-none num]  +>.$
    =.  q.outbox  (~(del by q.outbox) num)
    =.  q.u.oot
      %+  ~(put by q.u.oot) 
        [%& her man]
      ?+  sih  !!
        [%g %mean *]  ~&([%radio-repeat-rejected num her man sih] %rejected)
        [%g %nice ~]  %received
      ==
    (ra-think | her u.oot ~)
  ::
  ++  ra-cancel                                         ::  drop a bone
    %_    .
        general  (~(del in general) ost)
        parties
      |-  ^-  (map span party)
      ?~  parties  ~
      :-  :-  p.n.parties 
          %=  q.n.parties
            guests  (~(del by guests.q.n.parties) ost)
            viewers  (~(del in viewers.q.n.parties) ost)
            owners  (~(del in owners.q.n.parties) ost)
          ==
      [$(parties l.parties) $(parties r.parties)]
    ==
  ::
  ++  ra-subscribe                                      ::  listen to
    |=  [her=ship pax=path]
    ^+  +>
    ::  ~&  [%ra-subscribe pax]
    ?:  ?=(~ pax)
      ra-house(general (~(put in general) ost))
    ?:  ?=([%am @ ~] pax)
      =+  pur=(~(get by parties) i.t.pax)
      ?~  pur
        ~&  [%bad-subscribe-party i.t.pax]
        (ra-evil %radio-no-party)
      pa-abet:(~(pa-watch pa i.t.pax u.pur) her)
    ?:  ?=([%xm @ ~] pax)
      =+  pur=(~(get by parties) i.t.pax)
      ?~  pur
        ~&  [%bad-subscribe-party i.t.pax]
        (ra-evil %radio-no-party)
      pa-abet:(~(pa-master pa i.t.pax u.pur) her)
    ?.  ?=([%fm *] pax)  
      ~&  [%bad-subscribe pax]
      (ra-evil %radio-bad-path)
    ?.  &(?=([@ *] t.pax) ((sane %tas) i.t.pax))
      ~&  [%bad-subscribe pax]
      (ra-evil %radio-bad-path)
    =+  pur=(~(get by parties) i.t.pax)
    ?~  pur
      ~&  [%bad-subscribe-party i.t.pax]
      (ra-evil %radio-no-party)
    pa-abet:(~(pa-listen pa i.t.pax u.pur) her t.t.pax)
  ::
  ++  ra-think                                          ::  publish/review
    |=  [pub=? her=ship tiz=(list thought)]
    ^+  +>
    ?~  tiz  +>
    $(tiz t.tiz, +> (ra-consume pub her i.tiz))
  ::
  ++  ra-consume                                        ::  consume thought
    |=  [pub=? her=ship tip=thought]
    =+  aud=`(list (pair station delivery))`(~(tap by q.tip) ~)
    |-  ^+  +>.^$
    ?~  aud  +>.^$
    $(aud t.aud, +>.^$ (ra-conduct pub her p.i.aud tip))
  ::
  ++  ra-conduct                                        ::  thought to station
    |=  [pub=? her=ship tay=station tip=thought]
    ^+  +>
    ?-  -.tay
      %&  ?:  pub
            =.  her  our.hid                            ::  XX security!
            ?:  =(her p.p.tay)
              (ra-record q.p.tay p.p.tay tip)
            (ra-transmit p.tay tip)
          ?:  =(our.hid q.p.tay)
            +>
          (ra-record q.p.tay p.p.tay tip)
      %|  ?.  pub  +>
          ?-    -.p.tay
              %twitter
            ~&  [%conduct-twitters]
            =+  ^=  msg
                ?+  -.q.r.tip  !!
                  %say  "@{(trip p.p.tay)} {<her>}: {(trip p.q.r.tip)}"
                  %own  "@{(trip p.p.tay)} {<her>} {(trip p.q.r.tip)}"
                ==
            ?<  (gth (lent msg) 140)
            %+  ra-emit  ost
            :+  %pass    /tweet/(scot %ud ost) 
            [%e [%them ~ (post:ti (crip msg))]]
    ==    ==
  ::
  ++  ra-record                                         ::  add to party
    |=  [man=span gam=telegram]
    ^+  +>
    =+  pur=(~(get by parties) man)
    ?~  pur
      ~&  [%no-party man]
      +>.$
    pa-abet:(~(pa-learn pa man u.pur) gam)
  ::
  ++  ra-transmit                                       ::  send to neighbor
    |=  [cuz=cousin tip=thought]
    ^+  +>
    =.  +>  
        %+  ra-emit  ost
        :*  %pass
            /repeat/(scot %ud p.outbox)/(scot %p p.cuz)/[q.cuz]
            %g
            %mess 
            [p.cuz /rodeo] 
            our.hid
            [%radio-command !>(`command`[%review tip ~])]
        ==
    +>(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox tip)) 
  ::
  ++  pa                                                ::  party core
    |_  $:  man=span
            party
        ==
    ++  pa-abet
      ^+  +>
      +>(parties (~(put by parties) man `party`+<+))
    ::
    ++  pa-admire                                       ::  accept from
      |=  her=ship
      ^-  ?
      ::?-  -.cordon.shape
      ::  %&  (~(has in p.cordon.shape) her)
      ::  %|  !(~(has in p.cordon.shape) her)
      ::==
      &
    ::
    ++  pa-watch                                        ::  watch presence
      |=  her=ship
      ?.  (pa-admire her)
        (pa-sauce ost [[%mean ~ %radio-watch-unauthorized ~] ~])
      =.  viewers  (~(put in viewers) ost)
      (pa-sauce ost [[%rust %radio-report %group present] ~])
    ::
    ++  pa-master                                       ::  hear config
      |=  her=ship
      ?.  (pa-admire her)
        (pa-sauce ost [[%mean ~ %radio-master-unauthorized ~] ~])
      =.  owners  (~(put in owners) ost)
      (pa-sauce ost [[%rust %radio-report %config shape] ~])
    ::
    ++  pa-display                                      ::  update presence
      =+  vew=viewers
      |-  ^+  +>
      ?~  vew  +>
      =.  +>  $(vew l.vew)
      =.  +>  $(vew r.vew)
      (pa-sauce n.vew [[%rust %radio-report %group present] ~])
    ::
    ::
    ++  pa-monitor                                      ::  update config
      =+  owe=owners
      |-  ^+  +>
      ?~  owe  +>
      =.  +>  $(owe l.owe)
      =.  +>  $(owe r.owe)
      ~&  [%monitor n.owe]
      (pa-sauce n.owe [[%rust %radio-report %config shape] ~])
    ::
    ++  pa-friend                                       ::  subscribed update
      |=  sih=sign
      ^+  +>
      ?+    sih  ~&([%radio-bad-friend sih] !!)
          [%g %nice ~]
        ~&  %pa-friend-nice 
        +>.$
      ::
          [%g %rust %radio-report *]
        ?+    -.+>+.sih  ~&([%radio-odd-friend sih] !!)
            %grams
          (pa-lesson q.+.+>+.sih)
        ==
      ==
    ::
    ++  pa-scrub                                        ::  pass forward
      |=  [ost=bone bub=(list (pair path note))]
      %_    +>.$
          moves 
        (welp (flop (turn bub |=(a=(pair path note) [ost %pass a]))) moves)
      ==
    ::
    ++  pa-sauce                                        ::  send backward
      |=  [ost=bone gub=(list gift)]
      %_    +>.$
          moves
        (welp (flop (turn gub |=(a=gift [ost %give a]))) moves)
      ==
    ::
    ++  pa-abjure                                       ::  unsubscribe move
      |=  tal=(list station)
      %+  pa-scrub  0
      %+  turn  tal
      |=  tay=station
      ?-  -.tay
        %|  !!
        %&  :-  /friend/nuke/[man]
            [%g %nuke [p.p.tay /rodeo] our.hid]
      ==
    ::
    ++  pa-acquire                                      ::  subscribe to
      |=  tal=(list station)
      %+  pa-scrub  0
      %+  turn  tal
      |=  tay=station
      =+  num=(fall (~(get by sequence) tay) 0)
      ?-  -.tay
        %|  !!
        %&  :-  /friend/show/[man]
            [%g %show [p.p.tay /rodeo] our.hid /fm/[q.p.tay]/(scot %ud num)]
      ==
    ::
    ++  pa-reform                                       ::  reconfigure, ugly
      |=  cof=config
      =+  ^=  dif  ^-  (pair (list station) (list station))
          =+  old=`(list station)`(~(tap in sources.shape) ~)
          =+  new=`(list station)`(~(tap in sources.cof) ~)
          :-  (skip new |=(a=station (~(has in sources.shape) a)))
          (skip old |=(a=station (~(has in sources.cof) a)))
      =.  +>.$  (pa-acquire p.dif)
      =.  +>.$  (pa-abjure q.dif)
      pa-monitor
    ::
    ++  pa-cancel                                       ::  unsubscribe from
      ^+  .
      ~&  [%pa-cancel ost]
      =.  guests  (~(del in guests) ost)
      (pa-sauce ost [[%mean ~] ~])
    ::
    ++  pa-notify                                       ::  new presence
      |=  [her=ship per=presence]
      ^+  +>
      pa-display(present (~(put by present) her [per lat.hid *human]))
    ::
    ++  pa-start                                        ::  start stream
      |=  riv=river
      ^+  +>
      =-  =.  +>.$  (pa-sauce ost [[%rust %radio-report %grams q.lab r.lab] ~])
          ?:  p.lab  
            (pa-sauce ost [[%mean ~] ~])
          +>.$(guests (~(put by guests) ost riv))
      ^=  lab  
      =+  [end=count gaz=grams dun=| zeg=*(list telegram)]
      ~&  [%river riv]
      |-  ^-  (trel ,? ,@ud (list telegram))
      ?~  gaz  [dun end (flop zeg)]
      ?:  ?-  -.q.riv                                   ::  after the end
            %ud  (lte p.q.riv end)
            %da  (lte p.q.riv p.r.q.i.gaz)
          ==
        $(end (dec end), gaz t.gaz)
      ?:  ?-  -.p.riv                                   ::  before the start
            %ud  (lth end p.p.riv)
            %da  (lth p.r.q.i.gaz p.p.riv)
          ==
        [dun end (flop zeg)]
      $(end (dec end), gaz t.gaz, zeg [i.gaz zeg])
    ::
    ++  pa-listen                                       ::  subscribe
      |=  [her=ship pax=path]
      ^+  +>
      ?.  (pa-admire her)
        (pa-sauce ost [[%mean ~ %radio-listen-unauthorized ~] ~])
      =+  ^=  ruv  ^-  (unit river)
          ?:  ?=(~ pax)
            `[[%ud count] [%da (dec (bex 128))]]
          ?:  ?=([@ ~] pax)
            =+  say=(slay i.pax)
            ?.  ?=([~ %$ ?(%ud %da) @] say)  ~
            `[(point +>.say) [%da (dec (bex 128))]]
          ?.  ?=([@ @ ~] pax)  ~
          =+  [say=(slay i.pax) den=(slay i.t.pax)]
          ?.  ?=([~ %$ ?(%ud %da) @] say)  ~
          ?.  ?=([~ %$ ?(%ud %da) @] den)  ~
          `[(point +>.say) (point +>.den)]
      ?~  ruv
        (pa-sauce ost [[%mean ~ %radio-malformed ~] ~])
      (pa-start u.ruv)
    ::
    ++  pa-refresh                                      ::  update stream
      |=  [num=@ud gam=telegram]
      ~&  [%pa-refresh num gam]
      =+  ^=  moy
          |-  ^-  (pair (list bone) (list move))
          ?~  guests  [~ ~]
          =+  lef=$(guests l.guests)
          =+  rit=$(guests r.guests)
          =+  old=[p=(welp p.lef p.rit) q=(welp q.lef q.rit)]
          ?:  ?-  -.q.q.n.guests                          ::  after the end
                %ud  (lte p.q.q.n.guests num)
                %da  (lte p.q.q.n.guests p.r.q.gam)
              ==
            [[p.n.guests p.old] [[p.n.guests %give %mean ~] q.old]]
          ?:  ?-  -.p.q.n.guests                          ::  before the start
                %ud  (gth p.p.q.n.guests num)
                %da  (gth p.p.q.n.guests p.r.q.gam)
              ==
            old
          :-  p.old
          [[p.n.guests %give %rust %radio-report %grams num gam ~] q.old]
      =.  moves  (welp q.moy moves)
      |-  ^+  +>.^$
      ?~  p.moy  +>.^$
      $(p.moy t.p.moy, guests (~(del by guests) i.p.moy))
    ::
    ++  pa-lesson                                       ::  learn multiple
      |=  gaz=(list telegram)
      ^+  +>
      ?~  gaz  +>
      $(gaz t.gaz, +> (pa-learn i.gaz))
    ::
    ++  pa-learn                                        ::  learn message
      |=  gam=telegram
      ^+  +>
      ?.  (pa-admire p.gam)
        ~&  %pa-admire-rejected
        +>.$
      =.  q.q.gam  (~(put by q.q.gam) [%& our.hid man] %received)
      =+  old=(~(get by known) p.q.gam)
      ?~  old
        (pa-append gam)
      (pa-revise u.old gam)
    ::
    ++  pa-append                                       ::  append new
      |=  gam=telegram
      ^+  +>
      %+  %=  pa-refresh
            grams  [gam grams]
            count  +(count)
            known  (~(put by known) p.q.gam count)
          ==
        count
      gam
    ::
    ++  pa-revise                                       ::  revise existing
      |=  [num=@ud gam=telegram]
      =+  way=(sub count num)
      =.  grams  (welp (scag (dec way) grams) [gam (slag way grams)])
      (pa-refresh num gam)
    --
  --
++  peer
  |=  [ost=bone her=ship pax=path]
  ^-  [(list move) _+>]
  ::  ~&  [%rodeo-peer ost her pax]
  ra-abet:(~(ra-subscribe ra ost ~) her pax)
::
++  poke-radio-command
  |=  [ost=bone her=ship cod=command]
  ^-  [(list move) _+>]
  ::  ~&  [%rodeo-poke-command her cod]
  ra-abet:(~(ra-apply ra ost ~) her cod)
::
++  pour
  |=  [ost=bone pax=path sih=*]
  ^-  [(list move) _+>]
  ::  ~&  [%rodeo-pour ost pax sih]
  ::  ~&  sih=sih
  =+  sih=((hard sign) sih)
  ?+    pax  ~&  [%rodeo-strange-path pax]  !!
      [%tweet ^]
    ?>  ?=(%thou +<.sih)
    ~&  ?:  =(2 (div p.p.sih 100)) 
          [%tweet-ack p.p.sih]
        ~!  sih
        [%tweet-lost [p `(unit ,[@ @t])`r]:[p.sih .]]
    [~ +>.$]
      [%friend *]
    ?>  ?=([@ @ ~] t.pax)
    ?.  =(%show i.t.pax)
      ~&  [%pour-friend-nuke-nuke pax]
      [~ +>.$]
    ra-abet:(~(ra-friend ra ost ~) i.t.t.pax sih)
  ::
      [%repeat *]
    ?>  ?=([@ @ @ ~] t.pax)
    =+  [num her man]=[(slav %ud i.t.pax) (slav %p i.t.t.pax) i.t.t.t.pax]
    ra-abet:(~(ra-repeat ra ost ~) num her man sih)
  ==
::
++  prep
  |=  old=(unit (unit house))
  ^-  [(list move) _+>]
  ?>  ?=(^ old)
  ?^  u.old
    ~&  %rodeo-prep-old
    [~ +>(+<+ u.u.old)]
  ~&  %rodeo-prep-new
  [~ +:ra-abet:(~(ra-apply ra 0 ~) our.hid %design %main `[~ [%| ~]])]
::
++  pull
  |=  ost=bone
  ^-  [(list move) _+>]
  ~&  [%rodeo-pull ost]
  ra-abet:~(ra-cancel ra ost ~)
--