Merge branches 'breach-20160302' and 'cgyarvin-teaching', remote-tracking branches 'ohaitch/talk-read-component', 'ohaitch/virtualize-pact-hoon' and 'ohaitch/eyre-sec'

Conflicts:
	arvo/eyre.hoon

Breaching changes for 2016-03-02
Language/dojo improvements for teaching.
add web/listen.hoon module for listening to comment changes
virtualize ++pact %hoon side-path
Eyre security drivers
This commit is contained in:
Raymond Pasco 2016-03-02 21:21:23 -05:00
42 changed files with 2192 additions and 174 deletions

View File

@ -1,13 +1,13 @@
:: :: ::
:::: /hoon/dojo/app :: ::::
:: :: ::
/? 310 :: arvo kelvin
/? 314 :: arvo kelvin
/- sole :: console structures
/+ sole :: console library
[. sole]
:: :: ::
:::: :: ::::
:: :: ::
!: :: ::
=> |% :: external structures
++ house :: all state
$: $4
@ -32,7 +32,7 @@
{$pill p/path} :: noun to unix pill
:: {$tree p/path} :: noun to unix tree
{$file p/beam} :: save to clay
{$http p/?($post $put) q/purl} :: http outbound
{$http p/?($post $put) q/iden r/purl} :: http outbound
{$poke p/goal} :: poke app
{$show p/?($0 $1 $2 $3)} :: print val+span+twig
{$verb p/term} :: store variable
@ -41,8 +41,8 @@
$: p/@ud :: assembly index
q/dojo-build :: general build
== ::
++ dojo-build :: one ford step
$% {$ur p/purl} :: http GET request
++ dojo-build :: one arvo step
$% {$ur p/iden q/purl} :: http GET request
{$ge p/dojo-model} :: generator
{$dv p/path} :: core from source
{$ex p/twig} :: hoon expression
@ -87,7 +87,7 @@
++ card :: general card
$% {$diff $sole-effect sole-effect} ::
{$send wire {ship term} clap} ::
{$hiss wire mark {$hiss hiss}} ::
{$hiss wire {$~ iden} mark {$hiss hiss}} ::
{$exec wire @p (unit {beak silk})} ::
{$deal wire sock term club} ::
{$info wire @p toro} ::
@ -167,8 +167,8 @@
;~(plug (cold %file tar) dp-beam)
;~(plug (cold %flat pat) (most fas qut))
;~(plug (cold %pill dot) (most fas sym))
;~(plug (cold %http lus) (easy %post) auri:epur)
;~(plug (cold %http hep) (easy %put) auri:epur)
;~(plug (cold %http lus) (easy %post) dp-iden-url)
;~(plug (cold %http hep) (easy %put) dp-iden-url)
(stag %show (cook $?($1 $2 $3) (cook lent (stun [1 3] wut))))
==
++ dp-hooves :: hoof list
@ -198,7 +198,7 @@
++ dp-build :: ++dojo-build
%+ knee *dojo-build |. ~+
;~ pose
;~(plug (cold %ur lus) auri:epur)
;~(plug (cold %ur lus) dp-iden-url)
;~(plug (cold %ge lus) dp-model)
;~(plug (cold %as pam) sym ;~(pfix ace dp-source))
;~(plug (cold %do cab) dp-twig ;~(pfix ace dp-source))
@ -220,6 +220,9 @@
=+ vez=(vang | dp-path)
(sear plex:vez (stag %conl poor:vez))
::
++ dp-iden-url
(cook |=({a/(unit iden) b/purl} [(fall a *iden) b]) auru:epur)
::
++ dp-model ;~(plug dp-server dp-config) :: ++dojo-model
++ dp-path (tope he-beam) :: ++path
++ dp-server (stag 0 (most fas sym)) :: ++dojo-server
@ -266,10 +269,10 @@
(he-card(poy `+>+<(pux `way)) %exec way our.hid `[he-beak kas])
::
++ dy-eyre :: send work to eyre
|= {way/wire req/hiss}
|= {way/wire usr/iden req/hiss}
^+ +>+>
?> ?=($~ pux)
(he-card(poy `+>+<(pux `way)) %hiss way %httr %hiss req)
(he-card(poy `+>+<(pux `way)) %hiss way `usr %httr %hiss req)
::
++ dy-stop :: stop work
^+ +>
@ -481,7 +484,7 @@
?> ?=($mime p.cay)
=+ mim=;;(mime q.q.cay)
=+ maf=(~(add ja *math) %content-span (moon p.mim))
(dy-eyre /show [q.p.mad p.p.mad maf ~ q.mim])
(dy-eyre /show q.p.mad [r.p.mad p.p.mad maf ~ q.mim])
::
$show
%+ dy-print cay
@ -506,7 +509,8 @@
:- "HTTP {<p.hit>}"
%+ weld
(turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}"))
(turn `wain`?~(r.hit ~ (lore q.u.r.hit)) trip)
:- i=""
t=(turn `wain`?~(r.hit ~ (lore q.u.r.hit)) trip)
==
::
++ dy-show-span-noun
@ -533,7 +537,7 @@
++ dy-shown
$? twig
$^ {dy-shown dy-shown}
$% {$ur purl}
$% {$ur iden purl}
{$dv path}
{$as mark dy-shown}
{$do twig dy-shown}
@ -584,7 +588,7 @@
++ dy-cage |=(num/@ud (~(got by rez) num)) :: known cage
++ dy-vase |=(num/@ud q:(dy-cage num)) :: known vase
++ dy-silk-vase |=(vax/vase [%$ %noun vax]) :: vase to silk
++ dy-silk-sources :: sources to silk
++ dy-silk-sources :: arglist to silk
|= src/(list dojo-source) ^- silk
%- dy-silk-vase
|-
@ -594,6 +598,18 @@
++ dy-silk-config :: configure
|= {cay/cage cig/dojo-config}
^- {wire silk}
?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay)
::
:: naked gate
::
?. &(?=({* $~} p.cig) ?=($~ q.cig))
~|(%one-argument !!)
:- /noun
:+ %call (dy-silk-vase q.cay)
(dy-silk-vase (dy-vase p.i.p.cig))
::
:: normal generator
::
:- ?+ -.q.q.cay ~|(%bad-gen ~_((sell (slot 2 q.cay)) !!))
$say /gent
$ask /dial
@ -662,7 +678,7 @@
$|
=+ hiz=;;(hiss +<.q.vax)
=. ..dy (he-diff %tan leaf+"< {(earn p.hiz)}" ~)
(dy-eyre(pro `(slap (slot 7 vax) limb+%q)) /scar hiz)
(dy-eyre(pro `(slap (slot 7 vax) limb+%q)) /scar ~. hiz)
==
::
++ dy-sigh-scar :: scraper result
@ -676,12 +692,16 @@
|= cag/cage
(dy-meal q.cag)
::
++ dy-made-noun :: generator product
|= cag/cage
(dy-hand %noun q.cag)
::
++ dy-make :: build step
^+ +>
?> ?=(^ cud)
=+ bil=q.u.cud :: XX =*
?: ?=($ur -.bil)
(dy-eyre /hand [p.bil %get ~ ~])
(dy-eyre /hand p.bil [q.bil %get ~ ~])
%- dy-ford
^- (pair path silk)
?- -.bil
@ -853,6 +873,7 @@
{$hand $~} dy-hand:dye
{$dial $~} dy-made-dial:dye
{$gent $~} dy-made-gent:dye
{$noun $~} dy-made-noun:dye
{$scar $~} dy-made-scar:dye
{$edit $~} dy-made-edit:dye
==

269
app/gh.hoon Normal file
View File

@ -0,0 +1,269 @@
:: 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
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
// /%/split
::
!:
=> |%
++ 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 pax [+ -]:(split pax)
=| mow/(list move)
|%
:: Resolve core.
::
++ abet
^- {(list move) _+>.$}
[(flop mow) +>.$]
::
:: 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]
=+ new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]
:: ~& [%sending-hiss new-move]
+>.$(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 (endpoint-to-purl pax) %get ~ ~)
::
:: Create or update a webhook to listen for a set of events.
::
++ listen
^+ .
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ events=t.t.paf
|- ^+ +>+.$
?~ events
+>+.$
?: (~(has by hook) i.events)
=. +>+.$ (update-hook i.events)
$(events t.events)
=. +>+.$ (create-hook i.events)
$(events t.events)
::
:: Set up a webhook.
::
++ create-hook
|= event/@t
^+ +>
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ 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.paf) (trip i.t.paf)]
"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
^+ +>
=+ hok=(~(got by hook) event)
%_ +>.$
hook
%+ ~(put by hook) event
hok(listeners (~(put in listeners.hok) ost.hid))
==
--
::
:: 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.
::
++ 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]
::
:: 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
|= {method/meth endpoint/path jon/json}
^- {(list move) _+>.$}
:_ +>.$ :_ ~
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
(scan "https://api.github.com{<`path`endpoint>}" auri:epur)
method ~ `(taco (crip (pojo jon)))
==
::
:: 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 +(cnt))]: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)
~& res=res
[~ +>.$]
=+ arg=(path (cue (slav %uv i.t.t.way)))
:_ +>.$ :_ ~
:+ ost.hid %diff
?+ 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 ~)
::
:: 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))
::
$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
::
:: 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< tan) `+>.$)
::
:: 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]
--

179
app/gh/split.hoon Normal file
View File

@ -0,0 +1,179 @@
!:
|%
:: 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 $~}
==
--

49
app/github.hoon Normal file
View File

@ -0,0 +1,49 @@
:: This is a command-line ui for the %gh Github driver.
::
:: Usage:
:: :github &path /read{/endpoint}
:: :github &path /listen/{owner}/{repo}/{events...}
::
/- gh
!:
=> |%
++ diff-result
$% {$gh-issue issues:gh}
{$gh-issue-comment issue-comment:gh}
==
--
|_ {hid/bowl *}
++ poke-path
|= pax/path
:_ +>.$ :_ ~
[ost.hid %peer /into-the-mist [our.hid %gh] scry+x+pax]
++ diff-gh-issues
|= {way/wire issues:gh}
%- %- slog :~
leaf+"in repository {(trip login.owner.repository)}/{(trip name.repository)}:"
leaf+"{(trip login.sender)} {(trip -.action)} issue #{<number.issue>} {<title.issue>}"
?+ -.action *tank
?($assigned $unassigned)
leaf+"to {(trip login.assignee.action)}"
?($labeled $unlabeled)
leaf+"with {(trip name.label.action)}"
==
==
[~ +>.$]
++ diff-gh-issue-comment
|= {way/wire issue-comment:gh}
%- %- slog :~
leaf+"in repository {(trip login.owner.repository)}/{(trip name.repository)}:"
leaf+"{(trip login.sender)} commented on issue #{<number.issue>} {<title.issue>}:"
leaf+(trip body.comment)
==
[~ +>.$]
++ diff-json
|= {way/wire jon/json}
~& jon
[~ +>.$]
++ peek
|= {ren/@tas tyl/path}
^- (unit (unit (pair mark *)))
``noun+[ren tyl]
--

282
app/gmail.hoon Normal file
View File

