checkpoint

app/gh.hoon

@@ -13,6 +13,7 @@
 ::
 /?  314
 /-  gh, plan-acct
+/+  gh-parse
 ::  /ape/gh/split.hoon defines ++split, which splits a request
 ::  at the end of the longest possible endpoint.
 ::
@@ -23,6 +24,7 @@
     ++  move  (pair bone card)
     ++  sub-result
       $%  {$arch arch}
+          {$gh-list-issues (list issue:gh)}
           {$gh-issues issues:gh}
           {$gh-issue-comment issue-comment:gh}
           {$json json}
@@ -32,7 +34,6 @@
       $%  {$diff sub-result}
           {$them wire (unit hiss)}
           {$hiss wire {$~ $~} $httr {$hiss hiss}}
-          {$poke wire {ship $hood} $write-plan-account {knot plan-acct}}
       ==
     ++  hook-response
       $%  {$gh-issues issues:gh}
@@ -41,10 +42,7 @@
     --
 ::
 |_  {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
-++  prep
+++  prep  _`.
-  |=  a/(unit _+<+)  ^-  (quip move +>)
-  ?^  a  [~ +>(+<+ u.a)]
-  (peer-scry %x %read /user)
 ::
 ::  This core manages everything related to a particular request.
 ::
@@ -54,7 +52,8 @@
 ::
 ++  help
   |=  {ren/care style/@tas pax/path}
-  =^  arg  pax  [+ -]:(split pax)
+  ::  =^  arg  pax  [+ -]:(split pax)
+  =|  arg/path
   =|  mow/(list move)
   |%
   ::  Resolve core.
@@ -63,6 +62,22 @@
     ^-  {(list move) _+>.$}
     [(flop mow) +>.$]
   ::
+  ::  Send a move.
+  ::
+  ++  send
+    |=  mov/move
+    +>.$(mow [mov mow])
+  ::
+  ::  Produce null
+  ::
+  ++  send-null
+    (send ost.hid %diff %null ~)
+  ::
+  ::  Produce empty arch
+  ::
+  ++  send-null-arch
+    (send ost.hid %diff %arch ~ ~)
+  ::
   ::  Append path to api.github.com and parse to a purl.
   ::
   ++  endpoint-to-purl
@@ -74,21 +89,72 @@
   ++  send-hiss 
     |=  hiz/hiss
     ^+  +>
-    =+  wir=`wire`[(scot %ud cnt) ren (pack style arg) pax]
+    =+  wir=`wire`[ren (scot %ud cnt) (scot %uv (jam arg)) style pax]
-    =+  new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]
+    (send ost.hid %hiss wir `~ %httr [%hiss hiz])
-    ::  ~&  [%sending-hiss new-move]
+  ::
-    +>.$(mow [new-move mow])
+  ::  Send a %get hiss
+  ::
+  ++  get
+    |=  endpoint/path
+    (send-hiss (endpoint-to-purl endpoint) %get ~ ~)
   ::
   ::  Decide how to handle a request based on its style.
   ::
   ++  scry
     ^+  .
-    ?+  style  ~|(invalid-style+[style want=p:!>(*?($read $listen))] !!)
+    ?+  style  ~|([%invalid-style style] !!)
-      $read     read
+      $read     ?+(ren ~&([%invalid-care ren] !!) $x read-x, $y read-y)
       $listen   listen
     ==
   ::
