urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-03 05:43:18 +03:00
Code Issues Packages Projects Releases Wiki Activity

generalized endpoint translation

Browse Source
This commit is contained in:
Philip C Monk 2016-04-05 20:44:04 -04:00
parent 1e6d290243
commit c66fe58402
2 changed files with 151 additions and 323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

295
app/gh.hoon
View File

@ -7,20 +7,23 @@
::
:: - subscribe to /scry/x/listen/{owner}/{repo}/{events...}
:: for webhook-powered event notifications. For event list,
:: see https://developer.github.com/webhooks/.
:: see kttps://developer.github.com/webhooks/.
::
:: See the %github app for example usage.
::
/? 314
/- gh, plan-acct
/+ gh-parse
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
// /%/split
::
!:
=> |%
++ place
$: guard/mold
read-x/$-(path move)
read-y/$-(path move)
sigh-x/$-(jon/json (unit sub-result))
sigh-y/$-(jon/json (unit arch))
==
++ move (pair bone card)
++ sub-result
$% {$arch arch}
@ -44,6 +47,106 @@
|_ {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
++ prep _`.
::
:: List of endpoints
::
++ places
|= wir/wire
=<
^- (list place)
:~ ^- place
:* guard=$~
read-x=read-null
read-y=(read-static %issues ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place
:* guard={$issues $~}
read-x=read-null
read-y=(read-static %mine %by-repo ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place
:* guard={$issues $mine $~}
read-x=(read-get /issues)
read-y=(read-get /issues)
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place
:* guard={$issues $by-repo $~}
read-x=read-null
^= read-y
|= pax/path
=+ /(scot %p our.hid)/home/(scot %da now.hid)/web/plan
=+ .^({* acc/(map knot plan-acct)} %cx -)
::
((read-static usr:(~(got by acc) %github) ~) pax)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place
:* guard={$issues $by-repo @t $~}
read-x=read-null
read-y=|=(pax/path (get /users/[-.+>.pax]/repos))
sigh-x=sigh-strange
^= sigh-y
|= jon/json
%+ bind ((ar:jo repository:gh-parse) jon)
|= repos/(list repository:gh)
:- `(shax (jam repos))
(malt (turn repos |=(repository:gh [name ~])))
==
^- place
:* guard={$issues $by-repo @t @t $~}
read-x=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
read-y=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
==
=>
|% :: generic helpers (should be library)
++ read-null |=(pax/path [ost.hid %diff %null ~])
++ read-static
|= children/(list @t)
|= pax/path
[ost.hid %diff %arch ~ (malt (turn children |=(@t [+< ~])))]
::
++ read-get
|= endpoint/path
|= pax/path
(get endpoint)
::
++ sigh-strange |=(jon/json ~)
::
++ get
|= endpoint/path
^- move
:* ost.hid %hiss wir `~ %httr %hiss
(endpoint-to-purl endpoint) %get ~ ~
==
::
++ endpoint-to-purl
|= endpoint/path
(scan "https://api.github.com{<`path`endpoint>}" auri:epur)
--
|% :: gh-specific helpers
++ sigh-list-issues-x
|= jon/json
%+ bind ((ar:jo issue:gh-parse) jon)
|= issues/(list issue:gh)
gh-list-issues+issues
::
++ sigh-list-issues-y
|= jon/json
%+ bind ((ar:jo issue:gh-parse) jon)
|= issues/(list issue:gh)
:- `(shax (jam issues))
(malt (turn issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~])))
--
::
:: This core manages everything related to a particular request.
::
:: Each request has a particular 'style', which is currently
@ -68,93 +171,36 @@
|= 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
|= endpoint/path
(scan "https://api.github.com{<`path`endpoint>}" auri:epur)
::
:: Send a hiss
::
++ send-hiss
|= hiz/hiss
^+ +>
=+ wir=`wire`[ren (scot %ud cnt) (scot %uv (jam arg)) style pax]
=+ wir=`wire`[ren style pax]
(send ost.hid %hiss wir `~ %httr [%hiss hiz])
::
:: 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] !!)
$read ?+(ren ~&([%invalid-care ren] !!) $x read-x, $y read-y)
$read read
$listen listen
==
::
++ 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)
==
==
==
:: Match to the endpoint in ++places and execute read-x or read-y
::
++ 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 [+< ~])))
==
++ read
~& [%read pax]
=+ places=(places ren style pax)
|- ^+ +>.$
?~ places
~& [%strange-path pax]
(send ost.hid %diff ?+(ren !! $x null+~, $y arch+*arch))
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
(send (?+(ren !! $x read-x.i.places, $y read-y.i.places) pax))
::
:: Create or update a webhook to listen for a set of events.
::
@ -272,14 +318,15 @@
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
?. ?=({care @ @ @ *} way)
?. ?=({care ?($read $listen) @ *} way)
~& res=res
[~ +>.$]
=+ arg=(path (cue (slav %uv i.t.t.way)))
=* pax t.t.t.way
=* ren i.way
=* style i.t.way
=* pax t.t.way
:_ +>.$ :_ ~
:+ ost.hid %diff
?+ i.way null+~
?+ ren null+~
$x
?~ r.res
json+(jobe err+s+%empty-response code+(jone p.res) ~)
@ -288,33 +335,18 @@
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
::
{$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))
=+ places=(places ren style pax)
|- ^- sub-result
?~ places
~&([%sigh-strange-path pax] null+~)
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
=+ (sigh-x.i.places u.jon)
?~ -
~& [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
null+~
u.-
::
$y
?~ r.res
@ -327,43 +359,18 @@
?. =(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 ~])))
::
{$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 ~])))
::
{$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))
=+ places=(places ren style pax)
|- ^- sub-result
?~ places
~&([%sigh-strange-path pax] arch+*arch)
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
=+ (sigh-y.i.places u.jon)
?~ -
~& [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
arch+*arch
arch+u.-
==
::
++ sigh-tang

179
app/gh/split.hoon
View File

@ -1,179 +0,0 @@
!:
|%
:: Splits a path into the endpoint prefix and the remainder,
:: which is assumed to be a path within the JSON object. We
:: choose the longest legal endpoint prefix.
::
++ split
|= pax/path
:: =- ~& [%pax pax - (valid-endpoint pax)] -
=+ l=(lent pax)
|- ^- {path path}
?~ l
[~ pax]
?: ?=(valid-endpoint (scag l pax))
[(scag l pax) (slag l pax)]
$(l (dec l))
::
:: These are all the github GET endpoints, sorted with
:: `env LC_ALL=C sort`
::
++ valid-endpoint
$? {$emojis $~}
{$events $~}
{$feeds $~}
{$gists $public $~}
{$gists $starred $~}
{$gists gist-id/@ta $comments id/@ta $~}
{$gists gist-id/@ta $comments $~}
{$gists id/@ta $commits $~}
{$gists id/@ta $forks $~}
{$gists id/@ta $star $~}
{$gists id/@ta sha/@ta $~}
{$gists id/@ta $~}
{$gists $~}
{$gitignore $templates language/@ta $~}
{$gitignore $templates $~}
{$issues $~}
{$licenses license/@ta $~}
{$licenses $~}
{$meta $~}
{$networks onwer/@ta repo/@ta $events $~}
{$notifications $threads id/@ta $subscription $~}
{$notifications $threads id/@ta $~}
{$notifications $~}
{$organizations $~}
{$orgs org/@ta $events $~}
{$orgs org/@ta $hooks id/@ta $~}
{$orgs org/@ta $hooks $~}
{$orgs org/@ta $members username/@ta $~}
{$orgs org/@ta $members $~}
{$orgs org/@ta $memberships username/@ta $~}
{$orgs org/@ta $migrations id/@ta $archive $~}
{$orgs org/@ta $migrations id/@ta $~}
{$orgs org/@ta $migrations $~}
{$orgs org/@ta $'public_members' username/@ta $~}
{$orgs org/@ta $'public_members' $~}
{$orgs org/@ta $repos $~}
{$orgs org/@ta $teams $~}
{$orgs org/@ta $~}
{$'rate_limit' $~}
{$repos owner/@ta repo/@ta $assignees assignee/@ta $~}
{$repos owner/@ta repo/@ta $assignees $~}
{$repos owner/@ta repo/@ta $branches branch/@ta $~}
{$repos owner/@ta repo/@ta $branches $~}
{$repos owner/@ta repo/@ta $collaborators username/@ta $~}
{$repos owner/@ta repo/@ta $collaborators $~}
{$repos owner/@ta repo/@ta $comments id/@ta $~}
{$repos owner/@ta repo/@ta $comments $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $comments $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $status $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $statuses $~}
{$repos owner/@ta repo/@ta $commits sha/@ta $~}
{$repos owner/@ta repo/@ta $commits $~}
{$repos owner/@ta repo/@ta $compare base-head/@ta $~}
{$repos owner/@ta repo/@ta $contents path/@ta $~}
{$repos owner/@ta repo/@ta $contributors $~}
{$repos owner/@ta repo/@ta $deployments id/@ta $statuses $~}
{$repos owner/@ta repo/@ta $deployments $~}
{$repos owner/@ta repo/@ta $events $~}
{$repos owner/@ta repo/@ta $forks $~}
{$repos owner/@ta repo/@ta $git $blobs sha/@ta $~}
{$repos owner/@ta repo/@ta $git $commits sha/@ta $~}
{$repos owner/@ta repo/@ta $git $refs ref/@ta $~}
{$repos owner/@ta repo/@ta $git $refs $~}
{$repos owner/@ta repo/@ta $git $tags sha/@ta $~}
{$repos owner/@ta repo/@ta $git $trees sha/@ta $~}
{$repos owner/@ta repo/@ta $hooks id/@ta $~}
{$repos owner/@ta repo/@ta $hooks $~}
{$repos owner/@ta repo/@ta $issues $comments id/@ta $~}
{$repos owner/@ta repo/@ta $issues $comments $~}
{$repos owner/@ta repo/@ta $issues $events id/@ta $~}
{$repos owner/@ta repo/@ta $issues $events $~}
{$repos owner/@ta repo/@ta $issues issue-number/@ta $events $~}
{$repos owner/@ta repo/@ta $issues number/@ta $comments $~}
{$repos owner/@ta repo/@ta $issues number/@ta $labels $~}
{$repos owner/@ta repo/@ta $issues number/@ta $~}
{$repos owner/@ta repo/@ta $issues $~}
{$repos owner/@ta repo/@ta $keys id/@ta $~}
{$repos owner/@ta repo/@ta $keys $~}
{$repos owner/@ta repo/@ta $labels name/@ta $~}
{$repos owner/@ta repo/@ta $labels $~}
{$repos owner/@ta repo/@ta $language $~}
{$repos owner/@ta repo/@ta $license $~}
{$repos owner/@ta repo/@ta $milestones number/@ta $labels $~}
{$repos owner/@ta repo/@ta $milestones number/@ta $~}
{$repos owner/@ta repo/@ta $milestones $~}
{$repos owner/@ta repo/@ta $notifications $~}
{$repos owner/@ta repo/@ta $pages $builds $latest $~}
{$repos owner/@ta repo/@ta $pages $builds $~}
{$repos owner/@ta repo/@ta $pages $~}
{$repos owner/@ta repo/@ta $pulls $comments id/@ta $~}
{$repos owner/@ta repo/@ta $pulls $comments $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $comments $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $commits $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $files $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $merge $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $~}
{$repos owner/@ta repo/@ta $pulls $~}
{$repos owner/@ta repo/@ta $readme $~}
{$repos owner/@ta repo/@ta $releases $assets id/@ta $~}
{$repos owner/@ta repo/@ta $releases $latest $~}
{$repos owner/@ta repo/@ta $releases $tags tag/@ta $~}
{$repos owner/@ta repo/@ta $releases id/@ta $assets $~}
{$repos owner/@ta repo/@ta $releases id/@ta $~}
{$repos owner/@ta repo/@ta $releases $~}
{$repos owner/@ta repo/@ta $stargazers $~}
{$repos owner/@ta repo/@ta $stats $'commit_activity' $~}
{$repos owner/@ta repo/@ta $stats $contributors $~}
{$repos owner/@ta repo/@ta $stats $participation $~}
{$repos owner/@ta repo/@ta $stats $'punch_card' $~}
{$repos owner/@ta repo/@ta $subscribers $~}
{$repos owner/@ta repo/@ta $subscription $~}
{$repos owner/@ta repo/@ta $tags $~}
{$repos owner/@ta repo/@ta $teams $~}
{$repos owner/@ta repo/@ta archive-format/@ta ref/@ta $~}
{$repos owner/@ta repo/@ta $~}
{$repositories $~}
{$search $code $~}
{$search $issues $~}
{$search $repositories $~}
{$search $users $~}
{$teams id/@ta $members $~}
{$teams id/@ta $memberships username/@ta $~}
{$teams id/@ta $repos owner/@ta repo/@ta $~}
{$teams id/@ta $~}
{$user $emails $~}
{$user $followers $~}
{$user $following username/@ta $~}
{$user $following $~}
{$user $issues $~}
{$user $keys id/@ta $~}
{$user $keys $~}
{$user $memberships $orgs org/@ta $~}
{$user $memberships $orgs $~}
{$user $orgs $~}
{$user $repos $~}
{$user $starred owner/@ta repo/@ta $~}
{$user $starred $~}
{$user $subscriptions $~}
{$user $teams $~}
{$user username/@ta $orgs $~}
{$user $~}
{$users username/@ta $events $orgs org/@ta $~}
{$users username/@ta $events $public $~}
{$users username/@ta $events $~}
{$users username/@ta $followers $~}
{$users username/@ta $following target-user/@ta $~}
{$users username/@ta $following $~}
{$users username/@ta $gists $~}
{$users username/@ta $keys $~}
{$users username/@ta $'received_events' $public $~}
{$users username/@ta $'received_events' $~}
{$users username/@ta $starred $~}
{$users username/@ta $subscriptions $~}
{$users username/@ta $~}
{$users usernmae/@ta $repos $~}
{$users $~}
==
--