urbit/ape/gh.hoon

::  This is a driver for the Github API v3.
::
::  You can interact with this in a few different ways:
::
::    - .^(%gx /=gh=/read{/endpoint}) or subscribe to
::      /scry/x/read{/endpoint} for authenticated reads.
::
::    - subscribe to /scry/x/listen/{owner}/{repo}/{events...}
::      for webhook-powered event notifications.  For event list,
::      see https://developer.github.com/webhooks/.
::
::  See the %github app for example usage.
::
/?    314
/-  gh
=>  |%
    ++  move  (pair bone card)
    ++  sub-result
      $%  [%arch arch]
          [%gh-issues issues:gh]
          [%gh-issue-comment issue-comment:gh]
          [%json json]
          [%null ~]
      ==
    ++  card  
      $%  [%diff sub-result]
          [%them wire (unit hiss)]
          [%hiss wire [~ ~] %httr [%hiss hiss]]
      ==
    ++  hook-response
      $%  [%gh-issues issues:gh]
          [%gh-issue-comment issue-comment:gh]
      ==
    --
|_  [hid=bowl cnt=@ hook=(map ,@t ,[id=@t listeners=(set bone)])]
::++  prep  ,_`.
::
::  This core manages everything related to a particular request.
::
::  Each request has a particular 'style', which is currently
::  one of 'read', or 'listen'.  ++scry handles all three types
::  of requests.
::
++  help
  |=  [ren=care style=@tas pax=path arg=path]
  =|  mow=(list move)
  |%
  ::  Resolve core.
  ::
  ++  abet
    ^-  [(list move) _+>.$]
    [(flop mow) +>.$]
  ::
  ::  Append path to api.github.com and parse to a purl.
  ::
  ++  real-pax  (scan "https://api.github.com{<`path`pax>}" auri:epur)
  ::
  ::  Send a hiss
  ::
  ++  send-hiss 
    |=  hiz=hiss
    ^+  +>
    =+  wir=`wire`[ren (scot %ud cnt) (scot %uv (jam arg)) style pax]
    =+  new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]
    +>.$(mow [new-move mow])
  ::
  ::  Decide how to handle a request based on its style.
  ::
  ++  scry
    ^+  .
    ?+  style  ~|(%invalid-style !!)
      %read     read
      %listen   listen
    ==
  ::
  ++  read  (send-hiss real-pax %get ~ ~)
  ::
  ::  Create or update a webhook to listen for a set of events.
  ::
  ++  listen
    ^+  .
    ?>  ?=([@ @ *] pax)
    =+  events=t.t.pax
    |-  ^+  +>.$
    ?~  events
      +>.$
    ?:  (~(has by hook) i.events)
      =.  +>.$  =>((update-hook i.events) ?>(?=([@ @ *] pax) .))
      $(events t.events)
    =.  +>.$  =>((create-hook i.events) ?>(?=([@ @ *] pax) .))
    $(events t.events)
  ::
  ::  Set up a webhook.
  ::
  ++  create-hook
    |=  event=@t
    ^+  +>
    ?>  ?=([@ @ *] pax)
    =+  clean-event=`tape`(turn (trip event) |=(a=@tD ?:(=('_' a) '-' a)))
    =.  hook
      %+  ~(put by hook)  (crip clean-event)
      =+  %+  fall
            (~(get by hook) (crip clean-event))
          *[id=@t listeners=(set bone)]
      [id (~(put in listeners) ost.hid)]
    %-  send-hiss
    :*  %+  scan
          =+  [(trip i.pax) (trip i.t.pax)]
          "https://api.github.com/repos/{-<}/{->}/hooks"
        auri:epur
        %post  ~  ~
        %-  taco  %-  crip  %-  pojo  %-  jobe  :~
          name/s/%web
          active/b/&
          events/a/~[s/event] ::(turn `(list ,@t)`t.t.pax |=(a=@t s/a))
          :-  %config
          %-  jobe  :~
            =+  =+  clean-event
                "http://107.170.195.5:8443/~/to/gh/gh-{-}.json?anon&wire=/"
            [%url s/(crip -)]
            [%'content_type' s/%json]
          ==
        ==
    ==
  ::
  ::  Add current bone to the list of subscribers for this event.
  ::
  ++  update-hook
    |=  event=@t
    ^+  +>
    ?>  ?=([@ @ @ *] pax)
    =+  hok=(~(got by hook) event)
    %_    +>.$
        hook
      %+  ~(put by hook)  event
      hok(listeners (~(put in listeners.hok) ost.hid))
    ==
  --
::
::  Pokes that haven't already been caught are handled here.
::  These should be only from webhooks firing, so if we get any
::  mark that we shouldn't get from a webhook, we reject it.
::  Otherwise, we spam out the event to everyone who's listening
::  for that event.
::
++  poke
  |=  response=hook-response
  ^-  [(list move) _+>.$]
  =+  hook-data=(~(get by hook) (rsh 3 3 -.response))
  ?~  hook-data
    ~&  [%strange-hook hook response]
    `+>.$
  ~&  response=response
  :_  +>.$
  %+  turn  (~(tap in listeners.u.hook-data))
  |=  ost=bone
  [ost %diff response]