-  ++  read  (send-hiss (endpoint-to-purl pax) %get ~ ~)
+  ++  read-x
+    ~&  [%read-x pax]
+    ?+    pax  ~&([%strange-path pax] send-null)
+        $~  send-null
+        {$issues *}
+      ?+    +.pax  ~&([%strange-path pax] send-null)
+          $~         send-null
+          {$mine *}  (get /issues)
+          {$by-repo *}
+        ?+  +>.pax  ~&([%strange-path pax] send-null)
+          $~          send-null
+          {@t $~}     send-null
+          {@t @t $~}  (get /repos/[-.+>.pax]/[-.+>+.pax]/issues)
+        ==
+      ==
+    ==
+  ::
+  ++  read-y
+    ~&  [%read-y pax]
+    ?+    pax  ~&([%strange-path pax] send-null-arch)
+        $~  (send-children %issues ~)
+        {$issues *}
+      ?+    +.pax  ~&([%strange-path pax] send-null-arch)
+          $~            (send-children %mine %by-repo ~)
+          {$mine *}     (get /issues)
+          {$by-repo *}
+        ?+    +>.pax  ~&([%strange-path pax] send-null-arch)
+            $~
+          =+  /(scot %p our.hid)/home/(scot %da now.hid)/web/plan
+          =+  .^({* acc/(map knot plan-acct)} %cx -)
+          (send-children usr:(~(got by acc) %github) ~)
+        ::
+            {@t $~}     (get /users/[-.+>.pax]/repos)
+            {@t @t $~}  (get /repos/[-.+>.pax]/[-.+>+.pax]/issues)
+        ==
+      ==
+    ==
+  ::
+  ::  (send-hiss (endpoint-to-purl /issues) %get ~ ~)
+  ::
+  ::  Produce an arch with the given list of children
+  ::
+  ++  send-children
+    |=  children/(list @t)
+    %-  send  :*
+      ost.hid  %diff  %arch  ~
+      (malt (turn children |=(@t [+< ~])))
+    ==
   ::
   ::  Create or update a webhook to listen for a set of events.
   ::
@@ -200,86 +266,110 @@
   ::  =-  ~&  [%peered -]  -
   [abet(cnt +(cnt))]:scry:(help i.pax i.t.pax t.t.pax)
 ::
-::  Deconstruct an http request into a json result or error information  
-::
-++  parse-json  
-  |=  res/httr  ^-  (each json {err/term inf/(list {term json})})
-  ?~  r.res
-    [%| %empty-response code+(jone p.res) ~]
-  =+  jon=(rush q.u.r.res apex:poja)
-  ?~  jon
-    [%| %bad-json code+(jone p.res) body+s+q.u.r.res ~]
-  ?.  =(2 (div p.res 100))
-    [%| %request-rejected code+(jone p.res) msg+u.jon ~]
-  [%& u.jon]
-::
-::  Anywhere recieved data should go besides the initiating request
-::
-++  side-effects
-  |=  {pax/path rep/(each json ^)}  ^-  (list move)
-  ?.  ?=($& -.rep)  ~                 ::  XX logging maybe?
-  ?~  pax  ~
-  ?+    -.pax  ~
-      $user
-    =+  =;  jop  usr=(need (jop p.rep))
-        (ot login+so url+(cu some (su aurf:urlp)) ~):jo
-    [ost.hid %poke user+~ [our.hid %hood] %write-plan-account ~.github usr]~
-  ==
-::
 ::  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)
+  ?.  ?=({care @ @ @ *} way)
-    ~&  bad-wire+[way res=res]
+    ~&  res=res
     [~ +>.$]
-  =+  ^-  {ren/care {syl/term arg/path} pax/path}
+  =+  arg=(path (cue (slav %uv i.t.t.way)))
-      [i.t.way (need (puck i.t.t.way)) t.t.t.way]
+  =*  pax  t.t.t.way
-  :_  +>.$
+  :_  +>.$  :_  ~
-  =+  rep=(parse-json res)
-  :_  (side-effects pax rep)
   :+  ost.hid  %diff
-  ?+    ren  null+~
+  ?+    i.way  null+~
       $x
-    ?.  ?=($& -.rep)
+    ?~  r.res
-      json+(jobe err+s+err.p.rep inf.p.rep)
+      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 ~)
+    ?+    +.pax  ~&([%sigh-strange-path pax] null+~)
+        {$issues $mine $~}
+      =+  issues=((ar:jo issue:gh-parse) u.jon)
+      ?~  issues
+        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
+        null+~
+      gh-list-issues+u.issues
     ::
