urbit/ape/gh.hoon

/?    314
/-  gh
=>  |%
    ++  move  (pair bone card)
    ++  sub-result
      $%  [%json json]
      ==
    ++  card  
      $%  [%diff sub-result]
          [%them wire (unit hiss)]
          [%hiss wire [~ ~] %httr [%hiss hiss]]
      ==
    --
|_  [hid=bowl cnt=@ hook=(map ,@t ,[id=@t listeners=(set bone)])]
::++  prep  ,_`.
++  help
  |=  [style=@tas pax=path]
  =|  mow=(list move)
  |%
  ++  abet
    ^-  [(list move) _+>.$]
    [(flop mow) +>.$]
  ++  real-pax  (scan "https://api.github.com{<`path`pax>}" auri:epur)
  ++  send-hiss 
    |=  [aut=? hiz=hiss]
    ^+  +>
    =+  wir=`wire`[%x (scot %ud cnt) pax]
    =+  ^=  new-move
        ?.  aut  [ost.hid %them wir ~ hiz]
        [ost.hid %hiss wir `~ %httr [%hiss hiz]]
    +>.$(mow [new-move mow])
  ++  auth
    ['Authorization' 'Basic cGhpbGlwY21vbmt0ZXN0OjEzMzdwYXNzd29yZA==' ~]
  ++  scry
    ^+  .
    =-  ~&  [%requesting -]  -
    ?+  style  ~|(%invalid-style !!)
      %read-unauth  read-unauth
      %read-auth    read-auth
      %listen       listen
    ==
  ++  read-unauth  (send-hiss | real-pax %get ~ ~)
  ++  read-auth    (send-hiss & real-pax %get ~ ~)
  ++  listen
    ^+  .
    ?>  ?=([@ @ *] pax)
    =+  xap=t.t.pax
    |-  ^+  +>.$
    ?~  xap
      +>.$
    ?:  (~(has by hook) i.xap)
      =.  +>.$  =>((update-hook i.xap) ?>(?=([@ @ *] pax) .))
      $(xap t.xap)
    =.  +>.$  =>((create-hook i.xap) ?>(?=([@ @ *] pax) .))
    $(xap t.xap)
  ++  create-hook
    |=  event=@t
    ^+  +>
    ?>  ?=([@ @ *] pax)
    %-  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  :~
            =+  =+  `tape`(turn (trip event) |=(a=@tD ?:(=('_' a) '-' a)))
                "http://107.170.195.5:8445/~/to/gh/gh-{-}.json?anon&wire=/"
            [%url s/(crip -)]
            [%'content_type' s/%json]
          ==
        ==
    ==
  ++  update-hook
    |=  event=@t
    ^+  +>
    ?>  ?=([@ @ @ *] pax)
    =+  hok=(~(got by hook) event)
    %_    +>.$
        hook
      %+  ~(put by hook)  event
      hok(listeners (~(put in listeners.hok) ost.hid))
    ==
    ::  :*  %+  scan
    ::        =+  [(trip i.pax) (trip i.t.pax)]
    ::        "https://api.github.com/repos/{-<}/{->}/hooks/{(trip (need hook))}"
    ::      auri:epur
    ::      %post  ~  ~
    ::      %-  taco  %-  crip  %-  pojo  %-  jobe  :~
    ::        [%'add_events' a/(turn `(list ,@t)`t.t.pax |=(a=@t s/a))]
    ::      ==
    ::  ==
  --
::
++  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)]))]
::
++  poke-gh-issues
  |=  issue=issues:gh
  ^-  [(list move) _+>.$]
  ~&  issue
  `+>.$
++  peer-scry-x
  |=  pax=path
  ^-  [(list move) _+>.$]
  ?>  ?=(^ pax)
  =-  ~&  [%peered -]  -
  [abet(cnt now.hid)]:scry:(help i.pax t.pax)
::
++  poke-gh-issue-comment
  |=  comment=issue-comment:gh
  ^-  [(list move) _+>.$]
  ~&  comment
  `+>.$
::
++  sigh-httr-x  thou-x
++  thou-x
  |=  [way=wire res=httr]
  ^-  [(list move) _+>.$]
  ?>  ?=([@ *] way)
  :_  +>.$  :_  ~
  :^  ost.hid  %diff  %json
  ?~  r.res
    (jobe err/s/%empty-response code/(jone p.res) ~)
  =+  (rush q.u.r.res apex:poja)
  ?~  -
    (jobe err/s/%bad-json code/(jone p.res) body/s/q.u.r.res ~)
  ?.  =(2 (div p.res 100))
    (jobe err/s/%request-rejected code/(jone p.res) msg/u.- ~)
  u.-
::
++  peek
  |=  [ren=@tas tyl=path]
  ^-  (unit (unit (pair mark ,*)))
  ~ ::``noun/[ren tyl]
--