@ -0,0 +1,282 @@
:: Three ways we interactg with this app
:: 1. .^(%gx /=gh=/endpoint)
:: 2. [%peer [our %gh] /endpoint]
:: 3. :gh &gh-poke %post /gists json-data
:: 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
/- rfc, gmail-label, gmail-message
/+ http
::::
/= rfctext /: /%/rfc /txt/
::
// /%/split
::/- gmail
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
=> |% :: => only used for indentation
++ move (pair bone card)
++ subscription-result
$% {$arch arch}
{$json json}
{$null $~}
{$inbox (list {message-id/@t thread-id/@t})}
{$message from/@t subject/@t}
==
++ card
$% {$diff subscription-result}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
==
++ easy-ot |*({key/@t parser/fist:jo} =+(jo (ot [key parser] ~)))
++ ofis-google :: XX broken
=- |=(a/cord (rash a fel))
=< fel=(cook |~(a/@ `@t`(swap 3 a)) (bass 64 .))
=- (cook welp ;~(plug (plus siw) (stun 0^2 (cold %0 tis))))
^= siw
;~ pose
(cook |=(a/@ (sub a 'A')) (shim 'A' 'Z'))
(cook |=(a/@ (sub a 'G')) (shim 'a' 'z'))
(cook |=(a/@ (add a 4)) (shim '0' '9'))
(cold 62 (just '-'))
(cold 63 (just '_'))
==
--
::
|_ $: hid/bowl count/@
web-hooks/(map @t {id/@t listeners/(set bone)})
received-ids/(list @t)
==
:: We can't actually give the response to pretty much anything
:: without blocking, so we just block unconditionally.
::
++ prep ~& 'prep' _`. ::
::
++ peek
|= {ren/@tas pax/path}
^- (unit (unit (pair mark *)))
~
::
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care ^} pax) :: assert %u
=> (help i.pax i.t.pax t.t.pax)
=> scry
%= make-move
count +(count)
==
::
++ poke-gmail-req
|= $: method/meth endpoint/path quy/quay
mes/message:rfc
:: label-req:gmail-label
==
^- {(list move) _+>.$}
?> ?=(valid-get-endpoint endpoint)
:_ +>.$ :_ ~
^- move
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
^- purl
:+ [& ~ [%& /com/googleapis/www]]
[~ gmail+v1+users+me+`valid-get-endpoint`endpoint]
`quay`[[%alt %json] ~]
::
:+ method `math`(malt ~[content-type+['application/json']~])
=+ hoon-json-object=(joba %raw s+(message-to-rfc822:rfc mes))
=+ request-body=(tact (pojo hoon-json-object))
(some request-body)
::(some (pojo label-req-to-json:gmail-label label-req:gmail-label ~)) XX
==
::
:: HTTP response. We make sure the response is good, then
:: produce the result (as JSON) to whoever sent the request.
::
++ sigh-httr
|= {wir/wire res/httr}
^- {(list move) _+>.$}
:: ~& wir+wir
?. ?=({care @ @ @ *} wir)
:: pokes don't return anything
~& poke+res
[~ +>.$]
=+ arg=(path (cue (slav %uv i.t.t.wir)))
:: ~& ittwir+i.t.t.wir
:_ +>.$ :_ ~
:+ ost.hid %diff
?+ i.wir 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 ~)
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- subscription-result
?~ arg
=+ switch=t.t.t.t.wir
?+ switch [%json `json`u.jon]
{$messages $~}
=+ new-mezes=((ot messages+(ar (ot id+so 'threadId'^so ~)) ~):jo u.jon)
::%+ turn new-mezes
::|= id
::?< ?=($~ new-mezes)
::=. received-ids [new-mezes received-ids]
::~& received-ids
::=. received
[%inbox (need new-mezes)]
::
{$messages @t $~}
::
:: =+ body-parser==+(jo (ot body+(ot data+(cu ofis-google so) ~) ~)) :: (ok /body/data so):jo
:: ~& %.(u.jon (om (om |=(a/json (some -.a))):jo))
:: ~& %.(u.jon (ot headers+(cu milt (ar (ot name+so value+so ~))) ~))
=+ ^- $: headers/{from/@t subject/@t}
::body-text/wain
==
~| u.jon
=- (need (reparse u.jon))
^= reparse
=+ jo
=+ ^= from-and-subject
|= a/(map @t @t) ^- {@t @t}
[(~(got by a) 'From') (~(got by a) 'Subject')]
=+ ^= text-body
|= a/(list {@t @t}) ^- wain
%- lore
%- ofis-google
(~(got by (~(gas by *(map @t @t)) a)) 'text/plain')
%+ easy-ot %payload
%- ot :~
headers+(cu from-and-subject (cu ~(gas by *(map @t @t)) (ar (ot name+so value+so ~))))
:: parts+(cu text-body (ar (ot 'mimeType'^so body+(ot data+so ~) ~)))
==
:: =+ parsed-headers==+(jo ((ot payload+(easy-ot 'headers' (ar some)) ~) u.jon)) ::
:: =+ parsed-message==+(jo ((ot payload+(easy-ot 'parts' (ar body-parser)) ~) u.jon)) ::
::~& [headers body-text]
::=+ body==+(jo ((ot body+(easy-ot 'body' (easy-ot 'data' so))) parsed-message))
[%message headers]
==
=+ dir=((om:jo some) u.jon)
?~ dir json+(jobe err+s+%no-children ~)
=+ new-jon=(~(get by u.dir) i.arg)
`subscription-result`$(arg t.arg, u.jon ?~(new-jon ~ u.new-jon))
:: redo with next argument
::
$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
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- subscription-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
|= a/*
~& a+a
:_ +>.$ ~
::
++ help
|= {ren/care style/@tas pax/path}
=^ query pax
=+ xap=(flop pax)
?~ xap [~ ~]
=+ query=(rush i.xap ;~(pfix wut yquy:urlp))
?~ query [~ pax]
[u.query (flop t.xap)]
=^ arg pax ~|(pax [+ -]:(split pax))
~| [pax=pax arg=arg query=query]
=| mow/(list move)
|%
:: Resolve core
::
++ make-move
^- {(list move) _+>.$}
[(flop mow) +>.$]
::
++ endpoint-to-purl
|= endpoint/path
^- purl
%+ scan
"https://www.googleapis.com/gmail/v1/users/me{<`path`endpoint>}"
auri:epur
:: Send an HTTP req
++ send-http
|= hiz/hiss
^+ +>
=+ wir=`wire`[ren (scot %ud count) (scot %uv (jam arg)) style pax]
=+ new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]
+>.$(mow [new-move mow])
::
++ scry
^+ .
?+ style ~|(%invalid-style !!)
$read read
:: $listen listen
==
:: Standard GET request
++ read (send-http (endpoint-to-purl pax) %get ~ ~)
:: Subscription request
:: ++ listen
:: ^+ .
:: =+ events=?>(?=([@ @ *] pax) t.t.pax)
:: |- ^+ +>.$
:: ?~ events
:: +>.$
:: ?: (~(has by web-hooks) i.events) :: if hook exists
:: =. +>.$ (update-hook i.events)
:: $(events t.events)
:: =. +>.$ (create-hook i.events)
:: $(events t.events)
::
--
--

6
app/gmail/rfc.txt Normal file
View File

@ -0,0 +1,6 @@
From: urbit-test@gmail.com
To: jhenry.ault@gmail.com
Subject: As basic as it gets
This is the plain text body of the message. Note the blank line
between the header information and the body of the message.

71
app/gmail/split.hoon Normal file
View File

@ -0,0 +1,71 @@
!:
|%
:: 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}
?: ?=(valid-get-endpoint (scag l pax))
[(scag l pax) (slag l pax)]
?~ l
~& %bad-endpoint
~|(%bad-endpoint !!)
$(l (dec l))
::
:: These are all the github GET endpoints, sorted with
:: `env LC_ALL=C sort`
::
:: end-points include required query parameters
++ valid-get-endpoint
$? {$drafts id/@t $~}
{$drafts $~}
{$history $~}
{$labels id/@t $~}
{$labels $~}
{$messages id/@t $attachments id/@t $~}
{$messages id/@t $~}
{$messages $~}
{$profile $~}
{$threads id/@t $~}
{$threads $~}
==
++ vaild-post-endpoint
$? {$drafts $send $~}
{$drafts $~}
{$messages id/@t $modify $~}
{$messages id/@t $trash $~}
{$messages id/@t $untrash $~}
{$messages $import $~}
{$messages $send $~}
{$messages $~}
{$labels $~}
{$threads id/@t $trash $~}
{$threads id/@t $untrash $~}
{$threads id/@t $modify}
{$stop $~}
{$watch $~}
==
++ valid-delete-endpoint
$? {$drafts id/@t $~}
{$labels id/@t $~}
{$messages id/@t $~}
{$thread id/@t $~}
==
++ valid-put-endpoint
$? {$drafts id/@t $~}
{$labels id/@t $~}
==
++ valid-patch-endpoint
$? {$labels id/@t $~}
==
--
::

View File

@ -130,6 +130,7 @@
++ poke-kiln-overload (wrap poke-overload):from-kiln
++ poke-kiln-unmount (wrap poke-unmount):from-kiln
++ poke-kiln-unsync (wrap poke-unsync):from-kiln
++ poke-write-sec-atom (wrap poke-sec-atom):from-write
++ poke-write-paste (wrap poke-paste):from-write
++ poke-write-comment (wrap poke-comment):from-write
++ poke-write-paste (wrap poke-paste):from-write

View File

@ -413,7 +413,7 @@
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
tay=(cut 0 [27 5] mag) :: message type
==
?> =(1 vez)
?> =(2 vez)
?> =(chk (end 0 20 (mug bod)))
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
(kins tay)
@ -433,7 +433,7 @@
=+ tay=(ksin q.kec)
%+ mix
%+ can 0
:~ [3 1]
:~ [3 2]
[20 (mug bod)]
[2 yax]
[2 qax]
@ -1018,7 +1018,7 @@
++ gnaw :: gnaw:am
|= {kay/cape ryn/lane pac/rock} :: process packet
^- {p/(list boon) q/fort}
?. =(1 (end 0 3 pac)) [~ fox]
?. =(2 (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)

View File

@ -56,13 +56,21 @@
{$ay p/knot:ship q/knot:@uvH $~} :: remote duct
{$ha p/path:beak} :: GET request
{$he p/whir} :: HEAD request
{$hi p/mark $~} :: outbound HTTP
{$hi p/knot:(unit knot) q/mark $~} :: outbound HTTP
{$se p/whir-se q/{iden (list @t)}} :: outbound to domain
{$si $~} :: response done
{$of p/ixor q/$@($~ whir-of)} :: associated view
{$ow p/ixor $~} :: dying view
{$on $~} :: dependency
== ::
++ whir-of {p/knot:ship q/term r/wire} :: path in dock
++ whir-se ?($core vi-arm) :: build/call
++ vi-arm
$? $out :: ++out mod request
$res :: ++res use result
$bak :: ++bak auth response
$in :: ++in handle code
== ::
-- ::
|% :: models
++ bolo :: eyre state
@ -82,8 +90,12 @@
wup/(map hole cyst) :: secure sessions
sop/(map hole {ship ?}) :: foreign sess names
wix/(map ixor stem) :: open views
sec/(map {iden (list @t)} driv) :: security drivers
== ::
::
++ driv %+ pair (unit $@($~ vase)) :: driver state
(qeu (trel duct mark vase:hiss)) :: waiting requests
::
++ live :: in flight
$% {$exec p/whir} :: ford build
{$wasp p/(list @uvH)} :: ford deps
@ -117,6 +129,7 @@
++ perk :: parsed request
$% {$auth p/perk-auth}
{$away $~}
{$oath p/knot q/(list @t)}
{$bugs p/?($as $to) $~}
{$beam p/beam}
{$deps p/?($put $delt) q/@uvH}
@ -382,6 +395,12 @@
--
++ xml
|%
++ exit
;html
;head:title:"Accepted"
;body:"You may now close this window."
==
::
++ login-page
%+ titl 'Sign in - Urbit'
;= ;div.container
@ -568,10 +587,8 @@
:: kes (~(del by kes) hen)
:: ==
:: ~& eyre-them+(earn p.u.p.kyz)
=+ wir=hi+/[p.kyz]
?: ?=($hiss p.q.kyz)
(pass-note wir [%e %meta :(slop !>(%them) !>(~) q.q.kyz)])
(back wir %hiss q.kyz)
=+ usr=?~(p.kyz '~' (scot %ta u.p.kyz))
(back hi+/[usr]/[q.kyz] %hiss r.kyz)
::
$they :: inbound response
=+ kas=(need (~(get by q.ask) p.kyz))
@ -661,9 +678,8 @@
$thou
?+ -.tee !!
$ay (ames-gram (slav %p p.tee) got+~ (slav %uv q.tee) |2.sih)
$hi =+ cay=[%httr !>(`httr`p.sih)]
?: ?=($httr p.tee) (give-sigh %& cay)
(back si+~ p.tee cay)
$hi (cast-thou q.tee httr+!>(p.sih))
$se (get-thou:(dom-vi q.tee) p.tee p.sih)
==
::
$unto :: app response
@ -691,6 +707,8 @@
(give-json 200 ~ (joba %beat %b &))
::
$news :: dependency updated
?: ?=({$se *} tee)
(get-news:(dom-vi q.tee) p.sih)
?. ?=({$on $~} tee)
~&(e+lost+[tee hen] +>.$)
%+ roll (~(tap in (~(get ju liz) p.sih)))
@ -710,13 +728,27 @@
$@($~ {?($on $ay $ow) *}) ~|(e+ford+lost+tee !!)
{$of @ $~} ~|(e+ford+lost+tee !!)
{$si $~} (give-sigh q.sih)
::
{$se ^} (get-made:(dom-vi q.tee) p.tee [p q]:sih)
{$hi ^}
?: ?=($| -.q.sih)
(give-sigh q.sih) :: XX crash?
=* cay p.q.sih
?> ?=($hiss p.cay)
(pass-note tee [%e %meta :(slop !>(%them) !>(~) q.cay)])
?: =('~' p.tee)
(eyre-them tee q.cay)
=+ usr=(slav %ta p.tee)
=+ ((hard {pul/purl ^}) q.q.cay)
?. ?=($& -.r.p.pul)
~& [%auth-lost usr p.r.p.pul]
(eyre-them tee q.cay)
(get-req:(dom-vi usr p.r.p.pul) q.tee q.cay)
::
:: {$hi ^}
:: ?: ?=($| -.q.sih)
:: (give-sigh q.sih) :: XX crash?
:: =* cay p.q.sih
:: ?> ?=($hiss p.cay)
:: (eyre-them p.tee q.cay)
::
{$he *} :: XX hack
=. ..axon $(tee p.tee)
@ -756,7 +788,7 @@
?. ?=($mime p.cay)
=+ bek=-:(need (tome p.tee))
=+ bik=?+(r.bek bek {$ud $0} bek(r da+now))
(execute tee bik [%flag [p.sih `~] %cast %mime [%$ p.q.sih]])
(exec-live tee bik [%flag [p.sih `~] %cast %mime [%$ p.q.sih]])
~| q.q.cay
=+ ((hard {mit/mite rez/octs}) q.q.cay)
=+ dep=(crip "W/{(pojo %s (scot %uv p.sih))}")
@ -771,6 +803,9 @@
(fail 500 0v0 >%exit< p.mul)
::
++ ire-ix |=(ire/ixor ~(. ix ire (~(got by wix) ire)))
++ dom-vi
|= {usr/knot dom/path} ^+ vi :: XX default to initialized user?
~(. vi [usr dom] (fall (~(get by sec) usr dom) *driv))
::
++ ses-authed
|= ses/hole
@ -784,13 +819,22 @@
++ our-host `hart`[& ~ %& /org/urbit/(rsh 3 1 (scot %p our))]
:: [| [~ 8.443] `/localhost] :: XX testing
::
++ eyre-them
|= {tea/whir vax/vase:hiss}
(pass-note tea [%e %meta :(slop !>(%them) !>(~) vax)])
::
++ ames-gram
|=({him/ship gam/gram} (pass-note ~ %a %wont [our him] [%e -.gam] +.gam))
::
++ back :: %ford bounce
|= {tea/whir mar/mark cay/cage}
=+ bek=?+(r.top -.top {$ud $0} -.top(r da+now))
(pass-note tea (ford-req bek [%cast mar $+cay]))
(execute tea bek [%cast mar $+cay])
::
++ cast-thou
|= {mar/mark cay/cage}
?: ?=($httr mar) (give-sigh %& cay)
(back si+~ mar cay)
::
++ del-deps
|= {a/@uvH b/(each duct ixor)} ^+ +>.$
@ -812,10 +856,16 @@
(pass-note(hen `~) on+~ %f [%wasp our a &])
::
++ ford-req |=({bek/beak kas/silk} [%f [%exec our `[bek kas]]])
++ execute
++ exec-live
|= {tea/whir req/{beak silk}}
=. lyv (~(put by lyv) hen [%exec tea])
(pass-note tea (ford-req req))
(execute tea req)
::
++ execute
|= {tea/whir bek/beak sil/silk}
%+ pass-note tea
:^ %f %exec our
`[bek [%dude |.(leaf+"eyre: execute {<tea>}") sil]]
::
++ fail
|= {sas/@ud dep/@uvH mez/tang}
@ -879,9 +929,9 @@
++ abet ..handle
++ done .
++ teba |*(a/$-(* ..handle) |*(b/* %_(done ..handle (a b))))
++ execute (teba ^execute)
++ del-deps (teba ^del-deps)
++ new-deps (teba ^new-deps)
++ exec-live (teba ^exec-live)
++ give-html (teba ^give-html)
++ give-thou (teba ^give-thou)
++ give-json (teba ^give-json)
@ -914,7 +964,7 @@
$bake
=+ req=[%bake mar=q.pez [r s]:pez]
=+ red=req(mar %red-quri)
(execute p.pez -.s.pez `silk`[%alts ~[red req]])
(exec-live p.pez -.s.pez `silk`[%alts ~[red req]])
::
$red
=+ url=(earn hat pok(p [~ %html]) quy)
@ -1012,6 +1062,19 @@
?+ pef ~|(pfix-lost+`path`/~/[pef] !!)
$debug ((hard perk) [%bugs but])
$away [%away ~]
$ac
?~ but ~|(no-host+`path`/~/[pef] !!)
=+ `dom/host`~|(bad-host+i.but (rash i.but thos:urlp))
?: ?=($| -.dom) ~|(auth-ip+dom !!)
=- [%oath - p.dom]
~| bad-user+`path`t.but
?> ?=({@ $in $~} t.but)
=+ in-quy=(rush i.t.but ;~(pfix cab fque:urlp))
?~ in-quy
(slav %ta i.t.but)
=+ src=~|(no+u.in-quy (~(got by (malt quy)) u.in-quy))
p:(need (puck src)) :: allow state=usr_other-data
::
$at [%auth %at pok(q but)]
$am ?~(but !! [%auth %xen i.but pok(q t.but)])
$as
@ -1117,7 +1180,7 @@
=+ ext=(fall p.pok %urb)
=+ bem=?-(-.hem $beam p.hem, $spur [-.top (weld p.hem s.top)])
~| bad-beam+q.bem
?< =([~ 0] (sky %cw (tope bem(+ ~, r [%da now]))))
?< =([~ 0] (sky [151 %noun] %cw (tope bem(+ ~, r [%da now]))))
=+ wir=`whir`[%ha (tope -.bem ~)]
=. wir ?+(mef !! $get wir, $head [%he wir])
=. r.bem ?+(r.bem r.bem {$ud $0} da+now)
@ -1145,6 +1208,11 @@
=^ orx ..ya ?:(is-anon new-view:for-client [(need grab-oryx) ..ya])
=+ vew=(ire-ix (oryx-to-ixor orx))
((teba new-mess.vew) p.hem r.hem q.hem %json !>(`json`s.hem))
::
$oath
?. (~(has by sec) [p q]:hem)
~|(no-driver+[p q]:hem !!)
[%| %.(quy (teba get-quay:(dom-vi [p q]:hem)))]
::
$poll
?: ?=({$~ $js} p.pok) :: XX treat non-json cases?
@ -1511,6 +1579,190 @@
++ wake ^+(..ix abet(ude ~)) :: XX other effects?
:: XX unused
++ print-subs |=({a/dock b/path} "{<p.a>}/{(trip q.a)}{(spud b)}")
--
++ vi :: auth engine
|_ $: {usr/iden dom/path}
cor/(unit $@($~ vase))
req/(qeu {p/duct q/mark r/vase:hiss})
==
++ self .
++ abet +>(sec (~(put by sec) +<- +<+))
++ execute |=({a/whir-se b/{beak silk}} (execute:abet se+[a usr dom] b))
++ dead-this |=(a/tang (fail:abet 500 0v0 a))
++ dead-hiss |=(a/tang (give-sigh:abet(req ~(nap to req)) %| a))
++ eyre-them |=({a/whir-se b/vase} (eyre-them:abet se+[a usr dom] b))
++ pass-note |=({a/whir-se b/note} (pass-note:abet se+[a usr dom] b))
:: XX block reqs until correct core checked in?
++ warn |=(a/tang ((slog (flop a)) abet))
++ with |*({a/vase:gate b/$-(vase abet)} |=(c/vase (b (slam a c))))
++ root-beak `beak`[our %home da+now]
::
:: Main
::
++ cor-type ?~(cor %void ?~(u.cor %void p.u.cor))
++ has-arm ~(has in (silt (sloe cor-type)))
++ build
%^ execute %core root-beak
:::+ %dude [|.(+)]:>%mod-samp<
^- silk
:^ %mute core+[root-beak (flop %_(dom . sec+dom))]
[[%& 12]~ %$ bale+!>(*(bale @))] :: XX specify on type?
?~ cor ~
?~ u.cor ~
?: (has-arm %wyp) ~
?: (has-arm %upd)
[[%& 13]~ ride+[limb+%upd prep-cor]]~
[[%& 13]~ %$ noun+(slot 13 u.cor)]~
::
++ call
|= {arm/vi-arm sam/cage}
%^ execute arm root-beak
call+[ride+[limb+arm prep-cor] [%$ sam]]
::
++ prep-cor ^- silk
?~ cor ~|(%no-core !!)
?~ u.cor ~|(%nil-driver !!)
:+ %$ %core
%_ u.cor
+12.q
=+ ato=(sky [151 %noun] %cx (tope root-beak [%atom (flop %_(dom . sec+dom))]))
=+ key=?~(ato '' ;;(@t u.ato)) :: XX jael
`(bale)`[[our now (shas %bale eny) root-beak] [usr dom] key]
==
::
++ pump
^+ abet
?~ cor
build
=+ ole=~(top to req)
?~ ole abet
:: process hiss
=. hen p.u.ole
?~ u.cor (eyre-them %out r.u.ole) :: don't process
(call %out hiss+r.u.ole)
::
++ fin-httr
|= vax/vase:httr
=^ ole req ~(get to req)
=> .(ole `{p/duct q/mark *}`ole) :: XX types
=. ..vi (cast-thou(hen p.ole) q.ole httr+vax) :: error?
pump
::
:: Interfaces
::
++ get-news _build
++ get-quay |=(quy/quay (call %in quay+!>(quy)))
++ get-req |=(a/{mark vase:hiss} pump(req (~(put to req) hen a)))
++ get-thou
|= {wir/whir-se hit/httr}
?+ wir !!
$in (call %bak httr+!>(hit))
$out
?. (has-arm %res) (fin-httr !>(hit))
(call %res httr+!>(hit))
==
::
++ get-made
|= {wir/whir-se dep/@uvH res/(each cage tang)} ^+ abet
?: ?=($core wir) (update dep res)
%. res
?-(wir $out res-out, $res res-res, $bak res-bak, $in res-in)
::
++ update
|= {dep/@uvH gag/(each cage tang)}
:: ~& got-upd/dep
=. ..vi (pass-note %core [%f [%wasp our dep &]])
?~ -.gag pump(cor `q.p.gag)
?: &(=(~ cor) =(%$ usr))
=. cor `~
pump ::(cor `~) :: userless %hiss defaults to "nop" driver
(warn p.gag)
::
:: Result handling
::
:: XX formal dill-blit %url via hood
++ auth-print |=({$show a/purl} (slog auth-tank leaf+(earn a) ~))
++ auth-tank
=> rose+["." `~]^(turn (flop dom) |=(a/cord leaf+(trip a)))
rose+[" " `~]^~[leaf+"To authenticate" . leaf+"visit:"]
::
++ do-give (with !>(|=({$give a/httr} a)) fin-httr)
++ do-show (with !>(auth-print) _abet)
++ do-send
|= wir/whir-se ^- $-(vase _abet)
|= res/vase
(eyre-them wir (slam !>(|=({$send a/hiss} a)) res))
::
++ handle-moves
|= a/(list {p/term q/$-(vase _abet)})
|= b/vase
~> %nil.
~| %bad-sec-move :: XX move ~| into ?> properly
?>((~(nest ut p:!>(*sec-move)) %& p.b) ~)
=+ opt=|.((silt (turn a head)))
|-
?~ a ~|(allowed=(opt) !!)
?: =(p.i.a -.q.b)
(q.i.a (spec b))
$(a t.a)
::
++ on-ford-fail
|= {err/$-(tang _abet) try/$-((each cage tang) _abet)}
|= a/(each cage tang) ^+ abet
?-(-.a $| (err p.a), $& (try a))
::
++ on-error
|= {err/$-(tang _abet) handle-move/_|.(|~(vase:sec-move abet))}
|= a/(each cage tang) ^+ abet
=+ try=(possibly-stateful |=(b/_self (handle-move(+ b)))) :: XX types
?: ?=($| -.a) (err p.a)
=- ?-(-.- $& p.-, $| (err p.-))
(mule |.(~|(driver+dom ~|(bad-res+p.q.p.a (try q.p.a)))))
::
++ possibly-stateful
|= han/$-(_self $-(vase _abet)) :: XX |.(|+(vase:sec-move abet))
|= res/vase ^+ abet
?: ?=({@ *} q.res)
=. p.res (~(fuse ut p.res) p:!>(*{@ *}))
((han self) res)
?. ?=({{@ *} *} q.res)
~|(%misshapen-result !!)
=. p.res (~(fuse ut p.res) p:!>(*{{@ *} *}))
=+ [mow=(slot 2 res) roc=(slot 3 res)]
=- ((han self(cor (some roc))) mow):+ :: XX better stateless asserts
=+ typ=cor-type
~| %core-mismatch
?>((~(nest ut typ) & p.roc) ~)
::
::
++ res-in
%+ on-error dead-this |.
(handle-moves send+(do-send %in) ~)
::
++ res-res
%+ on-error dead-hiss |.
%- handle-moves :~
give+do-give
send+(do-send %out)
redo+_pump
==
::
++ res-bak
%+ on-error dead-this |.
%- handle-moves :~
give+do-give
send+(do-send %in)
redo+_pump(..vi (give-html 200 ~ exit:xml))
==
::
++ res-out
%+ on-ford-fail dead-hiss
%+ on-error warn |.
%- handle-moves :~
give+do-give
send+(do-send %out)
show+do-show
==
-- --
--
. ==

