urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2025-01-05 19:46:50 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'cgyarvin/neoames' into learning

Browse Source
This commit is contained in:
C. Guy Yarvin 2016-08-05 12:59:19 -07:00
commit 57f0abc3dd
123 changed files with 12809 additions and 5172 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored Normal file
View File

@ -0,0 +1 @@
/sec/**/*.atom

159
app/dojo.hoon
View File

@ -2,7 +2,7 @@
:::: /hoon/dojo/app :: ::::
:: :: ::
/? 314 :: arvo kelvin
/- sole :: console structures
/- sole, lens :: console structures
/+ sole :: console library
[. sole]
:: :: ::
@ -18,7 +18,7 @@
$: say/sole-share :: command-line state
dir/beam :: active path
poy/(unit dojo-project) :: working
{lib/(list hoof) arc/(list hoof)} :: lib+sur
{lib/(list hoof) sur/(list hoof)} :: lib+sur
var/(map term cage) :: variable state
old/(set term) :: used TLVs
buf/tape :: multiline buffer
@ -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/iden r/purl} :: http outbound
{$http p/?($post $put) q/(unit 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
@ -42,7 +42,7 @@
q/dojo-build :: general build
== ::
++ dojo-build :: one arvo step
$% {$ur p/iden q/purl} :: http GET request
$% {$ur p/(unit 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 {$~ iden} mark {$hiss hiss}} ::
{$hiss wire (unit iden) mark {$hiss hiss}} ::
{$exec wire @p (unit {beak silk})} ::
{$deal wire sock term club} ::
{$info wire @p toro} ::
@ -154,7 +154,7 @@
::
;~ pfix fas
;~ pose
(dp-variable (cold %arc hep) ;~(pfix gap dp-hooves))
(dp-variable (cold %sur hep) ;~(pfix gap dp-hooves))
(dp-variable (cold %lib lus) ;~(pfix gap dp-hooves))
==
==
@ -165,10 +165,10 @@
++ dp-sink
;~ pose
;~(plug (cold %file tar) dp-beam)
;~(plug (cold %flat pat) (most fas qut))
;~(plug (cold %flat pat) (most fas sym))
;~(plug (cold %pill dot) (most fas sym))
;~(plug (cold %http lus) (easy %post) dp-iden-url)
;~(plug (cold %http hep) (easy %put) dp-iden-url)
;~(plug (cold %http lus) (stag %post dp-iden-url))
;~(plug (cold %http hep) (stag %put dp-iden-url))
(stag %show (cook $?($1 $2 $3) (cook lent (stun [1 3] wut))))
==
++ dp-hooves :: hoof list
@ -221,7 +221,7 @@
(sear plex:vez (stag %conl poor:vez))
::
++ dp-iden-url
(cook |=({a/(unit iden) b/purl} [(fall a *iden) b]) auru:epur)
(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
@ -269,10 +269,10 @@
(he-card(poy `+>+<(pux `way)) %exec way our.hid `[he-beak kas])
::
++ dy-eyre :: send work to eyre
|= {way/wire usr/iden req/hiss}
|= {way/wire usr/(unit iden) req/hiss}
^+ +>+>
?> ?=($~ pux)
(he-card(poy `+>+<(pux `way)) %hiss way `usr %httr %hiss req)
(he-card(poy `+>+<(pux `way)) %hiss way usr %httr %hiss req)
::
++ dy-stop :: stop work
^+ +>
@ -286,6 +286,11 @@
^+ +>+>
(dy-ford way `silk`[%call [%$ %noun gat] [%$ %noun sam]])
::
++ dy-errd :: reject change, abet
|= {rev/(unit sole-edit) err/@u}
^+ +>+>
(he-errd(poy `+>+<) rev err)
::
++ dy-diff :: send effects, abet
|= fec/sole-effect
^+ +>+>
@ -402,8 +407,7 @@
!&(?=($del -.u.per) =(+(p.u.per) (lent buf.say)))
==
dy-abet(per ~)
=^ lic say (~(transmit sole say) u.per)
(dy-diff(per ~) %mor [%det lic] [%err q.q.cag] ~)
(dy-errd(per ~) per q.q.cag)
::
++ dy-done :: dialog submit
|= txt/tape
@ -415,6 +419,7 @@
++ dy-cast
|* {typ/_* bun/vase}
|= a/vase ^- typ
~| [p.bun p.a]
?> (~(nest ut p.bun) & p.a)
;;(typ q.a)
::
@ -428,7 +433,7 @@
?+ p.mad .
$?($eny $now $our) !!
$lib .(lib ~)
$arc .(arc ~)
$sur .(sur ~)
$dir .(dir [[our.hid %home ud+0] /])
==
=+ cay=(~(got by rez) p.q.mad)
@ -442,7 +447,7 @@
$now ~|(%time-is-immutable !!)
$our ~|(%self-is-immutable !!)
$lib .(lib ((dy-cast (list hoof) !>(*(list hoof))) q.cay))
$arc .(arc ((dy-cast (list hoof) !>(*(list hoof))) q.cay))
$sur .(sur ((dy-cast (list hoof) !>(*(list hoof))) q.cay))
$dir =+ ^= pax ^- path
=+ pax=((dy-cast path !>(*path)) q.cay)
?: ?=($~ pax) ~[(scot %p our.hid) %home '0']
@ -483,7 +488,7 @@
$http
?> ?=($mime p.cay)
=+ mim=;;(mime q.q.cay)
=+ maf=(~(add ja *math) %content-span (moon p.mim))
=+ maf=(~(add ja *math) %content-type (moon p.mim))
(dy-eyre /show q.p.mad [r.p.mad p.p.mad maf ~ q.mim])
::
$show
@ -537,7 +542,7 @@
++ dy-shown
$? twig
$^ {dy-shown dy-shown}
$% {$ur iden purl}
$% {$ur (unit iden) purl}
{$dv path}
{$as mark dy-shown}
{$do twig dy-shown}
@ -641,7 +646,7 @@
|= cag/cage
^+ +>+>
?. ?=(^ q.q.cag)
(dy-diff %err q.q.cag)
(dy-errd ~ q.q.cag)
=+ tan=((list tank) +2.q.q.cag)
=. +>+>.$ (he-diff %tan tan)
=+ vax=(spec (slot 3 q.cag))
@ -663,7 +668,7 @@
|= cag/cage
^+ +>+>
?. ?=(^ q.q.cag)
(dy-diff %err q.q.cag)
(dy-errd ~ q.q.cag)
=+ tan=((list tank) +2.q.q.cag)
=. +>+>.$ (he-diff %tan tan)
=+ vax=(spec (slot 3 q.cag))
@ -676,9 +681,11 @@
(dy-meal (slot 7 vax))
::
$|
=+ hiz=;;(hiss +<.q.vax)
=> .(vax (slap vax !,(*twig ?>(?=($| -) .)))) :: XX working spec #72
=+ typ={$| (unit iden) hiss *}
=+ [~ usr hiz ~]=((dy-cast typ !>(*typ)) 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 15 vax) limb+%r)) /scar usr hiz)
==
::
++ dy-sigh-scar :: scraper result
@ -754,7 +761,7 @@
=- ?~(too - [%cast u.too -])
:+ %ride gen
:- [%$ dy-twig-head]
[%plan he-beam blob+** [zuse arc lib ~ ~]]
[%plan he-beam blob+** [zuse sur lib ~ ~]]
::
++ dy-step :: advance project
|= nex/@ud
@ -838,6 +845,12 @@
?^ poy .
he-prom:he-pone
::
++ he-errd :: reject update
|= {rev/(unit sole-edit) err/@u} ^+ +>
=+ red=(fall rev [%nop ~]) :: required for error location sync
=^ lic say (~(transmit sole say) red)
(he-diff %mor [%det lic] [%err err] ~)
::
++ he-pone :: clear prompt
^+ .
=^ cal say (~(transmit sole say) [%set ~])
@ -921,9 +934,8 @@
=+ foy=(he-dope (tufa buf.say))
?: ?=($& -.foy) +>.$
:: ~& [%bad-change dat ted.cal]
=^ lic say (~(transmit sole say) dat)
:: ~& [%our-leg leg.say]
(he-diff %mor [%det lic] [%err q.p.foy] ~)
(he-errd `dat q.p.foy)
::
++ he-plan :: execute command
|= mad/dojo-command
@ -943,10 +955,10 @@
==
=+ doy=(he-duke txt)
?- -.doy
$| (he-diff [%err p.doy])
$| (he-errd ~ p.doy)
$&
?~ p.doy
(he-diff [%err (lent txt)])
(he-errd ~ (lent txt))
=+ old=(weld ?~(buf "> " " ") (tufa buf.say))
=^ cal say (~(transmit sole say) [%set ~])
=. +>.$ (he-diff %mor txt+old nex+~ det+cal ~)
@ -967,6 +979,88 @@
$clr he-pine(buf "")
==
::
++ he-lens
|= com/command:lens
^+ +>
=+ ^- source/dojo-source
=| num/@
=- ?. ?=($send-api -.sink.com) :: XX num is incorrect
sor
:- 0
:+ %as `mark`(cat 3 api.sink.com '-poke')
:- 1
:+ %do
:+ %gill [%base %noun]
:^ %cont [%rock %tas %post]
[%rock %$ endpoint.sink.com]
[%make ~[[%.y 6]] ~]
sor
^= sor
|- ^- dojo-source
:- num
?- -.source.com
$data [%ex %sand %t data.source.com]
$dojo (rash command.source.com dp-build:dp)
$clay
:- %ex
:* %wish
[%base %noun]
:+ %cons
[%rock %tas %cx]
%+ rash pax.source.com
rood:(vang | /(scot %p our.hid)/home/(scot %da now.hid))
==
::
$url [%ur `~. url.source.com]
$api !!
$get-api
:* %ex
%wish
[%wing ~[%json]]
:* %conl
[%rock %tas %gx]
[%sand %ta (scot %p our.hid)]
[%sand %tas api.source.com]
[%sand %ta (scot %da now.hid)]
(turn endpoint.source.com |=(a/@t [%sand %ta a]))
==
==
::
$listen-api !!
$as
:* %as mar.source.com
$(num +(num), source.com next.source.com)
==
::
$hoon
:* %do
%+ rash code.source.com
tall:(vang | /(scot %p our.hid)/home/(scot %da now.hid))
$(num +(num), source.com next.source.com)
==
::
$tuple
:- %tu
|- ^- (list dojo-source)
?~ next.source.com
~
=. num +(num)
:- ^$(source.com i.next.source.com)
$(next.source.com t.next.source.com)
==
=+ |- ^- sink/dojo-sink
?- -.sink.com
$stdout [%show %0]
$output-file $(sink.com [%command (cat 3 '@' pax.sink.com)])
$output-clay [%file (need (tome pax.sink.com))]
$url [%http %post `~. url.sink.com]
$to-api !!
$send-api [%poke our.hid api.sink.com]
$command (rash command.sink.com dp-sink:dp)
$app [%poke our.hid app.sink.com]
==
(he-plan sink source)
::
++ he-lame :: handle error
|= {wut/term why/tang}
^+ +>
@ -1018,6 +1112,17 @@
++ poke-sole-action
|= act/sole-action ~| poke+act %. act
(wrap he-span):arm
::
++ poke-lens-command
|= com/command:lens ~| poke-lens+com %. com
(wrap he-lens):arm
::
++ poke-json
|= jon/json
^- {(list move) _+>.$}
~& jon=jon
[~ +>.$]
::
++ made (wrap he-made):arm
++ sigh-httr (wrap he-sigh):arm
++ sigh-tang |=({a/wire b/tang} ~|(`term`(cat 3 'sigh-' -.a) (mean b)))

385
app/gh.hoon
View File

@ -1,114 +1,270 @@
:: This is a driver for the Github API v3.
:: This is a connector 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.
:: - .^({type} %gx /=gh={/endpoint}) to read data or
:: .^(arch %gy /=gh={/endpoint}) to explore the possible
:: endpoints.
::
:: - subscribe to /scry/x/listen/{owner}/{repo}/{events...}
:: for webhook-powered event notifications. For event list,
:: see https://developer.github.com/webhooks/.
:: - subscribe to /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.
:: This is written with the standard structure for api
:: connectors, as described in lib/connector.hoon.
::
/? 314
/- gh
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
// /%/split
/- gh, plan-acct
/+ gh-parse, connector
::
!:
=> |%
++ 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}}
==
::
:: Types of results we produce to subscribers.
::
++ sub-result
$% {$arch arch}
{$gh-issue issue:gh}
{$gh-list-issues (list issue:gh)}
{$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
{$json json}
{$null $~}
==
::
:: Types of webhooks we expect.
::
++ hook-response
$% {$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
==
--
=+ connector=(connector move sub-result) :: Set up connector library
::
|_ {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
++ prep _`.
|_ $: hid/bowl
hook/(map @t {id/@t listeners/(set bone)}) :: map events to listeners
==
:: ++ prep _`. :: Clear state when code changes
::
:: This core manages everything related to a particular request.
:: List of endpoints
::
:: Each request has a particular 'style', which is currently
:: one of 'read', or 'listen'. ++scry handles all three types
:: of requests.
++ places
|= wir/wire
^- (list place:connector)
=+ (helpers:connector ost.hid wir "https://api.github.com")
=> |% :: gh-specific helpers
++ read-sentinel
|=(pax/path [ost %diff %arch `0vsen.tinel ~])
::
++ 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 ^- (list {@ta $~})
:- [%gh-list-issues ~]
(turn issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~]))
--
:~ ^- place :: /
:* guard=$~
read-x=read-null
read-y=(read-static %issues ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place :: /issues
:* guard={$issues $~}
read-x=read-null
read-y=(read-static %mine %by-repo ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place :: /issues/mine
:* guard={$issues $mine $~}
read-x=(read-get /issues)
read-y=(read-static %gh-list-issues ~)
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place :: /issues/mine/<mark>
:* guard={$issues $mine @t $~}
read-x=read-null
read-y=read-sentinel
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place :: /issues/by-repo
:* 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 :: /issues/by-repo/<user>
:* 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)
[~ (malt (turn repos |=(repository:gh [name ~])))]
==
^- place :: /issues/by-repo/<user>/<repo>
:* 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
==
^- place :: /issues/by-repo/<user>/<repo>/<number>
:* guard={$issues $by-repo @t @t @t $~}
^= read-x
|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues/[-.+>+>.pax]))
::
^= read-y
|= pax/path
%. pax
?: ((sane %tas) -.+>+>.pax)
read-sentinel
(read-static %gh-issue ~)
::
^= sigh-x
|= jon/json
%+ bind (issue:gh-parse jon)
|= issue/issue:gh
gh-issue+issue
::
sigh-y=sigh-strange
==
^- place :: /issues/by-repo/<u>/<r>/<n>/<mark>
:* guard={$issues $by-repo @t @t @t @t $~}
read-x=read-null
read-y=read-sentinel
sigh-x=sigh-strange
sigh-y=sigh-strange
==
==
::
++ help
|= {ren/care style/@tas pax/path}
=^ arg pax [+ -]:(split pax)
:: 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.
::
:: We hand control to ++scry.
::
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care *} pax)
:_ +>.$ :_ ~
(read:connector ost.hid (places %read pax) i.pax 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) _+>.$}
?. ?=({$read care @ *} way)
~& res=res
[~ +>.$]
=* style i.way
=* ren i.t.way
=* pax t.t.way
:_ +>.$ :_ ~
:+ ost.hid %diff
(sigh:connector (places ren style pax) ren pax res)
::
:: HTTP error. We just print it out, though maybe we should
:: also produce a result so that the request doesn't hang?
::
++ sigh-tang
|= {way/wire tan/tang}
^- {(list move) _+>.$}
%- (slog >%gh-sigh-tang< tan)
[[ost.hid %diff null+~]~ +>.$]
::
:: 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]
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: Webhook-powered event streams (/listen) ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
:: To listen to a webhook-powered stream of events, subscribe
:: to /listen/<user>/<repo>/<events...>
::
:: We hand control to ++listen.
::
++ peer-listen
|= pax/path
^- {(list move) _+>.$}
?. ?=({@ @ *} pax)
~& [%bad-listen-path pax]
[~ +>.$]
(listen pax)
::
:: This core handles event subscription requests by starting or
:: updating the webhook flow for each event.
::
++ listen
|= pax/path
=| mow/(list move)
=< abet:listen
|%
:: Resolve core.
::
++ abet
++ abet :: Resolve core.
^- {(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
++ send-hiss :: Send a 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 ~ ~)
=+ wir=`wire`[%x %listen pax]
+>.$(mow [[ost.hid %hiss wir `~ %httr [%hiss hiz]] mow])
::
:: Create or update a webhook to listen for a set of events.
::
++ listen
^+ .
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ events=t.t.paf
=+ pax=pax :: TMI-proofing
?> ?=({@ @ *} pax)
=+ events=t.t.pax
|- ^+ +>+.$
?~ events
+>+.$
?: (~(has by hook) i.events)
=. +>+.$ (update-hook i.events)
$(events t.events)
=. +>+.$ (create-hook i.events)
$(events t.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)
?> ?=({@ @ *} pax)
=+ clean-event=`tape`(turn (trip event) |=(a/@tD ?:(=('_' a) '-' a)))
=. hook
%+ ~(put by hook) (crip clean-event)
@ -118,7 +274,7 @@
[id (~(put in listeners) ost.hid)]
%- send-hiss
:* %+ scan
=+ [(trip i.paf) (trip i.t.paf)]
=+ [(trip i.pax) (trip i.t.pax)]
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:epur
%post ~ ~
@ -167,103 +323,4 @@
%+ 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
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 $~}
==
--

282
app/gmail.hoon
View File

@ -1,282 +0,0 @@
:: 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
View File

@ -1,6 +0,0 @@
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
View File

@ -1,71 +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}
?: ?=(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 $~}
==
--
::

36
app/hood.hoon
View File

@ -1,14 +1,14 @@
:: :: ::
:::: /hoon/hood/app :: ::
:: :: ::
/? 310 :: zuse version
/? 310 :: zuse version
/+ sole, talk, helm, kiln, drum, write :: libraries
[. helm kiln drum]
:: :: ::
:::: :: ::
!: :: ::
=> |% :: module boilerplate
++ hood-0 ::
++ hood-0 ::
{$0 lac/(map @tas hood-part)} ::
++ hood-good ::
|* hed/hood-head ::
@ -19,17 +19,27 @@
$kiln ?>(?=($kiln -.paw) `kiln-part`paw) ::
$write ?>(?=($write -.paw) `part:write`paw) ::
== ::
++ hood-head _-:*hood-part ::
++ hood-head _-:*hood-part ::
++ hood-make ::
|* {our/@p hed/hood-head} ::
?- hed ::
$drum (drum-port our) ::
$drum (drum-make our) ::
$helm *helm-part ::
$kiln *kiln-part ::
$write *part:write ::
$write *part:write ::
== ::
++ hood-part-old ::
$? hood-part ::
{$drum $0 drum-pith-0} ::
== ::
++ hood-port ::
|= paw/hood-part-old ^- hood-part ::
?+ -.paw paw ::
$drum (drum-port paw) ::
== ::
:: ::
++ hood-part ::
$% {$drum $0 drum-pith} ::
$% {$drum $1 drum-pith} ::
{$helm $0 helm-pith} ::
{$kiln $0 kiln-pith} ::
{$write $0 pith:write} ::
@ -53,6 +63,12 @@
:: :: ::
:::: :: ::
:: :: ::
++ prep ::
|= old/(unit hood-0) ^- (quip _!! +>)
:- ~
?~ old +>
+>(lac (~(run by lac.u.old) hood-port))
::
++ coup-kiln-fancy (wrap take-coup-fancy):from-kiln
++ coup-kiln-spam ::
|= {way/wire saw/(unit tang)}
@ -116,16 +132,16 @@
++ poke-helm-spawn (wrap poke-spawn):from-helm
++ poke-hood-sync (wrap poke-sync):from-kiln
++ poke-hood-init-sync (wrap poke-init-sync):from-kiln
++ poke-kiln-cp (wrap poke-cp):from-kiln
++ poke-kiln-info (wrap poke-info):from-kiln
++ poke-kiln-label (wrap poke-label):from-kiln
++ poke-kiln-merge (wrap poke-merge):from-kiln
++ poke-kiln-cancel (wrap poke-cancel):from-kiln
++ poke-kiln-mount (wrap poke-mount):from-kiln
++ poke-kiln-mv (wrap poke-mv):from-kiln
++ poke-kiln-rm (wrap poke-rm):from-kiln
++ poke-kiln-schedule (wrap poke-schedule):from-kiln
++ poke-kiln-track (wrap poke-track):from-kiln
++ poke-kiln-sync (wrap poke-sync):from-kiln
++ poke-kiln-syncs (wrap poke-syncs):from-kiln
++ poke-kiln-start-autoload (wrap poke-start-autoload):from-kiln
++ poke-kiln-autoload (wrap poke-autoload):from-kiln
++ poke-kiln-overload (wrap poke-overload):from-kiln
@ -134,7 +150,9 @@
++ 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
++ poke-write-fora-post (wrap poke-fora-post):from-write
++ poke-write-plan-info (wrap poke-plan-info):from-write
++ poke-write-plan-account (wrap poke-plan-account):from-write
++ poke-write-tree (wrap poke-tree):from-write
++ poke-write-wipe (wrap poke-wipe):from-write
++ poke-will (wrap poke-will):from-helm

92
app/pipe.hoon Normal file
View File

@ -0,0 +1,92 @@
/+ talk
!:
=> |%
++ move (pair bone card)
++ card
$% {$peel wire dock mark path}
{$poke wire dock $talk-command command:talk}
==
--
::
|_ {hid/bowl connections/(set {app/term source/path station/knot})}
++ poke-noun
|= arg/*
^- {(list move) _+>.$}
?: ?=($list arg)
(poke-pipe-list ~)
=+ ((soft {$cancel app/term source/path station/knot}) arg)
?^ -
(poke-pipe-cancel app.u source.u station.u)
=+ ((hard {app/term source/path station/knot}) arg)
(poke-pipe-connect app source station)
::
++ poke-pipe-list
|= $~
^- {(list move) _+>.$}
%- %- slog
%+ turn (~(tap in connections))
|= {app/term source/path station/knot}
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
[~ +>.$]
::
++ poke-pipe-cancel
|= {app/term source/path station/knot}
^- {(list move) _+>.$}
?. (~(has in connections) [app source station])
%- %- slog :~
leaf+"no connection:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$]
%- %- slog :~
leaf+"canceling:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$(connections (~(del in connections) [app source station]))]
::
++ poke-pipe-connect
|= {app/term source/path station/knot}
^- {(list move) _+>.$}
:_ +>.$(connections (~(put in connections) [app source station]))
:_ ~
~& [%peeling app source station]
:* ost.hid %peel [%subscribe app station source]
[our.hid app] %talk-speeches source
==
::
++ diff-talk-speeches
|= {way/wire speeches/(list speech:talk)}
^- {(list move) _+>.$}
?> ?=({$subscribe @ @ *} way)
=+ app=(slav %tas i.t.way)
=+ station=i.t.t.way
=+ source=t.t.t.way
?. (~(has in connections) [app source station])
%- %- slog :~
leaf+"pipe dropping:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$]
:_ +>.$ :_ ~
:* ost.hid %poke [%relay app station source]
[our.hid %talk] %talk-command
%publish
|- ^- (list thought:talk)
?~ speeches
~
:_ $(speeches t.speeches, eny.hid (shax (cat 3 %pipe eny.hid)))
:* `@uvH`(end (sub 'H' 'A') 1 eny.hid)
[[[%& our.hid station] *envelope:talk %pending] ~ ~]
now.hid *(set flavor:talk) i.speeches
==
==
::
++ coup-relay
|= {way/wire saw/(unit tang)}
^- {(list move) _+>.$}
?> ?=({@ @ @ *} way)
?~ saw
[~ +>.$]
%- (slog leaf+"pipe relay failure in:" >way< u.saw)
[~ +>.$]
--

234
app/talk.hoon
View File

@ -72,7 +72,8 @@
== ::
++ pear :: poke fruit
$% {$talk-command command} ::
{$write-comment path ship cord} ::
{$write-comment spur ship cord} ::
{$write-fora-post spur ship cord cord} ::
== ::
++ card :: general card
$% {$diff lime} ::
@ -122,6 +123,20 @@
(runt [(sub len lez) '-'] nez)
:(welp pre (scag (dec len) nez) "+")
++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] :: station char pool
++ peer-type :: stream requests
=< apex
|%
++ apex ?($a-group $f-grams $v-glyph $x-cabal) :: options
++ encode |=(a/apex ^-(char (end 3 1 a))) :: by first char
++ decode :: discriminate
|= a/char ^- apex
?+ a ~|(bad-subscription-designator+a !!)
$a %a-group
$f %f-grams
$v %v-glyph
$x %x-cabal
==
--
--
|_ {hid/bowl house}
++ ra :: per transaction
@ -313,7 +328,10 @@
=< sh-prod
%_ .
+>
(ra-subscribe:(ra-subscribe her.she ~) her.she [%afx man.she ~])
=/ typ
=+ (ly ~[%a-group %f-grams %x-cabal])
(rap 3 (turn - encode:peer-type))
(ra-subscribe:(ra-subscribe her.she ~) her.she [typ man.she ~])
==
::
++ sh-prod :: show prompt
@ -808,63 +826,80 @@
|= buf/(list @c)
^- (list sole-edit)
?~ buf ~
=+ [inx=0 sap=0 con=0]
=+ isa==(i.buf (turf '@'))
=+ [[pre=*@c cur=i.buf buf=t.buf] inx=0 brk=0 len=0 new=|]
=* txt -<
|^ ^- (list sole-edit)
?: =(i.buf (turf '•'))
?. =(0 con) newline
[[%del inx] ?~(t.buf ~ $(buf t.buf))]
?: =(i.buf `@`' ')
?. =(64 con) advance(sap inx)
[(fix (turf '•')) newline]
?: =(64 con)
=+ dif=(sub inx sap)
?: =(cur (turf '•'))
?: =(pre (turf '•'))
[[%del inx] ?~(buf ~ $(txt +.txt))]
?: new
[(fix ' ') $(cur `@c`' ')]
newline
?: =(cur `@`' ')
=. brk ?:(=(pre `@`' ') brk inx)
?. =(64 len) advance
:- (fix(inx brk) (turf '•'))
?: isa
[[%ins +(brk) (turf '@')] newline(new &)]
newline(new &)
?: =(64 len)
=+ dif=(sub inx brk)
?: (lth dif 64)
[(fix(inx sap) (turf '•')) $(con dif)]
[[%ins inx (turf '•')] $(con 0, inx +(inx))]
?: |((lth i.buf 32) (gth i.buf 126))
:- (fix(inx brk) (turf '•'))
?: isa
[[%ins +(brk) (turf '@')] $(len dif, new &)]
$(len dif, new &)
[[%ins inx (turf '•')] $(len 0, inx +(inx), new &)]
?: |((lth cur 32) (gth cur 126))
[(fix '?') advance]
?: &((gte i.buf 'A') (lte i.buf 'Z'))
[(fix (add 32 i.buf)) advance]
?: &((gte cur 'A') (lte cur 'Z'))
[(fix (add 32 cur)) advance]
advance
::
++ advance ?~(t.buf ~ $(con +(con), inx +(inx), buf t.buf))
++ newline ?~(t.buf ~ $(con 0, inx +(inx), buf t.buf))
++ advance ?~(buf ~ $(len +(len), inx +(inx), txt +.txt))
++ newline ?~(buf ~ $(len 0, inx +(inx), txt +.txt))
++ fix |=(cha/@ [%mor [%del inx] [%ins inx `@c`cha] ~])
--
::
++ sh-sane :: sanitize input
|= {inv/sole-edit buf/(list @c)}
^- (list sole-edit)
^- {lit/(list sole-edit) err/(unit @u)}
=+ res=(rose (tufa buf) sh-scad)
?: ?=($| -.res) [inv ~]
=+ wok=`(unit work)`p.res
?: ?=($| -.res) [[inv]~ `p.res]
:_ ~
?~ p.res ~
=+ wok=u.p.res
|- ^- (list sole-edit)
?~ wok ~
?+ -.u.wok ~
$target $(wok q.u.wok)
?+ -.wok ~
$target ?~(q.wok ~ $(wok u.q.wok))
$say |- :: XX per line
?~ p.u.wok ~
?: ?=($lin -.i.p.u.wok)
?~ p.wok ~
?: ?=($lin -.i.p.wok)
(sh-sane-chat buf)
$(p.u.wok t.p.u.wok)
$(p.wok t.p.wok)
==
::
++ sh-slug :: edit to sanity
|= lit/(list sole-edit)
|= {lit/(list sole-edit) err/(unit @u)}
^+ +>
?~ lit +>
=^ lic say.she
(~(transmit sole say.she) `sole-edit`?~(t.lit i.lit [%mor lit]))
(sh-fact [%mor [%det lic] ~])
(sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)])
::
++ sh-stir :: apply edit
|= cal/sole-change
^+ +>
=^ inv say.she (~(transceive sole say.she) cal)
=+ lit=(sh-sane inv buf.say.she)
?~ lit
=+ fix=(sh-sane inv buf.say.she)
?~ lit.fix
+>.$
(sh-slug lit)
?~ err.fix
(sh-slug fix) :: just capital correction
?. &(?=($del -.inv) =(+(p.inv) (lent buf.say.she)))
+>.$ :: allow interior edits, deletes
(sh-slug fix)
::
++ sh-lame :: send error
|= txt/tape
@ -920,7 +955,7 @@
sh-prod(active.she `tr-pals:tay)
::
++ help
(sh-fact %txt "see http://urbit.org/docs/user/talk")
(sh-fact %txt "see http://urbit.org/docs/using/messaging/")
::
++ glyph
|= idx/@
@ -1133,19 +1168,17 @@
++ say :: publish
|= sep/(list speech)
^+ ..sh-work
?~ sep ..sh-work
=- ..sh-work(coz ?~(tot coz :_(coz [%publish tot])))
|- ^- tot/(list thought)
?~ sep ~
=^ sir ..sh-work sh-uniq
%_ $
sep t.sep
coz :_ coz
[%publish [[sir sh-whom [now.hid ~ i.sep]] ~]]
==
[[sir sh-whom [now.hid ~ i.sep]] $(sep t.sep)]
--
::
++ sh-done :: apply result
=+ lit=(sh-sane [%nop ~] buf.say.she)
?^ lit
(sh-slug lit)
=+ fix=(sh-sane [%nop ~] buf.say.she)
?^ lit.fix
(sh-slug fix)
=+ jub=(rust (tufa buf.say.she) sh-scad)
?~ jub (sh-fact %bel ~)
%. u.jub
@ -1262,11 +1295,16 @@
(ra-house n.gel)
::
++ ra-init :: initialize talk
%+ roll
^- (list {posture knot cord})
:~ [%brown (main our.hid) 'default home']
[%green ~.public 'visible activity']
==
|: [[typ=*posture man=*knot des=*cord] ..ra-init] ^+ ..ra-init
%+ ra-apply our.hid
:+ %design (main our.hid)
:+ %design man
:- ~ :- ~
:- 'default home'
[%brown ~]
[des [typ ~]]
::
++ ra-apply :: apply command
|= {her/ship cod/command}
@ -1294,35 +1332,75 @@
?:(neu +>.$ ra-homes)
::
++ ra-base-hart .^(hart %e /(scot %p our.hid)/host/(scot %da now.hid))
++ ra-fora-post
|= {pax/path sup/spur hed/@t txt/@t}
=. ..ra-emit
%+ ra-emit ost.hid
:* %poke
/fora-post
[our.hid %hood]
[%write-fora-post sup src.hid hed txt]
==
=+ man=%posts
?: (~(has by stories) man)
(ra-consume-fora-post man pax sup hed txt)
=; new (ra-consume-fora-post:new man pax sup hed txt)
=. ..ra-apply
%+ ra-apply our.hid
:+ %design man
:- ~ :- ~
:- 'towards a community'
[%brown ~]
%^ ra-consume & our.hid
:^ (shaf %init eny.hid)
(my [[%& our.hid (main our.hid)] *envelope %pending] ~)
now.hid
[~ %app %tree 'receiving forum posts, ;join %posts for details']
::
++ ra-consume-fora-post
|= {man/knot pax/path sup/spur hed/@t txt/@t} ^+ +>
=+ nam=?~(sup "" (trip i.sup)) :: file name
=+ fra=(crip (time-to-id now.hid)) :: url fragment
%^ ra-consume &
src.hid
:* (shaf %comt eny.hid)
(my [[%& our.hid man] *envelope %pending] ~)
now.hid
(sy /fora-post eyre+pax ~)
:- %mor :~
[%fat text+(lore txt) [%url [ra-base-hart `pax ~] `fra]]
[%app %tree (crip "forum post: '{(trip hed)}'")]
==
==
::
++ ra-comment
|= {pax/path txt/@t}
|= {pax/path sup/spur txt/@t}
=. ..ra-emit
%+ ra-emit ost.hid
:* %poke
/comment
[our.hid %hood]
[%write-comment pax src.hid txt]
[%write-comment sup src.hid txt]
==
=+ man=%comments
?: (~(has by stories) man)
(ra-consume-comment man pax txt)
(ra-consume-comment man pax sup txt)
=; new (ra-consume-comment:new man pax sup txt)
=. ..ra-apply
%+ ra-apply our.hid
:+ %design man
:- ~ :- ~
:- 'letters to the editor'
[%brown ~]
=. ..ra-consume
%^ ra-consume & our.hid
:^ (shaf %init eny.hid)
(my [[%& our.hid (main our.hid)] *envelope %pending] ~)
now.hid
[~ %app %tree 'receiving comments, ;join %comments for details']
(ra-consume-comment man pax txt)
%^ ra-consume & our.hid
:^ (shaf %init eny.hid)
(my [[%& our.hid (main our.hid)] *envelope %pending] ~)
now.hid
[~ %app %tree 'receiving comments, ;join %comments for details']
::
++ ra-consume-comment
|= {man/knot pax/path txt/@t} ^+ +>
=+ nam==+(xap=(flop pax) ?~(xap "" (trip i.xap))) :: file name
|= {man/knot pax/path sup/spur txt/@t} ^+ +>
=+ nam=?~(sup "" (trip i.sup)) :: file name
=+ fra=(crip (time-to-id now.hid)) :: url fragment
%^ ra-consume &
src.hid
@ -1413,7 +1491,7 @@
(ra-house(general (~(put in general) ost.hid)) ost.hid)
?. ?=({@ @ *} pax)
(ra-evil %talk-bad-path)
=+ vab=(~(gas in *(set @tas)) (rip 3 i.pax))
=+ vab=(~(gas in *(set peer-type)) (turn (rip 3 i.pax) decode:peer-type))
=+ pur=(~(get by stories) i.t.pax)
?~ pur
~& [%bad-subscribe-story-c i.t.pax]
@ -1422,10 +1500,10 @@
?. (pa-visible:soy her)
(ra-evil %talk-no-story)
=^ who +>.$ (ra-human her)
=. soy ?.((~(has in vab) %a) soy (pa-watch-group:soy her))
=. soy ?.((~(has in vab) %v) soy (pa-watch-glyph:soy her))
=. soy ?.((~(has in vab) %x) soy (pa-watch-cabal:soy her))
=. soy ?.((~(has in vab) %f) soy (pa-watch-grams:soy her t.t.pax))
=. soy ?.((~(has in vab) %a-group) soy (pa-watch-group:soy her))
=. soy ?.((~(has in vab) %v-glyph) soy (pa-watch-glyph:soy her))
=. soy ?.((~(has in vab) %x-cabal) soy (pa-watch-cabal:soy her))
=. soy ?.((~(has in vab) %f-grams) soy (pa-watch-grams:soy her t.t.pax))
=. soy (pa-notify:soy her %hear who)
pa-abet:soy
::
@ -1625,8 +1703,12 @@
%+ turn tal
|= tay/partner
^- (list card)
:: =+ num=(fall (~(get by sequence) tay) 0) :: XX unused
=+ old=(sub now.hid ~d1)
=+ num=(~(get by sequence) tay)
=+ old=(sub now.hid ~d1) :: XX full backlog
=+ ini=?^(num (scot %ud u.num) (scot %da old))
=/ typ
=+ (ly ~[%a-group %f-grams %x-cabal])
(rap 3 (turn - encode:peer-type))
?- -.tay
$| !!
$& :: ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]]
@ -1634,7 +1716,7 @@
:* %peer
/friend/show/[man]/(scot %p p.p.tay)/[q.p.tay]
[p.p.tay %talk]
/afx/[q.p.tay]/(scot %da old)
/[typ]/[q.p.tay]/[ini]
==
==
::
@ -1806,6 +1888,8 @@
++ pa-revise :: revise existing
|= {num/@ud gam/telegram}
=+ way=(sub count num)
?: =(gam (snag (dec way) grams))
+>.$ :: no change
=. grams (welp (scag (dec way) grams) [gam (slag way grams)])
(pa-refresh num gam)
--
@ -2018,6 +2102,15 @@
$url url+(crip (earf p.sep))
$mor mor+(turn p.sep |=(speech ^$(sep +<)))
$fat [%mor $(sep q.sep) tan+(tr-rend-tors p.sep) ~]
$api
:- %tan
:_ ~
:+ %rose
[": " ~ ~]
:~ leaf+"[{(trip id.sep)} on {(trip service.sep)}]"
leaf+(trip body.sep)
leaf+(earf url.sep)
==
==
::
++ tr-rend-tors
@ -2090,6 +2183,9 @@
::
$app
(tr-chow 64 "[{(trip p.sep)}]: {(trip q.sep)}")
::
$api
(tr-chow 64 "[{(trip id.sep)}@{(trip service.sep)}]: {(trip summary.sep)}")
==
--
::
@ -2201,8 +2297,12 @@
[ost.hid %info /jamfile our.hid (foal paf [%talk-telegrams !>(-)])]
::
++ poke-talk-comment
|= {pax/path txt/@t} ^- (quip move +>)
ra-abet:(ra-comment:ra pax txt)
|= {pax/path sup/spur txt/@t} ^- (quip move +>)
ra-abet:(ra-comment:ra pax sup txt)
::
++ poke-talk-fora-post
|= {pax/path sup/spur hed/@t txt/@t} ^- (quip move +>)
ra-abet:(ra-fora-post:ra pax sup hed txt)
::
++ poke-talk-save
|= man/knot

355
app/twit.hoon
View File

@ -1,73 +1,89 @@
:: Twitter daemon
::
:::: /hook/core/twit/app
:::: /hoon/twit/app
::
/- plan-acct
/+ twitter, talk
::
:::: ~fyr
::
|%
++ twit-path :: valid peer path
$% :: [%home ~] :: home timeline
[%user p=@t ~] :: user's tweets
[%post p=span:,@uv ~] :: status of status
$% {$cred $~} :: credential info
{$home p/@t $~} :: home timeline
{$user p/@t $~} :: user's tweets
{$post p/@taxuv $~} :: status of status
==
::
++ axle :: app state
$: %0
kes=(map span keys:twittter) :: auth
out=(map ,@uvI (each ,[span cord] stat)) :: sent tweets
ran=(map path ,[p=@ud q=@da]) :: polls active
fed=(jar path stat) :: feed cache
$: $0
out/(map @uvI (each {knot cord} stat)) :: sent tweets
ran/(map path {p/@ud q/@da}) :: polls active
fed/(jar path stat) :: feed cache
ced/(unit (pair @da json)) :: credentials
==
::
++ gift :: subscription action
$% [%quit ~] :: terminate
[%diff gilt] :: send data
$% {$quit $~} :: terminate
{$diff gilt} :: send data
==
++ gilt
$% [%twit-feed p=(list stat)] :: posts in feed
[%twit-stat p=stat] :: tweet accepted
[%ares term (list tank)]
$% {$twit-feed p/(list stat)} :: posts in feed
{$twit-post p/stat} :: tweet accepted
{$ares term (list tank)} :: error
{$json json} :: unspecialized
==
::
++ move ,[bone card]
++ move {bone card}
++ card :: arvo request
$? gift
$% [%them path ~ u=hiss] :: HTTP request
[%poke wire dock %talk-command command:talk] ::
[%wait path p=@da] :: timeout
$% {$hiss wire (unit iden) api-call} :: api request
{$poke wire app-message} ::
{$wait wire p/@da} :: timeout
== ==
::
++ api-call {response-mark $twit-req {endpoint quay}} :: full hiss payload
++ response-mark ?($twit-post $twit-feed $twit-cred) :: sigh options
++ app-message
$? {{ship $talk} $talk-command command:talk} :: chat message
{{ship $hood} $write-plan-account iden plan-acct} :: registration
== ::
++ sign :: arvo response
$% [%e %thou p=httr] :: HTTP result
[%t %wake ~] :: timeout ping
$% {$e $thou p/httr} :: HTTP result
{$t $wake $~} :: timeout ping
==
::
++ stat stat:twitter :: recieved tweet
++ twit main:twitter :: api interface
++ twir parse:twitter :: reparsers
++ twip render:twitter :: printers
:: XX =*
++ stat post:twitter :: recieved tweet
++ command command:twitter :: incoming command
++ endpoint endpoint:reqs:twitter :: outgoing target
++ param param:reqs:twitter :: twit-req paramters
++ print print:twitter :: their serialization
++ parse parse:twitter :: and deserialization
::
:: ++ twit args:reqs:twitter :: arugment types
:: ++ twir parse:twitter :: reparsers
:: ++ twip print:twitter :: printers
--
!:
::::
::
|_ [bowl axle]
++ any-auth ?~(kes (auth) (auth p.n.kes)) :: use any keys
++ auth :: build API door
|= a=span
~| [%no-auth a]
~(. twit (~(got by kes) a) now `@`eny)
|_ {bowl axle}
::
++ prep
|= a/(unit axle) ^- (quip move +>)
?^ a [~ +>(+<+ u.a)]
(peer-scry-x /cred)
::
++ cull :: remove seen tweets
|= [pax=path rep=(list stat)] ^+ rep
=+ pev=(sa (turn (~(get ja fed) pax) |=(stat id)))
|= {pax/path rep/(list stat)} ^+ rep
=+ pev=(silt (turn (~(get ja fed) pax) |=(stat id)))
(skip rep |=(stat (~(has in pev) id)))
::
++ done [*(list move) .]
++ dely :: next polling timeout
|= pax=path
^- [(unit time) _ran]
|= pax/path
^- {(unit time) _ran}
=+ cur=(~(get by ran) pax)
=+ tym=(add now (mul ~s8 (bex ?~(cur 0 p.u.cur))))
:: ~& dely/`@dr`(sub tym now)
@ -75,8 +91,12 @@
[~ ran]
[`tym (~(put by ran) pax ?~(cur 0 (min 5 +(p.u.cur))) tym)]
::
++ wait-new :: poll with min delay
|= {pax/path mof/(list move)}
(wait(ran (~(del by ran) pax)) pax mof)
::
++ wait :: ensure poll by path
|= [pax=path mof=(list move)]
|= {pax/path mof/(list move)} ^+ done
=^ tym ran (dely pax)
:_ +>.$
?~ tym
@ -87,117 +107,192 @@
mof
::
++ poke-twit-do :: recieve request
|= [usr=span act=command:twitter]
^+ [*(list move) +>]
|= {usr/iden act/command} ^+ done
?- -.act
%auth
:- [(print "authed @{(trip usr)}")]~
+>.$(kes (~(put by kes) usr p.act)) :: XX verify key
%post
=: out (~(put by out) p.act %& usr q.act)
ran (~(del by ran) /peer/home)
==
%+ wait /peer/home
=+ mez=(stat-upda:(auth usr) [%status q.act]~ ~)
[ost %them /post/(scot %uv p.act) ~ mez]~
$post
=. out (~(put by out) p.act %& usr q.act)
%+ wait-new /peer/home/[usr]
=+ req=[%twit-req `endpoint`update+[%status q.act]~ ~]
[ost %hiss post+(dray ~[%uv] p.act) `usr %twit-post req]~
==
::
++ wake-peer
|= [pax=path ~] ^+ done
~& twit-wake/peer/pax
|= {pax/path $~} ^+ done
~& twit-wake+peer+pax
:_ +>.$
?. (~(has by ran) peer/pax) :: ignore if retracted
?. (~(has by ran) peer+pax) :: ignore if retracted
~
=+ => |=([a=bone @ b=path] [b a])
=+ => |=({a/bone @ b/path} [b a])
pus=(~(gas ju *(jug path bone)) (turn (~(tap by sup)) .))
?~ (~(get ju pus) pax)
~
~& peer-again/[pax ran]
(pear | our pax)
~& peer-again+[pax ran]
(pear | `~. pax) ::(user-from-path pax))
::
++ thou
|= [pax=path hit=httr] ^+ done
?+ p.hit ~|([%unknown-code p.hit] !!)
429 :: Rate-limit
=. ran (~(put by ran) pax 6 now)
=+ lim=%.(%x-rate-limit-reset ;~(biff ~(get by (mo q.hit)) poja ni:jo))
=+ tym=?~(lim (add ~m7.s30 now) (add ~1970.1.1 (mul ~s1 u.lim)))
~& retrying-in/`@dr`(sub tym now)
:_(+>.$ [ost %wait pax tym]~)
::
200 :: OK
=+ jon=(need (poja q:(need r.hit)))
:: ~& twit-resp/%.(jon ?+(-.jon !! %o stat:twir, %a (ar:jo stat:twir)))
?+ pax ~|([%http-missed pax] !!)
[%post @ ~] :: post acknowledged
=+ ^= rep
~| [%bad-post jon]
(need %.(jon stat:twir))
=. out (~(put by out) (slav %uv i.t.pax) %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
:- (print (earn [& ~ `/com/twitter] `pax ~))
(spam pax (tweet-good rep))
[%peer *] :: feed data
=+ ^= rep
~| [%bad-feed jon]
(need %.(jon (ar:jo stat:twir)))
:: ~& got-feed/[(scag 5 (turn rep |=(stat id))) fed]
=+ ren=(cull t.pax rep) :: new messages
?~ ren
(wait pax ~) :: pump polling
:: ~& spam-feed/ren
=: ran (~(del by ran) pax) :: clear poll delay
fed (~(put by fed) t.pax rep) :: saw last message
==
(wait pax (spam t.pax [%diff twit-feed/(flop ren)] ~))
==
::
?(400 401 403 404) :: Err
=+ ^- git=gift
=+ err=%.(q:(need r.hit) ;~(biff poja mean:twir))
:^ %diff %ares %bad-http
[leaf/"HTTP Code {<p.hit>}" (turn (need err) mean:twip)]
?+ pax [[ost git]~ +>.$]
[%post @ ~]
[(spam pax git ~) +>.$]
==
++ sigh-recoverable-error :: Rate-limit
|= {pax/path $429 $rate-limit lim/(unit @da)}
=. ran (~(put by ran) pax 6 now)
=+ tym=?~(lim (add ~m7.s30 now) (add ~1970.1.1 (mul ~s1 u.lim)))
~& retrying-in+`@dr`(sub tym now)
:_(+>.$ [ost %wait pax tym]~)
::
++ sigh-twit-cred-scry-cred sigh-twit-cred-cred :: alias
++ sigh-twit-cred-cred
|= {wir/wire acc/plan-acct raw/json} ^+ done
?> ?=($~ wir)
=+ pax=`twit-path`cred+wir
:_ +>.$(ced `[now raw])
:- [ost %poke pax [our %hood] %write-plan-account ~.twitter acc]
(spam-with-scry-x pax json+raw)
::
++ sigh-twit-post-post :: status acknowledged
|= {wir/wire rep/stat} ^+ done
=+ (raid wir mez=%uv ~)
=. out (~(put by out) mez %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
:- (show-url [& ~ &+/com/twitter] `pax ~)
(spam-with-scry-x post+wir twit-post+rep)
::
++ sigh-twit-feed :: feed data
|= {wir/wire rep/(list stat)} ^+ done
?> ?=({?($peer $scry) *} wir)
=* pax t.wir
:: ~& got-feed+[(scag 5 (turn rep |=(stat id))) fed]
=+ ren=(cull pax rep) :: new messages
=. rep (weld ren (~(get ja fed) pax))
=. fed (~(put by fed) pax rep) :: save full list
?: ?=($scry -.wir)
[(spam scry+x+pax [%diff twit-feed+(flop rep)] [%quit ~] ~) +>.$]
?~ ren
(wait wir ~) :: pump polling
:: ~& spam-feed+ren
(wait-new wir (spam pax [%diff twit-feed+(flop ren)] ~))
::
++ sigh-tang :: Err
|= {pax/path tan/tang} ^+ done
~& sigh-tang+pax
%- (slog (flop tan))
=+ ^- git/gift
=+ err='' ::%.(q:(need r.hit) ;~(biff poja mean:twir)) :: XX parse?
:^ %diff %ares %bad-http
tan
:: [leaf/"HTTP Code {<p.hit>}" (turn (need err) mean:render:twit)]
?+ pax [[ost git]~ +>.$]
{$post @ $~}
[(spam pax git ~) +>.$]
==
++ tweet-good |=(rep=stat `(list gift)`~[[%diff %twit-stat rep] [%quit ~]])
++ peer |=(pax=path :_(+> (pear & src pax))) :: accept subscription
::
:: ++ user-to-path |=(a/(unit iden) ?~(a '~' (scot %ta u.a)))
:: ++ user-from-path
:: |= pax/path ^- {(unit iden) path}
:: ~| %bad-user
:: ?~ pax ~|(%empty-path !!)
:: ~| i.pax
:: ?: =('~' i.pax) [~ t.pax]
:: [`(slav %ta i.pax) t.pax]
::
::
++ compat |=({usr/(unit iden) req/(unit iden)} ?~(req & =(usr req)))
::
:: .^(twit-feed %gx /=twit=/~/home/urbit_test)
:: .^(twit-stat %gx /=twit=/~./post/0vv0old.0post.hash0.0000)
++ peek
|= {ren/care pax/path} ^- (unit (unit gilt))
?> ?=($x ren) :: others unsupported
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=+ gil=(pear-scry pax)
?- -.gil
$none ~
$part ~ :: stale data
$full ``p.gil
==
::
++ peer-scry-x
|= pax/path ^+ done
:_ +>
=+ pek=(peek %x pax)
?^ pek
?~ u.pek ~|(bad-scry+x+pax !!)
~[[ost %diff u.u.pek] [ost %quit ~]]
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=+ hiz=(pear-hiss pax)
?~ hiz ~ :: already in flight
::?> (compat usr -.u.hiz) :: XX better auth
[ost %hiss scry+pax usr +.u.hiz]~
::
++ peer |=(pax/path :_(+> (pear & `~. pax))) :: accept subscription
++ pear :: poll, possibly returning current data
|= [ver=? @ pax=path]
|= {ver/? usr/(unit iden) pax/path}
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=> .(pax `twit-path`pax)
?: ?=(%post -.pax)
?. ver ~
=+ sta=(~(get by out) (slav %uv p.pax))
?. ?=([~ %| ^] sta) :: post not received
~
~[[ost %diff %twit-stat p.u.sta] [ost %quit ~]]
=+ ole=(~(get ja fed) pax)
:_ ^- (list move)
?. ver ~
?~ ole ~
[ost %diff %twit-feed (flop ole)]~
=- `move`[ost %them peer/pax ~ `hiss`-]
=+ opt=?~(ole ~ ['since_id' (lutt:twit id.i.ole)]~)
=+ aut=any-auth
=+ gil=(pear-scry pax)
%+ welp
^- (list move)
?: ?=($full -.gil) ~ :: permanent result
=+ hiz=(pear-hiss pax)
?~ hiz ~
::?> (compat usr -.u.hiz) :: XX better auth
[ost %hiss peer+pax usr +.u.hiz]~
^- (list move)
?. ver ~
?- -.gil
$none ~
$part [ost %diff p.gil]~
$full ~[[ost %diff p.gil] [ost %quit ~]]
==
::
++ pear-scry
|= pax/twit-path ^- $%({$none $~} {$part p/gilt} {$full p/gilt})
?- -.pax
%user (stat-user:aut [(to-sd p.pax)]~ opt)
:: %home (stat-home:auth ~ opt)
$post
=+ (raid +.pax mez=%uv ~)
=+ sta=(~(get by out) mez)
?. ?=({$~ $| *} sta)
[%none ~]
[%full twit-post+p.u.sta]
::
?($user $home)
[%part twit-feed+(flop (~(get ja fed) pax))]
::
$cred
?~ ced [%none ~]
?: (gth now (add p.u.ced ~m1)) :: stale
[%none ~]
[%full %json q.u.ced]
==
::
++ pear-hiss
|= pax/twit-path ^- (unit {(unit iden) api-call})
?- -.pax
$post ~ :: future/unacked
$cred
`[`~. %twit-cred twit-req+[test-login+~ ['skip_status'^%t]~]]
::
$user
=+ ole=(~(get ja fed) pax)
=+ opt=?~(ole ~ ['since_id' (tid:print id.i.ole)]~)
`[`~. [%twit-feed twit-req+[posts-by+[(to-sd p.pax)]~ opt]]]
::
$home
=+ ole=(~(get ja fed) pax)
=+ opt=?~(ole ~ ['since_id' (tid:print id.i.ole)]~)
`[`p.pax [%twit-feed twit-req+[timeline+~ opt]]]
==
::
++ to-sd :: parse user name/numb
|= a=span ^- sd:twit
|= a/knot ^- sd:param
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:twir))
;~(pose (stag %user-id dem) (stag %screen-name user:parse))
::
:: ++ pull :: release subscription
:: |= ost=bone
:: |= ost/bone
:: ?. (~(has by sup) ost) `+>.$ :: XX should not occur
:: =+ [his pax]=(~(got by sup) ost)
:: ?: (lth 1 ~(wyt in (~(get ju pus) pax)))
@ -207,14 +302,18 @@
:: ==
:: `+>.$
::
++ spam-with-scry-x :: recieve final
|= {a/path b/gilt} ^- (list move)
=+ mof=~[[%diff b] [%quit ~]]
(weld (spam a mof) (spam scry+x+a mof))
::
++ spam :: send by path
|= [a=path b=(list gift)] ^- (list move)
|= {a/path b/(list gift)} ^- (list move)
%- zing ^- (list (list move))
%+ turn (~(tap by sup))
|= [ost=bone @ pax=path]
|= {ost/bone @ pax/path}
?. =(pax a) ~
(turn b |=(c=gift [ost c]))
(turn b |=(c/gift [ost c]))
::
++ print
|=(mes=tape [ost %poke / [our %talk] (said our %twit now eny leaf/mes ~)])
++ show-url ~(said-url talk `bowl`+<-)
--

2978
arvo/ames.hoon
View File

File diff suppressed because it is too large Load Diff

211
arvo/clay.hoon
View File

@ -18,7 +18,7 @@
can/(map path cage) :: new diffs
old/(map path $~) :: deleted files
== ::
++ cult (map duct rove) :: subscriptions
++ cult (jug rove duct) :: subscriptions
++ dojo :: domestic desk state
$: qyx/cult :: subscribers
dom/dome :: desk data
@ -76,7 +76,7 @@
== == == ::
++ sign :: in result $<-
$? $: $a :: by %ames
$% {$woot p/ship q/coop} ::
$% {$woot p/ship q/path r/coop} ::
== == ::
$: $c :: by %clay
$% {$note p/@tD q/tank} ::
@ -175,8 +175,8 @@
:: -- `ref` is a possible request manager. For local desks, this is null.
:: For foreign desks, this keeps track of all pending foreign requests
:: plus a cache of the responses to previous requests.
:: -- `qyx` is the set of subscriptions, keyed by duct. These subscriptions
:: exist only until they've been filled.
:: -- `qyx` is the set of subscriptions, with listening ducts. These
:: subscriptions exist only until they've been filled.
:: -- `dom` is the actual state of the filetree. Since this is used almost
:: exclusively in `++ze`, we describe it there.
:: -- `dok` is a possible set of outstanding requests to ford to perform
@ -338,6 +338,20 @@
|= hen/duct
(emit hen %give %writ ~)
::
++ duct-lift :: for each duct
|* send/_|=({duct *} ..duct-lift)
|= {a/(set duct) arg/_+<+.send} ^+ ..duct-lift
=+ all=(~(tap by a))
|- ^+ ..duct-lift
?~ all ..duct-lift
=. +>.send ..duct-lift
$(all t.all, duct-lift (send i.all arg))
::
++ blub-all (duct-lift |=({a/duct $~} (blub a))) :: ship stop
++ blab-all (duct-lift blab) :: ship result
++ balk-all (duct-lift balk) :: read and send
++ bleb-all (duct-lift bleb) :: ship sequence
::
++ print-to-dill
|= {car/@tD tan/tank}
=+ bar=emit
@ -357,7 +371,8 @@
++ duce :: produce request
|= rov/rove
^+ +>
=. qyx (~(put by qyx) hen rov)
=. rov (dedupe rov)
=. qyx (~(put ju qyx) rov hen)
?~ ref
(mabe rov |=(@da (bait hen +<)))
|- ^+ +>+.$
@ -375,6 +390,32 @@
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
++ dedupe :: find existing alias
|= rov/rove ^- rove
=; ros/(list rove) ?+(ros rov {^ $~} i.ros)
?- -.rov
$sing ~
$next
?~ (case-to-aeon:ze q.p.rov) ~
%- ~(rep by qyx)
|= {{a/rove *} b/(list rove)} ^+ b
=- ?.(- b [a b])
?& ?=($next -.a)
=(p.a p.rov(q q.p.a))
?=(^ (case-to-aeon:ze q.p.a))
==
::
$many
?~ (case-to-aeon:ze p.q.rov) ~
%- ~(rep by qyx)
|= {{a/rove *} b/(list rove)} ^+ b
=- ?.(- b [a b])
?& ?=($many -.a)
=(a rov(p.q p.q.a))
?=(^ (case-to-aeon:ze p.q.a))
==
==
::
++ must-ergo
|= can/(list path)
^- (map term (pair @ud (set path)))
@ -411,22 +452,24 @@
::
++ ease :: release request
^+ .
=^ ros/(list rove) qyx
:_ (~(run by qyx) |=(a/(set duct) (~(del in a) hen)))
%- ~(rep by qyx)
|= {{a/rove b/(set duct)} c/(list rove)}
?.((~(has in b) hen) c [a c])
?~ ref
=+ rov=(~(get by qyx) hen)
?~ rov + :: XX handle?
=. qyx (~(del by qyx) hen)
(mabe u.rov |=(@da (best hen +<)))
=. qyx (~(del by qyx) hen)
|- ^+ +.$
=> .(ref `(unit rind)`ref) :: XX TMI
?: =(~ ros) + :: XX handle?
|- ^+ +>
?~ ros +>
$(ros t.ros, +> (mabe i.ros |=(@da (best hen +<))))
^+ ..ease
=+ nux=(~(get by fod.u.ref) hen)
?~ nux +.$
=. +.$
=< ?>(?=(^ ref) .)
(send-over-ames hen [(scot %ud u.nux) ~] her u.nux syd ~)
%= +.$
fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
?~ nux ..ease
=: fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
(send-over-ames hen [(scot %ud u.nux) ~] her u.nux syd ~)
::
++ eave :: subscribe
|= rav/rave
@ -1075,6 +1118,13 @@
!!
==
::
++ vale-page
|= a/page
^- silk
?. ?=($hoon p.a) [%vale a]
?. ?=(@t q.a) [%dude |.(>%weird-hoon<) %ride [%fail ~] %$ *cage]
[%$ p.a [%atom %t ~] q.a]
::
++ validate-x
|= {car/care cas/case pax/path peg/page}
^+ +>
@ -1082,7 +1132,7 @@
:* hen %pass
[%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax]
%f %exec our ~ [her syd cas]
[%vale peg]
(vale-page peg)
==
::
++ take-foreign-x
@ -1109,8 +1159,9 @@
%+ turn (~(tap in pop))
|= a/plop
?- -.a
$delta [[%$ %blob !>([%delta p.a q.a *page])] [%vale p.r.a q.r.a]]
$direct [[%$ %blob !>([%direct p.a *page])] [%vale p.q.a q.q.a]]
$direct [[%$ %blob !>([%direct p.a *page])] (vale-page p.q.a q.q.a)]
$delta
[[%$ %blob !>([%delta p.a q.a *page])] (vale-page p.r.a q.r.a)]
==
==
::
@ -1175,76 +1226,77 @@
::
++ wake :: update subscribers
^+ .
=+ xiq=(~(tap by qyx) ~)
=| xaq/(list {p/duct q/rove})
=+ xiq=(~(tap by qyx))
=| xaq/(list {p/rove q/(set duct)})
|- ^+ ..wake
?~ xiq
..wake(qyx (~(gas by *cult) xaq))
?- -.q.i.xiq
?: =(~ q.i.xiq) $(xiq t.xiq, xaq xaq) :: drop forgotten
?- -.p.i.xiq
$sing
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.q.i.xiq))
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.p.i.xiq))
?^ cas
%= $
xiq t.xiq
..wake ?~ u.cas (blub p.i.xiq)
(blab p.i.xiq p.q.i.xiq %& u.u.cas)
..wake ?~ u.cas (blub-all q.i.xiq ~)
(blab-all q.i.xiq p.p.i.xiq %& u.u.cas)
==
=+ nao=(case-to-aeon:ze q.p.q.i.xiq)
=+ nao=(case-to-aeon:ze q.p.p.i.xiq)
?~ nao $(xiq t.xiq, xaq [i.xiq xaq])
:: ~& %reading-at-aeon
=+ vid=(read-at-aeon:ze u.nao p.q.i.xiq)
=+ vid=(read-at-aeon:ze u.nao p.p.i.xiq)
:: ~& %red-at-aeon
?~ vid
:: ?: =(0 u.nao)
:: ~& [%oh-poor `path`[syd '0' r.p.q.i.xiq]]
:: ~& [%oh-poor `path`[syd '0' r.p.p.i.xiq]]
:: $(xiq t.xiq)
:: ~& [%oh-well desk=syd mood=p.q.i.xiq aeon=u.nao]
:: ~& [%oh-well desk=syd mood=p.p.i.xiq aeon=u.nao]
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.vid p.q.i.xiq))
$(xiq t.xiq, ..wake (balk-all q.i.xiq u.vid p.p.i.xiq))
::
$next
=* mun p.q.i.xiq
:: =* dat q.q.i.xiq XX can't fuse right now
?~ q.q.i.xiq
=* mun p.p.i.xiq
:: =* dat q.p.i.xiq XX can't fuse right now
?~ q.p.i.xiq
=+ ver=(aver mun)
?~ ver
$(xiq t.xiq, xaq [i.xiq xaq])
?~ u.ver
$(xiq t.xiq, ..wake (blub p.i.xiq))
$(xiq t.xiq, xaq [i.xiq(q.q u.ver) xaq])
$(xiq t.xiq, ..wake (blub-all q.i.xiq ~))
$(xiq t.xiq, xaq [i.xiq(q.p u.ver) xaq])
=+ var=(aver mun(q [%ud let.dom]))
?~ var
~& [%oh-noes mood=mun letdom=let.dom]
$(xiq t.xiq)
?~ u.var
$(xiq t.xiq, ..wake (blab p.i.xiq mun %& %null [%atom %n ~] ~))
?: (equivalent-data:ze u.q.q.i.xiq u.u.var)
$(xiq t.xiq, ..wake (blab-all q.i.xiq mun %& %null [%atom %n ~] ~))
?: (equivalent-data:ze u.q.p.i.xiq u.u.var)
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (blab p.i.xiq mun u.u.var))
$(xiq t.xiq, ..wake (blab-all q.i.xiq mun u.u.var))
::
$many
=+ mot=`moot`q.q.i.xiq
=+ mot=`moot`q.p.i.xiq
=+ nab=(case-to-aeon:ze p.mot)
?~ nab
$(xiq t.xiq, xaq [i.xiq xaq])
=+ huy=(case-to-aeon:ze q.mot)
?~ huy
=+ ptr=[%ud +(let.dom)]
=. p.mot [%ud +(let.dom)]
%= $
xiq t.xiq
xaq [[p.i.xiq [%many p.q.i.xiq ptr q.mot r.mot s.mot]] xaq]
xaq [i.xiq(q.p mot) xaq]
..wake =+ ^= ear
(lobes-at-path:ze let.dom r.mot)
?: =(s.mot ear) ..wake
(bleb p.i.xiq let.dom ?:(p.q.i.xiq ~ `[u.nab let.dom]))
(bleb-all q.i.xiq let.dom ?:(p.p.i.xiq ~ `[u.nab let.dom]))
==
%= $
xiq t.xiq
..wake =- (blub:- p.i.xiq)
..wake =- (blub-all:- q.i.xiq ~)
=+ ^= ear
(lobes-at-path:ze u.huy r.mot)
?: =(s.mot ear) (blub p.i.xiq)
(bleb p.i.xiq +(u.nab) ?:(p.q.i.xiq ~ `[u.nab u.huy]))
?: =(s.mot ear) (blub-all q.i.xiq ~)
(bleb-all q.i.xiq +(u.nab) ?:(p.p.i.xiq ~ `[u.nab u.huy]))
==
==
++ drop-me
@ -1296,7 +1348,12 @@
$delta p.q
$direct p.q
==
++ lobe-to-silk :: XX maybe move hoo{n,k} stuff here
++ page-to-silk :: %hoon bootstrapping
|= a/page
?. ?=($hoon p.a) [%volt a]
[%$ p.a [%atom %t ~] q.a]
::
++ lobe-to-silk
|= {pax/path lob/lobe}
^- silk
=+ ^- hat/(map path lobe)
@ -1311,9 +1368,9 @@
[%$ p.-]
=+ bol=(~(got by lat.ran) lob)
?- -.bol
$direct [%volt q.bol]
$direct (page-to-silk q.bol)
$delta ~| delta+q.q.bol
[%pact $(lob q.q.bol) [%volt r.bol]]
[%pact $(lob q.q.bol) (page-to-silk r.bol)]
==
::
++ page-to-lobe |=(page (shax (jam +<)))
@ -1583,7 +1640,7 @@
=+ ^= yak
%- aeon-to-yaki
let.dom
?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])
?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])-all
(query(ank.dom ank:(descend-path:(zu ank.dom) r.mun)) p.mun)
::
++ read-u
@ -1677,6 +1734,7 @@
~
=+ yak=(tako-to-yaki u.tak)
=+ len=(lent pax)
:: ~& read-z+[yon=yon qyt=~(wyt by q.yak) pax=pax]
=+ ^- descendants/(list (pair path lobe))
:: ~& %turning
:: =- ~& %turned -
@ -2529,8 +2587,8 @@
[%$ +:(need fil.ank:(descend-path:(zu ank:(need alh)) pax))]
=+ bol=(~(got by lat.ran) lob)
?- -.bol
$direct [%volt q.bol]
$delta [%pact $(lob q.q.bol) [%volt r.bol]]
$direct (page-to-silk q.bol)
$delta [%pact $(lob q.q.bol) (page-to-silk r.bol)]
==
::
++ reduce-merge-points
@ -2569,7 +2627,7 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: $0 :: vane version
$: $1 :: vane version
ruf/raft :: revision tree
== ::
|= {now/@da eny/@ ski/sley} :: activate
@ -2720,10 +2778,14 @@
ease:den
(eave:den u.q.q.q.hic)
[mos ..^$]
::
$went
:: this won't happen until we send responses.
!!
::
$west
?: ?=({$question *} q.q.hic)
=+ ryf=((hard riff) r.q.hic)
=+ ryf=((hard riff) s.q.hic)
:_ ..^$
:~ [hen %give %mack ~]
:- hen
@ -2736,7 +2798,7 @@
=+ inx=(slav %ud i.t.t.q.q.hic)
=^ mos ruf
=+ den=((de now hen ruf) p.q.hic syd)
abet:(take-foreign-update:den inx ((hard (unit rand)) r.q.hic))
abet:(take-foreign-update:den inx ((hard (unit rand)) s.q.hic))
[[[hen %give %mack ~] mos] ..^$]
::
$wegh
@ -2760,9 +2822,34 @@
~
::
++ load
|= old/{$0 ruf/raft}
=> |%
++ cult-0 (map duct rove)
++ dojo-0 (cork dojo |=(a/dojo a(qyx *cult-0)))
++ rede-0 (cork rede |=(a/rede a(qyx *cult-0)))
++ room-0 (cork room |=(a/room a(dos (~(run by dos.a) dojo-0))))
++ rung-0 (cork rung |=(a/rung a(rus (~(run by rus.a) rede-0))))
++ raft-0
%+ cork raft
|=(a/raft a(fat (~(run by fat.a) room-0), hoy (~(run by hoy.a) rung-0)))
++ axle $%({$0 ruf/raft-0} {$1 ruf/raft})
--
|= old/axle
^+ ..^$
..^$(ruf ruf.old)
?- -.old
$1 ..^$(ruf ruf.old)
$0 =/ cul
|= a/cult-0 ^- cult
%- ~(gas ju *cult)
(turn (~(tap by a)) |=({p/duct q/rove} [q p]))
=/ rom
=+ doj=|=(a/dojo-0 a(qyx (cul qyx.a)))
|=(a/room-0 a(dos (~(run by dos.a) doj)))
=/ run
=+ red=|=(a/rede-0 a(qyx (cul qyx.a)))
|=(a/rung-0 a(rus (~(run by rus.a) red)))
=+ r=ruf.old
$(old [%1 r(fat (~(run by fat.r) rom), hoy (~(run by hoy.r) run))])
==
::
++ scry :: inspect
|= {fur/(unit (set monk)) ren/@tas his/ship syd/desk lot/coin tyl/path}
@ -2783,7 +2870,7 @@
?: ?=($& -.u.u.-) ``p.u.u.-
~
::
++ stay [%0 ruf]
++ stay [%1 ruf]
++ take :: accept response
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
@ -2949,8 +3036,8 @@
==
::
$woot
?~ q.q.hin [~ ..^$]
~& [%clay-lost p.q.hin q.q.hin tea]
?~ r.q.hin [~ ..^$]
~& [%clay-lost p.q.hin r.q.hin tea]
[~ ..^$]
==
::

354
arvo/eyre.hoon
View File

@ -32,7 +32,7 @@
== == == ::
++ sign :: in result $<-
$? $: $a :: by %ames
$% {$woot p/ship q/coop} :: ackgnowledgment
$% {$woot p/ship q/path r/coop} :: acknowledgment
{$went ship cape} :: XX ignore
== == ::
$: $b :: by %behn
@ -53,9 +53,10 @@
== == == ::
++ ixor @t :: oryx hash
++ whir $@ $~ :: wire subset
$% {$at p/hole q/whir} :: authenticated
{$ay p/knot q/knot $~} :: remote duct
{$ha p/path} :: GET request
$% {$ac p/hole q/whir} :: cookied
{$at p/hole q/whir} :: authenticated
{$ay p/knot:ship q/knot:@uvH $~} :: remote duct
{$ha p/path:beak} :: GET request
{$he p/whir} :: HEAD request
{$hi p/knot q/mark $~} :: outbound HTTP
{$se p/whir-se q/{iden (list @t)}} :: outbound to domain
@ -64,18 +65,22 @@
{$ow p/ixor $~} :: dying view
{$on $~} :: dependency
== ::
++ whir-of {p/knot:ship q/term r/wire} :: path in dock
++ whir-of {p/knot:ship q/term r/?($mess $lens) s/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
$? $filter-request :: ++out mod request
$filter-response :: ++res use result
$receive-auth-response :: ++bak auth response
$receive-auth-query-string :: ++in handle code
$out
$res
$bak
$in
== ::
-- ::
|% :: models
++ bolo :: eyre state
$: $4 :: version
$: $5 :: version
gub/@t :: random identity
hov/(unit ship) :: master for remote
top/beam :: ford serve prefix
@ -159,14 +164,14 @@
{$js p/@t} :: script
{$json p/json} :: data
{$html p/manx} :: successful page
{$htme p/manx} :: authentication fail
{$htme p/manx} :: authentication fail
==
-- ::
|%
++ eat-headers
|= hed/(list {p/@t q/@t}) ^- math
%+ roll hed
|= {a/{p/cord q/cord} b/math}
|= {a/{p/cord q/cord} b/math}
=. p.a (cass (trip p.a))
(~(add ja b) p.a q.a)
::
@ -178,7 +183,7 @@
?~ quy [%$ %n ~]~
[[%$ %t p.i.quy] [%$ %t q.i.quy] $(quy t.quy)]
::
++ gsig |=({a/dock b/path} [(scot %p p.a) q.a b])
++ gsig |=({a/dock b/?($mess $lens) c/path} [(scot %p p.a) q.a b c])
++ session-from-cookies
|= {nam/@t maf/math}
^- (unit hole)
@ -210,12 +215,12 @@
hit(q (weld cuh q.hit))
::
++ add-json :: inject window.urb
|= {urb/json jaz/cord} ^- cord
|= {urb/json jaz/cord} ^- cord
=- (cat 3 (crip -) jaz)
"""
var _urb = {(pojo urb)}
window.urb = window.urb || \{}; for(k in _urb) window.urb[k] = _urb[k]
var _urb = {(pojo urb)};
window.urb = window.urb || \{}; for(k in _urb) window.urb[k] = _urb[k];
"""
::
++ ares-to-json
@ -387,7 +392,7 @@
if (!deh) return;
if (urb.deps.indexOf(deh) !== -1) return;
urb.deps.push(deh)
urb.wreq.abort() // trigger keep
urb.wreq.abort() // trigger keep
}
urb.dewasp = function(deh){
var index = urb.deps.indexOf(deh)
@ -415,12 +420,12 @@
else if(cb) return cb(xhr.responseText,ev)
})
}
urb.foreign = /^\/~\/am/.test(window.location.pathname)
urb.redir = function(ship){
if(ship) document.location.pathname =
document.location.pathname.replace(/^\/~~|\/~\/as\/any/,'/~/as/~'+ship)
else document.location =
else document.location =
document.location.hash.match(/#[^?]+/)[0].slice(1) +
document.location.pathname.replace(
/^\/~\/am\/[^/]+/,
@ -439,15 +444,15 @@
if(!urb.is_me(ship))
return urb.redir(ship)
req(
"/~/auth.json?PUT",
"/~/auth.json?PUT",
{ship:ship, code:pass},
function(){
if(urb.foreign) urb.redir()
else document.location.reload()
})
}
urb.away = function(){req("/~/auth.json?DELETE", {},
function(){document.getElementById("c").innerHTML = "" }
urb.away = function(){req("/~/auth.json?DELETE", {},
function(){document.body.innerHTML = "" }
)}
'''
--
@ -461,15 +466,15 @@
::
++ login-page
%+ titl 'Sign in - Urbit'
;= ;div.container
;= ;div.container.top
;div.row
;div.col-md-4
;h1.sign: Sign in
==
;div.col-md-8
;p.ship
;p.ship
;label.sig: ~
;input#ship.mono(contenteditable "", placeholder "planet");
;input#ship.mono(contenteditable "", placeholder "your-urbit");
==
;input#pass.mono(type "password", placeholder "passcode");
;h2.advice: Type +{;code:("+code")} in your dojo for your passcode.
@ -482,7 +487,7 @@
$(function() {
$ship = $('#ship')
$pass = $('#pass')
$ship.on('keydown', function(e) {
$ship.on('keydown', function(e) {
if(e.keyCode === 13 || e.keyCode === 9) {
if(!urb.is_me($ship.val().toLowerCase()))
urb.redir($ship.val().toLowerCase())
@ -491,10 +496,10 @@
e.preventDefault()
}
})
$ship.on('focus', function(e) {
$ship.on('focus', function(e) {
$pass.hide()
})
$pass.on('keydown', function(e) {
$pass.on('keydown', function(e) {
if(e.keyCode === 13) {
urb.submit($ship.val().toLowerCase(),$pass.val())
}
@ -511,17 +516,11 @@
::
++ logout-page
%+ titl 'Log out'
;= ;div.container
;= ;div.container.top
;div.row
;div.col-md-4
;div.col-md-10
;h1.sign: Bye!
==
;div.col-md-8#c
;p.ship
;label.sig: ~
;span#ship;
==
;button#act(onclick "urb.away()"): Go
;button#act(onclick "urb.away()"): Log out
;pre:code#err;
;script@"/~/at/~/auth.js";
==
@ -542,21 +541,21 @@
}
'''
==
++ titl
|= {a/cord b/marl}
++ titl
|= {a/cord b/marl}
;html
;head
;meta(charset "utf-8");
;meta(name "viewport", content "width=device-width, ".
"height=device-height, initial-scale=1.0, user-scalable=0, ".
"minimum-scale=1.0, maximum-scale=1.0");
;title:"{(trip a)}"
;title:"{(trip a)}"
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/".
"libs/jquery/2.1.1/jquery.min.js");
;link(rel "stylesheet", href "/lib/css/fonts.css");
;link(rel "stylesheet", href "/lib/css/bootstrap.css");
==
;body:div#c:"*{b}"
;body:"*{b}"
==
--
--
@ -573,6 +572,7 @@
bolo :: all vane state
== ::
=* bol ->
~% %eyre-y ..is ~
|%
++ abet :: resolve moves
^- {(list move) bolo}
@ -599,7 +599,7 @@
=. our ?~(hov p.kyz (min u.hov p.kyz))
+>.$(hov [~ our], top [[our %home ud+0] /web])
::
$this :: inbound request
?($chis $this) :: inbound request
%- emule |. ^+ ..apex
=* sec p.kyz :: ? :: https bit
=* heq r.kyz :: httq :: request content
@ -613,9 +613,11 @@
[[sec (rash i.hot thor:epur)] p.ryp q.ryp]
==
=. p.p.pul |(p.p.pul ?=(hoke r.p.pul))
?: ?=($chis -.kyz) :: IPC escape hatch
~(lens handle pul [q.+.kyz |] [p.heq maf s.heq])
=+ her=(host-to-ship r.p.pul)
?: |(?=($~ her) =(our u.her))
(handle pul [q.+.kyz |] [p.heq maf s.heq])
~(apex handle pul [q.+.kyz |] [p.heq maf s.heq])
=+ han=(sham hen)
=. pox (~(put by pox) han hen)
(ames-gram u.her [%get ~] han +.kyz)
@ -636,7 +638,7 @@
kes (~(put by kes) hen p.ask)
==
::
$hiss :: outbound cage
$hiss :: outbound cage
::?~ p.kyz :: XX cancel
:: =+ sud=(need (~(get by kes) hen))
:: %= +>.$
@ -668,7 +670,7 @@
::
$poll
?. (~(has by wix) p.lid)
+>.$
+>.$
poll-dead:(ire-ix p.lid)
::
$xeno
@ -681,6 +683,10 @@
?~ p.lid +>.^$
(del-deps:$(p.lid t.p.lid) i.p.lid %& hen)
==
::
$went
:: this won't happen until we send responses.
!!
::
$west :: remote request
=. mow :_(mow [hen %give %mack ~])
@ -702,9 +708,9 @@
==
(give-thou q.u.mez)
::
$lon
$lon
~& ses-ask+[p.u.mez sop (~(run by wup) $~)]
?: (ses-authed p.u.mez)
?: (ses-authed p.u.mez)
(ames-gram q.p.kyz aut+~ p.u.mez)
=. sop (~(put by sop) p.u.mez q.p.kyz |)
(ames-gram q.p.kyz hat+~ p.u.mez our-host)
@ -721,22 +727,23 @@
:: [%of @ ^] (get-ack:(ire-ix p.tee) q.tee hon)
:: ==
++ axon :: accept response
|= {tee/whir typ/span sih/sign}
|= {tee/whir sih/sign}
^+ +>
=. our ?~(hov our u.hov) :: XX
?: &(?=({?($of $ow) ^} tee) !(~(has by wix) p.tee))
~&(dead-ire+[`whir`tee ({term term $~} +.sih)] +>)
?- &2.sih
$crud +>.$(mow [[hen %slip %d %flog +.sih] mow])
:: $dumb
:: $dumb
:: =. +> ?+(tee +> [%of ^] pop-duct:(ire-ix p.tee))
:: (emule |.(~|(gall-dumb+tee !!)))
::
$woot +>.$
$went
:: XX eyre sends no wests, so should get no wents
::~& e+unexpected+sih
::~& e+unexpected+sih
+>.$
::
::
$thou
?+ -.tee !!
@ -750,6 +757,7 @@
=+ cuf=`cuft`+>.sih
?- -.cuf
?($coup $reap)
:: ~? ?=($lens r.q.tee) hen=hen^hcuf=-.cuf
(get-ack:(ire-ix p.tee) q.tee ?~(p.cuf ~ `[-.cuf u.p.cuf]))
::
$doff !!
@ -786,6 +794,7 @@
$made
?< ?=($tabl -.q.sih)
=. our (need hov) :: XX
=| ses/(unit hole)
|- ^+ ..axon
?- tee
$@($~ {?($on $ay $ow) *}) ~|(e+ford+lost+tee !!)
@ -836,10 +845,12 @@
~& e+at-lost+[-.p.q.sih q.tee]
$(tee q.tee)
?> ?=(@ q.q.p.q.sih)
=. ses (some p.tee)
=+ cyz=(~(got by wup) p.tee)
=^ jon ..ya ~(stat-json ya p.tee cyz)
$(tee q.tee, q.q.p.q.sih (add-json jon q.q.p.q.sih))
::
{$ac ^} ?>((~(has by wup) p.tee) $(ses `p.tee, tee q.tee))
{$ha *}
%- emule |. ^+ ..apex
?. ?=($& -.q.sih)
@ -849,28 +860,33 @@
=+ url=((hard quri) q.q.cay)
(give-thou 307 [location+(crip (apex:earn url))]~ ~)
?. ?=($mime p.cay)
=+ bek=-:(need (tome p.tee))
=+ bik=?+(r.bek bek {$ud $0} bek(r da+now))
(exec-live tee bik [%flag [p.sih `~] %cast %mime [%$ p.q.sih]])
=+ bek=(norm-beak -:(need (tome p.tee)))
=+ tee-ses=?~(ses tee [%ac u.ses tee])
(exec-live tee-ses bek [%flag [p.sih `~] %cast %mime [%$ p.q.sih]])
~| q.q.cay
=+ cug=?~(ses ~ cug:(~(got by wup) u.ses))
=+ ((hard {mit/mite rez/octs}) q.q.cay)
=+ dep=(crip "W/{(pojo %s (scot %uv p.sih))}")
(give-thou 200 ~[etag+dep content-type+(moon mit)] ~ rez)
=+ hit=[200 ~[etag+dep content-type+(moon mit)] ~ rez]
(give-thou (add-cookies cug hit))
==
==
::
++ norm-beak |=(bek/beak ?+(r.bek bek {$ud $0} bek(r da+now)))
++ emule
|= a/_|?(..emule) ^+ ..emule
?: [unsafe=|]
(a)
=+ mul=(mule a)
?~ -.mul p.mul
(fail 500 0v0 >%exit< p.mul)
::
++ ire-ix |=(ire/ixor ~(. ix ire (~(got by wix) ire)))
++ dom-vi
++ 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-authed
|= ses/hole
=+ sap=(~(get by sop) ses)
?: ?=({$~ @ $&} sap) &
@ -891,13 +907,13 @@
::
++ back :: %ford bounce
|= {tea/whir mar/mark cay/cage}
=+ bek=?+(r.top -.top {$ud $0} -.top(r da+now))
(execute tea bek [%cast mar $+cay])
(execute tea (norm-beak -.top) [%cast mar $+cay])
::
++ cast-thou
|= {mar/mark cay/cage}
?: ?=($httr mar) (give-sigh %& cay)
(back si+~ mar cay)
%^ execute si+~ (norm-beak -.top)
[%alts [%cast mar $+cay] [%cast %recoverable-error $+cay] ~]
::
++ del-deps
|= {a/@uvH b/(each duct ixor)} ^+ +>.$
@ -911,7 +927,7 @@
++ new-deps
|= {a/@uvH b/(each duct ixor)} ^+ +>.$
:: ~& new-deps+[a b]
?: =(`@`0 a) +>.$
?: =(`@`~ a) +>.$
=+ had=(~(has by liz) a)
=. liz (~(put ju liz) a b)
?: had +>.$
@ -919,7 +935,7 @@
(pass-note(hen `~) on+~ %f [%wasp our a &])
::
++ ford-req |=({bek/beak kas/silk} [%f [%exec our `[bek kas]]])
++ exec-live
++ exec-live
|= {tea/whir req/{beak silk}}
=. lyv (~(put by lyv) hen [%exec tea])
(execute tea req)
@ -983,12 +999,11 @@
::
::
++ handle
|= $: {hat/hart pok/pork quy/quay} :: purl parsed url
~% %eyre-h ..is ~
|_ $: {hat/hart pok/pork quy/quay} :: purl parsed url
{cip/clip aut/?} :: client ip nonymous?
{mef/meth maf/math bod/(unit octs)} :: method+headers+body
==
=< apex
|%
++ abet ..handle
++ done .
++ teba |*(a/$-(* ..handle) |*(b/* %_(done ..handle (a b))))
@ -1015,6 +1030,13 @@
?: ?=($| -.pez) p.pez
(resolve ~ p.pez)
::
++ lens
=< abet
:: (process-parsed [%mess [our %dojo] %lens-command /lens (need grab-json)])
=^ orx ..ya new-view:(logon:for-client our)
=+ vew=(ire-ix (oryx-to-ixor orx))
((teba new-lens.vew) (need grab-json))
::
++ resolve
|= {cug/(list @t) pez/pest} ^+ done
?~ pez done
@ -1027,7 +1049,7 @@
$bake
=+ req=[%bake mar=q.pez [r s]:pez]
=+ red=req(mar %red-quri)
(exec-live p.pez -.s.pez `silk`[%alts ~[red req]])
(exec-live p.pez -.s.pez `silk`[%alts ~[req red]])
::
$red
=+ url=(earn hat pok(p [~ %html]) quy)
@ -1067,14 +1089,15 @@
^- (each perk httr)
|^ =+ hit=as-magic-filename
?^ hit [%| u.hit]
?: is-spur
[%& %spur (flop q.pok)]
=+ hem=as-aux-request
?^ hem
?. check-oryx
~|(%bad-oryx ~|([grab-oryx vew.cyz:for-client] !!))
[%& u.hem]
=+ bem=as-beam
?^ bem [%& %beam u.bem]
?. check-oryx
~|(%bad-oryx ~|([grab-oryx vew.cyz:for-client] !!))
=+ hem=as-aux-request
?^ hem [%& u.hem]
?: is-spur
[%& %spur (flop q.pok)]
~|(strange-path+q.pok !!)
::
++ as-magic-filename
@ -1085,25 +1108,20 @@
%^ resp 200 image+/png
favi
::
{$txt $robots $~}
:- ~
%^ resp 200 text+/plain
%- role
:~ 'User-agent: *'
'Disallow: /'
==
:: {$txt $robots $~} !!
==
::
++ is-spur |(?~(q.pok & ((sane %tas) i.q.pok)))
++ as-beam
++ is-spur |(?~(q.pok & ((sane %ta) i.q.pok)))
++ as-beam :: /~sipnym/desk/3/...
^- (unit beam)
?~ q.pok ~
=+ ^- (unit {@ dez/desk rel/?}) :: /=desk/, /=desk=/
(rush i.q.pok ;~(plug tis sym ;~(pose (cold | tis) (easy &))))
?~ - (tome q.pok) :: /~ship/desk/case/...
:+ ~ [our dez.u r.top]
?. rel.u (flop t.q.pok)
(weld (flop t.q.pok) s.top) :: /=desk/... as hoon /=desk%/...
=+ =< tyk=(zl:jo (turn q.pok .)) :: a path whose elements
|=(a/knot `(unit tyke)`(rush a gasp:vast)) :: are in /=foo==/=bar
?~ tyk ~ :: syntax
=+ %- posh:(vang & (tope top)) :: that the base path
[[~ (zing u.tyk)] ~] :: can interpolate into
?~ - ~ ::
=+ (plex:vast %conl u) :: staticly, and make a
(biff - tome) :: valid beam
::
++ as-aux-request :: /~/... req parser
^- (unit perk)
@ -1268,7 +1286,7 @@
::
$mess
:- %|
=^ orx ..ya ?:(is-anon new-view:for-client [(need grab-oryx) ..ya])
=^ 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))
::
@ -1304,7 +1322,7 @@
?- -.ham
$js [%& %js auth:js]
$json =^ jon ..ya stat-json.yac
[%| (give-json 200 ~ jon)]
[%| (give-json 200 cug.yac jon)]
$xen (show-login-page ~ ses.ham)
::
$at
@ -1315,15 +1333,15 @@
?+ -.p.pez ~&(bad-inject+p.pez !!)
$red pez
$bake
=. ya abet.yac
=. ya abet.yac
[%| (resolve ~ p.pez(p [%at ses.yac p.p.pez]))]
::
$js
=^ jon ..ya stat-json.yac
=^ jon ..ya stat-json.yac
[%| (resolve cug.yac p.pez(p (add-json jon p.p.pez)))]
==
::
$del
$del
=. ..ya (logoff:yac p.ham)
=+ cug=[(set-cookie cookie-prefix '~')]~
[%| (give-json 200 cug (joba %ok %b &))]
@ -1344,7 +1362,7 @@
:- %|
?. =(our him.ham)
~|(stub-foreign+him.ham !!)
?. ?| (~(has in aut.yac) him.ham)
?. ?| (~(has in aut.yac) him.ham)
?~(paz.ham | =(u.paz.ham load-secret))
==
~|(%auth-fail !!)
@ -1362,7 +1380,7 @@
?: (~(has by wup) u.ses)
[%& %htme login-page:xml]
=+ yac=(new-ya u.ses)
=+ =- lon=?~(- | (~(has in aut.u.-) our))
=+ =- lon=?~(- | (~(has in aut.u.-) our))
(biff (session-from-cookies cookie-prefix maf) ~(get by wup))
=. yac ?.(lon yac (logon.yac our))
[%| (give-html(..ya abet.yac) 401 cug.yac login-page:xml)]
@ -1370,12 +1388,12 @@
++ cookie-prefix (rsh 3 1 (scot %p our))
++ cookie-domain
^- cord
?- r.hat
?- r.hat
{$| @} (cat 3 '; Domain=' (rsh 3 1 (scot %if p.r.hat)))
{$& $org $urbit *} '; Domain=.urbit.org'
{$& @ @ *} =- (rap 3 "; Domain={-}{i.p.r.hat ~}")
(turn (flop `path`t.p.r.hat) |=(a/knot (cat 3 a '.')))
{$& *} '' :: XX security?
==
::
@ -1400,7 +1418,7 @@
?~ cyz
~& bad-cookie+u.lig
(new-ya (rsh 3 1 (scot %p (end 6 1 ney))))
~(. ya u.lig u.cyz(cug ~))
~(. ya u.lig u.cyz(cug ~))
::
++ new-ya |=(ses/hole ~(. ya ses (new-cyst ses)))
++ new-cyst
@ -1410,7 +1428,7 @@
:* ^- cred
:* hat(p sec)
~
'not-yet-implemented'
'not-yet-implemented'
::(rsh 3 1 (scot %p (end 6 1 (shaf %oryx ses))))
::
=+ lag=(~(get by maf) %accept-language)
@ -1419,7 +1437,7 @@
cip
~
==
[anon ~]
[`@p`(mix anon (lsh 5 1 (rsh 5 1 (shaf %ship ses)))) ~]
::
[(set-cookie cookie-prefix ses)]~
::
@ -1432,6 +1450,7 @@
::
++ oryx-to-ixor |=(a/oryx (rsh 3 1 (scot %p (end 6 1 (shas %ire a)))))
++ ya :: session engine
~% %eyre-y ..is ~
=| {ses/hole cyst}
=* cyz ->
|%
@ -1446,9 +1465,11 @@
++ foreign-hat
|= {him/ship hat/hart} ^+ ..ya
~| way
?. (~(has by way) him) :: XX crashes should be handled by ames
~&(strange-auth+[way him hat] ..ya)
=^ pul hen (~(got by way) him)
=: way (~(del by way) him)
dop (~(put by dop) r.hat him)
dop (~(put by dop) r.hat him)
q.q.pul ['~' %am ses q.q.pul]
==
=+ url=(welp (earn pul(p hat)) '#' (head:earn p.pul))
@ -1461,16 +1482,16 @@
him her
aut (~(put in aut) her)
..ya
~& logon+[our her ses]
:: ~& logon+[our her ses]
?. =(our her)
..ya
=+ sap=(~(get by sop) ses)
~& sap
:: ~& sap+sap
?. ?=({$~ @ $|} sap)
..ya
(ames-gram -.u.sap aut+~ ses)
==
++ logoff
++ logoff
|= her/(unit ship) ^+ ..ya
?~ her abut
=. aut (~(del in aut) u.her)
@ -1494,6 +1515,7 @@
%- jobe :~
oryx+s+orx
ixor+s+(oryx-to-ixor orx)
sein+(jape +:<(sein our)>)
ship+(jape +:<our>)
user+(jape +:<him>)
auth+a+(turn (~(tap in aut)) |=(a/@p (jape +:<a>)))
@ -1501,6 +1523,7 @@
--
::
++ ix
~% %eyre-x ..is ~
=| {ire/ixor stem}
=* sem ->
|%
@ -1516,8 +1539,8 @@
++ teba |*(a/$-(* ..ix) |*(b/* %_(done ..ix (a b))))
++ give-json (teba ^give-json)
++ pass-note (teba ^pass-note)
++ hurl-note
|= {a/{dock path} b/note} ^+ ..ix
++ hurl-note
|= {a/{dock ?($mess $lens) path} b/note} ^+ ..ix
=: med (~(put to med) hen)
hen `~
==
@ -1525,52 +1548,85 @@
(pass-note:abet [%of ire (gsig a)] b)
::
++ init
=. die (add ~d1 now)
=. die (add ~d1 now)
abet(mow :_(mow [`/ %pass ow+/[ire] [%b %wait die]]))
::
++ refresh
=. mow :_(mow [`/ %pass ow+/[ire] [%b %rest die]])
=. die (add ~d1 now)
=. die (add ~d1 now)
done(mow :_(mow [`/ %pass ow+/[ire] [%b %wait die]]))
::
++ add-even
|= a/even ^+ eve
[+(p.eve) (~(put by q.eve) p.eve a)]
::
++ new-lens
|= jon/json ^+ ..ix
=. +>.$
%+ pass-note
[%of ire (gsig [our %dojo] lens+/)]
[%g %deal [him our] %dojo %peel %lens-json /sole]
=. +>.$
%+ pass-note
[%of ire (gsig [our %dojo] lens+/)]
[%g %deal [him our] %dojo %punk %lens-command %json !>(`json`jon)]
abet
::
++ new-mess
|= {a/dock b/wire c/mark d/cage} ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %punk c d])
(hurl-note [a mess+b] [%g %deal [him -.a] +.a %punk c d])
::
++ add-subs
|= {a/dock $json b/wire c/path} ^+ ..ix
?: (~(has in sus) +<) ~|(duplicate+c !!)
=. sus (~(put in sus) +<)
(hurl-note [a b] [%g %deal [him -.a] +.a %peel %json c])
(hurl-note [a mess+b] [%g %deal [him -.a] +.a %peel %json c])
::
++ pul-subs
|= {a/dock $json b/wire c/path} ^+ ..ix
=. sus (~(del in sus) +<)
(hurl-note [a b] [%g %deal [him -.a] +.a %pull ~])
(hurl-note [a mess+b] [%g %deal [him -.a] +.a %pull ~])
::
++ del-subs :: XX per path?
|= {a/dock $json b/wire c/path} ^+ ..ix
=. ..ix (pul-subs +<)
(nice-json:pop-duct:(ire-ix ire)) :: XX gall ack
::
++ get-lens
|= {a/whir-of fec/json} ^+ ..ix
?~ fec ..ix :: nulled event we don't care about
=. +>.$
%+ pass-note
`whir`[%of ire (gsig [our %dojo] lens+/)]
`note`[%g %deal [him our] %dojo %pull ~]
abet:(give-json 200 ~ fec)
::
++ get-rush
|= {a/whir-of b/json} ^+ ..ix
(get-even [%rush [[(slav %p p.a) q.a] r.a] (joba %json b)])
?: ?=($lens r.a)
(get-lens a b)
(get-even [%rush [[(slav %p p.a) q.a] s.a] (joba %json b)])
::
++ get-quit
|= a/whir-of ^+ ..ix
(get-even [%quit [[(slav %p p.a) q.a] r.a]])
(get-even [%quit [[(slav %p p.a) q.a] s.a]])
::
++ get-ack
|= {a/whir-of b/(unit {term tang})} ^+ ..ix
?: ?=($lens r.a)
(ack-lens b)
?: =(~ med) ~& resp-lost+ire ..ix
?~ b (nice-json:pop-duct)
(mean-json:pop-duct 500 b)
::
++ ack-lens
|= a/(unit (pair term tang)) ^+ ..ix
?~ a
..ix :: (give-json 200 ~ (joba %okey-dokey %b &))
=+ tag=(flop `tang`[>[%eyre-lens-fail p.u.a]< q.u.a])
%- (slog tag)
abet:(give-json 500 ~ (jape (wush 160 tag)))
::
++ get-even
|= ven/even ^+ ..ix
=+ num=p.eve
@ -1583,9 +1639,9 @@
++ give-even
|= {pol/? num/@u ven/even} ^+ done
=: q.eve (~(del by q.eve) (dec num)) :: TODO ponder a-2
mow ?.(?=($rush -.ven) mow mow:(pass-took p.ven))
mow ?.(?=($rush -.ven) mow mow:(pass-took [- %mess +]:p.ven))
==
?> pol :: XX eventstream
?> pol :: XX eventstream
%^ give-json 200 ~
%^ jobe id+(jone num) type+[%s -.ven]
?- -.ven
@ -1600,9 +1656,9 @@
(pass-note of+/[ire] [%b %rest era])
::
++ pass-took
|= a/{p/dock wire}
|= a/{p/dock ?($mess $lens) wire}
%+ pass-note(hen `~)
[%of ire (gsig a)]
[%of ire (gsig a)]
[%g %deal [him -.p.a] +.p.a %pump ~]
::
++ pop-duct =^(ned med ~(get to med) abet(hen ned))
@ -1620,7 +1676,7 @@
(give-even & a ven)
::
++ poll-rest
?~ ude done
?~ ude done
%*(. pass-rest(hen p.u.ude) hen hen)
::
++ poll-dead
@ -1634,7 +1690,7 @@
|= {a/dock b/path}
%- jobe :~
ship+[%s (rsh 3 1 (scot %p p.a))]
appl+[%s q.a]
appl+[%s q.a]
path+(jape (spud b))
==
++ wake ^+(..ix abet(ude ~)) :: XX other effects?
@ -1642,6 +1698,7 @@
++ print-subs |=({a/dock b/path} "{<p.a>}/{(trip q.a)}{(spud b)}")
--
++ vi :: auth engine
~% %eyre-v ..is ~
|_ $: {usr/iden dom/path}
cor/(unit $@($~ vase))
req/(qeu {p/duct q/mark r/vase})
@ -1670,9 +1727,9 @@
[[%& 12]~ %$ bale+!>(*(bale @))] :: XX specify on type?
?~ cor ~
?~ u.cor ~
?: (has-arm %wyp) ~
?: (has-arm %upd)
[[%& 13]~ ride+[limb+%upd prep-cor]]~
?: (has-arm %discard-state) ~
?: (has-arm %update)
[[%& 13]~ ride+[limb+%update prep-cor]]~
[[%& 13]~ %$ noun+(slot 13 u.cor)]~
::
++ call
@ -1704,8 +1761,8 @@
?~ 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)
?~ u.cor (eyre-them %filter-request r.u.ole) :: don't process
(call %filter-request hiss+r.u.ole)
::
++ fin-httr
|= vax/vase
@ -1717,26 +1774,31 @@
:: Interfaces
::
++ get-news _build
++ get-quay |=(quy/quay (call %in quay+!>(quy)))
++ get-req |=(a/{mark vase} pump(req (~(put to req) hen a)))
++ get-quay |=(quy/quay (call %receive-auth-query-string 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))
?($receive-auth-query-string $in) (call %receive-auth-response httr+!>(hit))
?($filter-request $out)
?. (has-arm %filter-response) (fin-httr !>(hit))
(call %filter-response 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)
?- wir
?($filter-request $out) res-out
?($filter-response $res) res-res
?($receive-auth-response $bak) res-bak
?($receive-auth-query-string $in) res-in
==
::
++ update
++ update
|= {dep/@uvH gag/(each cage tang)}
:: ~& got-upd/dep
:: ~& got-update/dep
=. ..vi (pass-note %core [%f [%wasp our dep &]])
?~ -.gag pump(cor `q.p.gag)
?: &(=(~ cor) =(%$ usr))
@ -1749,7 +1811,8 @@
:: 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)))
=> =- ?~(usr - rose+["@" `~]^~[leaf+(trip usr) -])
rose+["." `~]^(turn (flop dom) |=(a/cord leaf+(trip a)))
rose+[" " `~]^~[leaf+"To authenticate" . leaf+"visit:"]
::
++ do-give (with !>(|=({$give a/httr} a)) fin-httr)
@ -1803,13 +1866,13 @@
::
++ res-in
%+ on-error dead-this |.
(handle-moves send+(do-send %in) ~)
(handle-moves send+(do-send %receive-auth-query-string) ~)
::
++ res-res
%+ on-error dead-hiss |.
%- handle-moves :~
give+do-give
send+(do-send %out)
send+(do-send %filter-request)
redo+_pump
==
::
@ -1817,7 +1880,7 @@
%+ on-error dead-this |.
%- handle-moves :~
give+do-give
send+(do-send %in)
send+(do-send %receive-auth-query-string)
redo+_pump(..vi (give-html 200 ~ exit:xml))
==
::
@ -1826,7 +1889,7 @@
%+ on-error warn |.
%- handle-moves :~
give+do-give
send+(do-send %out)
send+(do-send %filter-request)
show+do-show
==
-- --
@ -1877,8 +1940,12 @@
~
::
++ load :: take previous state
|= old/bolo
..^$(+>- old)
=+ bolo-4={$4 _%*(+ *bolo lyv *(map duct ^))}
|= old/?(bolo bolo-4)
?- -.old
$5 ..^$(+>- old)
$4 $(old [%5 +.old(lyv ~)]) :: minor leak
==
::
++ scry
|= {fur/(unit (set monk)) ren/@tas who/ship syd/desk lot/coin tyl/path}
@ -1899,7 +1966,7 @@
=. p.lot ?.(=([%da now] p.lot) p.lot [%tas %real])
?+ p.lot [~ ~]
{$tas $fake} ``[& [~ 8.443] %& /localhost] :: XX from unix
{$tas $real}
{$tas $real}
``~(our-host ye [`duct`~[/] [now eny our sky] ~] bol)
==
==
@ -1918,9 +1985,6 @@
?~ tee ~& [%e %lost -.q.hin hen] [~ ..^$]
=^ mos bol
=< abet
%^ axon:~(adit ye [hen [now eny our sky] ~] bol) u.tee
(~(peek ut p.hin) %free 3)
q.hin
(axon:~(adit ye [hen [now eny our sky] ~] bol) u.tee q.hin)
[mos ..^$]
--

298
arvo/ford.hoon
View File

@ -14,12 +14,18 @@
$% $: $c :: to %clay
$% {$warp p/sock q/riff} ::
== == ::
$: $g :: to %clay
$: $f :: to %ford
$% {$exec p/@p q/(unit bilk)} ::
== == ::
$: $g :: to %gall
$% {$deal p/sock q/cush} ::
== == == ::
++ sign :: in result $<-
$% $: $c :: by %clay
$% {$writ p/riot} ::
== == ::
$: $f :: by %ford
$% {$made p/@uvH q/gage} ::
== == ::
$: $g :: by %gall
$% {$unto p/cuft} ::
@ -64,6 +70,7 @@
$% {$hood p/calm q/(pair beam cage) r/hood} :: compile
{$bake p/calm q/(pair mark beam) r/(unit vase)} :: load
{$boil p/calm q/(trel coin beam beam) r/vase} :: execute
{$path p/calm q/beam r/(unit beam)} :: -to/ transformation
{$slit p/calm q/{p/span q/span} r/span} :: slam type
{$slim p/calm q/{p/span q/twig} r/(pair span nock)}:: mint
{$slap p/calm q/{p/vase q/twig} r/vase} :: compute
@ -78,7 +85,7 @@
$: nah/duct :: cause
{bek/beak kas/silk} :: problem
keg/(map (pair term beam) cage) :: block results
kig/{p/@ud q/(map @ud {van/vane ren/care bem/beam})} :: blocks
kig/(set (trel vane care beam)) :: blocks
== ::
++ gagl (list (pair gage gage)) ::
++ vane ?($a $b $c $d $e $f $g) ::
@ -91,6 +98,7 @@
$hood ?>(?=($hood -.cax) r.cax)
$bake ?>(?=($bake -.cax) r.cax)
$boil ?>(?=($boil -.cax) r.cax)
$path ?>(?=($path -.cax) r.cax)
$slap ?>(?=($slap -.cax) r.cax)
$slam ?>(?=($slam -.cax) r.cax)
$slim ?>(?=($slim -.cax) r.cax)
@ -156,7 +164,7 @@
(rap 3 |-([i.a ?~(t.a ~ ['-' $(a t.a)])]))
::
++ tear :: split term
=- |=(a/term (rush a (most hep sym)))
=- |=(a/term `(list term)`(fall (rush a (most hep sym)) /[a]))
sym=(cook crip ;~(plug low (star ;~(pose low nud))))
::
++ za :: per event
@ -192,26 +200,23 @@
=: p.tad.bay +(p.tad.bay)
dym.bay (~(put by dym.bay) hen num)
==
~(exec zo [num `task`[hen kub ~ 0 ~]])
~(exec zo [num `task`[hen kub ~ ~]])
::
++ axon :: take
|= {num/@ud tik/@ud sih/sign}
|= {num/@ud {van/vane ren/care bem/beam} sih/sign}
^+ +>
?: ?=({$unto $quit *} +.sih)
+>.$
=+ tus=(~(get by q.tad.bay) num)
?~ tus
~& [%ford-lost van num]
+>.$
?- -.+.sih
$writ
=+ tus=(~(get by q.tad.bay) num)
?~ tus
~& [%ford-lost num]
+>.$
(~(resp zo [num u.tus]) tik p.+.sih)
::
$writ (~(resp zo [num u.tus]) [van ren bem] p.+.sih)
$made (~(resm zo [num u.tus]) [van ren bem] [p q]:+.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)
?+ -.p.+.sih ~|(ford-strange-unto+-.p.+.sih !!)
$diff (~(resd zo [num u.tus]) [van ren bem] p.p.+.sih)
$reap ?~ p.p.+.sih +>.$
((slog leaf+"ford-reap-fail" u.p.p.+.sih) +>.$)
==
@ -255,7 +260,6 @@
+>.$(mow ?.(ask mow :_(mow [hen %give %news dep])))
=+ dap=(~(get by deh.bay) dep)
?~ dap ~&(dep-missed+dep +>.$) :: XX ~| !!
:: ~& awap+[dep u.dap]
?- -.u.dap
$done +>.$(mow ?.(ask mow :_(mow [hen %give %news dep])))
$sent
@ -292,49 +296,46 @@
==
++ camo :: stop requests
^+ .
=+ kiz=(~(tap by q.kig) *(list {p/@ud q/{van/vane ren/care bem/beam}}))
=+ kiz=(~(tap in kig))
|- ^+ +>
?~ kiz +>
?. ?=($c van.q.i.kiz) +>
%= $
kiz t.kiz
mow
:_ mow
:- hen
:^ %pass
[(scot %p our) (scot %ud num) (scot %ud p.i.kiz) ~]
%c
[%warp [our p.bem.q.i.kiz] q.bem.q.i.kiz ~]
$(kiz t.kiz, mow :_(mow [hen (cancel i.kiz)]))
::
++ cancel :: stop a request
|= {van/vane ren/care bem/beam} ^- (wind note gift)
?+ van ~|(stub-cancel+van !!)
$c [%pass (camp-wire +<) van [%warp [our p.bem] q.bem ~]]
$g [%pass (camp-wire +<) van [%deal [our p.bem] q.bem [%pull ~]]]
==
++ camp-wire :: encode block
|= {van/vane ren/care bem/beam} ^- wire
[(scot %p our) (scot %ud num) van ren (tope bem)]
::
++ camp :: request a file
|= {van/vane ren/care bem/beam}
^+ +>
?: ?=($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)]]
~& >> [%camping van ren bem]
%_ +>.$
kig (~(put in kig) +<)
mow
:_ mow
:- hen
?+ van ~&(%camp-stub !!)
$g
:+ %pass (camp-wire +<)
=+ ^= tyl
?. ?=($x ren)
s.bem
?> ?=(^ s.bem)
t.s.bem
[%g [%deal [our p.bem] q.bem [%peer %scry ren (flop tyl)]]]
::
$c
:+ %pass (camp-wire +<)
[%c [%warp [our p.bem] q.bem [~ %sing ren r.bem (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]
@ -580,7 +581,7 @@
::
++ exec :: execute app
^+ ..zo
?: !=(~ q.kig) ..zo
?: !=(~ kig) ..zo
=+ bot=(make-norm-bek [~ jav.bay deh.bay] kas)
=^ dep bot (clad bot)
=. ..exec (dash p.bot)
@ -600,11 +601,11 @@
::
++ fade :: compile to hood
~/ %fade
|= {cof/cafe for/mark bem/beam}
|= {cof/cafe bem/beam}
:: ~& fade+(tope bem)
^- (bolt hood)
%+ cool |.(leaf+"ford: fade {<[(tope bem)]>}")
%+ cope (liar cof %*(. bem s [for s.bem]))
%+ cope (liar cof %*(. bem s [%hoon s.bem]))
|= {cof/cafe cay/cage}
%+ (clef %hood) (fine cof bem(r [%ud 0]) cay)
^- (burg (pair beam cage) hood)
@ -621,21 +622,45 @@
~/ %fame
|= {cof/cafe bem/beam}
^- (bolt beam)
%+ cope
?~ s.bem (flue cof)
=+ opt=`(list term)`(fall (tear i.s.bem) ~)
?~ opt (flue cof)
|- ^- (bolt (unit beam))
=. i.s.bem (tack opt)
=; une/(bolt (unit beam))
%+ cope une
|= {cof/cafe bom/(unit beam)} ^- (bolt beam)
?^ bom (fine cof u.bom)
(flaw cof leaf+"fame: no {<(tope bem)>}" ~)
%+ (clef %path) (fine cof bem)
|= {cof/cafe bem/beam}
=^ pax bem [(flop s.bem) bem(s ~)]
|^ opts
++ opts :: search unless done
^- (bolt (unit beam))
?^ pax (wide(pax t.pax) (tear i.pax))
%+ cope (lima cof %hoon bem)
|= {cof/cafe vax/(unit vase)} ^- (bolt (unit beam))
?^ vax (fine cof `bem)
?~ t.opt (flue cof)
%+ cope ^$(opt t.opt, t.s.bem :_(t.s.bem i.opt), cof cof)
|= {cof/cafe bem/(unit beam)} ^- (bolt (unit beam))
?^ bem (fine cof bem)
^$(opt :_(t.t.opt (tack i.opt i.t.opt ~)), cof cof)
(flux |=(a/(unit beam) (fall a bem)))
(flux |=(a/(unit vase) ?~(a ~ `bem)))
::
++ wide :: match segments
|= sub/(list term) ^- (bolt (unit beam))
?~ sub opts
?~ t.sub opts(s.bem [i.sub s.bem])
=> .(sub `(list term)`sub) :: TMI
=- (cope - flat)
%^ lash cof bem
|= {cof/cafe dir/knot} ^- (bolt (unit beam))
=+ sus=(tear dir)
?. =(sus (scag (lent sus) sub))
(flue cof)
%_ ^$
cof cof
sub (slag (lent sus) sub)
s.bem [dir s.bem]
==
::
++ flat :: at most one
|= {cof/cafe opt/(map term beam)} ^- (bolt (unit beam))
?~ opt (flue cof)
?: ?=({^ $~ $~} opt) (fine cof `q.n.opt)
=+ all=(~(run by `(map term beam)`opt) tope)
(flaw cof leaf+"fame: fork {<all>}" ~)
--
::
++ fang :: protocol door
|= {cof/cafe for/mark} ^- (bolt vase)
@ -655,6 +680,7 @@
[~ u=(^case a)]
nuck:so
::
++ mota ;~(pfix pat mota:vez) :: atom odor
++ hath (sear plex (stag %conl poor)):vez :: hood path
++ have (sear tome ;~(pfix fas hath)) :: hood beam
++ hith :: static path
@ -729,7 +755,7 @@
(stag %lin ;~(pfix pam lin:read))
(stag %man ;~(pfix tar man:read))
(stag %nap ;~(pfix cab day:read))
(stag %now ;~(pfix pat day:read))
(stag %nod ;~(pfix cab now:read))
(stag %saw ;~(pfix sem saw:read))
(stag %see ;~(pfix col see:read))
(stag %sic ;~(pfix ket sic:read))
@ -783,6 +809,10 @@
=< ;~(sfix (star (sear . day)) gap duz)
|= a/^horn ^- (unit {term ^horn})
?+(-.a ~ $dub `[p.a q.a])
::
++ now
%+ rail ;~((glue cab) mota day)
;~(pfix gap ;~(plug mota day))
::
++ saw
%+ rail
@ -911,11 +941,17 @@
++ keel :: apply mutations
|= {cof/cafe suh/vase yom/(list (pair wing vase))}
^- (bolt vase)
%+ cool =< |.(leaf+"ford: keel {<(murn yom +)>}")
|= {a/wing b/span *}
=+ c=p:(slap suh wing+a)
?: (~(nest ut c) | b) ~
(some [a c b])
%+ cool
=< |. ^- tank
:+ %palm [" " ~ ~ ~]
~[leaf+"ford: keel" rose+[" " ~ ~]^(murn yom +)]
|= {a/wing b/span *} ^- (unit tank)
=+ typ=(mule |.(p:(slap suh wing+a)))
?: ?=($| -.typ)
(some (show [%c %pull] %l a))
?: (~(nest ut p.typ) | b) ~
%^ some %palm ["." ~ ~ ~]
~[(show [%c %mute] %l a) >[p.typ b]<]
%^ maim cof
%+ slop suh
|- ^- vase
@ -954,27 +990,23 @@
%+ cool |.(leaf+"ford: load {<for>} {<(tope bem)>}")
=. s.bem [for s.bem]
%+ cope (liar cof bem)
|= {cof/cafe cay/cage}
|= {cof/cafe cay/cage} ^- (bolt vase)
?. =(for p.cay)
(flaw cof leaf+"unexpected mark {<p.cay>}" ~)
((lake for) cof q.cay)
(fine cof q.cay)
::
++ lake :: check+coerce
|= for/mark
|= {fit/? for/mark}
|= {cof/cafe sam/vase}
^- (bolt vase)
%+ cool |.(leaf+"ford: check {<[for bek `@p`(mug q.sam)]>}")
?: ?=($hoon for)
=+ mas=((soft @t) q.sam)
?~ mas
(flaw cof [leaf+"ford: bad hoon: {<[for bek]>}"]~)
(fine cof [%atom %t ~] u.mas)
%+ cope (fang cof for)
|= {cof/cafe tux/vase}
=+ typ=p:(slot 6 tux)
=. typ ?+(-.typ typ $face q.typ)
?: (~(nest ut typ) | p.sam)
(fine cof typ q.sam)
?. fit (flaw cof [%leaf "ford: invalid type: {<p.sam>}"]~)
?. (slob %grab p.tux)
(flaw cof [%leaf "ford: no grab: {<[for bek]>}"]~)
=+ gab=(slap tux [%limb %grab])
@ -995,11 +1027,6 @@
?~ von [p=cof q=[%1 [%c %w bem ~] ~ ~]]
(fine cof bem(r [%ud ((hard @) +.+:(need u.von))]))
::
++ lave :: validate
|= {cof/cafe for/mark som/*}
^- (bolt vase)
((lake for) cof [%noun som])
::
++ lane :: span infer
|= {cof/cafe typ/span gen/twig}
%+ (cowl cof) (mule |.((~(play ut typ) gen)))
@ -1012,18 +1039,20 @@
::
++ lear :: load core
|= {cof/cafe bem/beam} ^- (bolt vase)
%+ cope (lamp cof bem)
|= {cof/cafe bem/beam}
(leap cof many+~ bem bem)
::
++ leap :: XX load with path
~/ %leap
|= {cof/cafe arg/coin bem/beam bom/beam}
%+ (clef %boil) (fine cof arg bem bom)
|= {cof/cafe arg/coin bem/beam bom/beam}
%+ cope (lamp cof bem)
|= {cof/cafe bem/beam}
%+ (clef %boil) (fine cof arg bem bom)
|= {cof/cafe arg/coin bem/beam bom/beam}
%+ cope (fame cof bem)
|= {cof/cafe bem/beam}
(cope (fade cof %hoon bem) abut:(meow bom arg))
(cope (fade cof bem) abut:(meow bom arg))
::
++ lend :: load arch
|= {cof/cafe bem/beam}
@ -1084,10 +1113,12 @@
++ lime :: load beam
|= {cof/cafe for/mark arg/coin bem/beam}
^- (bolt vase)
%+ coop (leap cof arg [-.bem /[for]/ren] bem)
|= cof/cafe ^- (bolt vase)
%+ cope (lima cof for bem)
|= {cof/cafe vux/(unit vase)}
?^ vux (fine cof u.vux)
(leap cof arg [-.bem /[for]/ren] bem)
(flaw cof leaf+"ford: no {<for>} at {<(tope bem)>}" ~)
::
++ link :: translate
~/ %link
@ -1098,7 +1129,7 @@
:: %+ cool |.(leaf+"ford: link {<too>} {<for>} {<p.vax>}")
?: =(too for) (fine cof vax)
?: |(=(%noun for) =(%$ for))
((lake too) cof vax)
((lake & too) cof vax)
%+ cope (fang cof for)
|= {cof/cafe pro/vase} ^- (bolt vase)
?: :: =< $ ~% %limb-grow link-jet ~ |.
@ -1243,8 +1274,6 @@
::
$bunt
%+ cool |.(leaf+"ford: bunt {<p.kas>}")
?: ?=($hoon p.kas)
(fine cof %& p.kas [%atom %t ~] '')
%+ cope (fang cof p.kas)
|= {cof/cafe tux/vase}
=+ [typ=p val=q]:(slot 6 tux)
@ -1359,7 +1388,7 @@
::
$vale
%+ cool |.(leaf+"ford: vale {<p.kas>} {<`@p`(mug q.kas)>}")
%+ cope (lave cof p.kas q.kas)
%+ cope ((lake & p.kas) cof [%noun q.kas])
(flux |=(vax/vase `gage`[%& p.kas vax]))
::
$volt
@ -1572,6 +1601,10 @@
$now
%+ cope (chad cof bax %da p.hon)
(flux |=(a/vase noun+a))
::
$nod
%+ cope (chad cof bax p.hon q.hon)
(flux |=(a/vase noun+a))
::
$nap
%+ cope (chai cof bax p.hon)
@ -1609,10 +1642,10 @@
=. arg ?.(lit arg many+~)
(cope (make cof %bake q.hon arg how) furl)
%+ cool |.(leaf+"ford: hook {<q.hon>} {<(tope how)>}")
%+ cope (fade cof %hoon how)
%+ cope (fade cof how)
|= {cof/cafe hyd/hood}
%+ cope (abut:(meow how arg) cof hyd)
;~(cope (lake q.hon) (flux |=(a/vase [q.hon a])))
;~(cope (lake | q.hon) (flux |=(a/vase [q.hon a])))
==
::
++ head :: consume structures
@ -1627,7 +1660,7 @@
$(bir t.bir)
%+ cope (fame cof (hone %sur i.bir))
|= {cof/cafe bem/beam}
%+ cope (fade cof %hoon bem)
%+ cope (fade cof bem)
|= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..head}
@ -1659,7 +1692,7 @@
$(bir t.bir)
%+ cope (fame cof (hone %lib i.bir))
|= {cof/cafe bem/beam}
%+ cope (fade cof %hoon bem)
%+ cope (fade cof bem)
|= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..neck}
@ -1683,7 +1716,7 @@
%+ cope (lend cof p.hop)
|= {cof/cafe arc/arch}
?: (~(has by dir.arc) %hoon)
%+ cope (fade cof %hoon p.hop)
%+ cope (fade cof p.hop)
|= {cof/cafe hyd/hood}
%+ cope (apex(boy ~) cof hyd)
(flux |=(sel/_..wilt sel(boy [[%tow boy.sel] boy])))
@ -1726,12 +1759,6 @@
|=({cof/cafe p/silk q/silk} (cope (make cof q) furl))
==
|= {cof/cafe cay/cage coy/cage} ^- (bolt gage)
?: ?=($hoon p.cay)
?. ?=($txt-diff p.coy)
(flaw cof leaf+"{<p.cay>} mark with bad diff type: {<p.coy>}" ~)
%+ cope (maul cof !>(pact-hoon) (slop q.cay q.coy))
(flux |=(vax/vase [%& p.cay vax]))
::
%+ cope (fang cof p.cay)
|= {cof/cafe pro/vase}
?. (slab %grad p.pro)
@ -1762,23 +1789,43 @@
==
::
++ resp
|= {tik/@ud rot/riot}
|= {{van/vane ren/care bem/beam} rot/riot}
^+ ..zo
?> (~(has by q.kig) tik)
=+ `{van/vane ren/care bem/beam}`(~(got by q.kig) tik)
?> ?=($c van)
=. kig (~(del in kig) +<-.$)
?~ 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))
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] r.u.rot))
::
++ resd
|= {tik/@ud cag/cage}
++ resd :: take %diff
|= {{van/vane ren/care bem/beam} 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))
?> ?=($g van)
?: |(!?=($x ren) =(-.s.bem p.cag))
=. kig (~(del in kig) +<-.$)
=. mow :_(mow [hen (cancel van ren bem)])
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] cag))
=. mow
:_ mow
:^ hen %pass (camp-wire van ren bem)
[%f %exec our ~ bek %cast ((hard mark) -.s.bem) %$ cag]
..zo
::
++ resm :: take %made
|= {{van/vane ren/care bem/beam} dep/@uvH gag/gage} :: XX depends?
^+ ..zo
?> ?=($g van)
=. kig (~(del in kig) +<-.$)
=. mow :_(mow [hen (cancel van ren bem)])
?: ?=($| -.gag)
amok:(expo [%made dep %| leaf+"ford-scry-made-fail" p.gag])
?: ?=($tabl -.gag)
amok:(expo [%made dep %| leaf+"ford-scry-made-strange" ~])
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] p.gag))
::
++ syve
^- sley
@ -1789,6 +1836,9 @@
%+ biff +<
|= cay/cage ^- (unit cage)
?. -:(nets:wa +.ref `span`p.q.cay) :: error if bad type
~& :^ %ford-syve-lost `path`[tem (tope bem)]
want=;;(span +.ref)
have=p.q.cay
~
`cay
^- (unit (unit cage))
@ -1897,10 +1947,12 @@
?^ dep
=+ bem=(need (tome t.t.tea))
abet:(~(axun za [our hen [now eny ski] ~] bay) tea u.dep bem q.hin)
?> ?=({@ $~} t.t.tea)
?> ?=({@ @ ^} t.t.tea)
=+ :* num=(slav %ud i.t.tea)
tik=(slav %ud i.t.t.tea)
van=((hard vane) i.t.t.tea)
ren=((hard care) i.t.t.t.tea)
bem=(need (tome t.t.t.t.tea))
==
abet:(~(axon za [our hen [now eny ski] ~] bay) num tik q.hin)
abet:(~(axon za [our hen [now eny ski] ~] bay) num [van ren bem] q.hin)
[mos ..^$(pol (~(put by pol) our bay))]
--

189
arvo/gall.hoon
View File

@ -46,7 +46,7 @@
== ::
++ mast :: ship state
$: sys/duct :: system duct
sap/(map ship scad) :: foreign contacts
sap/(map ship scar) :: foreign contacts
bum/(map dude seat) :: running agents
wub/(map dude sofa) :: waiting queue
== ::
@ -55,11 +55,6 @@
q/ship :: attributed to
== ::
++ prey (pair volt ffuc) :: privilege
++ scad :: foreign connection
$: p/@ud :: index
q/(map duct @ud) :: by duct
r/(map @ud duct) :: by index
== ::
++ scar :: opaque input
$: p/@ud :: bone sequence
q/(map duct bone) :: by duct
@ -225,7 +220,6 @@
:: to this returning pump.
::
+>
=^ num +>.$ (mo-bale him)
=+ ^= roc ^- rook
?- -.q.caz
$peel !!
@ -234,10 +228,16 @@
$puff !!
$punk !!
$peer [%s p.q.caz]
==
=+ ^= dak
?+ -.q.caz !!
$poke %k
$pull %l
$peer %r
==
%+ mo-pass
[%sys %way -.q.caz ~]
`note-arvo`[%a %wont [our him] [%g %ge p.caz ~] [num roc]]
[%sys %way ~]
`note-arvo`[%a %wont [our him] [%g dak p.caz ~] [42 roc]]
::
++ mo-baal :: error convert a
|= art/(unit ares)
@ -261,28 +261,6 @@
$pull +>.$
==
::
++ mo-bale :: assign outbone
|= him/ship
^- {@ud _+>}
=+ sad=(fall (~(get by sap) him) `scad`[1 ~ ~])
=+ nom=(~(get by q.sad) hen)
?^ nom [u.nom +>.$]
:- p.sad
%_ +>.$
sap
%+ ~(put by sap) him
%_ sad
p +(p.sad)
q (~(put by q.sad) hen p.sad)
r (~(put by r.sad) p.sad hen)
==
==
::
++ mo-ball :: outbone by index
|= {him/ship num/@ud}
^- duct
(~(got by r:(~(got by sap) him)) num)
::
++ mo-come :: handle locally
|= {her/ship caz/cush}
^+ +>
@ -335,40 +313,30 @@
==
::
$red :: diff ack
?> ?=({@ @ @ $~} t.pax)
?. ?=({$a $woot *} sih)
~& [%red-went pax]
+>.$
?> ?=({@ @ $~} t.pax)
?> ?=({$a ?($waft $woot) *} sih)
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
=> .(pax `path`[%req t.pax])
?~ q.+>.sih
(mo-pass [%sys pax] %g %deal [him our] dap %pump ~)
~& [%diff-bad-ack q.+>.sih] :: should not happen
=. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~)
(mo-pass [%sys pax] %a %wont [our him] [%g %gh dap ~] [num %x ~])
::
$rep :: reverse request
?> ?=({@ @ @ $~} t.pax)
?> ?=({$f $made *} sih)
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
?- -.q.+>.sih
$tabl ~|(%made-tabl !!)
$| (mo-give %mack `p.q.+>.sih) :: XX should crash
$& =. +>.$ (mo-give %mack ~) :: XX pump should ack
(mo-give(hen (mo-ball him num)) %unto %diff `cage`p.q.+>.sih)
?- +<.sih
$waft
~& %red-waft
=+ fay=((hard (unit (pair mark noun))) r.+>.sih)
(mo-give %unto ?~(fay [%quit ~] [%doff u.fay]))
::
$woot
?~ r.+>.sih
(mo-pass [%sys pax] %g %deal [him our] dap %pump ~)
~& [%diff-bad-ack q.+>.sih]
=. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~)
(mo-give %rend [%g %r dap ~] ~)
==
::
$req :: inbound request
?> ?=({@ @ @ $~} t.pax)
?> ?=({@ @ $~} t.pax)
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
?: ?=({$f $made *} sih)
?- -.q.+>.sih
@ -381,13 +349,11 @@
=+ cuf=`cuft`+>.sih
?- -.cuf
$coup (mo-give %mack p.cuf)
$diff %+ mo-pass [%sys %red t.pax]
[%a %wont [our him] [%g %gh dap ~] [num %d p.p.cuf q.q.p.cuf]]
$doff !!
$quit %+ mo-pass [%sys pax]
[%a %wont [our him] [%g %gh dap ~] [num %x ~]]
$reap (mo-give %mack p.cuf)
==
$diff (mo-give %rend [%g %r dap ~] [~ p.p.cuf q.q.p.cuf])
$doff (mo-give %rend [%g %r dap ~] [~ p.cuf q.cuf])
$quit (mo-give %rend [%g %r dap ~] ~)
==
::
$val :: inbound validate
?> ?=({@ @ $~} t.pax)
@ -400,20 +366,24 @@
==
::
$way :: outbound request
?: ?=({$a $went *} sih) :: XX AWFUL
~& %way-went-bug
?> ?=({@ $~} t.pax)
?> ?=({$a ?($waft $woot) *} sih)
?- +<.sih
$waft
?> ?=({$g $r @ $~} q.+>.sih)
=+ fay=((hard (unit (pair mark noun))) r.+>.sih)
(mo-give %unto ?~(fay [%quit ~] [%doff u.fay]))
::
$woot
?> ?=({$g @ @ $~} q.+>.sih)
%- mo-awed
:* p.+>.sih
(?($peer $poke $pull) i.t.pax)
~
?+ i.t.q.+>.sih !!
$k %poke
$r %peer
$l %pull
==
r.+>.sih
==
?> ?=({$a $woot *} sih)
?> ?=({@ $~} t.pax)
%- mo-awed
:* p.+>.sih
(?($peer $poke $pull) i.t.pax)
+>+.sih
==
==
::
@ -519,7 +489,7 @@
|= {him/@p dap/dude num/@ud rok/rook}
=. +> ?.(?=($u -.rok) +> (mo-give %mack ~))
%+ mo-pass
[%sys %req (scot %p him) dap (scot %ud num) ~]
[%sys %req (scot %p him) dap ~]
^- note-arvo
?- -.rok
:: %m [%f %exec our ~ (mo-beak dap) %vale p.rok q.rok]
@ -528,14 +498,14 @@
$u [%g %deal [him our] dap %pull ~]
==
::
++ mo-gawd :: ames backward
|= {him/@p dap/dude num/@ud ron/roon}
=. +> (mo-give %mack ~)
=. hen (mo-ball him num)
?- -.ron
$d (mo-give %unto %doff p.ron q.ron)
$x (mo-give %unto %quit ~)
==
++ mo-gawp :: response ack
|= {him/@p dap/dude cop/coop}
^+ +>
%+ mo-pass
[%sys %req (scot %p him) dap ~]
?~ cop
[%g %deal [him our] dap %pump ~]
[%g %deal [him our] dap %pull ~]
::
++ ap :: agent engine
~% %gall-ap +> ~
@ -637,9 +607,14 @@
++ ap-peek
|= {ren/@tas tyl/path}
^- (unit (unit cage))
=+ ?. ?=($x ren)
[mar=%$ tyl=tyl]
=+ `path`(flop tyl)
?> ?=(^ -)
[mar=i tyl=(flop t)]
=+ cug=(ap-find %peek ren tyl)
?~ cug
((slog leaf+"peek find fail" >tyl< ~) [~ ~])
((slog leaf+"peek find fail" >tyl< >mar< ~) [~ ~])
=^ 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)]))
@ -647,7 +622,13 @@
?+ q.p.zem ((slog leaf+"peek bad result" ~) [~ ~])
$~ ~
{$~ $~} [~ ~]
{$~ $~ term *} ``[+14.q.p.zem (slot 15 p.zem)]
{$~ $~ ^}
=+ caz=(spec (slot 7 p.zem))
?. &(?=({p/@ *} q.caz) ((sane %tas) p.q.caz))
((slog leaf+"scry: malformed cage" ~) [~ ~])
?. =(mar p.q.caz)
[~ ~]
``[p.q.caz (slot 3 caz)]
==
::
++ ap-club :: apply effect
@ -782,6 +763,7 @@
(ap-move-pass -.q.vax +<.q.vax cav)
$diff (ap-move-diff -.q.vax cav)
$hiss (ap-move-hiss -.q.vax cav)
$peel (ap-move-peel -.q.vax cav)
$peer (ap-move-peer -.q.vax cav)
$pull (ap-move-pull -.q.vax cav)
$poke (ap-move-poke -.q.vax cav)
@ -871,6 +853,22 @@
:- p.p.yep
[%send q.p.yep r.p.yep %poke p.q.gaw paw]
::
++ ap-move-peel :: pass %peel
|= {sto/bone vax/vase}
^- {(each cove tang) _+>}
=^ yep +>.$ (ap-move-mess vax)
:_ +>.$
?: ?=($| -.yep) yep
=+ mar=((soft mark) +>-.q.vax)
?~ mar
[%| (ap-suck "peel: malformed mark")]
=+ pux=((soft path) +>+.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
[%| (ap-suck "peel: malformed path")]
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %peel u.mar u.pux]
::
++ ap-move-peer :: pass %peer
|= {sto/bone vax/vase}
^- {(each cove tang) _+>}
@ -1223,22 +1221,29 @@
$init
:: ~& [%gall-init p.q.hic]
[~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))]
::
$went
?. (~(has by pol.all) p.p.q.hic)
~& [%gall-not-ours p.q.hic]
[~ ..^$]
?> ?=({?($k $l $r) @ $~} q.q.hic)
=+ dap=i.t.q.q.hic
=+ our=p.p.q.hic
=+ him=q.p.q.hic
=< mo-abet
(mo-gawp:(mo-abed:mo our hen) him dap s.q.hic)
::
$west
?. (~(has by pol.all) p.p.q.hic)
~& [%gall-not-ours p.q.hic]
[~ ..^$]
?> ?=({?($ge $gh) @ $~} q.q.hic)
?> ?=({?($k $l $r) @ $~} q.q.hic)
=+ dap=i.t.q.q.hic
=+ our=p.p.q.hic
=+ him=q.p.q.hic
?: ?=($ge i.q.q.hic)
=+ mes=((hard {@ud rook}) r.q.hic)
=< mo-abet
(mo-gawk:(mo-abed:mo our hen) him dap mes)
=+ mes=((hard {@ud roon}) r.q.hic)
=+ mes=((hard {@ud rook}) s.q.hic)
=< mo-abet
(mo-gawd:(mo-abed:mo our hen) him dap mes)
(mo-gawk:(mo-abed:mo our hen) him dap mes)
::
$wegh
:_ ..^$ :_ ~
@ -1285,6 +1290,8 @@
~
?. (~(has by bum:(~(got by pol.all) who)) syd)
[~ ~]
?. ?=(^ tyl)
~
(mo-peek:(mo-abed:mo who *duct) syd high+`who ren tyl)
::
++ stay :: save w+o cache

464
arvo/hoon.hoon
View File

@ -421,6 +421,24 @@
^+ t.a
[i.a $(a (skim t.a |=(c/_i.a !(b c i.a))))]
::
++ spin
|* {a/(list) b/_|=({* *} [** +<+]) c/*}
:: ?< ?=($-([_?<(?=($~ a) i.a) _c] [* _c]) b)
|-
?~ a
~
=+ v=(b i.a c)
[i=-.v t=$(a t.a, c +.v)]
::
++ spun
|* {a/(list) b/_|=({* *} [** +<+])}
=| c/_+<+.b
|-
?~ a
~
=+ v=(b i.a c)
[i=-.v t=$(a t.a, c +.v)]
::
++ swag :: slice
|* {{a/@ b/@} c/(list)}
(scag +<-> (slag +<-< c))
@ -606,42 +624,44 @@
:: ::
::
++ fnv |=(a/@ (end 5 1 (mul 16.777.619 a))) :: FNV scrambler
::
++ muk :: standard murmur3
~/ %muk
|= {syd/@ key/@}
?> (lte (met 5 syd) 1)
=+ ^= row
|= {a/@ b/@}
(con (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
=+ mow=|=({a/@ b/@} (end 5 1 (mul a b)))
=+ len=(met 5 key)
=- =. goc (mix goc len)
=. goc (mix goc (rsh 4 1 goc))
=. goc (mow goc 0x85eb.ca6b)
=. goc (mix goc (rsh 0 13 goc))
=. goc (mow goc 0xc2b2.ae35)
(mix goc (rsh 4 1 goc))
^= goc
=+ [inx=0 goc=syd]
|- ^- @
?: =(inx len) goc
=+ kop=(cut 5 [inx 1] key)
=. kop (mow kop 0xcc9e.2d51)
=. kop (row 15 kop)
=. kop (mow kop 0x1b87.3593)
=. goc (mix kop goc)
=. goc (row 13 goc)
=. goc (end 5 1 (add 0xe654.6b64 (mul 5 goc)))
$(inx +(inx))
::
++ mum :: mug with murmur3
~/ %mum
|= a/*
|^ (trim ?@(a a (mix $(a -.a) (mix 0x7fff.ffff $(a +.a)))))
++ spec :: standard murmur3
|= {syd/@ key/@}
?> (lte (met 5 syd) 1)
=+ ^= row
|= {a/@ b/@}
(con (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
=+ mow=|=({a/@ b/@} (end 5 1 (mul a b)))
=+ len=(met 5 key)
=- =. goc (mix goc len)
=. goc (mix goc (rsh 4 1 goc))
=. goc (mow goc 0x85eb.ca6b)
=. goc (mix goc (rsh 0 13 goc))
=. goc (mow goc 0xc2b2.ae35)
(mix goc (rsh 4 1 goc))
^= goc
=+ [inx=0 goc=syd]
|- ^- @
?: =(inx len) goc
=+ kop=(cut 5 [inx 1] key)
=. kop (mow kop 0xcc9e.2d51)
=. kop (row 15 kop)
=. kop (mow kop 0x1b87.3593)
=. goc (mix kop goc)
=. goc (row 13 goc)
=. goc (end 5 1 (add 0xe654.6b64 (mul 5 goc)))
$(inx +(inx))
::
++ trim :: 31-bit nonzero
|= key/@
=+ syd=0xcafe.babe
|- ^- @
=+ haz=(spec syd key)
=+ haz=(muk syd key)
=+ ham=(mix (rsh 0 31 haz) (end 0 31 haz))
?.(=(0 ham) ham $(syd +(syd)))
--
@ -928,10 +948,13 @@
$(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
::
+- run :: apply gate to values
|* {b/$-(* *) c/*}
|-
?~ a c
$(a r.a, c [(b n.a) $(a l.a)])
~/ %run
|* b/gate
=| c/(set _?>(?=(^ a) (b n.a)))
|- ?~ a c
=. c (~(put in c) (b n.a))
=. c $(a l.a, c c)
$(a r.a, c c)
::
+- tap :: convert to list
~/ %tap
@ -1160,6 +1183,12 @@
?~ a a
[n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
::
+- rut :: apply gate to nodes
|* b/gate
|-
?~ a a
[n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
::
+- tap :: listify pairs
~/ %tap
|= b/(list _?>(?=(^ a) n.a))
@ -2976,7 +3005,7 @@
++ rads :: random continuation
|= b/@
=+ r=(rad b)
[r +>.$(a (shas %og-s r))]
[r +>.$(a (shas %og-s (mix a r)))]
::
++ raw :: random bits
~/ %raw
@ -2995,293 +3024,12 @@
++ raws :: random bits
|= b/@ :: continuation
=+ r=(raw b)
[r +>.$(a (shas %og-s r))]
[r +>.$(a (shas %og-s (mix a r)))]
--
:: ::
:::: 3e: AES encryption ::
:::: 3e: AES encryption (XX removed) ::
:: ::
:: aesc, ga ::
::
++ aesc :: AES-256
~% %aesc + ~
|%
++ en :: ECB enc
~/ %en
|= {a/@I b/@H} ^- @uxH
=+ ahem
(be & (ex a) b)
++ de :: ECB dec
~/ %de
|= {a/@I b/@H} ^- @uxH
=+ ahem
(be | (ix (ex a)) b)
--
++ ahem :: AES helpers
:: XX should be in aesc, isn't for performance reasons
=>
=+ =+ [gr=(ga 8 0x11b 3) few==>(fe .(a 5))]
=+ [pro=pro.gr dif=dif.gr pow=pow.gr ror=ror.few]
[pro=pro dif=dif pow=pow ror=ror nnk=8 nnb=4 nnr=14]
=> |%
++ cipa :: AES params
$_ ^? |%
++ co *{p/@ q/@ r/@ s/@} :: col coefs
++ ix |~(a/@ *@) :: key index
++ ro *{p/@ q/@ r/@ s/@} :: row shifts
++ su *@ :: s-box
--
--
|%
++ pen :: encrypt
^- cipa
|%
++ co [0x2 0x3 1 1]
++ ix |~(a/@ a)
++ ro [0 1 2 3]
++ su 0x16bb.54b0.0f2d.9941.6842.e6bf.0d89.a18c.
df28.55ce.e987.1e9b.948e.d969.1198.f8e1.
9e1d.c186.b957.3561.0ef6.0348.66b5.3e70.
8a8b.bd4b.1f74.dde8.c6b4.a61c.2e25.78ba.
08ae.7a65.eaf4.566c.a94e.d58d.6d37.c8e7.
79e4.9591.62ac.d3c2.5c24.0649.0a3a.32e0.
db0b.5ede.14b8.ee46.8890.2a22.dc4f.8160.
7319.5d64.3d7e.a7c4.1744.975f.ec13.0ccd.
d2f3.ff10.21da.b6bc.f538.9d92.8f40.a351.
a89f.3c50.7f02.f945.8533.4d43.fbaa.efd0.
cf58.4c4a.39be.cb6a.5bb1.fc20.ed00.d153.
842f.e329.b3d6.3b52.a05a.6e1b.1a2c.8309.
75b2.27eb.e280.1207.9a05.9618.c323.c704.
1531.d871.f1e5.a534.ccf7.3f36.2693.fdb7.
c072.a49c.afa2.d4ad.f047.59fa.7dc9.82ca.
76ab.d7fe.2b67.0130.c56f.6bf2.7b77.7c63
--
::
++ pin :: decrypt
^- cipa
|%
++ co [0xe 0xb 0xd 0x9]
++ ix |~(a/@ (sub nnr a))
++ ro [0 3 2 1]
++ su 0x7d0c.2155.6314.69e1.26d6.77ba.7e04.2b17.
6199.5383.3cbb.ebc8.b0f5.2aae.4d3b.e0a0.
ef9c.c993.9f7a.e52d.0d4a.b519.a97f.5160.
5fec.8027.5910.12b1.31c7.0788.33a8.dd1f.
f45a.cd78.fec0.db9a.2079.d2c6.4b3e.56fc.
1bbe.18aa.0e62.b76f.89c5.291d.711a.f147.
6edf.751c.e837.f9e2.8535.ade7.2274.ac96.
73e6.b4f0.cecf.f297.eadc.674f.4111.913a.
6b8a.1301.03bd.afc1.020f.3fca.8f1e.2cd0.
0645.b3b8.0558.e4f7.0ad3.bc8c.00ab.d890.
849d.8da7.5746.155e.dab9.edfd.5048.706c.
92b6.655d.cc5c.a4d4.1698.6886.64f6.f872.
25d1.8b6d.49a2.5b76.b224.d928.66a1.2e08.
4ec3.fa42.0b95.4cee.3d23.c2a6.3294.7b54.
cbe9.dec4.4443.8e34.87ff.2f9b.8239.e37c.
fbd7.f381.9ea3.40bf.38a5.3630.d56a.0952
--
::
++ mcol
|= {a/(list @) b/{p/@ q/@ r/@ s/@}} ^- (list @)
=+ c=[p=*@ q=*@ r=*@ s=*@]
|- ^- (list @)
?~ a ~
=> .(p.c (cut 3 [0 1] i.a))
=> .(q.c (cut 3 [1 1] i.a))
=> .(r.c (cut 3 [2 1] i.a))
=> .(s.c (cut 3 [3 1] i.a))
:_ $(a t.a)
%+ rep 3
%+ turn
%- limo
:~ [[p.c p.b] [q.c q.b] [r.c r.b] [s.c s.b]]
[[p.c s.b] [q.c p.b] [r.c q.b] [s.c r.b]]
[[p.c r.b] [q.c s.b] [r.c p.b] [s.c q.b]]
[[p.c q.b] [q.c r.b] [r.c s.b] [s.c p.b]]
==
|= {a/{@ @} b/{@ @} c/{@ @} d/{@ @}}
:(dif (pro a) (pro b) (pro c) (pro d))
::
++ pode :: explode to block
|= {a/bloq b/@ c/@} ^- (list @)
=+ d=(rip a c)
=+ m=(met a c)
|-
?: =(m b)
d
$(m +(m), d (weld d (limo [0 ~])))
++ sube :: s-box word
|= {a/@ b/@} ^- @
(rep 3 (turn (pode 3 4 a) |=(c/@ (cut 3 [c 1] b))))
--
|%
++ be :: block cipher
|= {a/? b/@ c/@H} ^- @uxH
=> %= .
+
=> +
|%
++ ankh
|= {a/cipa b/@ c/@}
(pode 5 nnb (cut 5 [(mul (ix.a b) nnb) nnb] c))
++ sark
|= {c/(list @) d/(list @)} ^- (list @)
?~ c ~
?~ d !!
[(mix i.c i.d) $(c t.c, d t.d)]
++ srow
|= {a/cipa b/(list @)} ^- (list @)
=+ [c=0 d=~ e=ro.a]
|-
?: =(c nnb)
d
:_ $(c +(c))
%+ rep 3
%+ turn
(limo [0 p.e] [1 q.e] [2 r.e] [3 s.e] ~)
|= {f/@ g/@}
(cut 3 [f 1] (snag (mod (add g c) nnb) b))
++ subs
|= {a/cipa b/(list @)} ^- (list @)
?~ b ~
[(sube i.b su.a) $(b t.b)]
--
==
=+ [d=?:(a pen pin) e=(pode 5 nnb c) f=1]
=> .(e (sark e (ankh d 0 b)))
|-
?. =(nnr f)
=> .(e (subs d e))
=> .(e (srow d e))
=> .(e (mcol e co.d))
=> .(e (sark e (ankh d f b)))
$(f +(f))
=> .(e (subs d e))
=> .(e (srow d e))
=> .(e (sark e (ankh d nnr b)))
(rep 5 e)
::
++ ex :: key expand
|= a/@I ^- @
=+ [b=a c=0 d=su:pen i=nnk]
|-
?: =(i (mul nnb +(nnr)))
b
=> .(c (cut 5 [(dec i) 1] b))
=> ?: =(0 (mod i nnk))
=> .(c (ror 3 1 c))
=> .(c (sube c d))
.(c (mix c (pow (dec (div i nnk)) 2)))
?: &((gth nnk 6) =(4 (mod i nnk)))
.(c (sube c d))
.
=> .(c (mix c (cut 5 [(sub i nnk) 1] b)))
=> .(b (can 5 [i b] [1 c] ~))
$(i +(i))
::
++ ix :: key expand, inv
|= a/@ ^- @
=+ [i=1 j=*@ b=*@ c=co:pin]
|-
?: =(nnr i)
a
=> .(b (cut 7 [i 1] a))
=> .(b (rep 5 (mcol (pode 5 4 b) c)))
=> .(j (sub nnr i))
%= $
i +(i)
a
%+ can 7
:~ [i (cut 7 [0 i] a)]
[1 b]
[j (cut 7 [+(i) j] a)]
==
==
--
++ ga :: GF (bex p.a)
|= a/{p/@ q/@ r/@} :: dim poly gen
=+ si=(bex p.a)
=+ ma=(dec si)
=> |%
++ dif :: add and sub
|= {b/@ c/@}
?> &((lth b si) (lth c si))
(mix b c)
::
++ dub :: mul by x
|= b/@
?> (lth b si)
?: =(1 (cut 0 [(dec p.a) 1] b))
(dif (sit q.a) (sit (lsh 0 1 b)))
(lsh 0 1 b)
::
++ pro :: slow multiply
|= {b/@ c/@}
?: =(0 b)
0
?: =(1 (dis 1 b))
(dif c $(b (rsh 0 1 b), c (dub c)))
$(b (rsh 0 1 b), c (dub c))
::
++ toe :: exp+log tables
=+ ^= nu
|= {b/@ c/@}
^- (map @ @)
=+ d=*(map @ @)
|-
?: =(0 c)
d
%= $
c (dec c)
d (~(put by d) c b)
==
=+ [p=(nu 0 (bex p.a)) q=(nu ma ma)]
=+ [b=1 c=0]
|- ^- {p/(map @ @) q/(map @ @)}
?: =(ma c)
[(~(put by p) c b) q]
%= $
b (pro r.a b)
c +(c)
p (~(put by p) c b)
q (~(put by q) b c)
==
::
++ sit :: reduce
|= b/@
(mod b (bex p.a))
--
=+ toe
|%
++ fra :: divide
|= {b/@ c/@}
(pro b (inv c))
::
++ inv :: invert
|= b/@
=+ c=(~(get by q) b)
?~ c !!
=+ d=(~(get by p) (sub ma u.c))
(need d)
::
++ pow :: exponent
|= {b/@ c/@}
=+ [d=1 e=c f=0]
|-
?: =(p.a f)
d
?: =(1 (cut 0 [f 1] b))
$(d (pro d e), e (pro e e), f +(f))
$(e (pro e e), f +(f))
::
++ pro :: multiply
|= {b/@ c/@}
=+ d=(~(get by q) b)
?~ d 0
=+ e=(~(get by q) c)
?~ e 0
=+ f=(~(get by p) (mod (add u.d u.e) ma))
(need f)
--
:: ::
:::: 3f: scrambling ::
:: ::
@ -3403,7 +3151,7 @@
=+ lo=(dis pyn 0xffff.ffff)
=+ hi=(dis pyn 0xffff.ffff.0000.0000)
%+ con hi
(add 0x1.0000 (fice (sub lo 0x1.0000)))
$(pyn lo)
pyn
::
++ fend :: restore structure v2
@ -3414,14 +3162,15 @@
=+ lo=(dis cry 0xffff.ffff)
=+ hi=(dis cry 0xffff.ffff.0000.0000)
%+ con hi
(add 0x1.0000 (teil (sub lo 0x1.0000)))
$(cry lo)
cry
::
++ fice :: adapted from
|= nor/@ :: black and rogaway
^- @ :: "ciphers with
=+ ^= sel :: arbitrary finite
%+ rynd 2 :: domains", 2002
%+ rynd 3 :: domains", 2002
%+ rynd 2
%+ rynd 1
%+ rynd 0
[(mod nor 65.535) (div nor 65.535)]
@ -3434,6 +3183,7 @@
%+ rund 0
%+ rund 1
%+ rund 2
%+ rund 3
[(mod vip 65.535) (div vip 65.535)]
(add (mul 65.535 -.sel) +.sel)
::
@ -3442,25 +3192,23 @@
^- {@ @}
:- r
?~ (mod n 2)
(~(sum fo 65.535) l (en:aesc (snag n raku) r))
(~(sum fo 65.536) l (en:aesc (snag n raku) r))
(~(sum fo 65.535) l (muk (snag n raku) r))
(~(sum fo 65.536) l (muk (snag n raku) r))
::
++ rund :: reverse round
|= {n/@ l/@ r/@}
^- {@ @}
:- r
?~ (mod n 2)
(~(dif fo 65.535) l (en:aesc (snag n raku) r))
(~(dif fo 65.536) l (en:aesc (snag n raku) r))
(~(dif fo 65.535) l (muk (snag n raku) r))
(~(dif fo 65.536) l (muk (snag n raku) r))
::
++ raku
^- (list @ux)
:~ 0x15f6.25e3.083a.eb3e.7a55.d4db.fb99.32a3.
43af.2750.219e.8a24.e5f8.fac3.6c36.f968
0xf2ff.24fe.54d0.1abd.4b2a.d8aa.4402.8e88.
e82f.19ec.948d.b1bb.ed2e.f791.83a3.8133
0xa3d8.6a7b.400e.9e91.187d.91a7.6942.f34a.
6f5f.ab8e.88b9.c089.b2dc.95a6.aed5.e3a4
:~ 0xb76d.5eed
0xee28.1300
0x85bc.ae01
0x4b38.7af7
==
--
::
@ -4735,7 +4483,8 @@
++ bip =+ tod=(ape qex:ab)
(bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod))))
++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab)))))
++ dim (ape (bass 10 ;~(plug sed:ab (star sid:ab))))
++ dim (ape dip)
++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
++ dum (bass 10 (plus sid:ab))
++ fed ;~ pose
%+ bass 0x1.0000.0000.0000.0000
@ -4750,6 +4499,13 @@
++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab)))))
++ lip =+ tod=(ape ted:ab)
(bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod))))
++ mot ;~ pose
;~ pfix
(just '1')
(cook |=(a/@ (add 10 (sub a '0'))) (shim '0' '2'))
==
sed:ab
==
++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab)))))
++ vum (bass 32 (plus siv:ab))
++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab)))))
@ -4926,6 +4682,7 @@
::
++ s-co
|= esc/(list @) ^- tape
~| [%so-co esc]
?~ esc
rep
:- '.'
@ -5020,8 +4777,8 @@
%+ cook
|=({a/@ b/?} [b a])
;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
;~(pfix dot dim:ag) :: month
;~(pfix dot dim:ag) :: day
;~(pfix dot mot:ag) :: month
;~(pfix dot dip:ag) :: day
;~ pose
;~ pfix
;~(plug dot dot)
@ -5468,6 +5225,7 @@
{$$ p/axis} :: simple leg
:: ::
{$base p/base} :: base
{$bunt p/twig} :: mold default value
{$bust p/base} :: bunt base
{$dbug p/spot q/twig} :: debug info in trace
{$hand p/span q/nock} :: premade result
@ -7908,6 +7666,7 @@
$path ::
$span ::
$void ::
$wall ::
$wool ::
$yarn ::
== ::
@ -7956,6 +7715,7 @@
$span :_(gid [%leaf '#' 't' ~])
$void :_(gid [%leaf '#' '!' ~])
$wool :_(gid [%leaf '*' '"' '"' ~])
$wall :_(gid [%leaf '*' '\'' '\'' ~])
$yarn :_(gid [%leaf '"' '"' ~])
{$mato *} :_(gid [%leaf '@' (trip p.q.ham)])
{$core *}
@ -8043,6 +7803,15 @@
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
$wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[[%leaf (trip ((hard @) -.lum))] $(lum +.lum)]
::
$wool
:- ~
@ -8188,7 +7957,7 @@
|= ham/cape
=- ?+ woz woz
{$list * {$mato $'ta'}} %path
:: {$list * {$mato $'t'}} %wall
{$list * {$mato $'t'}} %wall
{$list * {$mato $'tD'}} %yarn
{$list * $yarn} %wool
==
@ -9068,6 +8837,7 @@
(word %gate expb)
(word %tray expa)
::
(word %bunt expa)
(word %claw expb)
(word %shoe expa)
(word %bank exps)
@ -9586,8 +9356,14 @@
^- {? worm}
?: (~(has in nes) [sut ref]) [& +>+<]
?. (~(nest ut sut) | ref)
:: ~& %nest-failed
[| +>+<]
~& %nest-failed
=+ foo=(skol ref)
=+ bar=(skol sut)
~& %nets-need
~> %slog.[0 bar]
~& %nest-have
~> %slog.[0 foo]
[| +>+<.$]
[& +>+<(nes (~(put in nes) [sut ref]))]
::
++ nets :: spanless nest
@ -9596,16 +9372,16 @@
?: (~(has in nes) [sut ref]) [& +>+<]
=+ gat=|=({a/span b/span} (~(nest ut a) | b))
?. (? .*(gat(+< [sut ref]) -.gat))
:: ~& %nets-failed
:: =+ tag=`*`skol
:: =+ foo=(tank .*(tag(+< ref) -.tag))
:: =+ bar=(skol sut)
:: ~& %nets-need
:: ~> %slog.[0 bar]
:: ~& %nets-have
:: ~> %slog.[0 foo]
~& %nets-failed
=+ tag=`*`skol
=+ foo=(tank .*(tag(+< ref) -.tag))
=+ bar=(tank .*(tag(+< sut) -.tag))
~& %nets-need
~> %slog.[0 bar]
~& %nets-have
~> %slog.[0 foo]
[| +>+<.$]
[& +>+<.$(nes (~(put in nes) [sut ref]))]
[& +>+<.$(nes (~(put in nes) [sut ref]))]
::
++ play :: play:ut
|= {sut/span gen/twig}

1171
arvo/lalg.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

2557
arvo/usez.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

933
arvo/zuse.hoon
View File

File diff suppressed because it is too large Load Diff

90
gen/change.hoon
View File

@ -1,90 +0,0 @@
::
:::: /hoon/change/gen
::
/? 310
::
::::
!:
:- %say
|= *
:- %noun
=- %+ turn -
|= {a/@tas b/@tas}
?: |
^- @ta
%- crip
;: weld
"s/\\$"
(trip a)
"/"
"?($"
(trip a)
" $"
(trip b)
")"
"/g"
==
?: |
^- @ta
%- crip
;: weld
"s/%"
(trip a)
"/"
"%"
(trip b)
"/g"
==
?: &
^- @ta
%- crip
;: weld
"s/\\?(\\$"
(trip a)
" \\$"
(trip b)
")/$"
(trip b)
"/g"
==
!!
^- (list (pair @tas @tas))
:~ [%flap %claw] :: used in ames
[%slug %shoe]
[%rack %bank]
[%gate %lamb]
[%lock %gill]
:: [%lamp %gate] reused
[%bud %scon]
[%qua %conq]
[%dub %cons]
[%tri %cont] :: collides with %trip
[%ray %conl]
[%all %conp]
[%cold %bunt] :: parser jet
[%quid %calq]
[%quip %calt]
[%with %open]
:: [%kick %nock] reused; used in ames
[%live %poll] :: also a hint
[%show %dump] :: used in %ames
:: [%fate %show] reused
[%germ %ddup] :: also a hint
[%type %peep]
[%fly %fix]
[%ram %rev] :: also %ramp
[%eat %sip]
[%has %pin]
[%saw %nip]
[%dig %ifcl] :: %digitalocean in ape/cloud
[%nay %deny]
[%aye %sure]
[%deal %deft] :: used in all vanes
[%dab %ifat]
[%non %ifno] :: also %none
[%fit %fits] :: also %fitz
[%nock %code] :: reused
==

17
gen/code.hoon
View File

@ -1,17 +1,14 @@
::
:::: /hoon/code/gen
::
/- sole
=+ sole
:- %ask
:- %say
|= $: {now/@da eny/@uvI bec/beak}
$~
$~
==
^- (sole-result)
%+ sole-yo
:- %leaf
%+ slag 1
%+ scow %p
.^(@p %a /(scot %p p.bec)/code/(scot %da now)/(scot %p p.bec))
sole-no
:- %tang
:_ ~
:- %leaf
%+ slag 1
%+ scow %p
.^(@p %a /(scot %p p.bec)/code/(scot %da now)/(scot %p p.bec))

6
gen/curl-hiss.hoon
View File

@ -1,14 +1,14 @@
::
:::: /hoon/curl/gen
:::: /hoon/curl-hiss/gen
::
/? 310
/- sole
[sole]
:- %get |= {^ {a/hiss $~} $~}
:- %get |= {^ {a/hiss $~} usr/iden}
^- (sole-request (cask httr))
?. ?=($get p.q.a)
~| %only-get-requests-supported-in-generators :: XX enforced?
!!
:- *tang
:+ %| `hiss`a
:^ %| `usr `hiss`a
|=(hit/httr (sole-so %httr hit))

1
gen/curl.hoon
View File

@ -5,6 +5,7 @@
/- sole
[sole]
:- %get |= {^ {a/tape $~} $~}
^- (sole-request (cask httr))
%+ sole-at (scan a auri:epur)
|= hit/httr
(sole-so %httr hit)

18
gen/gmail/list.hoon
View File

@ -1,18 +0,0 @@
::
:::: /hoon/list/gmail/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
View File

@ -1,14 +0,0 @@
::
:::: /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) '']

4
gen/hello.hoon
View File

@ -6,6 +6,6 @@
::::
!:
:- %say
|= {* {{txt/@tas $~} $~}}
|= {^ {{txt/@tas $~} $~}}
:- %noun
`tape`[2 (trip txt)]
(crip (weld "hello, " (trip txt)))

11
gen/hood/cp.hoon
View File

@ -3,4 +3,13 @@
::
/? 310
:- %say
|=({^ {input/path output/path $~} $~} kiln-cp+[input output])
|= {^ {input/path output/path $~} $~}
:- %kiln-info
?. =(-:(flop input) -:(flop output))
["Can't move to a different mark" ~]
=+ dir=.^(arch %cy input)
?~ fil.dir
~& "No such file:"
[<input> ~]
:- "copied"
`(foal output -:(flop input) [%atom %t ~] .^(* %cx input)) :: XX type

12
gen/hood/invite.hoon
View File

@ -1,12 +0,0 @@
::
:::: /hoon/invite/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
{{who/@p myl/@t $~} $~}
==
[%helm-invite who myl]

12
gen/hood/mv.hoon
View File

@ -3,4 +3,14 @@
::
/? 310
:- %say
|=({^ {input/path output/path $~} $~} kiln-mv+[input output])
|= {^ {input/path output/path $~} $~}
:- %kiln-info
?. =(-:(flop input) -:(flop output))
["Can't move to a different mark" ~]
=+ dir=.^(arch %cy input)
?~ fil.dir
~& "No such file:"
[<input> ~]
:- "moved" :- ~
%+ furl (fray input)
(foal output -:(flop input) [%noun .^(* %cx input)])

4
gen/hood/overload.hoon
View File

@ -7,7 +7,7 @@
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
{arg/$@($~ {tym/@dr} $~) $~}
{arg/$@($~ {tym/@dr $~}) $~}
==
?~ arg $(arg [~60m ~])
?~ arg $(arg [~h4 ~])
[%kiln-overload tym.arg]

10
gen/hood/syncs.hoon Normal file
View File

@ -0,0 +1,10 @@
::
:::: /hoon/syncs/hood/gen
::
/? 310
::
::::
!:
:- %say
|= {{now/@da eny/@uvI bec/beak} $~ $~}
[%kiln-syncs ~]

6
gen/make.hoon
View File

@ -1,6 +0,0 @@
::
:::: /hoon/make/gen
::
/? 310
:- %say
|=({^ arg/(list @) foo/_`@`1 bar/_`@`2} noun+[arg foo bar])

6
gen/moon.hoon
View File

@ -10,8 +10,10 @@
$~
$~
==
:- %noun
?> =(1 (met 5 p.bec))
:- %tang :_ ~ :- %leaf
=+ ran=(clan p.bec)
?: ?=({?($earl $pawn)} ran)
"can't create a moon from a {?:(?=($earl ran) "moon" "comet")}"
=+ mon=(mix (lsh 5 1 (end 5 1 eny)) p.bec)
=+ tic=.^(@ /a/(scot %p p.bec)/tick/(scot %da now)/(scot %p mon))
"moon: {<`@p`mon>}; ticket: {<`@p`tic>}"

6
gen/pipe/cancel.hoon Normal file
View File

@ -0,0 +1,6 @@
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
{{app/term source/path station/knot $~} $~}
==
[%pipe-cancel app source station]

6
gen/pipe/connect.hoon Normal file
View File

@ -0,0 +1,6 @@
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
{{app/term source/path station/knot $~} $~}
==
[%pipe-connect app source station]

6
gen/pipe/list.hoon Normal file
View File

@ -0,0 +1,6 @@
!:
:- %say
|= $: {now/@da eny/@uvI bec/beak}
{$~ $~}
==
[%pipe-list ~]

4
gen/twit/as.hoon
View File

@ -4,7 +4,7 @@
::
[twitter .]
:- %say
|= $: [now=@da eny=@uvI bec=beak]
[[who=span msg=cord ~] ~]
|= $: {now/@da eny/@uvI bec/beak}
{{who/knot msg/cord $~} $~}
==
[%twit-do [who %post eny msg]]

23
gen/twit/auth.hoon
View File

@ -1,23 +0,0 @@
:: Input twitter keys
/- sole, twitter
!:
[sole twitter .]
|%
++ baz64 (cook crip (star alp))
--
!:
:- %ask
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
^- (sole-result (cask twit-do))
%+ sole-lo [%& %$ "User: "] %+ sole-go urs:ab |= acc=span
%+ sole-lo [%& %$ "App token: "] %+ sole-go baz64 |= ctok=cord
%+ sole-lo [%& %$ "App secret: "] %+ sole-go baz64 |= csec=cord
%+ sole-lo [%& %$ "User token: "] %+ sole-go baz64 |= atok=cord
%+ sole-lo [%& %$ "User secret: "] %+ sole-go baz64 |= asec=cord
(sole-so %twit-do [acc %auth [ctok csec] atok asec])

5
gen/twit/auth/hoontap-keys.txt
View File

@ -1,5 +0,0 @@
hoontap
AP3G1t8ki6rPzeeAqdWCTw03F
VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD
2821727326-BAABHUpwCuoeVjINTHTVvfPlJlGHmigqKywlLcE
o6TCNfQhhUkzx6fKIC3CGi2cWn3YbEoQVCVgg210YYTtV

17
gen/twit/feed.hoon Normal file
View File

@ -0,0 +1,17 @@
:: Display twitter feed
::
:::: /hoon/feed/twit/gen
::
/- twitter
!:
:::: ~fyr
::
:- %say
|= $: {now/@da eny/@uvI bek/beak}
{{who/iden $~} typ/?($home $user)}
==
=+ pax=/(scot %p p.bek)/twit/(scot %da now)/[typ]/[who]
:- %tang
%+ turn (flop .^((list post:twitter) %gx pax))
|= post:twitter ^- tank
rose+[": " `~]^~[leaf+"{<now>} @{(trip who)}" leaf+(trip txt)]

13
gen/twit/tweet.hoon
View File

@ -1,13 +0,0 @@
/+ sh-utils
!:
|_ [hide ~]
++ peer ,_`.
++ poke--args
%+ add-subs [[our /twit] our /post/(scot %uv eny)]
%^ gate-mess .
|=([a=span b=cord ~] [/twit %twit-do !>([a %post eny b])])
,_`.
++ posh-twit-stat
(args-into-gate . |=([@ @ a=@da @] tang/~[leaf/"Tweet recieved {<a>}"]))
++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

23
gen/twit/twitter-feed.hoon
View File

@ -1,23 +0,0 @@
:: Display twitter feed
::
:::: /hook/core/twitter-feed/app
::
/+ sh-utils
!:
::
:::: ~fyr
::
|_ [hide ~]
++ stat ,[id=@u who=@ta now=@da txt=@t]
++ rens
:- %say
|=(stat rose/[": " `~]^~[leaf/"{<now>} @{(trip who)}" leaf/(trip txt)])
++ peer ,_`.
++ poke--args
|= [ost=bone his=ship who=span ~]
%.(+< (add-subs [[our /twit] our /user/[who]] ,_`+>.$))
::
++ posh-twit-feed
(args-into-gate . |=(a=(list stat) tang/(turn a rens)))
:: ++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

41
lib/basic-auth.hoon
View File

@ -1,8 +1,33 @@
!:
=+ keys=@t
|= bal/(bale keys)
?~ key.bal
~|(%basic-auth-no-key ~_(leaf+"Run |init-auth-basic {<`path`dom.bal>}" !!))
=+ aut=authorization+(cat 3 'Basic ' key.bal)
~& aut=`{@tas @t}`aut
|=(a/hiss [%send %_(a q.q (~(add ja q.q.a) -.aut +.aut))])
:: Basic authentication
::
:::: /hoon/basic-auth/lib
::
|%
++ keys @t
--
::
::::
::
|_ {bal/(bale keys) $~}
++ auth
|%
++ header
^- cord
?~ key.bal
~_ leaf+"Run |init-auth-basic {<`path`dom.bal>}"
~|(%basic-auth-no-key !!)
(cat 3 'Basic ' key.bal)
--
::
++ add-auth-header
|= a/hiss ^- hiss
~& auth+(earn p.a)
%_(a q.q (~(add ja q.q.a) %authorization header:auth))
::
++ standard
|%
++ out-adding-header
|= a/hiss ^- sec-move
[%send (add-auth-header a)]
--
--

167
lib/connector.hoon Normal file
View File

@ -0,0 +1,167 @@
:: This is a library for writing API connectors.
::
:: The basic flow is as follows:
:: -- define a list of `++place`s, which specify the exported
:: interface.
:: -- in `++peer-scry` in the connector app, call `++read` in
:: this library to match to the appropriate place and
:: produce a move (usually either an immediate response or
:: an http request to the api).
:: -- in `++sigh-httr` in the connector app, call `++sigh` in
:: this library to handle the response according to the
:: place.
|* {move/mold sub-result/mold}
=> |%
:: A place consists of:
:: -- `guard`, the type of the paths we should match. For
:: example, to match `/issues/<user>/<repo>` use
:: `{$issues @t @t $~}`.
:: -- `read-x`, called when someone tries to read the
:: place with care `%x`. Should produce a single move,
:: usually either a `%diff` response if we can
:: immediately answer or a `%hiss` http request if we
:: need to make a request to the api. See the
:: `++read-*` functions in `++helpers` for some common
:: handlers.
:: -- `read-y`, same as `read-x` except with care `%y`.
:: -- `sigh-x`, called when an http response comes back on
:: this place. You're given the json of the result, and
:: you should produce either a result or null. Null
:: represents an error. If you didn't create an http
:: request in `read-x`, then this should never be
:: called. Use `++sigh-strange` from `++helpers` to
:: unconditionally signal an error.
:: -- `sigh-y`, same as `sigh-x` except with care `%y`.
:: Note that a `%y` request must produce an arch, unlike
:: a `%x` request, which may produce data of any mark.
::
++ place
$: guard/mold
read-x/$-(path move)
read-y/$-(path move)
sigh-x/$-(jon/json (unit sub-result))
sigh-y/$-(jon/json (unit arch))
==
--
|%
:: Generic helpers for place definitions
::
++ helpers
|= {ost/bone wir/wire api-url/tape}
|%
:: Produce null. Used as `++read-x` in places which are pure
:: directories. `++sigh-x` should be `++sigh-strange`.
::
++ read-null |=(pax/path [ost %diff %null ~])
::
:: Produce an arch with the given list of children. Used as
:: `++read-y` in places which have a static list of (known)
:: children rather than having to ask the api. `++sigh-y`
:: should be `++sigh-strange`.
::
++ read-static
|= children/(list @t)
|= pax/path
[ost %diff %arch ~ (malt (turn children |=(@t [+< ~])))]
::
:: Produce an api request to the given path. Use this if the
:: endpoint is static. If the endpoint depends on parameters
:: in the path, use `++get`. For example:
:: `|=(pax/path (get /users/[+<.pax]/repos))`.
::
++ read-get
|= endpoint/path
|= pax/path
(get endpoint)
::
:: Make an api request to the specified endpoint.
::
++ get
|= endpoint/path
^- move
:* ost %hiss wir `~ %httr %hiss
(endpoint-to-purl endpoint) %get ~ ~
==
::
:: Convert an endpoint path to a purl.
::
++ endpoint-to-purl
|= endpoint/path
(scan (weld api-url <`path`endpoint>) auri:epur)
::
:: Return error. Used when no http response is expected.
::
++ sigh-strange |=(jon/json ~)
--
::
:: Handles one-time requests by mapping them to their handling,
:: either `read-x` or `read-y`, in `places`.
::
++ read
|= {ost/bone places/(list place) ren/care pax/path}
^- move
?~ places
~& [%strange-path pax]
(move [ost %diff ?+(ren !! $x null+~, $y arch+*arch)])
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
(?+(ren !! $x read-x.i.places, $y read-y.i.places) pax)
::
:: Handles http responses sent in `++read` by mappig them to
:: their handling, either `sigh-x` or `sigh-y`, in `places`.
::
++ sigh
|= {places/(list place) ren/care pax/path res/httr}
^- sub-result
=< ?+(ren ~|([%invalid-care ren] !!) $x sigh-x, $y sigh-y)
|%
++ sigh-x
?~ r.res
~& [err+%empty-response code+p.res]
null+~
=+ jon=(rush q.u.r.res apex:poja)
?~ jon
~& [err+%bad-json code+p.res body+q.u.r.res]
null+~
?. =(2 (div p.res 100))
~& [err+%request-rejected code+p.res msg+u.jon]
null+~
|- ^- sub-result
?~ places
~&([%sigh-strange-path pax] (sub-result 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]
(sub-result null+~)
u.-
::
++ sigh-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
%- sub-result
|- ^- {$arch arch}
?~ 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.-
--
--

2
lib/down-jet/rend.hoon
View File

@ -210,7 +210,7 @@
|= a/tape ^- tape
?~ a ~
?: ?| [?=(^ q)]:(alp 1^1 a)
(~(has in (silt "!*'();:@&=+$,/?/%.~_")) i.a) :: XX reparse
(~(has in (silt "#!*'();:@&=+$,/?/%.~_")) i.a) :: XX reparse
==
[i.a $(a t.a)]
(weld (urle (trip i.a)) $(a t.a))

339
lib/drum.hoon
View File

@ -9,10 +9,18 @@
:::: :: ::
:: :: ::
|% :: ::
++ drum-part {$drum $0 drum-pith} ::
++ drum-part {$drum $1 drum-pith} ::
++ drum-part-any ::
$: $drum ::
$% {$1 drum-pith} ::
{$0 drum-pith-0} ::
== == ::
++ drum-pith-0 :: old drum-pith
%+ cork drum-pith |= drum-pith ::
+<(bin *(map bone source-0)) ::
++ drum-pith ::
$: eel/(set gill) :: connect to
ray/(set well) ::
$: eel/(set gill) :: connect to
ray/(set well) ::
fur/(map dude (unit server)) :: servers
bin/(map bone source) :: terminals
== ::
@ -24,10 +32,23 @@
$: syd/desk :: app identity
cas/case :: boot case
== ::
++ kill-0 (unit (list @c)) :: old kill buffer
++ kill :: kill ring
$: pos/@ud :: ring position
num/@ud :: number of entries
max/_60 :: max entries
old/(list (list @c)) :: entries proper
== ::
++ source-0 :: old source without
%+ cork source |= source :: kill ring or
%= +< :: blt.target
kil *kill-0 ::
fug *(map gill (unit target-0)) ::
== ::
++ source :: input device
$: edg/_80 :: terminal columns
$: edg/_80 :: terminal columns
off/@ud :: window offset
kil/(unit (list @c)) :: kill buffer
kil/kill :: kill buffer
inx/@ud :: ring index
fug/(map gill (unit target)) :: connections
mir/(pair @ud (list @c)) :: mirrored terminal
@ -46,8 +67,11 @@
$: pos/@ud :: search position
str/(list @c) :: search string
== ::
++ target-0 :: target without blt
(cork target |=(target |1.+<)) ::
++ target :: application target
$: ris/(unit search) :: reverse-i-search
$: blt/(pair (unit dill-belt) (unit dill-belt)) :: curr & prev belts
ris/(unit search) :: reverse-i-search
hit/history :: all past input
pom/sole-prompt :: static prompt
inp/sole-command :: input state
@ -85,6 +109,7 @@
|= our/ship
^- master
:* %&
[~ ~]
*(unit search)
*history
[%& %sole "{(scow %p our)}/ "]
@ -93,27 +118,42 @@
::
++ deft-pipe :: default source
|= our/ship ::
^- source ::
^- source ::
:* 80 :: edg
0 :: off
~ :: kil
[0 0 60 ~] :: kil
0 :: inx
~ :: fug
[0 ~] :: mir
==
::
++ deft-tart *target :: default target
++ drum-port :: initial part
++ drum-make :: initial part
|= our/ship
^- drum-part
^- drum-part
:* %drum
%0
%1
(deft-fish our) :: eel
(deft-apes our) :: ray
~ :: fur
~ :: bin
== ::
::
++ drum-port
|= old/drum-part-any
^- drum-part
?: ?=($1 &2.old) old
~& [%drum-porting &2.old]
=; bin [%drum %1 |2.old(bin bin)]
%- ~(run by bin.old)
|= source-0
%= +<
kil (kill ?~(kil ~ [1 1 60 [u.kil]~]))
fug %- ~(run by fug)
|= t/(unit target-0)
?~(t ~ [~ [[~ ~] u.t]])
==
::
++ drum-path :: encode path
|= gyl/gill
[%drum %phat (scot %p p.gyl) q.gyl ~]
@ -147,7 +187,7 @@
--
|_ {moz/(list move) biz/(list dill-blit)}
++ diff-sole-effect-phat ::
|= {way/wire fec/sole-effect}
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
=+ gyl=(drum-phat way)
?: (se-aint gyl) +>.$
@ -164,12 +204,12 @@
se-view:(se-text "[{<src>}, driving {<our>}]")
::
++ poke-dill-belt ::
|= bet/dill-belt
|= bet/dill-belt
=< se-abet =< se-view
(se-belt bet)
::
++ poke-start ::
|= wel/well
|= wel/well
=< se-abet =< se-view
(se-born wel)
::
@ -187,7 +227,7 @@
:: |=(~ se-abet:(se-blit `dill-blit`[%qit ~])) :: XX find bone
:: ::
++ reap-phat ::
|= {way/wire saw/(unit tang)}
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
=+ gyl=(drum-phat way)
?~ saw
@ -195,7 +235,7 @@
(se-dump:(se-drop & gyl) u.saw)
::
++ take-coup-phat ::
|= {way/wire saw/(unit tang)}
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
?~ saw +>
=+ gyl=(drum-phat way)
@ -204,7 +244,7 @@
(se-dump:(se-drop & gyl) u.saw)
::
++ take-onto ::
|= {way/wire saw/(each suss tang)}
|= {way/wire saw/(each suss tang)}
=< se-abet =< se-view
?> ?=({@ @ $~} way)
?> (~(has by fur) i.t.way)
@ -213,11 +253,11 @@
$| (se-dump p.saw)
$& ?> =(q.wel p.p.saw)
:: =. +>.$ (se-text "live {<p.saw>}")
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
::
++ quit-phat ::
|= way/wire
|= way/wire
=< se-abet =< se-view
=+ gyl=(drum-phat way)
~& [%drum-quit src ost gyl]
@ -233,7 +273,7 @@
=. . se-subze:se-adze:se-adit
:_ %_(+>+>+<+ bin (~(put by bin) ost `source`+>+<))
^- (list move)
%+ welp (flop moz)
%+ welp (flop moz)
^- (list move)
?~ biz ~
[ost %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
@ -245,7 +285,7 @@
=< .(con +>)
|= {wel/well con/_..se-adit} ^+ con
=. +>.$ con
=+ hig=(~(get by fur) q.wel)
=+ hig=(~(get by fur) q.wel)
?: &(?=(^ hig) |(?=($~ u.hig) =(p.wel syd.u.u.hig))) +>.$
=. +>.$ (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
%- se-emit(fur (~(put by fur) q.wel ~))
@ -326,6 +366,7 @@
=+ tur=`(unit (unit target))`?~(gul ~ (~(get by fug) u.gul))
?: |(=(~ gul) =(~ tur) =([~ ~] tur)) (se-blit %bel ~)
=+ taz=~(. ta [& (need gul)] `target`(need (need tur)))
=. blt.taz [q.blt.taz `bet]
=< ta-abet
?- -.bet
$aro (ta-aro:taz p.bet)
@ -353,7 +394,7 @@
?. (~(has by fug) gyl) +>.$
=. fug (~(del by fug) gyl)
=. eel ?.(pej eel (~(del in eel) gyl))
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
+>.$(inx 0)
(se-alas u.lag)
=. +>.$ (se-text "[unlinked from {<gyl>}]")
@ -393,7 +434,7 @@
++ se-like :: act in master
|= kus/ukase
?- -.kus
$add
$add
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-link i.p.kus))
@ -453,7 +494,7 @@
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
+>(mir lin)
::
++ se-just :: adjusted buffer
++ se-just :: adjusted buffer
|= lin/(pair @ud (list @c))
^+ +>
=. off ?:((lth p.lin edg) 0 (sub p.lin edg))
@ -472,10 +513,13 @@
|= mov/move
%_(+> moz [mov moz])
::
++ se-talk
|= tac/(list tank)
++ se-talk
|= tac/(list tank)
^+ +>
(se-emit 0 %poke /drum/talk [our %talk] (said:talk our %drum now eny tac))
:: XX talk should be usable for stack traces, see urbit#584 which this change
:: closed for the problems there
((slog (flop tac)) +>)
::(se-emit 0 %poke /drum/talk [our %talk] (said:talk our %drum now eny tac))
::
++ se-text :: return text
|= txt/tape
@ -513,7 +557,7 @@
== ::
++ ta-abet :: resolve
^+ ..ta
?. liv
?. liv
?: (~(has in (deft-fish our)) gyl)
(se-blit qit+~)
(se-nuke gyl)
@ -531,7 +575,7 @@
^+ +>
?- key
$d =. ris ~
?. =(num.hit pos.hit)
?. =(num.hit pos.hit)
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
@ -545,7 +589,8 @@
?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
==
::
++ ta-bel .(+> (se-blit %bel ~)) :: beep
++ ta-bel :: beep
.(+> (se-blit %bel ~), q.blt ~)
++ ta-cat :: mass insert
|= {pos/@ud txt/(list @c)}
^- sole-edit
@ -577,6 +622,31 @@
=+ pre=(dec pos.inp)
(ta-hom %del pre)
::
++ ta-kil :: build kil
|= {a/?($l $r) b/(list @c)}
^- kill
=+ max=|=(a/(list (list @c)) (scag max.kil a))
?. ?& ?=(^ p.blt)
?| ?=({$ctl p/?($k $u $w)} u.p.blt)
?=({$met p/?($d $bac)} u.p.blt)
== ==
%= kil
num +(num.kil)
pos +(num.kil)
old (max [b old.kil])
==
%= kil
pos num.kil
old ?~ old.kil
[b]~
%- max
:_ t.old.kil
?- a
$l (welp b i.old.kil)
$r (welp i.old.kil b)
==
==
::
++ ta-ctl :: hear control
|= key/@ud
^+ +>
@ -593,21 +663,24 @@
(ta-hom(pos.hit num.hit, ris ~) [%set ~])
$k =+ len=(lent buf.say.inp)
?: =(pos.inp len)
ta-bel
%- ta-hom(kil `(slag pos.inp buf.say.inp), ris ~)
ta-bel
%- %= ta-hom
ris ~
kil (ta-kil %r (slag pos.inp buf.say.inp))
==
(ta-cut pos.inp (sub len pos.inp))
$l +>(+> (se-blit %clr ~))
$n (ta-aro %d)
$p (ta-aro %u)
$r ?~ ris
+>(ris `[pos.hit ~])
$r ?~ ris
+>(ris `[pos.hit ~])
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
$t =+ len=(lent buf.say.inp)
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=. pos.inp +(sop)
=. ris ~
%- ta-hom
@ -617,12 +690,25 @@
==
$u ?: =(0 pos.inp)
ta-bel
%- ta-hom(kil `(scag pos.inp buf.say.inp), ris ~)
%- %= ta-hom
ris ~
kil (ta-kil %l (scag pos.inp buf.say.inp))
==
(ta-cut 0 pos.inp)
$v ta-bel
$w ?: =(0 pos.inp)
ta-bel
=+ b=(bwrd pos.inp buf.say.inp nace)
%- %= ta-hom
ris ~
kil (ta-kil %l (slag b (scag pos.inp buf.say.inp)))
==
(ta-cut b (sub pos.inp b))
$x +>(+> se-anon)
$y ?~ kil ta-bel
(ta-hom(ris ~) (ta-cat pos.inp u.kil))
$y ?: =(0 num.kil)
ta-bel
%- ta-hom(ris ~)
(ta-cat pos.inp (snag (sub num.kil pos.kil) old.kil))
==
::
++ ta-cru :: hear crud
@ -637,7 +723,7 @@
(ta-hom %del pos.inp)
::
++ ta-erl :: hear local error
|= pos/@ud
|= pos/@ud
ta-bel(pos.inp (min pos (lent buf.say.inp)))
::
++ ta-err :: hear remote error
@ -695,10 +781,163 @@
=. +> (ta-dog(say.inp (~(commit sole say.inp) ted)) ted)
+>
::
++ lcas :: lowercase
|* a/(list @)
^+ a
%+ turn a
|=(a/@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a)))
::
++ ucas :: uppercase
|* a/(list @)
^+ a
%+ turn a
|=(a/@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32)))
::
++ alnm :: alpha-numeric
|= a/@ ^- ?
?| &((gte a '0') (lte a '9'))
&((gte a 'A') (lte a 'Z'))
&((gte a 'a') (lte a 'z'))
==
::
++ nace :: next ace offset
|= a/(list @)
=| i/@ud
=+ b=|
|- ^+ i
?~ a i
=+ c=.=(32 i.a)
=. b |(b c)
?: &(b !|(=(0 i) c))
i
$(i +(i), a t.a)
::
++ nedg :: next boundary offset
|= a/(list @)
=| i/@ud
=+ b=|
|- ^+ i
?~ a i
=+ c=(alnm i.a)
=. b |(b c)
?: &(b !|(=(0 i) c))
i
$(i +(i), a t.a)
::
++ nwrd :: word-offset
|= a/(list @)
=| i/@ud
|- ^+ i
?: |(?=($~ a) (alnm i.a))
i
$(i +(i), a t.a)
::
++ bwrd :: prev pos by offset
|= {a/@ud b/(list @) c/$-((list @) @)}
^- @ud
(sub a (c (flop (scag a b))))
::
++ fwrd :: next pos by offset
|= {a/@ud b/(list @) c/$-((list @) @)}
^- @ud
(add a (c (slag a b)))
::
++ ta-met :: meta key
|= key/@ud
~& [%ta-met key]
+>
?+ key ta-bel
$dot ?. &(?=(^ old.hit) ?=(^ -.old.hit))
ta-bel
=+ old=`(list @c)`-.old.hit
=+ b=(bwrd (lent old) old nedg)
%- ta-hom(ris ~)
(ta-cat pos.inp (slag b old))
::
$bac ?: =(0 pos.inp)
ta-bel
=+ b=(bwrd pos.inp buf.say.inp nedg)
%- %= ta-hom
ris ~
kil (ta-kil %l (slag b (scag pos.inp buf.say.inp)))
==
(ta-cut b (sub pos.inp b))
::
$b ?: =(0 pos.inp)
ta-bel
+>(pos.inp (bwrd pos.inp buf.say.inp nedg))
::
$c ?: =(pos.inp (lent buf.say.inp))
ta-bel
=+ sop=(fwrd pos.inp buf.say.inp nwrd)
%- ta-hom(pos.inp (fwrd sop buf.say.inp nedg))
:~ %mor
[%del sop]
:+ %ins sop
(head (ucas (limo [(snag sop buf.say.inp)]~)))
==
::
$d ?: =(pos.inp (lent buf.say.inp))
ta-bel
=+ f=(fwrd pos.inp buf.say.inp nedg)
%- %= ta-hom
ris ~
kil (ta-kil %r (slag pos.inp (scag f buf.say.inp)))
==
(ta-cut pos.inp (sub f pos.inp))
::
$f ?: =(pos.inp (lent buf.say.inp))
ta-bel
+>(pos.inp (fwrd pos.inp buf.say.inp nedg))
::
$r %- ta-hom(lay.hit (~(put by lay.hit) pos.hit ~))
:~ %mor
(ta-cut 0 (lent buf.say.inp))
%+ ta-cat 0
?: =(pos.hit num.hit) ~
(snag (sub num.hit +(pos.hit)) old.hit)
==
::
$t =+ a=(fwrd pos.inp buf.say.inp nedg)
=+ b=(bwrd a buf.say.inp nedg)
=+ c=(bwrd b buf.say.inp nedg)
?: =(b c)
ta-bel
=+ prev=`(pair @ud @ud)`[c (fwrd c buf.say.inp nedg)]
=+ next=`(pair @ud @ud)`[b a]
%- ta-hom(pos.inp q.next)
:~ %mor
(ta-cut p.next (sub q.next p.next))
(ta-cat p.next (slag p.prev (scag q.prev buf.say.inp)))
(ta-cut p.prev (sub q.prev p.prev))
(ta-cat p.prev (slag p.next (scag q.next buf.say.inp)))
==
::
?($u $l)
?: =(pos.inp (lent buf.say.inp))
ta-bel
=+ case=?:(?=($u key) ucas lcas)
=+ sop=(fwrd pos.inp buf.say.inp nwrd)
=+ f=(fwrd sop buf.say.inp nedg)
%- ta-hom
:~ %mor
(ta-cut sop (sub f pos.inp))
(ta-cat sop (case (slag sop (scag f buf.say.inp))))
==
::
$y ?. ?& (gth num.kil 0)
?=(^ p.blt)
?| ?=({$ctl p/$y} u.p.blt)
?=({$met p/$y} u.p.blt)
== ==
ta-bel
=+ las=(lent (snag (sub num.kil pos.kil) old.kil))
=+ sop=(sub pos.inp las)
=+ pos=?:(=(1 pos.kil) num.kil (dec pos.kil))
%- ta-hom(pos.kil pos, ris ~)
:~ %mor
(ta-cut sop las)
(ta-cat sop (snag (sub num.kil pos) old.kil))
==
==
::
++ ta-mov :: move in history
|= sop/@ud
@ -706,8 +945,8 @@
?: =(sop pos.hit) +>
%+ %= ta-hom
pos.hit sop
lay.hit %+ ~(put by lay.hit)
pos.hit
lay.hit %+ ~(put by lay.hit)
pos.hit
buf.say.inp
==
%set
@ -715,6 +954,10 @@
(~(get by lay.hit) sop)
::
++ ta-nex :: advance history
?: ?| =(0 (lent buf.say.inp))
&(?=(^ old.hit) =(-.old.hit buf.say.inp))
==
%_(. pos.hit num.hit, ris ~, lay.hit ~)
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
@ -743,7 +986,7 @@
?~(a & ?~(b | &(=(i.a i.b) $(a t.a, b t.b))))
|= {a/(list @c) b/(list @c)} ^- ?
?~(a & ?~(b | |((beg a b) $(b t.b))))
=+ ^= sup
=+ ^= sup
|- ^- (unit @ud)
?~ dol ~
?: (ser tot i.dol)
@ -775,7 +1018,7 @@
?^ ris
%= $
ris ~
cad.pom
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
==
=- [(add pos.inp (lent p.vew)) (weld (tuba p.vew) q.vew)]
@ -790,8 +1033,8 @@
"> "
==
==
=+ len=(lent buf.say.inp)
|- ^- (list @c)
=+ len=(lent buf.say.inp)
|- ^- (list @c)
?:(=(0 len) ~ [`@c`'*' $(len (dec len))])
--
--

30
lib/gh-parse.hoon
View File

@ -101,6 +101,9 @@
==
++ issue
^- $-(json (unit issue:gh))
|= jon/json
=- (bind - |*(issue/* `issue:gh`[jon issue]))
%. jon
=+ jo
%- ot :~
'url'^so
@ -145,4 +148,31 @@
'body'^so
==
++ id no:jo
++ print-issue
|= issue:gh
^- wain
=+ c=(cury cat 3)
:* :(c 'title: ' title ' (#' (rsh 3 2 (scot %ui number)) ')')
(c 'state: ' state)
(c 'creator: ' login.user)
(c 'created-at: ' created-at)
(c 'assignee: ' ?~(assignee 'none' login.u.assignee))
::
%+ c 'labels: '
?~ labels ''
|- ^- @t
?~ t.labels name.i.labels
:(c name.i.t.labels ', ' $(t.labels t.t.labels))
::
(c 'comments: ' (rsh 3 2 (scot %ui comments)))
(c 'url: ' url)
''
%+ turn (lore body) :: strip carriage returns
|= l/@t
?: =('' l)
l
?. =('\0d' (rsh 3 (dec (met 3 l)) l))
l
(end 3 (dec (met 3 l)) l)
==
--

2
lib/helm.hoon
View File

@ -115,7 +115,7 @@
++ coup-hi
|= {pax/path cop/(unit tang)} =< abet
?> ?=({@t $~} pax)
(emit %flog ~ %text "hi {(trip i.pax)} {?~(cop "" "un")}succesful")
(emit %flog ~ %text "hi {(trip i.pax)} {?~(cop "" "un")}successful")
::
++ poke-reload |=(all/(list term) (poke-reload-desk %home all))
++ poke-reload-desk :: reload vanes

25
lib/hep-to-cab.hoon Normal file
View File

@ -0,0 +1,25 @@
:: rewrite query string keys
::
:::: /hoon/hep-to-cab/lib
::
/? 310
::
:::: ~fyr
::
=< term
|%
++ gsub :: replace chars
|= {a/@t b/@t t/@t}
^- @t
?: =('' t) t
%+ mix (lsh 3 1 $(t (rsh 3 1 t)))
=+ c=(end 3 1 t)
?:(=(a c) b c)
::
++ term |=(a/^term (gsub '-' '_' a)) :: single atom
++ path |=(a/^path (turn a term)) :: path elements
++ quay :: query string keys
|= a/^quay ^+ a
%+ turn a
|=({p/@t q/@t} [(term p) q])
--

48
lib/interpolate.hoon Normal file
View File

@ -0,0 +1,48 @@
:: /foo/:bar/baz interpolation syntax
::
:::: /hoon/interpolate/lib
::
/? 310
::
:::: ~fyr
::
|%
++ parse-url
|= a/$@(cord:purl purl) ^- purl
?^ a a
~| bad-url+a
(rash a auri:epur)
::
++ add-query
|= {a/$@(@t purl) b/quay} ^- purl
?@ a $(a (parse-url a)) :: deal with cord
a(r (weld r.a b))
::
++ into-url
|= {a/$@(cord purl) b/(unit hart) c/(list (pair term knot))}
^- purl
?@ a $(a (parse-url a)) :: deal with cord
%_ a
p ?^(b u.b p.a)
q.q (into-path q.q.a c)
==
::
++ into-path :: [/a/:b/c [%b 'foo']~] -> /a/foo/c
=+ replacable=|=(a/knot `(unit term)`(rush a ;~(pfix col sym)))
|= {a/path b/(list (pair term knot))} ^- path
?~ a ?~(b ~ ~|(unused-values+b !!))
=+ (replacable i.a)
?~ - [i.a $(a t.a)] :: literal value
?~ b ~|(no-value+u !!)
?. =(u p.i.b) ~|(mismatch+[u p.i.b] !!)
[q.i.b $(a t.a, b t.b)]
::
++ into-path-partial :: [/a/:b/c [d+'bar' b+'foo']~] -> [/a/foo/c [d+'bar']~]
|= {pax/path quy/quay} ^- {path quay}
=+ ^= inline :: required names
%- ~(gas in *(set term))
(murn pax replacable:into-path)
=^ inter quy
(skid quy |=({a/knot @} (~(has in inline) a)))
[(into-path pax inter) quy]
--

46
lib/kiln.hoon
View File

@ -47,8 +47,6 @@
cas/case ::
gim/?($auto germ) ::
== ::
++ kiln-cp {input/path output/path} ::
++ kiln-mv {input/path output/path} ::
-- ::
:: :: ::
:::: :: ::
@ -121,6 +119,16 @@
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:(start-sync:(auto hos) |)
::
++ poke-syncs ::
|= $~
=< abet %- spam
=+ a=(~(tap by syn))
?: =(0 (lent a))
[%leaf "no syncs configured"]~
%- flop %+ turn a
|= a/(pair kiln-sync *)
(render "sync configured" [sud her syd]:p.a)
::
++ poke-init-sync
|= hos/kiln-sync
?: (~(has by syn) hos)
@ -143,35 +151,31 @@
|= syd/desk
abet:(emit %drop /cancel our syd)
::
++ do-info
|= {mez/tape tor/toro}
abet:(emit:(spam leaf+mez ~) %info /kiln our tor)
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
abet:(emit:(spam leaf+mez ~) %info /kiln our u.tor)
::
++ poke-rm |=(a/path (do-info "removed" (fray a)))
++ poke-cp
|= {input/path output/path}
%+ do-info "copied"
?> =(-:(flop input) -:(flop output))
(foal output -:(flop input) [%atom %t ~] .^(* %cx input)) :: XX type
::
++ poke-mv
|= {input/path output/path}
%+ do-info "moved"
?> =(-:(flop input) -:(flop output))
%+ furl (fray input)
(foal output -:(flop input) %noun .^(* %cx input))
++ poke-rm
|= a/path
=+ b=.^(arch %cy a)
?~ fil.b
=+ ~[leaf+"No such file:" leaf+"{<a>}"]
abet:(spam -)
(poke-info "removed" `(fray a))
::
++ poke-label
|= {syd/desk lab/@tas}
=+ pax=/(scot %p our)/[syd]/[lab]
(do-info "labeled {(spud pax)}" [syd %| lab])
(poke-info "labeled {(spud pax)}" `[syd %| lab])
::
++ poke-schedule
|= {where/path tym/@da eve/@t}
=. where (welp where /sched)
%+ do-info "scheduled"
%+ poke-info "scheduled"
=+ old=;;((map @da cord) (fall (file where) ~))
(foal where %sched !>((~(put by old) tym eve)))
`(foal where %sched !>((~(put by old) tym eve)))
::
++ poke-autoload
|= lod/(unit ?)

312
lib/oauth1.hoon
View File

@ -2,6 +2,7 @@
::
:::: /hoon/oauth1/lib
::
/+ interpolate, hep-to-cab
|%
++ keys cord:{key/@t sec/@t} :: app key pair
++ token :: user keys
@ -15,20 +16,7 @@
::::
::
|%
++ 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
%+ mix (lsh 3 1 $(t (rsh 3 1 t)))
=+ c=(end 3 1 t)
?:(=(a c) b c)
::
++ parse-url parse-url:interpolate
++ join
|= {a/cord b/(list cord)}
?~ b ''
@ -43,7 +31,7 @@
++ to-header
|= a/quay ^- tape
%+ joint ", "
(turn a |=({k/@t v/@t} `tape`~[k '="' v '"'])) :: normalized later
(turn a |=({k/@t v/@t} `tape`~[k '="' v '"'])) :: normalized later
::
:: partial tail:earn for sorting
++ encode-pairs
@ -52,7 +40,7 @@
|= {k/@t v/@t} ^- tape
:(weld (urle (trip k)) "=" (urle (trip v)))
::
++ parse-pairs :: x-form-urlencoded
++ parse-pairs :: x-form-urlencoded
|= bod/(unit octs) ^- quay-enc
~| %parsing-body
?~ bod ~
@ -60,6 +48,7 @@
::
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (tact +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
::
@ -69,60 +58,30 @@
=- (mean (flop `tang`[>a< -]))
(turn (lore (crip b)) |=(c/cord leaf+(trip c)))
::
++ dbg-post `purl`[`hart`[| `6.000 [%& /localhost]] `pork``/testing `quay`/]
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ quay-keys |-($@(knot {$ $})) :: improper tree
++ grab-quay :: ?=({@t @t @t} ((grab-quay *httr) %key1 %key2 %key3))
|* {a/httr b/quay-keys}
~| bad-quay+r.a
=+ quy=(rash q:(need r.a) yquy:urlp)
~| quy
=+ all=(malt quy)
++ grab-quay :: ?=({@t @t @t} (grab-quay r:*httr %key1 %key2 %key3))
|* {a/(unit octs) b/quay-keys}
=+ ~| bad-quay+a
c=(rash q:(need `(unit octs)`a) yquy:urlp)
~| grab-quay+[c b]
=+ all=(malt c)
%. b
|* b/quay-keys
?@ b ~|(b (~(got by all) b))
[(..$ -.b) (..$ +.b)]
::
++ parse-url
|= a/$@(cord:purl purl) ^- purl
?^ a a
~| bad-url+a
(rash a auri:epur)
::
++ interpolate-url
|= {a/$@(cord purl) b/(unit hart) c/(list (pair term knot))}
^- purl
?@ a $(a (parse-url a)) :: deal with cord
%_ a
p ?^(b u.b p.a)
q.q (interpolate-path q.q.a c)
==
::
++ interpolate-path :: [/a/:b/c [%b 'foo']~] -> /a/foo/c
|= {a/path b/(list (pair term knot))} ^- path
?~ a ?~(b ~ ~|(unused-values+b !!))
=+ (rush i.a ;~(pfix col sym))
?~ - [i.a $(a t.a)] :: not interpolable
?~ b ~|(no-value+u !!)
?. =(u p.i.b) ~|(mismatch+[u p.i.b] !!)
[q.i.b $(a t.a, b t.b)]
--
!:
::::
::
|= {request/$@(@t purl) dialog/$@(@t purl) code-exchange/$@(@t purl)}
=+ :+ dialog-url=(parse-url dialog)
exchange-url=(parse-url code-exchange)
token-reqs-url=(parse-url request)
|_ {done/* (bale keys) tok/token}
+- core-move $^({sec-move _done} sec-move) :: stateful
|_ {(bale keys) tok/token}
++ consumer-key key:decode-keys
++ consumer-secret sec:decode-keys
++ decode-keys :: XX from bale w/ typed %jael
^- {key/@t sec/@t $~}
?. =(~ `@`key)
~| %oauth-bad-keys
((hard {cid/@t cis/@t $~}) (lore key))
((hard {key/@t sec/@t $~}) (lore key))
%+ mean-wall %oauth-no-keys
"""
Run |init-oauth1 {<`path`dom>}
@ -130,97 +89,74 @@
{(trip oauth-callback)}
"""
::
++ exchange-token
|= a/$@(@t purl) ^- hiss
(post-quay (parse-url a) ~)
::
++ request-token
|= a/$@(@t purl) ^- hiss
(post-quay (parse-url a) oauth-callback+oauth-callback ~)
::
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ oauth-callback
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
%- crip %- earn
%^ interpolate-url 'https://our-host/~/ac/:domain/:user/in'
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
user+(scot %ta usr)
==
::
++ auth-url
|= url/$@(@t purl) ^- purl
%+ add-query:interpolate url
%- quay:hep-to-cab
?. ?=({$request-token ^} tok)
~|(%no-token-for-dialog !!)
:- oauth-token+oauth-token.tok
?~(usr ~ [screen-name+usr]~)
::
++ toke-url
|= quy/quay ^- purl
%_ dialog-url
r (fass ?~(usr quy [screen-name+usr quy]))
==
++ grab-token-response
|= a/httr ^- {tok/@t sec/@t}
(grab-quay r.a 'oauth_token' 'oauth_token_secret')
::
++ token-exchange (post-quay exchange-url ~)
++ token-request (post-quay token-reqs-url oauth-callback+oauth-callback ~)
++ identity
%+ weld
?~(usr "default identity for " "{(trip usr)}@")
(trip (join '.' (flop dom)))
::
:: use token to sign authorization header. requires:
:: ++ res (res-handle-reqt handle-token) :: take request token
:: ++ bak (res-save-access handle-token) :: obtained access token
++ out-math
^- $-(hiss $%({$send hiss} {$show purl}))
?~ tok
_[%send (add-auth ~ token-request)]
?: ?=($request-token -.tok)
_[%show (toke-url oauth-token+oauth-token.tok ~)]
|= a/hiss ^- {$send hiss}
[%send (add-auth [oauth-token+oauth-token.tok]~ a)]
++ check-screen-name
|= a/httr ^- ?
=+ nam=(grab-quay r.a 'screen_name')
?~ usr &
?: =(usr nam) &
=< |
%- %*(. slog pri 1)
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] !!))))
::
++ in-oauth-token
|= a/quay ^- sec-move
++ check-token-quay
|= a/quay ^+ %&
=. a (sort a aor)
?. ?=({{$'oauth_token' oauth-token/@t} {$'oauth_verifier' @t} $~} a)
~|(no-token+a !!)
?~ tok
~|(%no-secret-for-token !!)
%+ mean-wall %no-secret-for-token
"""
Attempting to authorize {identity}
"""
?. =(oauth-token.tok oauth-token.q.i.a)
~| wrong-token+[id=usr q.i.a]
~|(%multiple-tokens-unsupported !!)
[%send (add-auth a token-exchange)]
%&
::
++ token-response ['oauth_token' 'oauth_token_secret']
+- bak-save-access
|= handle/$-(token _done)
%- (res-parse token-response)
|= access-token/{tok/@t sec/@t} ^- core-move
[[%redo ~] (handle `token`[%access-token access-token])]
::
+- res-parse
|* para/quay-keys
|= handle/$-(_?~(para ~ (grab-quay *httr para)) core-move)
|= a/httr ^- core-move
?: (bad-response p.a)
[%give a]
:: [%redo ~] :: handle 4xx?
(handle (grab-quay a para))
::
++ res-give |=(a/httr [%give a])
+- res-handle-reqt
|= handle/$-(token _done) ^- $-(httr core-move)
?~ tok
(res-save-reqt handle)
res-give
::
+- res-save-reqt
|= handle/$-(token _done) ^- $-(httr core-move)
%- (res-parse token-response 'oauth_callback_confirmed')
|= {request-token/{tok/@t sec/@t} cof/term} ^- core-move
?. =(%true cof)
~|(%callback-rejected !!)
[[%redo ~] (handle `token`[%request-token request-token])]
::
::
++ add-auth
=< |= $: auq/quay :: extra oauth parameters
hiz/{purl meth hed/math (unit octs)}
==
^- hiss
~& add-auth+(earn -.hiz)
%_ hiz
hed (~(add ja hed.hiz) %authorization (authorization auq hiz))
==
++ auth
|%
++ authorization
++ header
|= {auq/quay url/purl med/meth math bod/(unit octs)}
^- cord
=^ quy url [r.url url(r ~)] :: query string handled separately
=. auq (fass (weld auq auth-quay))
=. auq (quay:hep-to-cab (weld auq computed-query))
=+ ^- qen/quay-enc :: semi-encoded for sorting
%+ weld (parse-pairs bod)
(encode-pairs (weld auq quy))
@ -229,7 +165,7 @@
=. auq ['oauth_signature'^(crip (urle sig)) auq]
(crip "OAuth {(to-header auq)}")
::
++ auth-quay
++ computed-query
^- quay
:~ oauth-consumer-key+consumer-key
oauth-nonce+(scot %uw (shaf %non eny))
@ -256,4 +192,138 @@
(trip ?^(tok token-secret.tok ''))
==
--
::
++ add-auth-header
|= {extra/quay request/{url/purl meth hed/math (unit octs)}}
^- hiss
:: =. url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
%_ request
hed
(~(add ja hed.request) %authorization (header:auth extra request))
==
:: expected semantics, to be copied and modified if anything doesn't work
++ standard
|* {done/* save/$-(token *)} :: save/$-(token _done)
|%
++ save ^-($-(token _done) ^save) :: shadow(type canary)
++ core-move $^({sec-move _done} sec-move) :: stateful
::
:: use token to sign authorization header. expects:
:: ++ res res-handle-request-token :: save request token
:: ++ in (in-token-exhange 'http://...') :: handle callback
++ out-add-header
|= {request-url/$@(@t purl) dialog-url/$@(@t purl)}
::
|= a/hiss ^- $%({$send hiss} {$show purl})
?- tok
$~
[%send (add-auth-header ~ (request-token request-url))]
::
{$access-token ^}
[%send (add-auth-header [oauth-token+oauth-token.tok]~ a)]
::
{$request-token ^}
[%show (auth-url dialog-url)]
==
::
:: If no token is saved, the http response we just got has a request token
++ res-handle-request-token
|= a/httr ^- core-move
?^ tok [%give a]
?. =(%true (grab-quay r.a 'oauth_callback_confirmed'))
~|(%callback-rejected !!)
=+ request-token=(grab-token-response a)
[[%redo ~] (save `token`[%request-token request-token])]
::
:: Exchange oauth_token in query string for access token. expects:
:: ++ bak bak-save-token :: save access token
++ in-exchange-token
|= exchange-url/$@(@t purl)
::
|= a/quay ^- sec-move
?> (check-token-quay a)
[%send (add-auth-header a (exchange-token exchange-url))]
::
:: If a valid access token has been returned, save it
++ bak-save-token
|= a/httr ^- core-move
?: (bad-response p.a)
[%give a] :: [%redo ~] :: handle 4xx?
?. (check-screen-name a)
[[%redo ~] (save `token`~)]
=+ access-token=(grab-token-response a)
[[%redo ~] (save `token`[%access-token access-token])]
--
--
::
:::: Example "standard" sec/ core:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth1
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth1) tok/token:oauth1}
:: ++ aut (~(standard oauth1 bal tok) . |=(tok/token:oauth1 +>(tok tok)))
:: ++ out
:: %+ out-add-header:aut
:: request-token='https://my-api.com/request_token'
:: oauth-dialog='https://my-api.com/authorize'
:: ::
:: ++ res res-handle-request-token:aut
:: ++ in
:: %- in-exchagne-token:aut
:: exchange-url='https://my-api.com/access_token'
:: ::
:: ++ bak bak-save-token:aut
:: --
::
::
:::: Equivalent imperative code:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth1
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth1) tok/token:oauth1}
:: ++ aut ~(. oauth1 bal tok)
:: ++ out :: add header
:: =+ aut
:: |= req/hiss ^- $%({$send hiss} {$show purl})
:: ?~ tok
:: [%send (add-auth-header ~ (request-token 'https://my-api.com/request_token'))]
:: ?: ?=($request-token -.tok)
:: [%show (auth-url 'https://my-api.com/authorize')]
:: [%send (add-auth-header [oauth-token+ouath-token.tok]~ req)]
:: ::
:: ++ res :: handle request token
:: =+ aut
:: |= res/httr ^- $%({{$redo $~} _..res} {$give httr})
:: ?^ tok [%give a]
:: ?> =(%true (grab r.res 'oauth_callback_confirmed'))
:: =. tok [%request-token (grab-token-response res)]
:: [[%redo ~] ..res]
:: ::
:: ++ in :: exchange token
:: =+ aut
:: |= inp/quay ^- {$send hiss}
:: ?> (check-token-quay inp)
:: :- %send
:: (add-auth-header inp (exchange-token 'https://my-api.com/access_token'))
:: ::
:: ++ bak :: save token
:: =+ aut
:: |= bak/httr ^- $%({{$redo $~} _..bak} {$give httr})
:: ?: (bad-response bak) [%give bak]
:: =. tok [%access-token (grab-token-response res)]
:: [[%redo ~] ..bak]
:: --
::

441
lib/oauth2.hoon
View File

@ -1,80 +1,47 @@
:: OAuth 2.0 %authorization
::
:::: /hoon/oauth2/lib
::
/+ hep-to-cab, interpolate
|%
++ 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
%+ mix (lsh 3 1 $(t (rsh 3 1 t)))
=+ c=(end 3 1 t)
?:(=(a c) b c)
::
++ join
++ parse-url parse-url:interpolate
++ join
|= {a/cord b/(list cord)}
?~ b ''
(rap 3 |-([i.b ?~(t.b ~ [a $(b t.b)])]))
::
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (tact +:(tail:earn b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
=- (mean (flop `tang`[>a< -]))
(turn (lore (crip b)) |=(c/cord leaf+(trip c)))
::
++ dbg-post `purl`[`hart`[| `6.000 [%& /localhost]] `pork``/testing `quay`/]
++ 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)))
::
++ parse-url
|= a/$@(cord:purl purl) ^- purl
?^ a a
~| bad-url+a
(rash a auri:epur)
::
++ interpolate-url
|= {a/$@(cord purl) b/(unit hart) c/(list (pair term knot))}
^- purl
?@ a $(a (parse-url a)) :: deal with cord
%_ a
p ?^(b u.b p.a)
q.q (interpolate-path q.q.a c)
==
::
++ interpolate-path :: [/a/:b/c [%b 'foo']~] -> /a/foo/c
|= {a/path b/(list (pair term knot))} ^- path
?~ a ?~(b ~ ~|(unused-values+b !!))
=+ (rush i.a ;~(pfix col sym))
?~ - [i.a $(a t.a)] :: not interpolable
?~ b ~|(no-value+u !!)
?. =(u p.i.b) ~|(mismatch+[u p.i.b] !!)
[q.i.b $(a t.a, b t.b)]
--
::
::::
::
|%
++ token ?($~ @t)
++ refresh {tok/token needed/@da pending/_`?`|}
++ refresh {tok/token expiry/@da pending/_`?`|}
++ both-tokens {token refresh}
++ keys cord:{cid/@t cis/@t}
++ core-move |*(a/* $^({sec-move _a} sec-move)) ::here's a change
--
::
::::
::
|= {dialog/$@(cord:purl purl) code-exchange/$@(cord:purl purl)}
=+ :+ state-usr=|
dialog-url=(parse-url dialog)
exchange-url=(parse-url code-exchange)
|_ {(bale keys) scope/(list cord)}
=+ state-usr=|
|_ {(bale keys) tok/token}
++ client-id cid:decode-keys
++ client-secret cis:decode-keys
++ decode-keys :: XX from bale w/ typed %jael
@ -89,55 +56,32 @@
{(trip redirect-uri)}
"""
::
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ auth-url
|= {scopes/(list @t) url/$@(@t purl)} ^- purl
~& [%oauth-warning "Make sure this urbit ".
"is running on {(earn our-host `~ ~)}"]
^- purl
%_ dialog-url
r
%+ welp r.dialog-url
%- fass
:~ state+?.(state-usr '' (pack usr /''))
client-id+client-id
redirect-uri+redirect-uri
scope+(join ' ' scope)
==
%+ add-query:interpolate url
%- quay:hep-to-cab
:~ state+?.(state-usr '' (pack usr /''))
client-id+client-id
redirect-uri+redirect-uri
scope+(join ' ' scopes)
==
::
++ our-host .^(hart %e /(scot %p our)/host/fake)
++ redirect-uri
%- crip %- earn
%^ interpolate-url 'https://our-host/~/ac/:domain/:user/in'
%^ interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
user+?:(state-usr '_state' (scot %ta usr))
==
::
::
++ 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 exchange-url
:+ %post (malt ~[content-type+~['application/x-www-form-urlencoded']])
=- `(tact +:(tail:earn -))
%- fass
++ request-token
|= {a/$@(@t purl) grant-type/cord quy/quay} ^- hiss
%+ post-quay (parse-url a)
%- quay:hep-to-cab
%+ welp quy
:~ client-id+client-id
client-secret+client-secret
@ -145,60 +89,295 @@
grant-type+grant-type
==
::
++ in-code
|= a/quay ^- sec-move
=+ code=~|(%no-code (~(got by (malt a)) %code))
(toke-req 'authorization_code' code+code ~)
++ request-token-by-code
|=({a/$@(@t purl) b/@t} (request-token a 'authorization_code' code+b ~))
::
++ 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)])
++ grab-token
|= a/httr ^- axs/@t
(grab-json a (ot 'access_token'^so ~):jo)
::
++ 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)
[%give a]
:: [%redo ~] :: handle 4xx?
(handle (grab-json a (ot:jo parse)))
++ grab-expiring-token
|= a/httr ^- {axs/@t exp/@u}
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):jo)
::
++ res-give |=(a/httr [%give a])
++ grab-both-tokens
|= a/httr ^- {axs/@t exp/@u ref/@t}
(grab-json a (ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~):jo)
::
++ auth
?~ tok ~|(%no-bearer-token !!)
|%
++ header `cord`(cat 3 'Bearer ' `@t`tok)
++ query `cord`tok
--
::
++ add-auth-header
|= request/{url/purl meth hed/math (unit octs)}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-header+(earn url.request)
request(hed (~(add ja hed.request) %authorization header:auth))
::
++ add-auth-query
|= {token-name/cord request/{url/purl meth math (unit octs)}}
^+ request
:: =. p.url.request [| `6.000 [%& /localhost]] :: for use with unix nc
~& add-auth-query+(earn url.request)
request(r.url [[token-name query:auth] r.url.request])
::
++ 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 ~)
|_ ref/refresh
++ needs-refresh ?~(tok.ref | is-expired)
++ is-expired (lth expiry.ref (add now ~m5))
++ update
|= exp/@u ^+ ref
ref(pending |, expiry (add now (mul ~s1 exp)))
::
++ 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)]
++ update-if-needed
|= exchange-url/$@(@t purl)
^- {(unit hiss) refresh}
?~ tok.ref `ref
?. is-expired `ref
:_ ref(pending &)
`(request-token exchange-url 'refresh_token' refresh-token+tok.ref ~)
--
::
:: expected semantics, to be copied and modified if anything doesn't work
++ standard
|* {done/* save/$-(token *)}
|%
++ save ^-($-(token _done) ^save) :: shadow(type canary)
++ core-move $^({sec-move _done} sec-move) :: stateful
::
++ 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)]
:: Insert token into query string. expects:
:: ++ in (in-code-to-token 'http://...') :: handle callback
++ out-add-query-param
|= {token-name/knot scopes/(list cord) dialog/$@(@t purl)}
::
|= a/hiss ^- $%({$send hiss} {$show purl})
?~ tok [%show (auth-url scopes dialog)]
[%send (add-auth-query token-name a)]
::
:: Add token as a header. expects:
:: ++ in (in-code-to-token 'http://...') :: handle callback
++ out-add-header
|= {scopes/(list cord) dialog/$@(@t purl)}
::
|= a/hiss ^- sec-move
?~ tok [%show (auth-url scopes dialog)]
[%send (add-auth-header a)]
::
:: Exchange code in query string for access token. expects:
:: ++ bak bak-save-token :: save access token
++ in-code-to-token
|= exchange-url/$@(@t purl)
::
|= a/quay ^- sec-move
=+ code=~|(%no-code (~(got by (malt a)) %code))
[%send (request-token-by-code exchange-url code)]
::
:: If an access token has been returned, save it
++ bak-save-token
|= a/httr ^- core-move
?: (bad-response p.a)
[%give a] :: [%redo ~] :: handle 4xx?
[[%redo ~] (save `token`(grab-token a))]
--
::
++ standard-refreshing
|* {done/* ref/refresh save/$-({token refresh} *)}
=+ s=(standard done |=(tok/token (save tok ref)))
|%
++ save ^-($-(both-tokens _done) ^save) :: shadow(type canary)
++ core-move $^({sec-move _done} sec-move) :: stateful
::
:: See ++out-add-query-param:standard
:: Refresh token if we have an expired one, ask for authentication if none is present,
:: insert auth token into the query string if it's valid. expects:
:: ++ in (in-code-to-token 'http://...') :: handle callback
:: ++ res res-save-after-refresh
++ out-refresh-or-add-query-param
|= {exchange/$@(@t purl) s-args/{knot (list cord) $@(@t purl)}}
::
|= a/hiss ^- core-move
=^ upd ref (~(update-if-needed re ref) exchange)
?^ upd [[%send u.upd] (save tok ref)]
%.(a (out-add-query-param.s s-args))
::
:: See ++out-add-header:standard
:: Refresh token if we have an expired one, ask for authentication if none is present,
:: add token as a header if it's valid. expects:
:: ++ in (in-code-to-token 'http://...') :: handle callback
:: ++ res res-save-after-refresh
++ out-refresh-or-add-header
|= {exchange/$@(@t purl) s-args/{(list cord) dialog/$@(@t purl)}}
::
|= a/hiss ^- core-move
=^ upd ref (~(update-if-needed re ref) exchange)
?^ upd [[%send u.upd] (save tok ref)]
%.(a (out-add-header.s s-args))
::
:: If the last request refreshed the access token, save it.
++ res-save-after-refresh
|= a/httr ^- core-move
?. pending.ref [%give a]
=+ `{axs/token exp/@u}`(grab-expiring-token a)
=. ref (~(update re ref) exp)
[[%redo ~] (save axs ref)]
::
:: Exchange code in query string for access and refresh tokens. expects:
:: ++ bak bak-save-both-tokens :: save access token
++ in-code-to-token in-code-to-token.s
::
:: If valid access and refresh tokens have been returned, save them
++ bak-save-both-tokens
|= a/httr ^- core-move
=+ `{axs/token exp/@u ref-new/token}`(grab-both-tokens a)
=. tok.ref ref-new
=. ref (~(update re ref) exp)
[[%redo ~] (save axs ref)]
--
--
::
:: XX move-me
::
::
:::: Example "standard" sec/ core:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth2
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
:: ++ out
:: %+ out-add-header:aut scope=/full
:: oauth-dialog='https://my-api.com/authorize'
:: ::
:: ++ in
:: %- in-code-to-token:aut
:: exchange-url='https://my-api.com/access_token'
:: ::
:: ++ bak bak-save-token:aut
:: --
::
::
:::: Equivalent imperative code:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth2
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++ aut ~(. oauth2 bal tok)
:: ++ out :: add header
:: =+ aut
:: |= req/hiss ^- $%({$send hiss} {$show purl})
:: ?~ tok
:: [%show (auth-url scope=/full 'https://my-api.com/authorize')]
:: [%send (add-auth-header req)]
:: ::
:: ++ in :: code to token
:: =+ aut
:: |= inp/quay ^- {$send hiss}
:: =+ code=~|(%no-code (~(got by (malt inp)) %code))
:: [%send (request-token-by-code 'https://my-api.com/access_token' code)]
:: ::
:: ++ bak :: save token
:: =+ aut
:: |= bak/httr ^- $%({{$redo $~} _..bak} {$give httr})
:: ?: (bad-response bak) [%give bak]
:: =. tok (grab-token bak)
:: [[%redo ~] ..bak]
:: --
::
::: :::
::::: ::
::: :::
::
:::: Example "standard-refreshing" sec/ core:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth2
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) tok/token:oauth2 ref/refresh:oauth2}
:: ++ aut
:: %^ ~(standard-refreshing oauth2 bal tok) . ref
:: |=({tok/token ref/refresh}:oauth2 +>(tok tok, ref ref))
:: ::
:: ++ exchange-url 'https://my-api.com/access_token'
:: ++ out
:: %^ out-refresh-or-add-header:aut exchange-url
:: scope=/full
:: oauth-dialog='https://my-api.com/authorize'
:: ::
:: ++ res res-save-after-refresh:aut
:: ++ in (in-code-to-token:aut exchange-url)
:: ++ bak bak-save-both-tokens:aut
:: --
::
::
:::: Equivalent imperative code:
::
::
:: ::
:: :::: /hoon/my-api/com/sec
:: ::
:: /+ oauth2
:: ::
:: ::::
:: ::
:: |_ {bal/(bale keys:oauth2) axs/token:oauth2 ref/refresh:oauth2}
:: ++ aut ~(. oauth2 bal axs)
:: ++ exchange-url 'https://my-api.com/access_token'
:: ++ out :: refresh or add header
:: =+ aut
:: |= req/hiss ^- $^({{$send hiss} _..out} $%({$send hiss} {$show purl}))
:: ?~ axs
:: [%show (auth-url scope=/full 'https://my-api.com/authorize')]
:: =^ upd ref (~(update-if-needed re ref) exchange-url)
:: ?^ upd [[%send u.upd] ..out]
:: [%send (add-auth-header req)]
:: ::
:: ++ res :: save after refresh
:: =+ aut
:: |= a/httr ^- $^({{$redo $~} _..res} {$give httr})
:: ?. pending.ref [%give a]
:: =+ `{axs/token exp/@u}`(grab-expiring-token a)
:: [[%redo ~] ..out(axs axs, ref (~(update re ref) exp))]
:: ::
:: ++ in :: exchange token
:: =+ aut
:: |= inp/quay ^- {$send hiss}
:: =+ code=~|(%no-code (~(got by (malt inp)) %code))
:: [%send (request-token-by-code exchange-url code)]
::
:: ++ bak :: save both tokens
:: =+ aut
:: |= a/httr ^- {{$redo $~} _..res}
:: =+ `{axs/token exp/@u ref-new/token}`(grab-both-tokens a)
:: =. tok.ref ref-new
:: [[%redo ~] ..bak(axs axs, ref (~(update re ref) exp))]
:: ::
:: ::
:: ++ bak
:: =+ aut
:: |= bak/httr ^- $%({{$redo $~} _..bak} {$give httr})
:: ?: (bad-response bak) [%give bak]
:: =. tok (grab-token bak)
:: [[%redo ~] ..bak]
:: --
::

14
lib/talk.hoon
View File

@ -9,7 +9,7 @@
::::
::
[. ^talk]
|%
|_ bol/bowl
++ main :: main story
|= our/ship ^- cord
=+ can=(clan our)
@ -18,6 +18,18 @@
$king %floor
==
::
++ said-url :: app url
|= url/purl
:^ ost.bol %poke /said-url
:+ [our.bol %talk] %talk-command
^- command
:- %publish
:_ ~
^- thought
:+ (shaf %thot eny.bol)
[[[%& our.bol (main our.bol)] [*envelope %pending]] ~ ~]
[now.bol *bouquet [%app dap.bol (crip (earn url))]] :: XX
::
++ said :: app message
|= {our/@p dap/term now/@da eny/@uvI mes/(list tank)}
:- %talk-command

1
lib/tree.hoon
View File

@ -2,7 +2,6 @@
:::: /hoon/tree/lib
::
/? 314
/- tree-include
!:
|%
++ getall :: search in manx

72
lib/twitter.hoon
View File

@ -4,49 +4,18 @@
::
/? 314
/- twitter
/+ interpolate, hep-to-cab
=+ sur-twit:^twitter :: XX
!:
:::: functions
::
|%
++ fass :: rewrite path
|= a/path
%+ turn a
|=(b/@t (gsub '-' '_' b))
::
++ gsub :: replace chars
|= {a/@t b/@t t/@t}
^- @t
?: =('' t) t
%+ mix (lsh 3 1 $(t (rsh 3 1 t)))
=+ c=(end 3 1 t)
?:(=(a c) b c)
::
++ join
|= {a/char b/(list @t)} ^- @t
%+ rap 3
?~ b ~
|-(?~(t.b b [i.b a $(b t.b)]))
::
++ interpolate-some :: [/a/:b/c [d+'bar' b+'foo']~] -> [/a/foo/c [d+'bar']~]
|= {pax/path quy/quay} ^- {path quay}
=+ ^= inline :: required names
%- ~(gas in *(set term))
(murn pax replacable:interpolate-path)
=^ inter quy
(skid quy |=({a/knot @} (~(has in inline) a)))
[(interpolate-path pax inter) quy]
::
++ interpolate-path :: [/a/:b/c [%b 'foo']~] -> /a/foo/c
=+ replacable=|=(a/knot `(unit term)`(rush a ;~(pfix col sym)))
|= {a/path b/(list (pair term knot))} ^- path
?~ a ?~(b ~ ~|(unused-values+b !!))
=+ (replacable i.a)
?~ - [i.a $(a t.a)] :: literal value
?~ b ~|(no-value+u !!)
?. =(u p.i.b) ~|(mismatch+[u p.i.b] !!)
[q.i.b $(a t.a, b t.b)]
::
++ valve :: produce request
|= {med/?($get $post) pax/path quy/quay}
^- hiss
@ -58,7 +27,7 @@
$get [url med *math ~]
$post
=+ hed=(my content-type+['application/x-www-form-urlencoded']~ ~)
[url(r ~) med hed (some (tact +:(tail:earn r.url)))]
[url(r ~) med hed ?~(r.url ~ (some (tact +:(tail:earn r.url))))]
==
::
++ find-req
@ -74,25 +43,40 @@
::
|%
++ render :: response printers
=+ args:reqs
|%
++ mean
|= {msg/@t num/@ud} ^- tank
rose+[": " `~]^~[leaf+"Error {<num>}" leaf+(trip msg)]
::
++ user-url
|= a/scr ^- purf
:_ ~
%^ into-url:interpolate 'https://twitter.com/:scr'
~
~[scr+a]
::
++ post-url
|= {a/scr b/tid} ^- purf
:_ ~
%^ into-url:interpolate 'https://twitter.com/:scr/status/:tid'
~
~[scr+a tid+(tid:print b)]
--
++ parse :: json reparsers
|%
++ ce |*({a/_* b/fist:jo} (cu:jo |=(c/a c) b)) :: output type
++ fasp |*(a/{@tas *} [(gsub '-' '_' -.a) +.a]) :: XX usable electroplating
++ fasp |*(a/{@tas *} [(hep-to-cab -.a) +.a]) :: XX usable electroplating
++ user (cook crip (plus ;~(pose aln cab)))
++ mean (ot errors+(ar (ot message+so code+ni ~)) ~):jo
++ stat
++ post
=+ jo
%+ ce stat:sur-twit
%+ ce post:sur-twit
%- ot
:~ id+ni
user+(ot (fasp screen-name+(su user)) ~)
(fasp created-at+da)
text+so
text+(cu crip (su (star escp:poxa))) :: parse html escapes
==
++ usel
=+ jo
@ -109,10 +93,6 @@
|= a/$@(^scr ^lsc) ^- @t
?@(a `@t`a (join ',' a))
::
++ lst
|= a/$@(@t ^lst) ^- @t
?@(a `@t`a (join ',' a))
::
++ lid
|= a/$@(^tid (list ^tid)) ^- @t
?~ a ~|(%nil-id !!)
@ -123,7 +103,7 @@
=+ args:reqs
|%
++ apex
|= {a/endpoint b/quay}
|= {a/endpoint b/quay} ^- hiss
=+ [med pax]=(find-req -.a)
(valve med (cowl pax +.a b))
::
@ -149,16 +129,16 @@
quy/quay
==
^- {path quay}
%+ interpolate-some (fass pax)
%+ into-path-partial:interpolate
(path:hep-to-cab pax)
=- (weld - quy)
%+ turn ban
|= p/param
^- {@t @t}
:- (gsub '-' '_' -.p)
:- (hep-to-cab -.p)
?+ -.p p.p :: usually plain text
?($source-id $target-id) (tid:print p.p)
?($follow $id $name $user-id) (lid:print p.p)
$track (lst:print p.p)
?($id $name $user-id) (lid:print p.p)
$screen-name (lsc:print p.p)
==
--

60
lib/write.hoon
View File

@ -3,6 +3,7 @@
:::: /hoon/write/lib
::
/? 310
/- plan-diff, plan-acct
|%
++ part {$write $0 pith} :: no state
++ pith $~
@ -16,7 +17,7 @@
{$info wire @p toro}
==
--
::
!:
::::
::
|= {bowl part}
@ -37,13 +38,47 @@
|= {sup/spur mim/mime} ^+ abet :: XX determine extension, beak
(poke--data [`%md (flop sup)] %mime mim)
::
++ poke-plan-account
|= {sev/knot usr/plan-acct} ^+ abet
(poke-plan-diff [~ ~ [[sev usr] ~ ~]])
::
++ poke-plan-info
|= {who/@t loc/@t}
(poke-plan-diff [[~ who loc] ~ ~])
::
++ poke-plan-diff
|= dif/plan-diff ^+ abet
?. =(our src)
~|(foreign-write+[our=our src=src] !!)
=; sob/soba
?~(sob abet abet:(emit %info write+~ our `toro`[q.byk %& sob]))
=+ pax=`path`/web/plan
=+ paf=(tope beak-now (flop pax))
?~ [fil:.^(arch %cy paf)]
=+ ins=(pact-plan [['' ''] ~] dif)
[pax %ins plan+!>(ins)]~
=+ ole=.^({{@t @t} (map iden plan-acct)} %cx paf)
=+ neu=(pact-plan ole dif)
?: =(ole neu) ~
[pax %dif plan-diff+!>(dif)]~
::
++ pact-plan :: XX clay should handle fused insert+diff
|= {all/{{who/@t loc/@t} acc/(map iden plan-acct)} dif/plan-diff}
^+ all
:- (fall inf.dif -.all)
=; neu (~(uni by neu) put.dif)
=+ del=(~(tap by del.dif)) :: XXX map functions
|- ^+ acc.all
?~ del acc.all
$(del t.del, acc.all (~(del by acc.all) p.i.del))
::
++ poke-paste
|= {typ/?($hoon $md $txt) txt/@t} ^+ abet
(poke--data [`typ /web/paste/(scot %da now)] %mime / (taco txt))
::
++ poke-comment
|= {pax/path him/ship txt/@t} ^+ abet
=. pax [%web (welp pax /comments/(scot %da now))]
|= {sup/spur him/ship txt/@t} ^+ abet
=+ pax=(welp (flop sup) /comments/(scot %da now))
=. txt
%+ rap 3 :~
'## `' (scot %p him) '`'
@ -51,6 +86,25 @@
==
(poke--data [`%md pax] %mime / (taco txt))
::
++ poke-fora-post
|= {sup/spur him/ship hed/@t txt/@t} ^+ abet
=+ pax=(welp (flop sup) /posts/(cat 3 (scot %da now) '~'))
=. txt
%- crip
"""
---
type: post
date: {<now>}
title: {(trip hed)}
author: {<him>}
navuptwo: true
comments: reverse
---
{(trip txt)}
"""
(poke--data [`%md pax] %mime / (taco txt))
::
++ ames-secret
^- @t
=- (crip +:<.^(@p %a pax)>)

42
mar/gh/issue-comment.hoon
View File

@ -1,18 +1,42 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse
/+ gh-parse, talk
|_ issue-comment/issue-comment:gh
++ grow
|%
++ talk-speeches
^- (list speech:talk)
:_ ~
=+ ^= txt
;: (cury cat 3)
'on issue #'
`@t`(rsh 3 2 (scot %ui number.issue.issue-comment))
': '
body.comment.issue-comment
==
:* %api %github
login.sender.issue-comment
(rash html-url.sender.issue-comment aurf:epur)
txt
txt
(rash html-url.comment.issue-comment aurf:epur)
%- jobe :~
repository+s+name.repository.issue-comment
number+(jone number.issue.issue-comment)
title+s+title.issue.issue-comment
==
==
--
++ 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)))
=; jop |=(jon/^json `issue-comment:gh`(need (jop jon)))
%- ot:jo
:~ repository+repository:gh-parse
sender+user:gh-parse
action+so:jo
issue+issue:gh-parse
comment+comment:gh-parse
==
--
--

14
mar/gh/issue.hoon Normal file
View File

@ -0,0 +1,14 @@
/- gh
/+ gh-parse
|_ issue/issue:gh
++ grab
|%
++ noun issue:gh
--
++ grow
|%
++ json raw.issue
++ mime [/txt/plain (taco (crip <issue>))]
++ txt (print-issue:gh-parse issue)
--
--

115
mar/gh/issues.hoon
View File

@ -1,7 +1,120 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse
/+ gh-parse, talk
|_ issues/issues:gh
++ grow
|%
++ talk-speeches
^- (list speech:talk)
:_ ~
=+ ^= txt
?- -.action.issues
$assigned
;: (cury cat 3)
'assigned issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' to '
login.assignee.action.issues
' ('
title.issue.issues
')'
==
::
$unassigned
;: (cury cat 3)
'unassigned issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' from '
login.assignee.action.issues
' ('
title.issue.issues
')'
==
::
$labeled
;: (cury cat 3)
'labeled issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' as '
name.label.action.issues
' ('
title.issue.issues
')'
==
::
$unlabeled
;: (cury cat 3)
'unlabeled issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' as '
name.label.action.issues
' ('
title.issue.issues
')'
==
::
$opened
;: (cury cat 3)
'opened issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
::
$closed
;: (cury cat 3)
'closed issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
::
$reopened
;: (cury cat 3)
'reopened issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
==
^- speech:talk
:* %api %github
login.sender.issues
(rash html-url.sender.issues aurf:epur)
txt txt
(rash html-url.issue.issues aurf:epur)
%- jobe
%+ welp
:~ repository+s+name.repository.issues
number+(jone number.issue.issues)
title+s+title.issue.issues
action+s+-.action.issues
==
?- -.action.issues
$assigned
:~ assignee+s+login.assignee.action.issues
assignee-url+s+url.assignee.action.issues
==
::
$unassigned
:~ assignee+s+login.assignee.action.issues
assignee-url+s+url.assignee.action.issues
==
::
$labeled
:~ label+s+name.label.action.issues
==
::
$unlabeled
:~ label+s+name.label.action.issues
==
::
$opened ~
$closed ~
$reopened ~
==
==
--
++ grab
|%
++ json

17
mar/gh/list-issues.hoon Normal file
View File

@ -0,0 +1,17 @@
/- gh
/+ gh-parse
|_ issues/(list issue:gh)
++ grab
|%
++ noun (list issue:gh)
--
++ grow
|%
++ json [%a (turn issues |=(issue:gh raw))]
++ mime [/txt/plain (taco (crip <issues>))]
++ txt =- ?~ - - ->
%+ roll (turn issues print-issue:gh-parse)
|= {a/wain b/wain}
:(welp b ~['----------------------------------------'] a)
--
--

4
mar/gh/poke.hoon
View File

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

8
mar/gmail/req.hoon
View File

@ -1,8 +0,0 @@
/- 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)]
--
--

2
mar/json.hoon
View File

@ -9,7 +9,7 @@
::
++ grow :: convert to
|%
++ mime [/text/json (taco txt)] :: convert to %mime
++ mime [/application/json (taco txt)] :: convert to %mime
++ txt (crip (pojo jon))
--
++ grab

61
mar/lens/command.hoon Normal file
View File

@ -0,0 +1,61 @@
/- lens
!:
|_ com/command:lens
++ grab
|%
++ noun command:lens
++ json
|= jon/^json
^- command:lens
~| jon=jon
%- need
%. jon
=> [. jo]
=< %- ot :~
source+source
sink+sink
==
|%
++ source
^- $-(^json (unit source:lens))
|= jon/^json
=+ tuple=%.(jon (ar source))
?^ tuple
`[%tuple u.tuple]
%. jon
%- of :~
data+so:jo
dojo+so:jo
clay+so:jo
url+(su auri:urlp)
api+(su ;~(plug sym ;~(pfix col prn)))
:- %get-api
%- su
;~ plug
sym
;~(pfix col (more fas (cook crip (star ;~(less fas prn)))))
==
listen-api+(su ;~(plug sym ;~(pfix col sym)))
as+(ot mark+(su sym) next+source ~)
hoon+(ot code+so:jo next+source ~)
==
++ sink
^- $-(^json (unit sink:lens))
%- of :~
stdout+|=(^json (some ~))
output-file+so:jo
output-clay+(su (easy /sentinel/path))
url+(su auri:urlp)
to-api+(su ;~(plug sym ;~(pfix col prn)))
:- %send-api
%- su
;~ plug
sym
;~(pfix col (more fas (cook crip (star ;~(less fas prn)))))
==
command+so:jo
app+(su sym)
==
--
--
--

12
mar/lens/json.hoon Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hoon/json/lens/mar
::
/? 310
!:
:::: ~fyr
::
|_ jon/json
++ grab |% ++ noun json
--
++ grow |% ++ json jon
-- --

11
mar/plan-diff.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/plan-diff/mar
::
/? 310
/- plan-diff
!:
:::: ~fyr
::
|_ plan-diff
++ grab |% ++ noun plan-diff
-- --

97
mar/plan.hoon Normal file
View File

@ -0,0 +1,97 @@
::
:::: /hoon/plan/mar
::
/? 310
/- plan-acct, plan-diff
!:
:::: ~fyr
::
|_ all/{{who/@txname loc/@txloc} acc/(map knot plan-acct)}
::
++ grow :: convert to
=+ all
|%
++ txt
^- wain
:+ (cat 3 'User ' ?~(who 'of Urbit' who))
(cat 3 'Location ' ?~(loc %unknown loc))
%+ turn (sort (~(tap by acc)) aor)
|= {a/knot b/plan-acct} ^- cord
%+ rap 3
:^ a ': ' usr.b
?~(url.b ~ [', ' (earf u.url.b)])
::
++ plan-json
%- jobe :~
who+?~(who ~ s+who)
loc+?~(loc ~ s+loc)
acc+o+(~(run by acc) json-acct)
==
++ json-acct :: helper
|= a/plan-acct ^- json
(jobe usr+s+usr.a url+?~(url.a ~ (jape (earf u.url.a))) ~)
--
++ grab |% :: convert from
++ noun {{cord cord} (map knot plan-acct)} :: clam from %noun
++ txt
|^ |= a/wain ^+ all
?> ?=({@t @t *} a)
:- [(rash i.a user) (rash i.t.a location)]
(malt (turn t.t.a |=(b/cord (rash b account))))
::
++ user ;~(pfix (jest 'User ') (cook crip (star prn)))
++ knot (sear (flit |=(a/^knot !=('' a))) urs:ab)
++ location ;~(pfix (jest 'Location ') (cook crip (star prn)))
++ account
;~ plug
knot
;~(pfix col ace knot)
(punt ;~(pfix com ace aurf:urlp))
==
--
++ mime |=({* a/octs} (txt (lore q.a))) :: XX mark translation
--
++ grad
|%
++ form %plan-diff
++ diff
|= neu/_all ^- plan-diff :: XXX map functions
:+ ?:(=(-.all -.neu) ~ (some -.neu))
=< (malt `(list {knot $~})`(murn (~(tap by acc.all)) .))
|= {a/knot *} ^- (unit {knot $~})
?:((~(has by acc.neu) a) ~ (some [a ~]))
=< (malt (murn (~(tap by acc.neu)) .))
|= {a/knot b/plan-acct} ^- (unit {knot plan-acct})
?: =([~ b] (~(get by acc.all) a))
~
(some [a b])
::
++ pact
|= dif/plan-diff ^+ all :: XXX map functions
:- (fall inf.dif -.all)
=; neu (~(uni by neu) put.dif)
=+ del=(~(tap by del.dif))
|- ^+ acc.all
?~ del acc.all
$(del t.del, acc.all (~(del by acc.all) p.i.del))
::
++ can-join
|= {ali/plan-diff bob/plan-diff} ^- ?
?& !&(?=({{^ *} {^ *}} +<) !=(u.inf.ali u.inf.bob)) :: compatible info
=(~ (~(int by `(map knot *)`del.ali) put.bob)) :: no del-put
=(~ (~(int by `(map knot *)`put.ali) del.bob)) :: conflicts
.= (~(int by put.ali) put.bob) :: and all put
(~(int by put.bob) put.ali) :: values match
==
::
++ join
|= {ali/plan-diff bob/plan-diff}
^- (unit plan-diff)
?. (can-join ali bob)
~
%^ some
(mate inf.ali inf.bob)
(~(uni by del.ali) del.bob)
(~(uni by put.ali) put.bob)
--
--

22
mar/recoverable-error.hoon Normal file
View File

@ -0,0 +1,22 @@
:: Possibly non-fatal http error
::
:::: /hoon/recoverable-error/mar
::
/- recoverable-error
!:
:::: ~fyr
::
|_ recoverable-error
++ grab
|%
++ noun recoverable-error
++ httr
|= a/^httr ^- recoverable-error
~! a
?+ p.a ~|(non-recoverable+p.a !!)
$429 :+ p.a %rate-limit
%.(%x-rate-limit-reset ;~(biff ~(get by (malt q.a)) poja ni:jo))
==
--
++ grow |% ++ tank >[+<]< --
--

16
mar/sole/effect.hoon
View File

@ -41,6 +41,22 @@
--
++ grow
|%
++ lens-json :: json for cli client
^- ?($~ ^json) :: null = ignore
?+ -.sef ~
$tan s+(role (turn (flop p.sef) |=(a/tank (crip ~(ram re a)))))
$txt s+(crip p.sef)
$sav
(jobe file+s+(crip <`path`p.sef>) data+s+(crip (sifo q.sef)) ~)
::
$mor
=+ all=(turn p.sef |=(a/sole-effect lens-json(sef a)))
=. all (skip all |=(a/^json ?=($~ a)))
?~ all ~
?~ t.all i.all
~|(multiple-effects+`(list ^json)`all !!)
==
::
++ json
^- ^json
?+ -.sef

6
mar/talk/comment.hoon
View File

@ -3,11 +3,11 @@
::
/? 310
!:
|_ {pax/path txt/@t}
|_ {pax/path sup/spur txt/@t}
++ grab
|%
++ noun {path @t}
++ noun {path spur @t}
++ json
(corl need =>(jo (ot pax+(su fel:stab) txt+so ~)))
(corl need =>(jo (ot pax+(su fel:stab) sup+(su fel:stab) txt+so ~)))
--
--

13
mar/talk/fora-post.hoon Normal file
View File

@ -0,0 +1,13 @@
::
:::: /hoon/fora-post/talk/mar
::
/? 310
!:
|_ {pax/path sup/spur hed/@t txt/@t}
++ grab
|%
++ noun {path spur @t @t}
++ json
(corl need =>(jo (ot pax+(su fel:stab) sup+(su fel:stab) hed+so txt+so ~)))
--
--

10
mar/talk/report.hoon
View File

@ -91,6 +91,16 @@
$app (jobe txt+[%s q.a] src+[%s p.a] ~)
$fat (jobe tor+(tors p.a) taf+$(a q.a) ~)
$mor a+(turn p.a spec)
$api
%- jobe :~
service+s+service.a
id+s+id.a
id-url+s+(crip (earf id-url.a))
summary+s+summary.a
body+s+body.a
url+s+(crip (earf url.a))
meta+meta.a
==
:: %inv (jobe ship+(jope p.a) party+[%s q.a] ~)
==
::

23
mar/talk/speeches.hoon Normal file
View File

@ -0,0 +1,23 @@
::
:::: /hoon/speeches/talk/mar
::
/? 310
/- talk
/+ talk,map-to-json
!:
=+ talk
|_ gam/(list speech)
::
++ grab
|%
++ noun (list speech)
--
::
++ grad
|%
++ form %talk-speeches
++ diff |=((list speech) +<)
++ pact |=((list speech) +<)
++ join |=({(list speech) (list speech)} `(unit mime)`~)
--
--

8
mar/tree/comments.hoon
View File

@ -6,7 +6,7 @@
!:
::::
::
|_ all/(list (pair time manx))
|_ all/(list (pair time {ship marl}))
::
++ grow :: convert to
|%
@ -14,9 +14,9 @@
:- %a
%+ turn
(sort all |=({a/* b/*} (lor b a)))
|= {a/time b/manx} ^- ^json
=. a.g.b [id+(time-to-id a) a.g.b]
(jobe time+(jode a) body+(react-to-json:react b) ~)
|= {a/time b/ship c/marl} ^- ^json
=+ bod=[[%div id+(time-to-id a) ~] c]
(jobe time+(jode a) user+(jape +:<b>) body+(react-to-json:react bod) ~)
--
++ grab |% :: convert from
++ noun (list {time manx}) :: clam from %noun

2
mar/tree/include.hoon
View File

@ -5,4 +5,4 @@
/- tree-include
|_ tree-include
++ grab |% ++ noun tree-include
-- --
-- --

22
mar/twit/cred.hoon Normal file
View File

@ -0,0 +1,22 @@
:: Twitter credentials
::
:::: /hoon/cred/twit/mar
::
/- plan-acct
/+ httr-to-json, twitter
|_ {acc/plan-acct raw/json}
++ grab
|%
++ noun {plan-acct ^json}
++ httr (cork httr-to-json json) :: XX mark translation
++ json
|= jon/^json ^- {plan-acct ^json}
=+ usr=(need ((ot 'screen_name'^so ~):jo jon))
=+ url=(user-url:render:twitter usr)
[[usr (some url)] jon]
--
++ grow
|%
++ tank >[+<.+]<
--
--

21
mar/twit/feed.hoon
View File

@ -2,16 +2,29 @@
::
:::: /hoon/feed/twit/mar
::
/- talk
/+ twitter, httr-to-json
|_ (list stat:twitter)
|_ fed/(list post:twitter)
++ grab
|%
++ noun (list stat:twitter)
++ json (corl need (ar:jo stat:parse:twitter))
++ noun (list post:twitter)
++ json (corl need (ar:jo post:parse:twitter))
++ httr (cork httr-to-json json) :: XX mark translation
--
++ grow
|%
++ tank >[+<]<
++ tank >[fed]<
++ talk-speeches
=+ r=render:twitter
%+ turn fed
|= a/post:twitter ^- speech:talk
:* %api %twitter
who.a
(user-url.r who.a)
txt.a
txt.a
(post-url.r who.a id.a)
(joba now+(jode now.a))
==
--
--

8
mar/twit/status.hoon → mar/twit/post.hoon
View File

@ -1,13 +1,13 @@
:: Twitter status
::
:::: /hoon/stat/twit/mar
:::: /hoon/post/twit/mar
::
/+ twitter, httr-to-json
|_ stat:twitter
|_ post:twitter
++ grab
|%
++ noun stat:twitter
++ json (corl need stat:parse:twitter)
++ noun post:twitter
++ json (corl need post:parse:twitter)
++ httr (cork httr-to-json json) :: XX mark translation
--
++ grow

28
mar/urb.hoon
View File

@ -5,13 +5,6 @@
/= urb-wasp-data-js /: /%/wasp-data /js/
!:
|_ {{dep/@uvH hed/marl} {dep-bod/@uvH bod/marl}}
++ linked-deps-js
'''
urb.waspAll = function(sel){
[].map.call(document.querySelectorAll(sel), urb.waspElem)
}
if(urb.wasp){urb.waspAll('script'); urb.waspAll('link')}
'''
++ grow :: convert to
|%
++ mime [/text/html (taco html)] :: convert to %mime
@ -21,18 +14,23 @@
;html
;head
;meta(charset "utf-8", urb_injected "");
;* ?~ dep ~
:~ ;script@"/~/on/{<dep>}.js"(urb_injected "");
;script(urb_injected "")
;- (trip urb-wasp-data-js)
;- "urb.waspData({(pojo %s (scot %uv dep-bod))})"
==
==
;* hed
==
;body
;* bod
;script(urb_injected ""):"{(trip linked-deps-js)}"
;* ?~ dep ~
:~ ;script@"/~/on/{<dep>}.js"(urb_injected "", async "", onload "setTimeout(urb.onDep,2000)");
;script(urb_injected "")
;- (trip urb-wasp-data-js)
; urb.waspWait = []
; urb.wasp = urb.wasp || [].push.bind(urb.waspWait)
; urb.onDep = function()\{
; urb.waspWait.map(urb.wasp)
; urb.onLoadUrbJS()
; urb.waspData({(pojo %s (scot %uv dep-bod))})
; }
==
==
==
==
--

32
mar/urb/wasp-data.js
View File

@ -1,7 +1,14 @@
window.urb = window.urb || {}
urb.waspWait = []
urb.wasp = urb.wasp || [].push.bind(urb.waspWait)
// debugging
urb.verb = false
urb.sources = {}
urb.deps.map(function(a){urb.sources[a] = "dep"})
urb.waspDeps = function(){
urb.deps.map(function(a){urb.sources[a] = "dep"})
}
urb.waspElem = function(ele){
url = ele.src || ele.href
@ -30,12 +37,21 @@ urb.waspData = function(dep){
urb.datadeps[dep] = true
urb.wasp(dep)
}
urb.ondataupdate = urb.onupdate // overridable
var _onupdate = urb.onupdate
urb.onupdate = function(dep){
if(urb.verb)
console.log("update", urb.datadeps[dep] ? "data" : "full", dep, urb.sources[dep])
if(urb.datadeps[dep]) urb.ondataupdate(dep)
else _onupdate(dep)
urb.onLoadUrbJS = function(){
urb.ondataupdate = urb.ondataupdate || urb.onupdate // overridable
var _onupdate = urb.onupdate
urb.onupdate = function(dep){
if(urb.verb)
console.log("update", urb.datadeps[dep] ? "data" : "full", dep, urb.sources[dep])
if(urb.datadeps[dep]) urb.ondataupdate(dep)
else _onupdate(dep)
}
urb.waspDeps()
urb.waspAll = function(sel){
[].map.call(document.querySelectorAll(sel), urb.waspElem)
}
urb.waspAll('script'); urb.waspAll('link')
}

13
mar/write/plan-info.hoon Normal file
View File

@ -0,0 +1,13 @@
::
:::: /hoon/paste/write/mar
::
/? 310
!:
|_ {who/@txname loc/@txloc}
++ grab
|%
++ noun {@txname @txloc}
++ json
(corl need =>(jo (ot who+so loc+so ~)))
--
--

9
ren/css.hoon Normal file
View File

@ -0,0 +1,9 @@
:: /!css/ in /===web/pack
::
:::: /hoon/css/ren
::
/? 310
/, /web/pack/css /% /!css/
/ /~ !!
==
-.-

9
ren/js.hoon Normal file
View File

@ -0,0 +1,9 @@
:: /!js/ in /===web/pack
::
:::: /hoon/js/ren
::
/? 310
/, /web/pack/js /% /!js/
/ /~ !!
==
-.-

5
ren/tree/body.hoon
View File

@ -3,7 +3,10 @@
::
/? 310
/= dat /% /tree-json/ :: default include
/= dat-sen /| /: /%%/ /% /tree-json/ :: default include
/~ ~
==
^- marl
;= ;script(type "text/javascript"): window.tree = {(pojo (joba %data dat))}
;= ;script(type "text/javascript"): window.tree = {(pojo (jobe data+dat sein+dat-sen ~))}
;div#tree;
==

5
ren/tree/combine.hoon
View File

@ -9,7 +9,10 @@
/= sect /&json&/tree-index/
/= snip /&snip&elem&/tree-elem/
/= meta /&json&front&/|(/front/ /~[~])
/= plan /^ json /|(/plan-json/ /~[~])
/= comt /&json&/tree-comments/
/= bump /; |=(a/(list {p/time *}) =.(a (flop a) ?~(a '' (scot %da p.i.a))))
/tree-comments/
!:
^- tree-include
=+ rj=react-to-json:react
@ -20,4 +23,6 @@
meta
sect
comt
plan
bump
==

10
ren/tree/comments.hoon
View File

@ -2,8 +2,14 @@
:::: /hoon/comments/tree/ren
::
/? 310
/: /%/comments /@ /&elem&/md/ :: XX descend horn
/: /%/comments /_ @da
/; |= a/manx ^- {ship marl}
~| a
?> ?=(_[/div ;/(~) ~[[%h2 **] ~[[%code **] ;/(who=**)]] kid=**] a)
=> .(a ^+([/div ;/(~) ~[[%h2 **] ~[[%code **] ;/(who=*tape)]] kid=*marl] a))
[(slav %p (crip who.a)) kid.a]
/&elem&/md/
::
::::
::
`(list (pair time manx))`-.-
`(list (pair time {ship marl}))`-.-

64
ren/tree/head.hoon
View File

@ -8,32 +8,56 @@
/$ %+ cork fuel :: after parsing params,
|= gas/epic ^- ? :: check that the fcgi
%+ lien (~(tap in (~(get ju aut.ced.gas) %$))) :: has an identity
|=(a/knot !=(%pawn (slav %p a))) :: which isn't a comet
|=(a/knot !=(%pawn (clan (slav %p a)))) :: which isn't a comet
/= dbg
/^ {nopack/? nomin/?}
/$ %+ cork fuel :: after parsing params,
|= gas/epic ^- {? ?} :: check if the query
:- (~(has by qix.gas) 'dbg.nopack') :: dictates separate files
(~(has by qix.gas) 'dbg.nomin') :: and/or unminified assets
::
|%
++ cdnjs
|=(a/tape "//cdnjs.cloudflare.com/ajax/libs/{a}{?:(nomin.dbg "" ".min")}.js")
++ maxcdn
|=(a/tape "//maxcdn.bootstrapcdn.com/{a}{?:(nomin.dbg "" ".min")}.js")
--
!:
::::
::
^- marl
;= ;title: Tree
;= ;title: Urbit - A personal server
;meta(name "viewport", content "width=device-width, initial-scale=1");
;link(type "text/css", rel "stylesheet", href "//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.min.css");
;link(type "text/css", rel "stylesheet", href "/lib/css/fonts.css");
;link(type "text/css", rel "stylesheet", href "/lib/css/bootstrap.css");
;link(type "text/css", rel "stylesheet", href "/lib/css/codemirror.css");
;link(type "text/css", rel "stylesheet", href "/tree/main.css");
:: ;link(type "text/css", rel "stylesheet", href "//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.min.css");
;* ?. nopack.dbg
:_ ~
;link(type "text/css", rel "stylesheet", href "/===/web/pack/css/codemirror-fonts-bootstrap-tree.css");
;=
;link(type "text/css", rel "stylesheet", href "/===/web/lib/css/fonts.css");
;link(type "text/css", rel "stylesheet", href "/===/web/lib/css/bootstrap.css");
;link(type "text/css", rel "stylesheet", href "/===/web/lib/css/codemirror.css");
;link(type "text/css", rel "stylesheet", href "/===/web/tree/main.css");
==
::;link(type "text/css", rel "stylesheet", href "http://localhost:8000/docs/pub/tree/main.css");
;script(type "text/javascript", src "{(cdnjs "jquery/2.1.3/jquery")}");
;script(type "text/javascript", src "{(maxcdn "bootstrap/3.3.6/js/bootstrap")}");
;script(type "text/javascript", src "{(cdnjs "lodash.js/2.4.1/lodash")}");
;script(type "text/javascript", src "{(cdnjs "react/0.14.6/react")}");
;script(type "text/javascript", src "{(cdnjs "react/0.14.6/react-dom")}");
;script(type "text/javascript", src "{(cdnjs "flux/2.1.1/Flux")}");
:: ;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js");
:: ;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/".
:: "codemirror/4.3.0/mode/markdown/markdown.min.js");
;* ?. nopack.dbg
:_ ~
;script(type "text/javascript", src "{?.(aut "" "/~~/~/at")}".
"/===/web/pack/js/tree-urb.js");
:: "/===/web/pack/js/tree-hoon-urb.js");
;=
:: ;script(type "text/javascript", src "/===/web/lib/js/hoon.js");
;script(type "text/javascript", src "/===/web/tree/main.js");
;script(type "text/javascript", src "{?.(aut "" "/~~/~/at")}".
"/===/web/lib/js/urb.js");
==
;link(type "application/rss+xml", rel "alternate", href "{(spud tub)}.rss-xml");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/jquery/2.1.3/jquery.min.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/lodash.js/2.4.1/lodash.min.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/react/0.14.6/react.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/react/0.14.6/react-dom.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/flux/2.1.1/Flux.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/codemirror/4.3.0/codemirror.js");
;script(type "text/javascript", src "/lib/js/urb.js");
;script(type "text/javascript", src "/lib/js/hoon.js");
;script(type "text/javascript", src "/tree/main.js");
;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/libs/".
"codemirror/4.3.0/mode/markdown/markdown.min.js");
;script(type "text/javascript", src "{?.(aut "" "/~~")}".
"/~/at/lib/js/urb.js");
==

13
ren/tree/json.hoon
View File

@ -2,6 +2,7 @@
:::: /hoon/json/tree/ren
::
/? 310
/- tree-include
/+ tree
/= gas /$ fuel
/= dat /^ tree-include /tree-include/
@ -20,7 +21,10 @@
{$path $t}
{$spur $t}
::
{$bump $t}
{$beak $t}
{$comt $j}
{$plan $j}
{$head $r}
{$sect $j}
{$snip $r}
@ -40,7 +44,7 @@
|= a/$%({$t p/cord} {$r p/json} {$j p/json} {$m mime})
?- -.a
$t [%s p.a]
$m (jobe mite+[%s (moon p.a)] octs+[%s q.q.a] ~)
$m (jobe mite+[%s (moon p.a)] octs+(jape (sifo q.q.a)) ~)
$r p.a
$j p.a
==
@ -51,8 +55,11 @@
:- -.a
?- -.a
$name (from-type +.a ?^(s.bem i.s.bem q.bem))
$beak (from-type +.a (crip (spud (tope bem(s /)))))
$path (from-type +.a (crip (spud (flop s.bem))))
$spur (from-type +.a (crip (spud s.bem)))
$bump (from-type +.a bump.dat)
$plan (from-type +.a plan.dat)
$comt (from-type +.a comt.dat)
$head (from-type +.a head.dat)
$snip (from-type +.a snip.dat)
@ -71,10 +78,10 @@
::
[tree .]
^- json
=+ default='spur.t_mime.m_body.r_comt.j_kids.name.t'
=+ default='spur.t_body.r_comt.j_plan.j_beak.t_meta.j_kids_meta.j_head.r_bump.t'
=+ ^= schem
=+ seh=(fall (~(get by qix.gas) 'q') default)
~|(bad-noun+seh ;;(schema (rash seh read-schem)))
%+ from-queries bem.gas(s but.gas)
%+ from-queries bem.gas
~| invalid-query+schem
;;((list query) (schema-to-plist schem))

41
sec/com/asana.hoon Normal file
View File

@ -0,0 +1,41 @@
:: Test url +https://app.asana.com/api/1.0/users/me
::
:::: /hoon/asana/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://app.asana.com/-/oauth_authorize?response_type=code'
++ exchange-url 'https://app.asana.com/-/oauth_token'
--
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~ dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app by logging into https://app.asana.com/, and clicking
:: "My Profile Settings" > Apps > "Manage my developer apps"
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/asana.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 /com/asana
:: Enter this sample command to get your user information:
:: +https://app.asana.com/api/1.0/users/me
:: Before you receive the response, you'll have to clink on the link.
:: If you successfully auth, you should receive the response in the dojo.

40
sec/com/digitalocean.hoon Normal file
View File

@ -0,0 +1,40 @@
:: Test url +https://api.digitalocean.com/v2/account
::
:::: /hoon/digitalocean/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://cloud.digitalocean.com/v1/oauth/authorize?response_type=code'
++ exchange-url 'https://cloud.digitalocean.com/v1/oauth/token'
--
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~[%read %write] dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://cloud.digitalocean.com/settings/api/applications/new
:: to get a client id and secret
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/digitalocean.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/digitalocean
:: Enter home this sample command to get your user information:
:: +https://api.digitalocean.com/v2/account
:: Before you receive the response, you'll have to clink on the link.
:: If you successfully auth, you should receive the response in the dojo.

41
sec/com/dropboxapi.hoon Normal file
View File

@ -0,0 +1,41 @@
:: Test url +https://api.dropboxapi.com/2/users/get_current_account &json ~
::
:::: /hoon/dropboxapi/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://www.dropbox.com/1/oauth2/authorize?response_type=code'
++ exchange-url 'https://api.dropboxapi.com/1/oauth2/token'
--
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~ dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://www.dropbox.com/developers-v1/apps to get a
:: client id and secret.
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/dropboxapi.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/dropbox
:: Enter this sample command to show your user info:
:: +https://api.dropboxapi.com/2/users/get_current_account &json ~
:: Before you receive the response, you'll have to click on the link in the
:: dojo to authenticate yourself.
:: You should receive a response listing the contents of that directory.

50
sec/com/facebook.hoon
View File

@ -6,21 +6,37 @@
::
::::
::
=+ ^= aut
%+ oauth2
dialog='https://www.facebook.com/dialog/oauth?response_type=code'
exchange='https://graph.facebook.com/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 key='access_token' value=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 grant-type='fb_exchange_token'
[key='fb_exchange_token' value=access-token]
~
[[%redo ~] ..bak(access-token access-token)]
::++ wyp ~
|%
++ dialog-url 'https://www.facebook.com/dialog/oauth?response_type=code'
++ exchange-url 'https://graph.facebook.com/v2.3/oauth/access_token'
--
::
::::
::
|_ {bal/(bale keys:oauth2) access-token/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut
%+ ~(standard oauth2 bal access-token) .
|=(access-token/token:oauth2 +>(access-token access-token))
::
++ filter-request
%^ out-add-query-param:aut 'access_token'
scope=~['user_about_me' 'user_posts']
dialog-url
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
::
++ receive-auth-response
|= a/httr ^- core-move:aut
?: (bad-response:aut p.a)
[%give a] :: [%redo ~] :: handle 4xx?
=+ `{access-token/@t expires-in/@u}`(grab-expiring-token:aut a)
?. (lth expires-in ^~((div ~d7 ~s1))) :: short-lived token
[[%redo ~] ..bak(access-token access-token)]
:- %send
%^ request-token:aut exchange-url
grant-type='fb_exchange_token'
[key='fb_exchange_token' value=access-token]~
--

3
sec/com/github.hoon
View File

@ -5,5 +5,6 @@
/+ basic-auth
!:
|_ {bal/(bale keys:basic-auth) $~}
++ out (basic-auth bal)
++ aut ~(standard basic-auth bal ~)
++ filter-request out-adding-header:aut
--

58
sec/com/googleapis.hoon
View File

@ -2,7 +2,7 @@
::
:::: /hoon/googleapis/com/sec
::
/+ oauth2
/+ oauth2, interpolate, hep-to-cab
::
::::
::
@ -18,40 +18,38 @@
++ auth-usr
|= usr/iden
=+ lon=(fall (slaw %t usr) usr)
=< .(state-usr &)
%- oauth2
:_ exchange='https://www.googleapis.com/oauth2/v4/token'
^= dialog
%* . (need (epur 'https://accounts.google.com/o/oauth2/v2/auth'))
r
%- fass:oauth2
:~ login-hint+?~(lon '' (crip (rash lon suffix-email)))
access-type+%offline
response-type+%code
prompt+%consent
==
%+ add-query:interpolate 'https://accounts.google.com/o/oauth2/v2/auth'
%- quay:hep-to-cab
:~ 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)
++ scopes
:~ 'https://mail.google.com'
'https://www.googleapis.com/auth/plus.me'
'https://www.googleapis.com/auth/userinfo.email'
==
::
++ 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
++ exchange-url 'https://www.googleapis.com/oauth2/v4/token'
--
!:
::::
::
|_ {bal/(bale keys:oauth2) own/user-state}
:: ++auth is a "standard refreshing oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ auth
=+ a=~(standard-refreshing oauth2 bal ber.own)
(a(state-usr &) ..auth ref.own |=(a/user-state ..auth(own a)))
::
++ filter-request (out-refresh-or-add-header:auth exchange-url scopes dialog-url)
++ dialog-url (auth-usr usr.bal)
::
++ filter-response res-save-after-refresh:auth
::
++ receive-auth-query-string (in-code-to-token:auth exchange-url)
++ receive-auth-response bak-save-both-tokens:auth
:: ++ update *user-state
--

42
sec/com/instagram.hoon Normal file
View File

@ -0,0 +1,42 @@
:: Test url +https://api.instagram.com/v1/users/self
::
:::: /hoon/instagram/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://api.instagram.com/oauth/authorize?response_type=code'
++ exchange-url 'https://api.instagram.com/oauth/access_token'
--
::
::::
::
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request
%^ out-add-query-param:aut 'access_token'
scope=~[%basic]
dialog-url
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://www.instagram.com/developer/ to get a
:: client id and secret
:: Be sure to be on https://localhost:8443, and to have registered
:: http://localhost:8443/~/ac/instagram.com/~./in as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/instagram
:: Enter this sample command to get your user information:
:: +https://api.instagram.com/v1/users/self
:: Before you receive the response, you'll have to clink on the link to
:: authenicate yourself. You should then receive the response.

21
sec/com/slack.hoon
View File

@ -6,13 +6,16 @@
::
::::
::
=+ ^= aut
%+ oauth2
'https://slack.com/oauth/authorize'
'https://slack.com/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)))
|_ {bal/(bale keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request
%^ out-add-query-param:aut 'token'
scope=~[%client %admin]
oauth-dialog='https://slack.com/oauth/authorize'
::
++ receive-auth-query-string (in-code-to-token:aut url='https://slack.com/api/oauth.access')
++ receive-auth-response bak-save-token:aut
--

33
sec/com/twitter.hoon
View File

@ -1,22 +1,27 @@
:: Test url +https://api.twitter.com/1.1/account/verify_credentials.json
::
::
:::: /hoon/twitter/com/sec
::
/+ oauth1
!:
::::
::
=+ ^= aut
%^ oauth1
'https://api.twitter.com/oauth/request_token'
'https://api.twitter.com/oauth/authorize'
'https://api.twitter.com/oauth/access_token'
|_ {(bale keys:oauth1) tok/token:oauth1}
++ aut ~(. ^aut . +<- +<+) :: XX electroplating
++ out out-math:aut
++ in in-oauth-token:aut
++ bak (bak-save-access:aut save-token)
++ res (res-handle-reqt:aut save-token)
++ save-token |=(tok/token:aut +>(tok tok))
::++ wyp ~
|_ {bal/(bale keys:oauth1) tok/token:oauth1}
:: ++aut is a "standard oauth1" core, which implements the
:: most common handling of oauth1 semantics. see lib/oauth1 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth1 bal tok) . |=(tok/token:oauth1 +>(tok tok)))
++ filter-request
%+ out-add-header:aut
token-request='https://api.twitter.com/oauth/request_token'
oauth-dialog='https://api.twitter.com/oauth/authorize'
::
++ filter-response res-handle-request-token:aut
::
++ receive-auth-query-string
%- in-exchange-token:aut
exchange-url='https://api.twitter.com/oauth/access_token'
::
++ receive-auth-response bak-save-token:aut
:: ++ discard-state ~
--

2
sur/down.hoon
View File

@ -3,5 +3,5 @@
::
/? 310
/- markdown
down.markdown
down:markdown

Some files were not shown because too many files have changed in this diff Show More