shrub/app/gh.hoon

382 lines
11 KiB
Plaintext
Raw Normal View History

2016-01-28 00:50:06 +03:00
:: This is a driver for the Github API v3.
::
:: You can interact with this in a few different ways:
::
2016-01-29 03:05:36 +03:00
:: - .^(%gx /=gh=/read{/endpoint}) or subscribe to
:: /scry/x/read{/endpoint} for authenticated reads.
2016-01-28 00:50:06 +03:00
::
:: - 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.
2016-01-29 03:05:36 +03:00
::
2016-02-03 02:41:04 +03:00
/? 314
2016-03-30 00:17:45 +03:00
/- gh, plan-acct
2016-04-06 01:52:48 +03:00
/+ gh-parse
2016-02-03 02:41:04 +03:00
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
// /%/split
::
!:
2016-01-21 02:06:50 +03:00
=> |%
++ move (pair bone card)
++ sub-result
$% {$arch arch}
2016-04-06 01:52:48 +03:00
{$gh-list-issues (list issue:gh)}
{$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
{$json json}
{$null $~}
2016-01-21 02:06:50 +03:00
==
++ card
$% {$diff sub-result}
{$them wire (unit hiss)}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
2016-01-21 02:06:50 +03:00
==
2016-01-28 00:50:06 +03:00
++ hook-response
$% {$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
2016-01-28 00:50:06 +03:00
==
2016-01-21 02:06:50 +03:00
--
2016-02-03 02:41:04 +03:00
::
|_ {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
2016-04-06 01:52:48 +03:00
++ prep _`.
2016-01-28 00:50:06 +03:00
::
:: This core manages everything related to a particular request.
::
:: Each request has a particular 'style', which is currently
2016-01-29 03:05:36 +03:00
:: one of 'read', or 'listen'. ++scry handles all three types
:: of requests.
::
2016-01-26 04:13:08 +03:00
++ help
|= {ren/care style/@tas pax/path}
2016-04-06 01:52:48 +03:00
:: =^ arg pax [+ -]:(split pax)
=| arg/path
=| mow/(list move)
2016-01-26 04:13:08 +03:00
|%
2016-01-28 00:50:06 +03:00
:: Resolve core.
2016-01-29 03:05:36 +03:00
::
2016-01-26 04:13:08 +03:00
++ abet
^- {(list move) _+>.$}
2016-01-26 04:13:08 +03:00
[(flop mow) +>.$]
2016-01-28 00:50:06 +03:00
::
2016-04-06 01:52:48 +03:00
:: 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 ~ ~)
::
2016-01-28 00:50:06 +03:00
:: Append path to api.github.com and parse to a purl.
2016-01-29 03:05:36 +03:00
::
2016-02-03 02:41:04 +03:00
++ endpoint-to-purl
|= endpoint/path
2016-02-03 02:41:04 +03:00
(scan "https://api.github.com{<`path`endpoint>}" auri:epur)
2016-01-28 00:50:06 +03:00
::
2016-01-29 03:05:36 +03:00
:: Send a hiss
::
2016-01-26 04:13:08 +03:00
++ send-hiss
|= hiz/hiss
2016-01-26 04:13:08 +03:00
^+ +>
2016-04-06 01:52:48 +03:00
=+ wir=`wire`[ren (scot %ud cnt) (scot %uv (jam arg)) style pax]
(send ost.hid %hiss wir `~ %httr [%hiss hiz])
::
:: Send a %get hiss
::
++ get
|= endpoint/path
(send-hiss (endpoint-to-purl endpoint) %get ~ ~)
2016-01-28 00:50:06 +03:00
::
:: Decide how to handle a request based on its style.
2016-01-29 03:05:36 +03:00
::
2016-01-21 02:06:50 +03:00
++ scry
2016-01-26 04:13:08 +03:00
^+ .
2016-04-06 01:52:48 +03:00
?+ style ~|([%invalid-style style] !!)
$read ?+(ren ~&([%invalid-care ren] !!) $x read-x, $y read-y)
$listen listen
2016-01-21 02:06:50 +03:00
==
2016-01-28 00:50:06 +03:00
::
2016-04-06 01:52:48 +03:00
++ 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 [+< ~])))
==
2016-01-28 00:50:06 +03:00
::
:: Create or update a webhook to listen for a set of events.
2016-01-29 03:05:36 +03:00
::
2016-01-21 02:06:50 +03:00
++ listen
2016-01-26 04:13:08 +03:00
^+ .
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ events=t.t.paf
|- ^+ +>+.$
2016-01-28 00:50:06 +03:00
?~ events
+>+.$
2016-01-28 00:50:06 +03:00
?: (~(has by hook) i.events)
=. +>+.$ (update-hook i.events)
2016-01-28 00:50:06 +03:00
$(events t.events)
=. +>+.$ (create-hook i.events)
2016-01-28 00:50:06 +03:00
$(events t.events)
::
:: Set up a webhook.
2016-01-29 03:05:36 +03:00
::
2016-01-21 02:06:50 +03:00
++ create-hook
|= event/@t
2016-01-26 04:13:08 +03:00
^+ +>
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ clean-event=`tape`(turn (trip event) |=(a/@tD ?:(=('_' a) '-' a)))
2016-01-28 00:50:06 +03:00
=. hook
%+ ~(put by hook) (crip clean-event)
=+ %+ fall
(~(get by hook) (crip clean-event))
*{id/@t listeners/(set bone)}
2016-01-28 00:50:06 +03:00
[id (~(put in listeners) ost.hid)]
2016-01-26 04:13:08 +03:00
%- send-hiss
2016-01-29 03:05:36 +03:00
:* %+ scan
=+ [(trip i.paf) (trip i.t.paf)]
2016-01-21 02:06:50 +03:00
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:epur
2016-01-26 22:03:31 +03:00
%post ~ ~
2016-01-21 02:06:50 +03:00
%- taco %- crip %- pojo %- jobe :~
name+s+%web
active+b+&
events+a+~[s+event] ::(turn `(list ,@t)`t.t.pax |=(a=@t s/a))
2016-01-21 02:06:50 +03:00
:- %config
%- jobe :~
2016-01-28 00:50:06 +03:00
=+ =+ clean-event
"http://107.170.195.5:8443/~/to/gh/gh-{-}.json?anon&wire=/"
[%url s+(crip -)]
[%'content_type' s+%json]
2016-01-21 02:06:50 +03:00
==
==
==
2016-01-28 00:50:06 +03:00
::
:: Add current bone to the list of subscribers for this event.
2016-01-29 03:05:36 +03:00
::
2016-01-21 02:06:50 +03:00
++ update-hook
|= event/@t
2016-01-26 04:13:08 +03:00
^+ +>
=+ hok=(~(got by hook) event)
%_ +>.$
hook
%+ ~(put by hook) event
hok(listeners (~(put in listeners.hok) ost.hid))
2016-01-21 02:06:50 +03:00
==
--
::
2016-02-03 02:41:04 +03:00
:: Pokes that aren't caught in more specific arms 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.
2016-01-29 03:05:36 +03:00
::
2016-01-28 00:50:06 +03:00
++ poke
|= response/hook-response
^- {(list move) _+>.$}
2016-01-28 00:50:06 +03:00
=+ hook-data=(~(get by hook) (rsh 3 3 -.response))
?~ hook-data
~& [%strange-hook hook response]
2016-02-03 02:41:04 +03:00
[~ +>.$]
:: ~& response=response
2016-01-28 00:50:06 +03:00
:_ +>.$
%+ turn (~(tap in listeners.u.hook-data))
|= ost/bone
2016-01-28 00:50:06 +03:00
[ost %diff response]
2016-01-21 03:49:13 +03:00
::
2016-02-03 02:41:04 +03:00
:: Here we handle PUT, POST, and DELETE requests. We probably
:: should return the result somehow, but that doesn't fit well
:: into poke semantics.
::
++ poke-gh-poke
2016-03-09 04:19:28 +03:00
|= {method/meth endpoint/(list @t) jon/json}
^- {(list move) _+>.$}
2016-02-03 02:41:04 +03:00
:_ +>.$ :_ ~
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
2016-03-09 04:19:28 +03:00
~| stuff="https://api.github.com{<(path endpoint)>}"
(scan "https://api.github.com{<(path endpoint)>}" auri:epur)
2016-02-03 02:41:04 +03:00
method ~ `(taco (crip (pojo jon)))
==
::
2016-01-28 00:50:06 +03:00
:: 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.
2016-01-29 03:05:36 +03:00
::
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care ^} pax)
2016-01-29 03:05:36 +03:00
:: =- ~& [%peered -] -
2016-02-03 02:41:04 +03:00
[abet(cnt +(cnt))]:scry:(help i.pax i.t.pax t.t.pax)
2016-01-26 04:13:08 +03:00
::
2016-01-28 00:50:06 +03:00
:: HTTP response. We make sure the response is good, then
:: produce the result (as JSON) to whoever sent the request.
2016-01-29 03:05:36 +03:00
::
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
2016-04-06 01:52:48 +03:00
?. ?=({care @ @ @ *} way)
~& res=res
2016-02-03 02:41:04 +03:00
[~ +>.$]
2016-04-06 01:52:48 +03:00
=+ arg=(path (cue (slav %uv i.t.t.way)))
=* pax t.t.t.way
:_ +>.$ :_ ~
2016-02-03 02:41:04 +03:00
:+ ost.hid %diff
2016-04-06 01:52:48 +03:00
?+ i.way null+~
$x
2016-04-06 01:52:48 +03:00
?~ 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 ~)
?+ +.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
2016-02-03 02:41:04 +03:00
::
2016-04-06 01:52:48 +03:00
{$issues $by-repo @t @t $~}
=+ 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
:: :: to find the specific piece of data referred to by 'arg'
:: ::
:: |- ^- 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))
2016-01-29 03:05:36 +03:00
::
$y
2016-04-06 01:52:48 +03:00
?~ 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
2016-04-06 01:52:48 +03:00
?. =(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 ~])))
2016-02-03 02:41:04 +03:00
::
2016-04-06 01:52:48 +03:00
{$issues $by-repo @t $~}
=+ 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 ~])))
2016-02-03 02:41:04 +03:00
::
2016-04-06 01:52:48 +03:00
{$issues $by-repo @t @t $~}
=+ 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 [(rsh 3 2 (scot %ui number)) ~])))
==
:: ::
:: :: 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))
2016-01-29 03:05:36 +03:00
==
2016-01-21 02:06:50 +03:00
::
++ sigh-tang
|= {way/wire tan/tang}
^- {(list move) _+>.$}
2016-04-06 01:52:48 +03:00
((slog >%gh-sigh-tang< tan) `+>.$)
::
2016-01-28 00:50:06 +03:00
:: We can't actually give the response to pretty much anything
:: without blocking, so we just block unconditionally.
2016-01-29 03:05:36 +03:00
::
2016-01-21 02:06:50 +03:00
++ peek
|= {ren/@tas tyl/path}
^- (unit (unit (pair mark *)))
2016-01-21 03:49:13 +03:00
~ ::``noun/[ren tyl]
2016-01-21 02:06:50 +03:00
--