View File

@ -13,10 +13,16 @@
++ note :: out request $->
$% $: $c :: to %clay
$% {$warp p/sock q/riff} ::
== == ::
$: $g :: to %clay
$% {$deal p/sock q/cush} ::
== == == ::
++ sign :: in result $<-
$% $: $c :: by %clay
$% {$writ p/riot} ::
== == ::
$: $g :: by %gall
$% {$unto p/cuft} ::
== == == ::
-- ::
|% :: structures
@ -35,7 +41,7 @@
$: p/cafe :: cache
$= q ::
$% {$0 p/(set beam) q/a} :: depends+product
{$1 p/(set {p/care q/beam r/tang})} :: blocks
{$1 p/(set {van/vane ren/care bem/beam tan/tang})} :: blocks
{$2 p/(set beam) q/tang} :: depends+error
== ::
== ::
@ -72,9 +78,10 @@
$: nah/duct :: cause
{bek/beak kas/silk} :: problem
keg/(map (pair term beam) cage) :: block results
kig/{p/@ud q/(map @ud {p/care q/beam})} :: blocks
kig/{p/@ud q/(map @ud {van/vane ren/care bem/beam})} :: blocks
== ::
++ gagl (list (pair gage gage))
++ gagl (list (pair gage gage)) ::
++ vane ?($a $b $c $d $e $f $g) ::
-- ::
|% ::
++ calf :: reduce calx
@ -197,12 +204,23 @@
~& [%ford-lost num]
+>.$
(~(resp zo [num u.tus]) tik p.+.sih)
::
$unto
=+ tus=(~(get by q.tad.bay) num)
?~ tus
~& [%ford-lost num]
+>.$
?+ -.p.+.sih ~|(%ford-strange-unto !!)
$diff (~(resd zo [num u.tus]) tik p.p.+.sih)
$reap ?~ p.p.+.sih +>.$
((slog leaf+"ford-reap-fail" u.p.p.+.sih) +>.$)
==
==
::
++ axun :: take rev update
|= {tea/wire dep/@uvH bem/beam sih/sign}
^+ +>
?- -.+.sih
?+ -.+.sih ~|(%bad-axun !!)
$writ
?~ p.sih +>.$
:: ~& writ+tea
@ -274,9 +292,10 @@
==
++ camo :: stop requests
^+ .
=+ kiz=(~(tap by q.kig) *(list {p/@ud q/{p/care q/beam}}))
=+ kiz=(~(tap by q.kig) *(list {p/@ud q/{van/vane ren/care bem/beam}}))
|- ^+ +>
?~ kiz +>
?. ?=($c van.q.i.kiz) +>
%= $
kiz t.kiz
mow
@ -285,23 +304,37 @@
:^ %pass
[(scot %p our) (scot %ud num) (scot %ud p.i.kiz) ~]
%c
[%warp [our p.q.q.i.kiz] q.q.q.i.kiz ~]
[%warp [our p.bem.q.i.kiz] q.bem.q.i.kiz ~]
==
::
++ camp :: request a file
|= {ren/care bem/beam}
|= {van/vane ren/care bem/beam}
^+ +>
%= +>
kig [+(p.kig) (~(put by q.kig) p.kig [ren bem])]
mow
:_ mow
:- hen
:^ %pass
[(scot %p our) (scot %ud num) (scot %ud p.kig) ~]
%c
~& >> [%camping ren bem]
[%warp [our p.bem] q.bem [~ %sing ren r.bem (flop s.bem)]]
==
?: ?=($g van)
%= +>.$
kig [+(p.kig) (~(put by q.kig) p.kig [%g ren bem])]
mow
:_ mow
:- hen
:^ %pass
[(scot %p our) (scot %ud num) (scot %ud p.kig) ~]
%g
~& >> [%camping van ren bem]
[%deal [our p.bem] q.bem [%peer %scry ren (flop s.bem)]]
==
?: ?=($c van)
%= +>.$
kig [+(p.kig) (~(put by q.kig) p.kig [%c ren bem])]
mow
:_ mow
:- hen
:^ %pass
[(scot %p our) (scot %ud num) (scot %ud p.kig) ~]
%c
~& >> [%camping van ren bem]
[%warp [our p.bem] q.bem [~ %sing ren r.bem (flop s.bem)]]
==
+>.$
::
++ clad :: hash dependencies
|* hoc/(bolt) ^+ [*@uvH hoc]
@ -404,28 +437,33 @@
^= p
%- silt
%+ turn p.faw
|=(a/{care beam} [-.a +.a *tang])
|=(a/{vane care beam} [-.a +<.a +>.a *tang])
$| [%2 p=*(set beam) q=p.faw]
==
^= faw
|- ^- (each (list (pair care beam)) tang)
|- ^- (each (list (trel vane care beam)) tang)
?~ p.ton [%& ~]
=+ nex=$(p.ton t.p.ton)
=+ err=|=(a/tape [%| leaf+a ?:(?=($& -.nex) ~ p.nex)])
=+ pax=(path i.p.ton)
?~ pax (err "blocking empty")
?. ?=($c (end 3 1 i.pax))
(err "blocking not clay")
=+ ren=((soft care) (rsh 3 1 i.pax))
?~ ren
(err "blocking not care")
=+ zis=(tome t.pax)
?~ zis
(err "blocking not beam")
?- -.nex
$& [%& [u.ren u.zis] p.nex]
$| nex
==
?: ?=($g (end 3 1 i.pax))
?- -.nex
$& [%& [%g u.ren u.zis] p.nex]
$| nex
==
?: ?=($c (end 3 1 i.pax))
?- -.nex
$& [%& [%c u.ren u.zis] p.nex]
$| nex
==
(err "blocking bad vane")
==
::
++ cowl :: each to bolt
@ -553,7 +591,7 @@
=< abet
|- ^+ ..exec
?~ zuk ..exec
$(zuk t.zuk, ..exec `_..exec`(camp p.i.zuk q.i.zuk))
$(zuk t.zuk, ..exec `_..exec`(camp van.i.zuk ren.i.zuk bem.i.zuk))
==
::
++ expo :: return gift
@ -693,7 +731,7 @@
(stag %nap ;~(pfix cab day:read))
(stag %now ;~(pfix pat day:read))
(stag %saw ;~(pfix sem saw:read))
(stag %sei ;~(pfix col sei:read))
(stag %see ;~(pfix col see:read))
(stag %sic ;~(pfix ket sic:read))
(stag %toy ;~(sfix toy:read fas))
==
@ -751,7 +789,7 @@
;~(plug ;~(sfix wide:vez sem) day)
;~(pfix gap ;~(plug tall:vez day))
::
++ sei :: XX see
++ see
%+ rail
;~(plug ;~(sfix hive col) day)
;~(pfix gap ;~(plug hive day))
@ -954,7 +992,7 @@
^- (bolt beam)
?: ?=($ud -.r.bem) (fine cof bem)
=+ von=(syve [151 %noun] ~ %cw bem(s ~))
?~ von [p=cof q=[%1 [%w bem ~] ~ ~]]
?~ von [p=cof q=[%1 [%c %w bem ~] ~ ~]]
(fine cof bem(r [%ud ((hard @) +.+:(need u.von))]))
::
++ lave :: validate
@ -991,7 +1029,7 @@
|= {cof/cafe bem/beam}
^- (bolt arch)
=+ von=(syve [151 %noun] ~ %cy bem)
?~ von [p=cof q=[%1 [%y bem ~] ~ ~]]
?~ von [p=cof q=[%1 [%c %y bem ~] ~ ~]]
?> ?=({$~ $arch ^} u.von)
=+ arc=((hard arch) q.q.u.u.von)
%+ cope (lamp cof bem)
@ -1006,7 +1044,7 @@
(flaw cof [leaf+"ford: no data: {<(tope bem(s ~))>}"]~)
=+ von=(syve [151 %noun] ~ %cx bem)
?~ von
[p=cof q=[%1 [[%x bem ~] ~ ~]]]
[p=cof q=[%1 [[%c %x bem ~] ~ ~]]]
?~ u.von
(flaw cof leaf+"file not found" (smyt (tope bem)) ~)
(fine cof u.u.von)
@ -1296,7 +1334,7 @@
$plan (cope (abut:(meow p.kas q.kas) cof r.kas) faun)
$reef (faun cof pit)
$ride
%+ cool |.(leaf+"ford: build failed")
%+ cool |.(leaf+"ford: build failed {<hen>}")
%+ cope $(kas q.kas)
%- tabl-run
|= {cof/cafe cay/cage}
@ -1542,11 +1580,7 @@
%+ cope (maul cof gat sam)
(flux |=(a/vase noun+a))
::
$see :: XX remove on breach
=. r.p.hon ?:(?=({$ud $0} r.p.hon) r.how r.p.hon)
$(hon q.hon, how p.hon)
::
$sei :: XX see
$see
=+ vez=(vang & (tope how))
=+ tuz=(posh:vez p.hon)
?~ tuz (flaw cof leaf+"bad tusk: {<p.hon>}" ~)
@ -1670,6 +1704,11 @@
==
--
::
++ pact-hoon :: .hoon special case
|= {a/@t b/(urge cord)} ^- @t
~| %lurk-hoon
(role (lurk (lore a) b))
::
++ pact :: patch
|= {cof/cafe kas/silk kos/silk}
^- (bolt gage)
@ -1683,15 +1722,8 @@
?: ?=($hoon p.cay)
?. ?=($txt-diff p.coy)
(flaw cof leaf+"{<p.cay>} mark with bad diff type: {<p.coy>}" ~)
=+ txt=((soft @t) q.q.cay)
?~ txt
(flaw cof leaf+"{<p.cay>} mark on bad data" ~)
=+ dif=((soft (urge cord)) q.q.coy)
?~ dif
=- (flaw cof leaf+"{<p.cay>} data with bad diff" -)
[>type=p.q.coy< >want=p:!>(*(urge cord))< ~]
=+ pac=(role (lurk (lore u.txt) u.dif))
(fine cof `gage`[%& p.cay [%atom %t ~] pac])
%+ cope (maul cof !>(pact-hoon) (slop q.cay q.coy))
(flux |=(vax/vase:cord [%& p.cay vax]))
::
%+ cope (fang cof p.cay)
|= {cof/cafe pro/vase}
@ -1726,13 +1758,21 @@
|= {tik/@ud rot/riot}
^+ ..zo
?> (~(has by q.kig) tik)
=+ `{ren/care bem/beam}`(~(got by q.kig) tik)
=+ `{van/vane ren/care bem/beam}`(~(got by q.kig) tik)
?~ rot
=^ dep deh.bay (daze ~ deh.bay) :: dependencies?
amok:(expo [%made dep %| (smyt ren (tope bem)) ~])
=+ (cat 3 'c' ren)
exec(q.kig (~(del by q.kig) tik), keg (~(put by keg) [- bem] r.u.rot))
::
++ resd
|= {tik/@ud cag/cage}
^+ ..zo
?> (~(has by q.kig) tik)
=+ `{van/vane ren/care bem/beam}`(~(got by q.kig) tik)
=+ (cat 3 'g' ren)
exec(q.kig (~(del by q.kig) tik), keg (~(put by keg) [- bem] cag))
::
++ syve
^- sley
|= {ref/* sec/(unit (set monk)) tem/term bem/beam}

View File

@ -22,7 +22,7 @@
++ cote :: ++ap note
$% {$meta p/@tas q/vase} ::
{$send p/ship q/cush} ::
{$hiss p/mark q/cage}
{$hiss p/(unit knot) q/mark r/cage} ::
== ::
++ cove (pair bone (mold cote cuft)) :: internal move
++ move {p/duct q/(mold note-arvo gift-arvo)} :: typed move
@ -488,6 +488,11 @@
^- beak
byk:(~(got by bum) dap)
::
++ mo-peek
|= {dap/dude pry/prey ren/@tas tyl/path}
^- (unit (unit cage))
(ap-peek:(ap-abed:ap dap pry) ren tyl)
::
++ mo-clip :: apply club
|= {dap/dude pry/prey cub/club}
?: ?=($puff -.cub)
@ -608,7 +613,7 @@
$pass
:+ %pass `path`[%use dap p.q.cov]
?- -.q.q.cov
$hiss `note-arvo`[%e %hiss p.q.q.cov q.q.q.cov]
$hiss `note-arvo`[%e %hiss +.q.q.cov]
$send `note-arvo`[%g %deal [our p.q.q.cov] q.q.q.cov]
$meta `note-arvo`[`@tas`p.q.q.cov %meta `vase`q.q.q.cov]
==
@ -628,6 +633,22 @@
?: ?=($| -.zem) [`p.zem +>.$]
(ap-sake p.zem)
::
++ ap-peek
|= {ren/@tas tyl/path}
^- (unit (unit cage))
=+ cug=(ap-find %peek ren tyl)
?~ cug
((slog leaf+"peek find fail" >tyl< ~) [~ ~])
=^ arm +>.$ (ap-farm q.u.cug)
?: ?=($| -.arm) ((slog leaf+"peek farm fail" p.arm) [~ ~])
=^ zem +>.$ (ap-slam q.u.cug p.arm !>([ren (slag p.u.cug tyl)]))
?: ?=($| -.zem) ((slog leaf+"peek slam fail" p.zem) [~ ~])
?+ q.p.zem ((slog leaf+"peek bad result" ~) [~ ~])
$~ ~
{$~ $~} [~ ~]
{$~ $~ term *} ``[+14.q.p.zem (slot 15 p.zem)]
==
::
++ ap-club :: apply effect
|= cub/club
^+ +>
@ -786,11 +807,15 @@
++ ap-move-hiss :: pass %hiss
|= {sto/bone vax/vase}
^- {(each cove tang) _+>}
?. &(?=({p/* q/@ q/^} q.vax) ((sane %tas) q.q.vax))
:_(+>.$ [%| (ap-suck "hiss: bad hiss ask.[%hiss wire mark cage]")])
=^ gaw vel (~(slot wa vel) 7 vax)
?. &(?=({p/* q/* r/@ s/^} q.vax) ((sane %tas) r.q.vax))
=+ args="[%hiss wire (unit knot) mark cage]"
:_(+>.$ [%| (ap-suck "hiss: bad hiss ask.{args}")])
=^ gaw vel (~(slot wa vel) 15 vax)
?. &(?=({p/@ q/^} q.gaw) ((sane %tas) p.q.gaw))
:_(+>.$ [%| (ap-suck "hiss: malformed cage")])
=+ usr=((soft (unit knot)) q.q.vax)
?. &(?=(^ usr) ?~(u.usr & ((sane %ta) u.u.usr)))
:_(+>.$ [%| (ap-suck "hiss: malformed (unit knot)")])
=+ pux=((soft path) p.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
:_(+>.$ [%| (ap-suck "hiss: malformed path")])
@ -798,7 +823,9 @@
:_ +>.$
:^ %& sto %pass
:- [(scot %p q.q.pry) %cay u.pux]
[%hiss q.q.vax [p.q.gaw paw]]
~! *cote
=- ~! - `cote`-
[%hiss u.usr r.q.vax [p.q.gaw paw]]
::
++ ap-move-mess :: extract path, target
|= vax/vase
@ -1242,8 +1269,21 @@
::
++ scry
|= {fur/(unit (set monk)) ren/@tas who/ship syd/desk lot/coin tyl/path}
^- (unit (unit (pair mark *)))
[~ ~]
^- (unit (unit cage))
?: ?& =(%u ren)
=(~ tyl)
=([%$ %da now] lot)
(~(has by pol.all) who)
(~(has by bum:(~(got by pol.all) who)) syd)
==
``[%null !>(~)]
?. (~(has by pol.all) who)
~
?. =([%$ %da now] lot)
~
?. (~(has by bum:(~(got by pol.all) who)) syd)
[~ ~]
(mo-peek:(mo-abed:mo who *duct) syd high+`who ren tyl)
::
++ stay :: save w+o cache
`axle`all

View File

@ -27,6 +27,7 @@
++ abel typo :: original sin: span
++ ache |* {a/$-(* *) b/$-(* *)} :: either a or b
$%({$| p/b} {$& p/a}) :: b default
++ atom @ :: just an atom
++ axis @ :: tree address
++ bank (list @cF) :: UTF-32 string
++ base :: base mold
@ -279,8 +280,8 @@
:: :::::: compositions
{$new p/twig q/twig} :: =| push bunt
{$fix p/(list (pair wing twig)) q/twig} :: =: q with p changes
{$var p/taco q/twig r/twig} :: =; typed variable
{$rev p/twig q/taco r/twig} :: =/ =;(q p r)
{$var p/taco q/twig r/twig} :: =/ typed variable
{$rev p/taco q/twig r/twig} :: =; =/(q p r)
{$set p/wing q/twig r/twig} :: =. r with p as q
{$rap p/twig q/twig} :: =< =>(q p)
{$nip p/twig q/twig} :: =- =+(q p)
@ -3786,7 +3787,7 @@
++ rig
|= hom/tape
^- wall
?: (lte (lent hom) (sub edg tab))
?: & ::(lte (lent hom) (sub edg tab))
[(runt [tab ' '] hom) lug]
=> .(tab (add tab 2), edg (sub edg 2))
=+ mut=(trim (sub edg tab) hom)
@ -7262,12 +7263,12 @@
[[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] ::
== ::
::
{$fry *} :: ;;
:+ %per [%name %v %$ 1] :: => v=.
:+ %pin :+ %name %a :: =+ ^= a
[%per [%limb %v] p.gen] :: =>(v {p.gen})
:+ %pin [%name %b [%per [%limb %v] q.gen]] :: =+ b==>(v {q.gen})
:+ %pin :: =+ c=(a b)
{$fry *} :: ;;
:+ %per [%name %v %$ 1] :: => v=.
:+ %pin :+ %name %a :: =+ ^= a
[%per [%limb %v] p.gen] :: =>(v {p.gen})
:+ %pin [%name %b [%per [%limb %v] q.gen]] :: =+ b==>(v {q.gen})
:+ %pin :: =+ c=(a b)
[%name %c [%call [%limb %a] [%limb %b] ~]] ::
[%sure [%same [%limb %c] [%limb %b]] [%limb %c]] :: ?>(=(c b) c)
::
@ -7282,21 +7283,23 @@
[%pin [%name p.gen q.gen] r.gen]
[%pin [%cast [%coat p.gen] q.gen] r.gen]
::
{$rev *} [%var q.gen p.gen r.gen]
{$rev *} [%var p.gen r.gen q.gen]
{$set *}
[%per [%keep [[%& 1] ~] [[p.gen q.gen] ~]] r.gen]
::
{$sip *} :: =^
{$sip *} :: =^
=+ wuy=(weld q.gen `wing`[%v ~]) ::
:+ %per [%name %v %$ 1] :: => v=.
:+ %pin [%name %a %per [%limb %v] r.gen] :: =+ a==>(v \r.gen)
:^ %set wuy [%rap [%$ 3] [%limb %a]] :: =. \wuy +.a
:+ %per :- ?@ p.gen ::
:+ %per [%name %v %$ 1] :: => v=.
:+ %pin [%name %a %per [%limb %v] r.gen] :: =+ a==>(v \r.gen)
:^ %set wuy [%rap [%$ 3] [%limb %a]] :: =. \wuy +.a
:+ %per :- ?@ p.gen ::
:+ %name p.gen :: => :- ^= \p.gen
[%rap [%$ 2] [%limb %a]] :: -.a
:+ %cast [%coat p.gen] :: => :- ^- \p.gen
[%rap [%$ 2] [%limb %a]] :: -.a
[%limb %v] :: v
[%rap [%$ 2] [%limb %a]] :: -.a
:+ %cast
:+ %coat -.p.gen
[%per [%limb %v] +.p.gen] :: => :- ^- \p.gen
[%rap [%$ 2] [%limb %a]] :: -.a
[%limb %v] :: v
s.gen :: s.gen
::
{$rap *} [%per q.gen p.gen]
@ -9894,6 +9897,8 @@
(word %sip expt)
(word %fix expp)
(word %rap expb)
(word %var expo)
(word %rev expo)
(word %per expb)
(word %nip expb)
(word %aka expl)
@ -9919,6 +9924,7 @@
(word %wrap expa)
(word %code expa)
(word %need hinh)
moar
==
==
:- '.'
@ -9982,6 +9988,8 @@
['.' (rune dot %set expq)]
['^' (rune ket %sip expt)]
[':' (rune col %fix expp)]
['/' (rune fas %var expo)]
[';' (rune sem %rev expo)]
['<' (rune gal %rap expb)]
['>' (rune gar %per expb)]
['-' (rune hep %nip expb)]
@ -10065,6 +10073,13 @@
|* {key/cord har/_expa}
;~(pfix (jest key) (stag key (toad har)))
::
++ moar :: :moar hack
%+ cook
|= {a/(list) b/(list (pair wing twig))}
^- twig
[%make [[%| (lent a) `%$] ~] b]
;~(pfix (jest %moar) ;~(plug (star (jest %r)) (toad |.((butt rick)))))
::
++ glop ~+((glue mash)) :: separated by space
++ gunk ~+((glue muck)) :: separated list
++ butt |* zor/rule :: closing == if tall
@ -10132,6 +10147,7 @@
++ exps |.((butt hank)) :: closed gapped twigs
++ expt |.(;~(gunk wise rope loaf loaf)) :: =^
++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, twig, twigs
++ expv |.((butt rick)) :: just changes
++ expz |.(loaf(bug &)) :: twig with tracing
::
:: tiki expansion for %wt runes

View File

@ -1328,21 +1328,30 @@
++ aurf :: 2396 with fragment
%+ cook |~(a/purf a)
;~(plug auri (punt ;~(pfix hax (cook crip (star pque)))))
++ auru :: 2396 with maybe user
%+ cook
|= $: a/{p/? q/(unit iden) r/{(unit @ud) host}}
b/{pork quay}
==
^- (pair (unit iden) purl)
[q.a [[p.a r.a] b]]
::
;~ plug
;~(plug htts (punt ;~(sfix urt:ab pat)) thor)
;~(plug ;~(pose apat (easy *pork)) yque)
==
++ auri :: 2396 URL
%+ cook
|= a/purl
?.(?=(hoke r.p.a) a a(p.p &))
;~ plug
;~ plug
%+ sear
|= a/@t
^- (unit ?)
?+(a ~ $http [~ %|], $https [~ %&])
;~(sfix scem ;~(plug col fas fas))
thor
==
;~(plug htts thor)
;~(plug ;~(pose apat (easy *pork)) yque)
==
++ htts
%+ sear ~(get by (malt `(list (pair term ?))`[http+| https+& ~]))
;~(sfix scem ;~(plug col fas fas))
::
++ cock :: cookie
(most ;~(plug sem ace) ;~(plug toke ;~(pfix tis tosk)))
++ dlab :: 2396 domainlabel
@ -1571,6 +1580,19 @@
== ::
++ apex {p/@uvI q/(map @ta @uvI) r/(map @ta $~)} :: node report (old)
++ ares (unit {p/term q/(list tank)}) :: possible error
++ bale :: driver state
|* a/_* :: %jael keys type
$: {our/ship now/@da eny/@uvI byk/beak} :: base info
{usr/iden dom/(list @t)} :: req user, domain
key/a :: secrets from %jael
== ::
++ iden knot:?($~ @ta) :: username
++ sec-move :: driver effect
$% {$send p/hiss} :: http out
{$show p/purl} :: direct user to url
{$give p/httr} :: respond immediately
{$redo $~} :: restart request qeu
== ::
++ ball @uw :: statement payload
++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec
++ bath :: convo per client
@ -2163,7 +2185,7 @@
++ kiss-eyre :: in request ->$
$% {$born $~} :: new unix process
{$crud p/@tas q/(list tank)} :: XX rethink
{$hiss p/mark q/cage} :: outbound user req
{$hiss p/(unit iden) q/mark r/cage} :: outbound user req
{$init p/@p} :: report install
{$serv p/$@(desk beam)} :: set serving root
{$them p/(unit hiss)} :: outbound request
@ -2212,8 +2234,7 @@
{$nap p/horn} :: /_ homo map
{$now p/horn} :: /@ list by @da
{$saw p/twig q/horn} :: /; operate on
{$see p/beam q/horn} :: XX remove on breach
{$sei p/hops q/horn} :: /: relative to XX see
{$see p/hops q/horn} :: /: relative to
{$sic p/twig q/horn} :: /^ cast
{$toy p/? q/mark} :: /mark/ static/hook
== ::

View File

@ -9,16 +9,16 @@
::::
::
:- %say
|= {^ {arg/(list path)} $~}
|= {^ {arg/(list path)} vane=?($c $g)}
=- tang+(flop `tang`(zing -))
%+ turn arg
|= pax/path
^- tang
=+ ark=.^(arch %cy pax)
=+ ark=.^(arch (cat 3 vane %y) pax)
?^ fil.ark
?: =(%sched -:(flop pax))
[>.^((map @da cord) %cx pax)<]~
[leaf+(spud pax) (pretty-file .^(noun %cx pax))]
[> .^((map ,@da cord) (cat 3 vane %x) pax)<]~
[leaf+(spud pax) (pretty-file .^(noun (cat 3 vane %x) pax))]
?- dir.ark :: handle ambiguity
$~
[rose+[" " `~]^~[leaf+"~" (smyt pax)]]~
@ -29,6 +29,6 @@
*
=- [palm+[": " ``~]^-]~
:~ rose+[" " `~]^~[leaf+"*" (smyt pax)]
`tank`(subdir pax dir.ark)
`tank`(subdir vane pax dir.ark)
==
==

18
gen/gmail/list.hoon Normal file
View File

@ -0,0 +1,18 @@
::
:::: /hoon/ticket/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
arg/$@($~ {number/@u $~})
$~
==
?~ arg $(arg [5 ~])
:- %noun
%+ turn (scag number.arg .^((list {@t @t}) %gx /=gmail=/read/messages))
|= {message-id/@t thread-id/@t}
=+ .^({from/@t subject/@t} %gx /=gmail=/read/messages/[message-id])
[from=from (trip subject)]

14
gen/gmail/send.hoon Normal file
View File

@ -0,0 +1,14 @@
::
:::: /hoon/send/gmail/gen
::
/? 310
/- rfc
:- %say
|= {^ {to/tape subject/tape $~} _from="urbit-test@gmail.com"}
:- %gmail-req
:^ %post /messages/'send' ~['uploadType'^'simple']
^- message:rfc
=+ parse-adr=;~((glue pat) (cook crip (star ;~(less pat next))) (cook crip (star next)))
:+ (scan from parse-adr)
(scan to parse-adr)
[(crip subject) '']

33
gen/hood/init-oauth2.hoon Normal file
View File

@ -0,0 +1,33 @@
::
:::: /hoon/init-oauth2/hood/gen
::
/? 314
/- sole
::
::::
!:
[sole .]
:- %ask
|= $: {now/@da eny/@uvI bec/beak}
{arg/$@($~ {dom/path $~})}
$~
==
^- (sole-result {$write-sec-atom p/host q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ sole-lo
[%& %oauth-hostname "api hostname: https://"]
%+ sole-go thos:urlp
|= hot/host
?: ?=($| -.hot)
~|(%ips-unsupported !!)
%+ sole-lo
[%& %oauth-client "client id: "]
%+ sole-go (boss 256 (star prn))
|= cid/@t
%+ sole-lo
[%& %oauth-secret "client secret: "]
%+ sole-go (boss 256 (star prn))
|= cis/@t
%+ sole-so %write-sec-atom :: XX typed pair
[hot (role cid cis ~)]

View File

@ -7,7 +7,8 @@
!:
::::
::
~& %
:- %say
|= {^ {arg/path $~} $~}
=+ lon=.^(arch %cy arg)
tang+[?~(dir.lon leaf+"~" (subdir arg dir.lon))]~
|= {^ {arg/path $~} vane/?($c $g)}
=+ lon=.^(arch (cat 3 vane %y) arg)
tang+[?~(dir.lon leaf+"~" (subdir vane arg dir.lon))]~

View File

@ -4,7 +4,7 @@
/? 310
|%
++ subdir
|= {pax/path des/(map @t $~)}
|= {vane/?($c $g) pax/path des/(map @t $~)}
^- tank
:+ %rose [" " `~]
%+ turn (sort (~(tap by des)) aor)
@ -13,7 +13,7 @@
=- :+ %rose ["/" ~ ?:(dir "/" ~)]
(turn paf |=(a/knot leaf+(trip a)))
|- ^- {dir/? paf/path}
=+ arf=.^(arch %cy (weld pax paf))
=+ arf=.^(arch (cat 3 vane %y) (weld pax paf))
?^ fil.arf
[| paf]
?~ dir.arf

6
lib/basic-auth.hoon Normal file
View File

@ -0,0 +1,6 @@
!:
=+ keys=@t
|= bal/(bale keys)
=+ aut=authorization+(cat 3 'Basic ' key.bal)
~& aut=`{@tas @t}`aut
|=(a/hiss [%send %_(a q.q (~(add ja q.q.a) -.aut +.aut))])

148
lib/gh-parse.hoon Normal file
View File

@ -0,0 +1,148 @@
:: This library includes parsing functions for the json objects
:: that Github's API produces. In general, the conversion from
:: JSON to urbit types should be performed in marks, so those
:: marks should include this library.
::
/- gh
|%
++ repository
^- $-(json (unit repository:gh))
=+ jo
%- ot :~
'id'^id
'name'^so
'full_name'^so
'owner'^user
'private'^bo
'html_url'^so
'description'^so
'fork'^bo
'url'^so
'forks_url'^so
'keys_url'^so
'collaborators_url'^so
'teams_url'^so
'hooks_url'^so
'issue_events_url'^so
'events_url'^so
'assignees_url'^so
'branches_url'^so
'tags_url'^so
'blobs_url'^so
'git_tags_url'^so
'git_refs_url'^so
'trees_url'^so
'statuses_url'^so
'languages_url'^so
'stargazers_url'^so
'contributors_url'^so
'subscribers_url'^so
'subscription_url'^so
'commits_url'^so
'git_commits_url'^so
'comments_url'^so
'issue_comment_url'^so
'contents_url'^so
'compare_url'^so
'merges_url'^so
'archive_url'^so
'downloads_url'^so
'issues_url'^so
'pulls_url'^so
'milestones_url'^so
'notifications_url'^so
'labels_url'^so
'releases_url'^so
'created_at'^so
'updated_at'^so
'pushed_at'^so
'git_url'^so
'ssh_url'^so
'clone_url'^so
'svn_url'^so
'homepage'^some
'size'^ni
'stargazers_count'^ni
'watchers_count'^ni
'language'^some
'has_issues'^bo
'has_downloads'^bo
'has_wiki'^bo
'has_pages'^bo
'forks_count'^ni
'mirror_url'^some
'open_issues_count'^ni
'forks'^ni
'open_issues'^ni
'watchers'^ni
'default_branch'^so
==
++ user
^- $-(json (unit user:gh))
=+ jo
%- ot :~
'login'^so
'id'^id
'avatar_url'^so
'gravatar_id'^so
'url'^so
'html_url'^so
'followers_url'^so
'following_url'^so
'gists_url'^so
'starred_url'^so
'subscriptions_url'^so
'organizations_url'^so
'repos_url'^so
'events_url'^so
'received_events_url'^so
'type'^so
'site_admin'^bo
==
++ issue
^- $-(json (unit issue:gh))
=+ jo
%- ot :~
'url'^so
'labels_url'^so
'comments_url'^so
'events_url'^so
'html_url'^so
'id'^id
'number'^ni
'title'^so
'user'^user::|+(* (some *user:gh))
'labels'^(ar label)::|+(* (some *(list label:gh)))::(ar label)
'state'^so
'locked'^bo
'assignee'^(mu user)::|+(* (some *(unit user:gh)))::(mu user)
'milestone'^some
'comments'^ni
'created_at'^so
'updated_at'^so
'closed_at'^(mu so)
'body'^so
==
++ label
^- $-(json (unit label:gh))
=+ jo
%- ot :~
'url'^so
'name'^so
'color'^so
==
++ comment
^- $-(json (unit comment:gh))
=+ jo
%- ot :~
'url'^so
'html_url'^so
'issue_url'^so
'id'^id
'user'^user
'created_at'^so
'updated_at'^so
'body'^so
==
++ id no:jo
--

1
lib/gmail.hoon Normal file
View File

@ -0,0 +1 @@
fd

159
lib/oauth2.hoon Normal file
View File

@ -0,0 +1,159 @@
|%
++ fass :: rewrite quay
|= a/quay
%+ turn a
|= {p/@t q/@t} ^+ +<
[(gsub '-' '_' p) q]
::
++ gsub :: replace chars
|= {a/@t b/@t t/@t}
^- @t
?: =('' t) t
%+ add (lsh 3 1 $(t (rsh 3 1 t)))
=+ c=(mod t (bex 8))
?:(=(a c) b c)
::
++ join
|= {a/cord b/(list cord)}
?~ b ''
(rap 3 |-([i.b ?~(t.b ~ [a $(b t.b)])]))
::
++ dbg-post `purl`[`hart`[| `6.000 [%& /localhost]] `pork``/testing `quay`/]
++ endpoint |=({dom/(list cord) a/path} [[& ~ &+dom] [~ a] ~])
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ grab-json
|* {a/httr b/fist:jo}
~| bad-json+r.a
~| (poja q:(need r.a))
(need (;~(biff poja b) q:(need r.a)))
--
::
::::
::
|%
++ token ?($~ @t)
++ refresh {tok/token needed/@da pending/_`?`|}
++ keys cord:{cid/@t cis/@t}
++ core-move |*(a/* $^({sec-move _a} sec-move)) ::here's a change
++ decode-keys :: XX from bale w/ typed %jael
|= key/keys
?~ key ~|(%oauth-no-keys ~_(leaf+"Run |init-oauth2" !!))
~| %oauth-bad-keys
((hard {cid/@t cis/@t $~}) (lore key))
--
::
::::
::
|= {dialog/{p/host q/path r/quay} code-exchange/path}
=+ state-usr=|
|_ {(bale keys) scope/(list cord)}
++ client-id cid:(decode-keys key)
++ client-secret cis:(decode-keys key)
::
++ urb-hart [| `8.443 [%& /localhost]] :: XX get from eyre
++ toke-url (endpoint dom code-exchange)
++ auth-url
~& [%oauth-warning "Make sure this urbit".
"is running on {(earn urb-hart `~ ~)}"]
^- purl
:+ [& ~ p.dialog] [~ q.dialog]
%- fass
%+ welp r.dialog
:~ state+?.(state-usr '' (pack usr /''))
client-id+client-id
redirect-uri+redirect-uri
scope+(join ' ' scope)
==
::
++ redirect-uri
%- crip %- earn
=+ usr-knot=?:(state-usr '_state' (scot %ta usr))
`purl`[`hart`urb-hart `pork``/~/ac/(join '.' (flop dom))/[usr-knot]/in `quay`~]
::
++ out-filtered
|= {tok/token aut/$-(hiss hiss)}
|= a/hiss ^- sec-move
?~(tok [%show auth-url] [%send (aut a)])
::
++ out-quay
|= {nam/knot tok/token}
%+ out-filtered tok
|=(a/hiss %_(a r.p :_(r.p.a nam^`@t`tok)))
::
++ out-math
|= ber/token
=+ hed=(cat 3 'Bearer ' `@t`ber)
%+ out-filtered ber
|= a/hiss ^+ a
:: =. p.a dbg-post
%_(a q.q (~(add ja q.q.a) %authorization hed))
::
++ toke-req
|= {grant-type/cord quy/quay} ^- {$send hiss}
:+ %send toke-url
:+ %post (malt ~[content-type+~['application/x-www-form-urlencoded']])
=- `(tact +:(tail:earn -))
%- fass
%+ welp quy
:~ client-id+client-id
client-secret+client-secret
redirect-uri+redirect-uri
grant-type+grant-type
==
::
++ in-code
|= a/quay ^- sec-move
=+ code=~|(%no-code (~(got by (malt a)) %code))
(toke-req 'authorization_code' code+code ~)
::
++ token-type 'token_type'^(cu cass sa):jo
++ expires-in 'expires_in'^ni:jo
++ access-token 'access_token'^so:jo
++ refresh-token 'refresh_token'^so:jo
++ bak-save-access
|* {done/* handle/$-(cord:token *)} :: $+(token _done)
%- (bak-parse done access-token ~)
|=(tok/cord:token [[%redo ~] (handle tok)])
::
++ bak-parse
|* {done/* parse/(pole {knot fist}:jo)}
|= handle/$-(_?~(parse ~ (need *(ot:jo parse))) (core-move done))
|= a/httr ^- (core-move done)
?: (bad-response p.a) [%redo ~] :: handle 4xx?
(handle (grab-json a (ot:jo parse)))
::
++ res-give |=(a/httr [%give a])
::
++ re
|* cor/* :: XX redundant with *export, but type headaches
|_ {ref/refresh export/$-(refresh _cor)}
++ out-fix-expired
|= default/$-(hiss sec-move)
^- $-(hiss (core-move cor))
?~ tok.ref default
?. (lth needed.ref (add now ~m59.s30))
default
|= a/hiss
:_ (export ref(pending &))
(toke-req 'refresh_token' refresh-token+tok.ref ~)
::
++ res-handle-refreshed
|= {handle-access/_=>(cor |=(@t +>)) default/$-(httr sec-move)}
^- $-(httr (core-move cor))
?. pending.ref default
%- (bak-parse cor expires-in access-token ~)
|= {exp/@u tok/axs/@t} ^- {sec-move _cor}
=. +>.handle-access
(export tok.ref (add now (mul ~s1 exp)) |)
[[%redo ~] (handle-access axs.tok)]
::
++ bak-save-tokens
|= handle-access/_=>(cor |=(@t +>))
%- (bak-parse cor expires-in access-token refresh-token ~)
|= {exp/@u tok/{axs/@t ref/@t}} ^- {sec-move _cor}
=. +>.handle-access
(export ref.tok (add now (mul ~s1 exp)) |)
[[%redo ~] (handle-access axs.tok)]
--
--

View File

@ -47,6 +47,11 @@
=. txt (rap 3 (scot %p him) ': ' txt ~)
(poke--data [`%md pax] %mime / (taco txt))
::
++ poke-sec-atom
|= {hot/host dat/@}
?> ?=($& -.hot)
(poke--data [`%atom [%sec p.hot]] %mime / (taco dat))
::
++ poke--data
|= {{ext/(unit @t) pax/path} dat/data} ^+ abet
?~ ext $(ext [~ -.dat])

View File

@ -11,4 +11,6 @@
--
++ grow |%
++ mime [/application/x-urb-unknown (taco ato)]
-- --
--
++ grad %mime
--

18
mar/gh/issue-comment.hoon Normal file
View File

@ -0,0 +1,18 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse
|_ issue-comment/issue-comment:gh
++ grab
|%
++ json
|= jon/^json
^- issue-comment:gh
=+ top=(need ((om:jo some) jon))
:* (need (repository:gh-parse (~(got by top) %repository)))
(need (user:gh-parse (~(got by top) %sender)))
(need (so:jo (~(got by top) %action)))
(need (issue:gh-parse (~(got by top) %issue)))
(need (comment:gh-parse (~(got by top) %comment)))
==
--
--

26
mar/gh/issues.hoon Normal file
View File

@ -0,0 +1,26 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse
|_ issues/issues:gh
++ grab
|%
++ json
|= jon/^json
^- issues:gh
=+ top=(need ((om:jo some) jon))
:* (need (repository:gh-parse (~(got by top) %repository)))
(need (user:gh-parse (~(got by top) %sender)))
=+ action=(need (so:jo (~(got by top) %action)))
?+ action ~|([%bad-action action] !!)
$assigned [action (need (user:gh-parse (~(got by top) %assignee)))]
$unassigned [action (need (user:gh-parse (~(got by top) %assignee)))]
$labeled [action (need (label:gh-parse (~(got by top) %label)))]
$unlabeled [action (need (label:gh-parse (~(got by top) %label)))]
$opened [action ~]
$closed [action ~]
$reopened [action ~]
==
(need (issue:gh-parse (~(got by top) %issue)))
==
--
--

6
mar/gh/poke.hoon Normal file
View File

@ -0,0 +1,6 @@
|_ {method/meth endpoint/path jon/json}
++ grab
|%
++ noun {method/meth endpoint/path jon/json}
--
--

8
mar/gmail/req.hoon Normal file
View File

@ -0,0 +1,8 @@
/- rfc, gmail-label
|_ {method/meth endpoint/path query/quay mes/?(message:rfc label-req:gmail-label)} :: jon=(unit json)]
++ grab
|%
++ noun {method/meth endpoint/path query/quay mes/?(message:rfc label-req:gmail-label)}:: jon=(unit json)]
--
--

6
mar/path.hoon Normal file
View File

@ -0,0 +1,6 @@
|_ pax/path
++ grab
|%
++ noun path
--
--

View File

@ -0,0 +1,18 @@
/+ oauth2
::
::::
::
=+ [`/com/facebook/www /dialog/oauth response-type/%code ~]
=+ aut=(oauth2 - /'v2.3'/oauth/'access_token')
|_ [bal=(bale keys.aut) access-token=token.aut]
++ auth ~(. aut bal /'user_about_me'/'user_posts')
++ out (out-quay:auth 'access_token'^access-token)
++ in in-code:auth
++ bak
%- (bak-parse:auth . access-token.aut expires-in.aut ~)
|= [access-token=@t expires-in=@u]
?: (lth expires-in ^~((div ~d7 ~s1))) :: short-lived token
(toke-req:auth 'fb_exchange_token' fb-exchange-token/access-token ~)
[[%redo ~] ..bak(access-token access-token)]
::++ wyp ~
--

1
sec/com/github/api.atom Normal file
View File

@ -0,0 +1 @@
cGhpbGlwY21vbmt0ZXN0OjEzMzdwYXNzd29yZA==

5
sec/com/github/api.hoon Normal file
View File

@ -0,0 +1,5 @@
/+ basic-auth
!:
|_ {bal/(bale keys:basic-auth) $~}
++ out (basic-auth bal)
--

View File

@ -0,0 +1,47 @@
/+ oauth2
::
::::
::
|%
++ user-state {ber/token ref/refresh}:oauth2
++ suffix-email
%+ cook welp
;~ plug
(star ;~(less pat prn))
;~(pose (plus prn) (easy "@gmail.com"))
==
::
++ auth-usr
|= usr/iden
=+ lon=(fall (slaw %t usr) usr)
=< .(state-usr &)
%- oauth2
=- [[&+/com/google/accounts /o/oauth2/v2/auth -] /oauth2/v4/token]
:~ login-hint+?~(lon '' (crip (rash lon suffix-email)))
access-type+%offline
response-type+%code
prompt+%consent
==
--
!:
::::
::
|_ {bal/(bale keys:oauth2) user-state}
++ auth-re ~(. (re:auth .) ref |=(a/_ref +>(ref a)))
++ auth ~(. (auth-usr usr.bal) bal (scopes 'userinfo.email' 'plus.me' ~))
++ scopes
=+ scope=|=(b/@ta (endpoint:oauth2 dom.bal /auth/[b]))
|=(a/(list @ta) ['https://mail.google.com' (turn a |=(b/@ta (crip (earn (scope b)))))])
::
++ out (out-fix-expired:auth-re (out-math:auth ber))
++ res |=(a/httr ((res-handle-refreshed:auth-re save-access res-give:auth) a))
::
++ save-access |=(a/cord:[token:oauth2] +>(ber a))
::
++ in
|= a/quay
(in-code:auth a)
++ bak |=(a/httr ((bak-save-tokens:auth-re save-access) a))
++ upd *user-state
::
--

11
sec/com/slack.hoon Normal file
View File

@ -0,0 +1,11 @@
/+ oauth2
::
::::
::
=+ aut=(oauth2 [`/com/slack /oauth/authorize ~] /api/'oauth.access')
|_ [(bale keys:oauth2) tok=token.aut]
++ aut ~(. ^aut +<- /client/admin)
++ out (out-quay:aut 'token'^tok)
++ in in-code:aut
++ bak (bak-save-access:aut . |=(tok=token:aut +>(tok tok)))
--

159
sur/gh.hoon Normal file
View File

@ -0,0 +1,159 @@
:: https:==developer.github.com/v3/
::
:: These types correspond to the types that Github's API
:: produces, so please check Github's documentation for
:: details.
::
:: For parsing JSON into these types, check out the gh-parse
:: library.
::
|%
++ repository
$: id/id
name/@t
full-name/@t
owner/user
private/?
html-url/@t
description/@t
fork/?
url/@t
forks-url/@t
keys-url/@t
collaborators-url/@t
teams-url/@t
hooks-url/@t
issue-events-url/@t
events-url/@t
assignees-url/@t
branches-url/@t
tags-url/@t
blobs-url/@t
git-tags-url/@t
git-refs-url/@t
trees-url/@t
statuses-url/@t
languages-url/@t
stargazers-url/@t
contributors-url/@t
subscribers-url/@t
subscription-url/@t
commits-url/@t
git-commits-url/@t
comments-url/@t
issue-comment-url/@t
contents-url/@t
compare-url/@t
merges-url/@t
archive-url/@t
downloads-url/@t
issues-urls/@t
pulls-url/@t
milestones-url/@t
notifications-url/@t
labels-url/@t
releases-url/@t
created-at/time
updated-at/time
pushed-at/time
git-url/@t
ssh-url/@t
clone-url/@t
svn-url/@t
homepage/json
size/@ud
stargazers-count/@ud
watchers-count/@ud
language/json
has-issues/?
has-downloads/?
has-wiki/?
has-pages/?
forks-count/@ud
mirror-url/json
open-issues-count/@ud
forks/@ud
open-issues/@ud
watchers/@ud
default-branch/@t
==
++ user
$: login/@t
id/id
avatar-url/@t
gravatar-id/@t
url/@t
html-url/@t
followers-url/@t
following-url/@t
gists-url/@t
starred-url/@t
subscriptions-url/@t
organizations-url/@t
repos-url/@t
events-url/@t
received-events/@t
type/@t
site-admin/?
==
++ issue
$: url/@t
labels-url/@t
comments-url/@t
events-url/@t
html-url/@t
id/id
number/@ud
title/@t
user/user
labels/(list label)
state/@t
locked/?
assignee/(unit user)
milestone/json
comments/@ud
created-at/time
updated-at/time
closed-at/(unit time)
body/@t
==
++ label
$: url/@t
name/@t
color/@t
==
++ comment
$: url/@t
html-url/@t
issue-url/@t
id/id
user/user
created-at/time
updated-at/time
body/@t
==
++ id @t
++ time @t
++ issues
$: repository/repository
sender/user
$= action
$% {$assigned assignee/user}
{$unassigned assignee/user}
{$labeled label/label}
{$unlabeled label/label}
{$opened $~}
{$closed $~}
{$reopened $~}
==
issue/issue
==
++ issue-comment
$: repository/repository
sender/user
action/@t
issue/issue
comment/comment
==
++ ping {repo/json sender/json hok/(list @t) hook-id/@t zen/json}
--

34
sur/gmail-label.hoon Normal file
View File

@ -0,0 +1,34 @@
:: This structure is the hoon equivalent of the labels resource used by the
:: gmail api
|%
++ label-list-visibility
$? $'labelHide' :: Do not show the label in the label list
$'labelShow' :: Show the label in the label list. (Default)
$'labelShowIfUnread' :: Show the label if any unread msgs w/that label.
==
++ message-list-visibility
$? $hide :: Do not show the label in the message list.
$show :: Show the label in the message list. (Default)
==
--
|%
:: label request is the body of the post request you send to gmail to create
:: a labels resource
++ label-req {llv/label-list-visibility mlv/message-list-visibility name/@t}
:: the label resource returned by gmail in response to your successful request
++ label *
++ label-req-to-json
|= label-req
%- jobe :^
['name' `json`s+name]
['labelListVisibility' `json`s+(crip (sifo `cord`llv))]
['messageListVisibility' `json`s+(crip (sifo `cord`mlv))]
~
--

1
sur/gmail-message.hoon Normal file
View File

@ -0,0 +1 @@
{to/@p subj/@t body/wain}

21
sur/rfc.hoon Normal file
View File

@ -0,0 +1,21 @@
:: This structure is the hoon equivalent of the RFC 822 E-mail message format
|%
++ message {from/email-address to/email-address subject/@t body/@t}
++ email-address {name/@t domain/@t}
--
!:
|%
++ email-adr-to-text |=({name/@t domain/@t} (trip (rap 3 name '@' domain ~)))
++ message-to-rfc822
|= a/message ^- cord
%- crip ^- tape %- sifo
%- crip
"""
From: {(email-adr-to-text from.a)}
To: {(email-adr-to-text to.a)}
Subject: {(trip subject.a)}
{(trip body.a)}
"""
--

10
web/listen.hoon Normal file
View File

@ -0,0 +1,10 @@
::
:::: /hoon/talk/web
::
/? 310
;div.mini-module
;script@"/~/at/lib/js/urb.js";
;script@"/talk/main.js";
;link/"/talk/main.css"(rel "stylesheet");
;talk(readonly "", chrono "reverse", station "comments");
==

View File

@ -497,7 +497,7 @@ module.exports = recl({
last: MessageStore.getLast(),
fetching: MessageStore.getFetching(),
listening: MessageStore.getListening(),
station: window.util.mainStation(),
station: StationStore.getStation(),
stations: StationStore.getStations(),
configs: StationStore.getConfigs(),
typing: MessageStore.getTyping(),
@ -541,10 +541,16 @@ module.exports = recl({
sortedMessages: function(messages) {
var station;
station = this.state.station;
return _.sortBy(messages, function(message) {
message.pending = message.thought.audience[station];
return message.key;
});
return _.sortBy(messages, (function(_this) {
return function(message) {
message.pending = message.thought.audience[station];
if (_this.props.chrono === "reverse") {
return -message.key;
} else {
return message.key;
}
};
})(this));
},
componentWillMount: function() {
return Infinite = require('react-infinite');
@ -972,6 +978,7 @@ module.exports = recl({
config: StationStore.getConfigs(),
members: StationStore.getMembers(),
typing: StationStore.getTyping(),
station: StationStore.getStation(),
valid: StationStore.getValidAudience()
};
s.audi = _.without(s.audi, window.util.mainStationPath(window.urb.user));
@ -1000,20 +1007,10 @@ module.exports = recl({
return this.cursorAtEnd;
},
addCC: function(audi) {
var cc, i, len, listening, s;
listening = this.state.config[window.util.mainStation(window.urb.user)].sources;
cc = false;
for (i = 0, len = audi.length; i < len; i++) {
s = audi[i];
if (listening.indexOf(s) === -1) {
cc = true;
}
}
if (listening.length === 0) {
cc = true;
}
if (cc === true) {
audi.push(window.util.mainStationPath(window.urb.user));
var listening, ref1, ref2;
listening = (ref1 = (ref2 = this.state.config[this.props.station]) != null ? ref2.sources : void 0) != null ? ref1 : [];
if (_.isEmpty(_.intersection(audi, listening))) {
audi.push("~" + window.urb.user + "/" + this.props.station);
}
return audi;
},
@ -1253,25 +1250,35 @@ ref = React.DOM, div = ref.div, link = ref.link;
TreeActions.registerComponent("talk", React.createClass({
displayName: "talk",
getStation: function() {
return this.props.station || window.util.defaultStation();
},
componentWillMount: function() {
var station;
require('./utils/util.coffee');
require('./utils/move.coffee');
station = this.getStation();
StationActions.listen();
return StationActions.listenStation(window.util.mainStation());
StationActions.listenStation(station);
return StationActions.switchStation(station);
},
render: function() {
var station;
station = this.getStation();
return div({
key: "talk-container"
}, [
div({
key: "grams-container"
}, MessagesComponent({
}, MessagesComponent(_.merge({}, this.props, {
station: station,
key: 'grams'
}, '')), div({
}), '')), this.props.readOnly == null ? div({
key: 'writing-container'
}, WritingComponent({
}, WritingComponent(_.merge({}, this.props, {
station: station,
key: 'writing'
}, ''))
}), '')) : void 0
]);
}
}));
@ -1425,6 +1432,7 @@ module.exports = function(arg) {
},
listen: function() {
return window.urb.bind("/", function(err, res) {
var house;
if (err || !res.data) {
console.log('/ err');
console.log(err);
@ -1432,14 +1440,15 @@ module.exports = function(arg) {
}
console.log('/');
console.log(res.data);
if (res.data.house) {
house = res.data.house;
if (house) {
return StationActions.loadStations(res.data.house);
}
});
},
listenStation: function(station) {
return window.urb.bind("/avx/" + station, function(err, res) {
var ref;
var cabal, glyph, group, ok, ref;
if (err || !res) {
console.log('/avx/ err');
console.log(err);
@ -1447,18 +1456,17 @@ module.exports = function(arg) {
}
console.log('/avx/');
console.log(res.data);
if (res.data.ok === true) {
StationActions.listeningStation(station);
}
if (res.data.group) {
res.data.group.global[window.util.mainStationPath(window.urb.user)] = res.data.group.local;
StationActions.loadMembers(res.data.group.global);
}
if ((ref = res.data.cabal) != null ? ref.loc : void 0) {
StationActions.loadConfig(station, res.data.cabal.loc);
}
if (res.data.glyph) {
return StationActions.loadGlyphs(res.data.glyph);
ref = res.data, ok = ref.ok, group = ref.group, cabal = ref.cabal, glyph = ref.glyph;
switch (false) {
case !ok:
return StationActions.listeningStation(station);
case !group:
group.global[window.util.mainStationPath(window.urb.user)] = group.local;
return StationActions.loadMembers(group.global);
case !(cabal != null ? cabal.loc : void 0):
return StationActions.loadConfig(station, cabal.loc);
case !glyph:
return StationActions.loadGlyphs(glyph);
}
});
}
@ -1844,8 +1852,6 @@ so.cs = $(window).scrollTop();
so.w = null;
so.$d = $('#nav > div');
setSo = function() {
so.$n = $('#station-container');
so.w = $(window).width();
@ -1939,6 +1945,13 @@ if (!window.util) {
}
_.merge(window.util, {
defaultStation: function() {
if (document.location.search) {
return document.location.search.replace(/^\?/, '');
} else {
return window.util.mainStation();
}
},
mainStations: ["court", "floor", "porch"],
mainStationPath: function(user) {
return "~" + user + "/" + (window.util.mainStation(user));