::
::  When a peek on a path blocks, ford turns it into a peer on
::  /scry/{care}/{path}.  You can also just peer to this
::  directly.
::
::  After some sanity checking we hand control to ++scry in
::  ++help.
::
++  peer-scry
  |=  pax=path
  ^-  [(list move) _+>.$]
  ?>  ?=([care ^] pax)
  ::  =-  ~&  [%peered -]  -
  [abet(cnt now.hid)]:scry:(help i.pax i.t.pax t.t.pax ~)
::
::  HTTP response.  We make sure the response is good, then
::  produce the result (as JSON) to whoever sent the request.
::
++  sigh-httr
  |=  [way=wire res=httr]
  ^-  [(list move) _+>.$]
  ?>  ?=([care @ @ @ *] way)
  =+  arg=(path (cue (slav %uv i.t.t.way)))
  =-  ?:  ?=(%& -<)
        [[ost.hid %diff p]~ +>.$]
      ?~  t.t.t.t.way
        [[ost.hid %diff p]~ +>.$]
      =+  len=(lent t.t.t.t.way)
      =+  pax=`path`(scag (dec len) `path`t.t.t.t.way)
      =+  new-arg=`path`(slag (dec len) `path`t.t.t.t.way)
      =-  ~&  [%giving -]  -
      [abet(cnt now.hid)]:scry:(help i.way i.t.t.t.way pax new-arg)
  ^-  (each sub-result sub-result)
  ?+    i.way  `null/~
      %x
    ?~  r.res
      [%| %json (jobe err/s/%empty-response code/(jone p.res) ~)]
    =+  jon=(rush q.u.r.res apex:poja)
    ?~  jon
      [%| %json (jobe err/s/%bad-json code/(jone p.res) body/s/q.u.r.res ~)]
    ?.  =(2 (div p.res 100))
      [%| %json (jobe err/s/%request-rejected code/(jone p.res) msg/u.jon ~)]
    |-  ^-  (each sub-result sub-result)
    ?~  arg
      `json/u.jon
    =+  dir=((om:jo some) u.jon)
    ?~  dir
      [%| %json (jobe err/s/%json-not-object code/(jone p.res) body/u.jon ~)]
    =+  new-jon=(~(get by u.dir) i.arg)
    $(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
  ::
      %y
    ?~  r.res
      ~&  [err/s/%empty-response code/(jone p.res)]
      [%| arch/*arch]
    =+  jon=(rush q.u.r.res apex:poja)
    ?~  jon
      ~&  [err/s/%bad-json code/(jone p.res) body/s/q.u.r.res]
      [%| arch/*arch]
    ?.  =(2 (div p.res 100))
      ~&  [err/s/%request-rejected code/(jone p.res) msg/u.jon]
      [%| arch/*arch]
    =+  dir=((om:jo some) u.jon)
    ?~  dir
      ~&  [err/s/%json-not-object code/(jone p.res) body/u.jon]
      [%| arch/*arch]
    [%& %arch `(shax (jam u.jon)) (~(run by u.dir) ,~)]
  ==
::
::  We can't actually give the response to pretty much anything
::  without blocking, so we just block unconditionally.
::
++  peek
  |=  [ren=@tas tyl=path]
  ^-  (unit (unit (pair mark ,*)))
  ~ ::``noun/[ren tyl]
--




::
::++  poke-json
::  |=  jon=json
::  ^-  [(list move) _+>.$]
::  =+  ^-  [repo=json sender=json hok=(list ,@t) hook-id=@t zen=json]
::      %-  need
::      %.  jon
::      =>  jo
::      (ot repository/some sender/some hook/(ot events/(ar so) ~) 'hook_id'^no zen/some ~)
::  ?.  ?=([@ ~] hok)
::    ~&  [%weird-hook hook-id hok]
::    [~ +>.$]
::  ~&  [%id hook-id hok]
::  =+  old-bones=`(set bone)`(biff (~(get by hook) i.hok) tail)
::  [~ +>.$(hook (~(put by hook) i.hok [hook-id (~(put in old-bones) ost.hid)]))]
.