-    ::  Once we know we have good data, we drill into the JSON
+        {$issues $by-repo @t @t $~}
-    ::  to find the specific piece of data referred to by 'arg'
+      =+  issues=((ar:jo issue:gh-parse) u.jon)
-    ::
+      ?~  issues
-    |-  ^-  sub-result
+        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-    ?~  arg
+        null+~
-      json+p.rep
+      gh-list-issues+u.issues
-    =+  dir=((om:jo some) p.rep)
+    ==
-    ?~  dir
+    ::  ::
-      json+(jobe err+s+%json-not-object code+(jone p.res) body+p.rep ~)
+    ::  ::  Once we know we have good data, we drill into the JSON
-    =+  new-jon=(~(get by u.dir) i.arg)
+    ::  ::  to find the specific piece of data referred to by 'arg'
-    $(arg t.arg, p.rep ?~(new-jon ~ u.new-jon))
+    ::  ::
+    ::  |-  ^-  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
-    ?.  ?=($& -.rep)
+    ?~  r.res
-      ~&  [%scry-gh-y err.p.rep inf.p.rep]
+      ~&  [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
+    ?+    +.pax  ~&([%sigh-strange-path pax] arch+*arch)
+        {$issues $mine $~}
+      =+  issues=((ar:jo issue:gh-parse) u.jon)
+      ?~  issues
+        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
+        arch+*arch
+      :+  %arch  `(shax (jam u.issues))
+      (malt (turn u.issues |=(issue:gh [id ~])))
     ::
-    ::  Once we know we have good data, we drill into the JSON
+        {$issues $by-repo @t $~}
-    ::  to find the specific piece of data referred to by 'arg'
+      =+  repos=((ar:jo repository:gh-parse) u.jon)
+      ?~  repos
+        ~&  [err+s+%response-not-repos pax+pax code+(jone p.res) msg+u.jon]
+        arch+*arch
+      :+  %arch  `(shax (jam u.repos))
+      (malt (turn u.repos |=(repository:gh [name ~])))
     ::
-    |-  ^-  sub-result
+        {$issues $by-repo @t @t $~}
-    =+  dir=((om:jo some) p.rep)
+      =+  issues=((ar:jo issue:gh-parse) u.jon)
-    ?~  dir
+      ?~  issues
-      [%arch `(shax (jam p.rep)) ~]
+        ~&  [err+s+%response-not-issues pax+pax code+(jone p.res) msg+u.jon]
-    ?~  arg
+        arch+*arch
-      [%arch `(shax (jam p.rep)) (~(run by u.dir) _~)]
+      :+  %arch  `(shax (jam u.issues))
-    =+  new-jon=(~(get by u.dir) i.arg)
+      (malt (turn u.issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~])))
-    $(arg t.arg, p.rep ?~(new-jon ~ u.new-jon))
+    ==
+    ::  ::
+    ::  ::  Once we know we have good data, we drill into the JSON
+    ::  ::  to find the specific piece of data referred to by 'arg'
+    ::  ::
+    ::  |-  ^-  sub-result
+    ::  =+  dir=((om:jo some) u.jon)
+    ::  ?~  dir
+    ::    [%arch `(shax (jam u.jon)) ~]
+    ::  ?~  arg
+    ::    [%arch `(shax (jam u.jon)) (~(run by u.dir) _~)]
+    ::  =+  new-jon=(~(get by u.dir) i.arg)
+    ::  $(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
   ==
 ::
 ++  sigh-tang
   |=  {way/wire tan/tang}
   ^-  {(list move) _+>.$}
-  ((slog >%gh-sigh-tang way< tan) `+>.$)
+  ((slog >%gh-sigh-tang< tan) `+>.$)
 ::
 ::  We can't actually give the response to pretty much anything
 ::  without blocking, so we just block unconditionally.