urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2025-01-06 04:07:23 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'lighter-than-eyre' into monorepo-candidate

Browse Source 
* lighter-than-eyre: (211 commits)
  do nothing but print in %wake error case
  dumb bug fix
  handle %wake error case
  Chat style fix
  Style fix for launch.hoon
  Updated Hoon style of chat, clock, timer
  Fixed bugs found in QA
  Updated publish files
  Updated chat and weather apps to latest
  Fix dumb bug
  All consistent tiling
  Tile titles are consistent
  publish: fixed viewing foreign posts unsubbed
  Don't display dropdown in launch app
  Updated clock, timer, weather tile backgrounds
  update publish and launch css
  Added working read numbers, stopped displaying talk read numbers
  don't federate channels
  updated publish files
  Updated hall, chat, launch, weather, timer
  ...
This commit is contained in:
Joe Bryan 2019-06-27 16:49:47 -07:00
commit bff6d9bdad
159 changed files with 213937 additions and 6401 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.travis/pin-parent-pill-pier.url
View File

@ -1 +1 @@
https://ci-piers.urbit.org/zod-f9000e4ae042dd36f103da8c8f4e997a892b8697.tgz
https://ci-piers.urbit.org/zod-d71780001aed3ba464d8b24f223f6bc597236718.tgz

2
.travis/pin-vere-commit.txt
View File

@ -1 +1 @@
2d571aa1681506e85aa66a3715d0f1bc0298aeba
d0401f0034e348ec1db498f2c7884194d99b6de4

3
.travis/test.js
View File

@ -119,6 +119,9 @@ Promise.resolve(urbit)
.then(function(){
return rePill(urbit);
})
.then(function(){
return urbit.expect(/dojo> /);
})
.then(function(){
return urbit.exit(0);
})

165
app/acme.hoon
View File

@ -12,6 +12,14 @@
::
++ de-base64url
~(de base64 | &)
:: +join-turf
::
++ join-turf
|= hot=(list turf)
^- cord
%+ rap 3
%- (bake join ,[cord wain])
[', ' (turn hot en-turf:html)]
:: |octn: encode/decode unsigned atoms as big-endian octet stream
::
++ octn
@ -23,7 +31,7 @@
::
++ body
|%
+$ acct [id=@t wen=@t sas=@t]
+$ acct [wen=@t sas=@t]
::
+$ order
$: exp=@t
@ -74,7 +82,7 @@
^- $-(json acct:body)
:: ignoring key, contact, initialIp
::
(ot 'id'^no 'createdAt'^json-date 'status'^so ~)
(ot 'createdAt'^json-date 'status'^so ~)
:: +order: parse certificate order
::
++ order
@ -139,11 +147,12 @@
:: +card: output effect payload
::
+$ card
$% [%hiss wire ~ %httr %hiss hiss:eyre]
$% [%connect wire =binding:http-server app=term]
[%http-response =http-event:http]
[%poke wire dock poke]
[%request wire request:http outbound-config:http-client]
[%rule wire %cert (unit [wain wain])]
[%wait wire @da]
[%well wire path (unit mime)]
==
:: +poke: outgoing app pokes
::
@ -385,7 +394,7 @@
++ request
|= [wir=wire req=hiss]
^- card
[%hiss wir ~ %httr %hiss req]
[%request wir (hiss-to-request:html req) *outbound-config:http-client]
:: +signed-request: JWS JSON POST
::
++ signed-request
@ -456,8 +465,8 @@
?~ rod
:: XX shouldn't happen
::
(join '.' /network/arvo/(crip +:(scow %p our.bow)))
(join ', ' (turn ~(tap in dom.u.rod) |=(a=turf (join '.' a))))
(en-turf:html /network/arvo/(crip +:(scow %p our.bow)))
(join-turf ~(tap in dom.u.rod))
'. retrying in ~d7.'
==
(emit (notify msg ~))
@ -473,7 +482,7 @@
' too many certificates issued for '
:: XX get from detail
::
(join '.' /network/arvo)
(en-turf:html /network/arvo)
'. retrying in '
(scot %dr lul) '.'
==
@ -587,7 +596,7 @@
:- %a
%+ turn
~(tap in ~(key by `(map turf *)`u.next-order))
|=(a=turf [%o (my type+s+'dns' value+s+(join '.' a) ~)])
|=(a=turf [%o (my type+s+'dns' value+s+(en-turf:html a) ~)])
==
=/ wire-params [try %new-order /(scot %da now.bow)]
(stateful-request wire-params new-order.dir json)
@ -678,28 +687,6 @@
(emit (request wire i.pending.aut.u.rod %get ~ ~))
:: XX check/finalize-authz ??
::
:: +save-trial: save ACME domain validation challenge to /.well-known/
::
++ save-trial
^+ this
~| %save-trial-effect-fail
?. ?=(^ reg.act) ~|(%no-account !!)
?. ?=(^ rod) ~|(%no-active-order !!)
?. ?=(^ active.aut.u.rod) ~|(%no-active-authz !!)
:: XX revisit wrt rate limits
::
?> ?=(%wake sas.u.rod)
=* aut u.active.aut.u.rod
%- emit
:^ %well
:: XX idx in wire?
::
/acme/save-trial/(scot %da now.bow)
/acme-challenge/[tok.cal.aut]
:+ ~
/text/plain
%- as-octs:mimes:html
(rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~])
:: +test-trial: confirm that ACME domain validation challenge is available
::
++ test-trial
@ -764,7 +751,7 @@
?. ?=(^ next-order)
this
=/ idx (slav %ud i.t.wire)
=/ valid =(200 p.rep)
=/ valid |(=(200 p.rep) =(307 p.rep))
=/ item=(list [=turf idx=@ud valid=?])
(skim ~(tap by u.next-order) |=([turf idx=@ud ?] =(^idx idx)))
?. ?& ?=([^ ~] item)
@ -783,7 +770,7 @@
=/ msg=cord
%+ rap 3
:~ 'unable to reach ' (scot %p our.bow)
' via http at ' (join '.' turf.i.item) ':80'
' via http at ' (en-turf:html turf.i.item) ':80'
==
(emit(next-order ~) (notify msg [(sell !>(rep)) ~]))
?: ?=(~ (skip ~(val by u.next-order) |=([@ud valid=?] valid)))
@ -802,7 +789,7 @@
?~(reg.act register:effect this)
:: +nonce: accept new nonce and trigger next effect
::
:: Nonce has already been saved in +sigh-httr. The next effect
:: Nonce has already been saved in +http-response. The next effect
:: is specified in the wire.
::
++ nonce
@ -978,7 +965,7 @@
=> =/ msg=cord
%+ rap 3
:~ 'received https certificate for '
(join ', ' (turn ~(tap in dom.u.liv) |=(a=turf (join '.' a))))
(join-turf ~(tap in dom.u.liv))
==
(emit (notify msg ~))
:: set renewal timer, install certificate in %eyre
@ -1029,14 +1016,11 @@
pending t.pending.aut.u.rod
active `[idx tau]
==
=< test-trial:effect
save-trial:effect(aut.u.rod rod-aut)
test-trial:effect(aut.u.rod rod-aut)
:: XX check/finalize-authz ??
::
:: +test-trial: accept response from challenge test
::
:: Note that +save-trial:effect has no corresponding event.
::
++ test-trial
|= [wir=wire rep=httr]
~| [%strange-test-trial wir]
@ -1053,7 +1037,7 @@
=/ msg=cord
%+ rap 3
:~ 'unable to retrieve self-hosted domain validation token '
'via ' (join '.' dom.aut) '. '
'via ' (en-turf:html dom.aut) '. '
'please confirm your urbit has network connectivity.'
==
(emit (notify msg [(sell !>(rep)) ~]))
@ -1063,7 +1047,6 @@
?. ?& ?=(^ r.rep)
=(bod u.r.rep)
==
:: XX save-trial again?
:: XX probably a DNS misconfiguration
::
=/ =tang
@ -1147,36 +1130,21 @@
%finalize-trial finalize-trial:fec
==
--
:: +sigh-tang: handle http request failure
::
++ sigh-tang
|= [=wire =tang]
++ http-response
|= [=wire response=client-response:http-client]
^- (quip move _this)
?> ?=([%acme ^] wire)
:: XX may God forgive me for this
:: ignore progress reports
::
?: ?=(%progress -.response)
[~ this]
::
=< abet
=- ?:(?=(%& -.-) p.- this)
%- mule |.
(retry:event t.wire)
:: +sigh-recoverable-error: handle http rate-limit response
::
:: XX we won't receive this unless we request a
:: mark conversion and it fails
::
++ sigh-recoverable-error
|= [=wire %429 %rate-limit lim=(unit @da)]
^- (quip move _this)
~& [%sigh-recoverable wire lim]
?> ?=([%acme ^] wire)
abet:(retry:event t.wire)
:: +sigh-httr: accept http response
::
++ sigh-httr
|= [=wire rep=httr]
^- (quip move _this)
?> ?=([%acme ^] wire)
=< abet
::
?: ?=(%cancel -.response)
(retry:event t.wire)
::
=/ rep=httr (to-httr:http-client +.response)
:: add nonce to pool, if present
::
=/ nonhed (skim q.rep |=((pair @t @t) ?=(%replay-nonce p)))
@ -1197,7 +1165,7 @@
(nonce:effect [act spur])
:: XX replace with :hall notification
::
~| [%sigh-fail wire]
~| [%http-response-fail wire]
%. [spur rep]
?+ act
~&([%unknown-http-response act] !!)
@ -1220,6 +1188,49 @@
:: XX delete-trial?
::
==
:: +poke-handle-http-request: receive incoming http request
::
:: Used to serve the domain validation challenge
::
++ poke-handle-http-request
|= =inbound-request:http-server
^- (quip move _this)
~& [%handle-http +<]
=/ url=(unit (pair pork:eyre quay:eyre))
%+ rush
url.request.inbound-request
;~(plug ;~(pose apat:de-purl:html (easy *pork:eyre)) yque:de-purl:html)
::
?. ?=(^ url)
~| [%invalid-url url.request.inbound-request] !!
?. ?=([%'.well-known' %acme-challenge @ ~] q.p.u.url)
~| [%unknown-url url.request.inbound-request] !!
::
:: XX these crashes should be restored
:: but %rver doesn't get an error notification from %gall
::
:: ?. ?=(^ reg.act) ~|(%no-account !!)
:: ?. ?=(^ rod) ~|(%no-active-order !!)
:: ?. ?=(^ active.aut.u.rod) ~|(%no-active-authz !!)
?. ?& ?=(^ reg.act)
?=(^ rod)
?=(^ active.aut.u.rod)
==
=/ =move [ost.bow %http-response %start [%500 ~] ~ %.y]
[[move ~] this]
::
=/ challenge i.t.t.q.p.u.url
=* aut u.active.aut.u.rod
?. =(tok.cal.aut challenge)
=/ =move [ost.bow %http-response %start [%404 ~] ~ %.y]
[[move ~] this]
=/ =move
=/ hed ['content-type' '/text/plain']~
=/ bod
%- some %- as-octs:mimes:html
(rap 3 [tok.cal.aut '.' (pass:thumb:jwk key.act) ~])
[ost.bow %http-response %start [%200 hed] bod %.y]
[[move ~] this]
:: +wake: timer wakeup event
::
++ wake
@ -1257,7 +1268,7 @@
~& [%cert `wain`cer.u.liv]
~& [%expires exp.u.liv]
~& :- %domains
(join ', ' (turn ~(tap in dom.u.liv) |=(a=turf (join '.' a))))
(join-turf ~(tap in dom.u.liv))
this
::
%dbug-history
@ -1297,8 +1308,20 @@
|= old=(unit acme)
^- (quip move _this)
?~ old
[~ this]
=/ =move
[ost.bow %connect /acme [~ /'.well-known'/acme-challenge] %acme]
[[move ~] this]
[~ this(+<+ u.old)]
:: +bound: response to %connect binding request
::
++ bound
|= [=wire accepted=? =binding:http-server]
?: accepted
[~ this]
:: XX better error message
::
~& [%acme-http-path-binding-failed +<]
[~ this]
:: +rekey: create new 2.048 bit RSA key
::
:: XX do something about this iteration
@ -1367,7 +1390,7 @@
=/ msg=cord
%+ rap 3
:~ 'requesting an https certificate for '
(join ', ' (turn ~(tap in dom) |=(a=turf (join '.' a))))
(join-turf ~(tap in dom))
==
(emit (notify msg ~))
:: if registered, create order

2
app/aqua-eyre.hoon
View File

@ -137,7 +137,7 @@
..abet-pe
=. http-requests (~(del in http-requests) num)
=. this
(emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]]~)
(emit-aqua-events [%event who [//http/0v1n.2m9vh %receive num [%start [p.res q.res] r.res &]]]~)
..abet-pe
::
:: Got error in HTTP response

2
app/aqua.hoon
View File

@ -474,7 +474,7 @@
%event
~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae))
raw-event=[who.ae -.q.ue.ae]
~? &(debug=| ?=(%they -.q.ue.ae))
~? &(debug=| ?=(%receive -.q.ue.ae))
raw-event=[who.ae ue.ae]
(push-events:(pe who.ae) [ue.ae]~)
==

615
app/chat.hoon Normal file
View File

@ -0,0 +1,615 @@
/- hall
/+ *server, chat, hall-json
/= index
/^ octs
/; as-octs:mimes:html
/: /===/app/chat/index
/| /html/
/~ ~
==
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/chat/js/tile
/| /js/
/~ ~
==
/= script
/^ octs
/; as-octs:mimes:html
/: /===/app/chat/js/index
/| /js/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
/: /===/app/chat/css/index
/| /css/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
/: /===/app/chat/css/index
/| /css/
/~ ~
==
/= chat-png
/^ (map knot @)
/: /===/app/chat/img /_ /png/
::
=, chat
::
|_ [bol=bowl:gall sta=state]
::
++ this .
::
:: +prep: set up the app, migrate the state once started
::
++ prep
|= old=(unit state)
^- (quip move _this)
=/ launchnoun [%noun [%chat /chattile '/~chat/js/tile.js']]
?~ old
=/ inboxpat /circle/inbox/config/group
=/ circlespat /circles/[(scot %p our.bol)]
=/ inboxwir /circle/[(scot %p our.bol)]/inbox/config/group
=/ inboxi/poke
:- %hall-action
[%source %inbox %.y (silt [[our.bol %i] ~]~)]
:_ this
:~ [ost.bol %peer inboxwir [our.bol %hall] inboxpat]
[ost.bol %peer circlespat [our.bol %hall] circlespat]
[ost.bol %connect / [~ /'~chat'] %chat]
[ost.bol %poke /chat [our.bol %hall] inboxi]
[ost.bol %poke /chat [our.bol %launch] launchnoun]
==
:- [ost.bol %poke /chat [our.bol %launch] launchnoun]~
this(sta u.old)
::
::
::
++ construct-tile-json
|= str=streams
^- json
=/ numbers/(list [circle:hall @ud])
%+ turn ~(tap by messages.str)
|= [cir=circle:hall lis=(list envelope:hall)]
^- [circle:hall @ud]
?~ lis
[cir 0]
=/ last (snag (dec (lent lis)) `(list envelope:hall)`lis)
[cir (add num.last 1)]
=/ maptjson=(map @t json)
%- my
:~ ['config' (config-to-json str)]
['numbers' (numbers-to-json numbers)]
==
[%o maptjson]
::
++ peer-chattile
|= wir=wire
^- (quip move _this)
:_ this
[ost.bol %diff %json (construct-tile-json str.sta)]~
::
:: +peer-messages: subscribe to subset of messages and updates
::
::
++ peer-primary
|= wir=wire
^- (quip move _this)
~& (lent (prey:pubsub:userlib /primary bol))
=* messages messages.str.sta
=/ lismov/(list move)
%+ murn ~(tap by messages)
|= [cir=circle:hall lis=(list envelope:hall)]
^- (unit move)
=/ envs/(unit (list envelope:hall)) (~(get by messages) cir)
?~ envs
~
=/ length/@ (lent u.envs)
=/ start/@
?: (gte length 100)
(sub length 100)
0
=/ end/@ length
=/ offset/@ (sub end start)
:- ~
:* ost.bol
%diff
%chat-update
[%messages cir start end (swag [start offset] u.envs)]
==
:_ this
[[ost.bol %diff %chat-config str.sta] lismov]
::
:: +poke-chat: send us an action
::
++ poke-chat-action
|= act=action:chat
^- (quip move _this)
:_ this
%+ turn lis.act
|= hac=action:hall
^- move
:* ost.bol
%poke
/p/[(scot %da now.bol)]
[our.bol %hall]
[%hall-action hac]
==
::
:: +send-chat-update: utility func for sending updates to all our subscribers
::
++ send-chat-update
|= [upd=update str=streams]
^- (list move)
=/ updates/(list move)
%+ turn (prey:pubsub:userlib /primary bol)
|= [=bone *]
[bone %diff %chat-update upd]
::
=/ tile-updates/(list move)
%+ turn (prey:pubsub:userlib /chattile bol)
|= [=bone *]
[bone %diff %json (construct-tile-json str)]
::
%+ weld
updates
tile-updates
::
::
:: +hall arms
::
::
:: +diff-hall-prize: handle full state initially handed to us by hall
::
++ diff-hall-prize
|= [wir=wire piz=prize:hall]
^- (quip move _this)
?~ wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
?+ i.wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
::
:: %circles wire
::
%circles
?> ?=(%circles -.piz)
=/ str %= str.sta
circles cis.piz
==
:- (send-chat-update [[%circles cis.piz] str])
this(str.sta str)
::
:: %circle wire
::
%circle
:: ::
:: :: %circle prize
:: ::
:: %circle
?> ?=(%circle -.piz)
=/ circle/circle:hall [our.bol &3:wir]
?: =(circle [our.bol %inbox])
::
:: fill inbox config and remote configs with prize data
::
=/ configs
%- ~(uni in configs.str.sta)
^- (map circle:hall (unit config:hall))
(~(run by rem.cos.piz) |=(a=config:hall `a))
::
=/ circles/(list circle:hall)
%+ turn ~(tap in src.loc.cos.piz)
|= src=source:hall
^- circle:hall
cir.src
::
=/ meslis/(list [circle:hall (list envelope:hall)])
%+ turn circles
|= cir=circle:hall
^- [circle:hall (list envelope:hall)]
[cir ~]
::
=/ localpeers/(set @p)
%- silt %+ turn ~(tap by loc.pes.piz)
|= [shp=@p stat=status:hall]
shp
::
=/ peers/(map circle:hall (set @p))
%- ~(rep by rem.pes.piz)
|= [[cir=circle:hall grp=group:hall] acc=(map circle:hall (set @p))]
^- (map circle:hall (set @p))
=/ newset
%- silt %+ turn ~(tap by grp)
|= [shp=@p stat=status:hall]
shp
(~(put by acc) cir newset)
::
:-
%+ turn ~(tap in (~(del in (silt circles)) [our.bol %inbox]))
|= cir=circle:hall
^- move
=/ wir/wire /circle/[(scot %p our.bol)]/[nom.cir]/config/group
=/ pat/path /circle/[nom.cir]/config/group
[ost.bol %peer wir [our.bol %hall] pat]
::
%= this
inbox.str.sta loc.cos.piz
configs.str.sta configs
messages.str.sta (molt meslis)
peers.str.sta (~(put by peers) [our.bol %inbox] localpeers)
==
::
:: fill remote configs with message data
::
=* messages messages.str.sta
=/ circle/circle:hall [`@p`(slav %p &2:wir) &3:wir]
=/ localpeers/(set @p)
%- silt %+ turn ~(tap by loc.pes.piz)
|= [shp=@p stat=status:hall]
shp
::
=/ peers/(map circle:hall (set @p))
%- ~(rep by rem.pes.piz)
|= [[cir=circle:hall grp=group:hall] acc=(map circle:hall (set @p))]
^- (map circle:hall (set @p))
=/ newset
%- silt %+ turn ~(tap by grp)
|= [shp=@p stat=status:hall]
shp
(~(put by acc) cir newset)
~& nes.piz
=/ str
%= str.sta
messages (~(put by messages) circle nes.piz)
peers (~(uni by peers.str.sta) (~(put by peers) circle localpeers))
==
=/ messageupdate/update
:* %messages
circle
0
(lent messages)
nes.piz
==
:- (send-chat-update [messageupdate str])
this(str.sta str)
==
::
:: +diff-hall-rumor: handle updates to hall state
::
++ diff-hall-rumor
|= [wir=wire rum=rumor:hall]
^- (quip move _this)
?~ wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
?+ i.wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
::
:: %circles
%circles
?> ?=(%circles -.rum)
=/ cis
?: add.rum
(~(put in circles.str.sta) cir.rum)
(~(del in circles.str.sta) cir.rum)
=/ str
%= str.sta
circles cis
peers
?: add.rum
(~(put by peers.str.sta) [our.bol cir.rum] ~)
(~(del by peers.str.sta) [our.bol cir.rum])
==
:- (send-chat-update [[%circles cis] str])
this(str.sta str)
::
::
:: %circle: fill remote configs with message data
::
%circle
?> ?=(%circle -.rum)
=* sto rum.rum
?+ -.sto
[~ this]
::
:: %gram:
::
%gram
?> ?=(%gram -.sto)
=* messages messages.str.sta
=/ circle/circle:hall [`@p`(slav %p &2:wir) &3:wir]
=/ unes/(unit (list envelope:hall)) (~(get by messages) circle)
?~ unes
[~ this]
=/ nes u.unes
=/ str
%= str.sta
messages (~(put by messages) circle (snoc nes nev.sto))
==
:- (send-chat-update [[%message circle nev.sto] str])
this(str.sta str)
::
:: %status:
::
%status
?> ?=(%status -.sto)
=/ upeers/(unit (set @p)) (~(get by peers.str.sta) cir.sto)
?~ upeers
[~ this]
=/ peers/(set @p)
?: =(%remove -.dif.sto)
(~(del in u.upeers) who.sto)
(~(put in u.upeers) who.sto)
=/ str
%= str.sta
peers (~(put by peers.str.sta) cir.sto peers)
==
:- (send-chat-update [[%peers cir.sto peers] str])
this(str.sta str)
::
:: %config: config has changed
::
%config
=* circ cir.sto
::
?+ -.dif.sto
[~ this]
::
:: %full: set all of config without side effects
::
%full
=* conf cof.dif.sto
=/ str
%= str.sta
configs (~(put by configs.str.sta) circ `conf)
==
:- (send-chat-update [[%config circ conf] str])
this(str.sta str)
::
:: %read: the read count of one of our configs has changed
::
%read
?: =(circ [our.bol %inbox])
:: ignore when circ is inbox
[~ this]
=/ uconf/(unit config:hall) (~(got by configs.str.sta) circ)
?~ uconf
:: should we crash?
[~ this]
=/ conf/config:hall
%= u.uconf
red red.dif.sto
==
=/ str
%= str.sta
configs (~(put by configs.str.sta) circ `conf)
==
:- (send-chat-update [[%config circ conf] str])
this(str.sta str)
::
:: %source: the sources of our inbox have changed
::
%source
?. =(circ [our.bol %inbox])
:: ignore when circ is not inbox
[~ this]
=* affectedcir cir.src.dif.sto
=/ newwir/wire
/circle/[(scot %p hos.affectedcir)]/[nom.affectedcir]/grams/0/config/group
=/ pat/path /circle/[nom.affectedcir]/grams/0/config/group
:: we've added a source to our inbox
::
?: add.dif.sto
=/ newinbox %= inbox.str.sta
src (~(put in src.inbox.str.sta) src.dif.sto)
==
=/ str
%= str.sta
inbox newinbox
::
configs
?: (~(has by configs.str.sta) affectedcir)
configs.str.sta
(~(put by configs.str.sta) affectedcir ~)
==
::
:_ this(str.sta str)
%+ weld
[ost.bol %peer newwir [hos.affectedcir %hall] pat]~
(send-chat-update [[%inbox newinbox] str])
::
=/ newinbox %= inbox.str.sta
src (~(del in src.inbox.str.sta) src.dif.sto)
==
:: we've removed a source from our inbox
::
=/ str
%= str.sta
inbox newinbox
::
configs (~(del by configs.str.sta) affectedcir)
messages (~(del by messages.str.sta) affectedcir)
peers (~(del by peers.str.sta) affectedcir)
==
=/ fakecir/circle:hall
:- our.bol
%- crip
%+ weld (trip 'hall-internal-') (trip nom.affectedcir)
::
?~ (~(get by configs.str) fakecir)
:: just forward the delete to our clients
::
:_ this(str.sta str)
%+ weld
[ost.bol %pull newwir [hos.affectedcir %hall] ~]~
%+ weld
(send-chat-update [[%inbox newinbox] str])
(send-chat-update [[%delete affectedcir] str])
:: if we get a delete from another ship, delete our fake circle copy
::
~& %deletefake
=/ deletefake/poke
:- %hall-action
[%delete nom.fakecir ~]
:_ this(str.sta str)
%+ weld
[ost.bol %pull newwir [hos.affectedcir %hall] ~]~
%+ weld
[ost.bol %poke /fake [our.bol %hall] deletefake]~
%+ weld
(send-chat-update [[%inbox newinbox] str])
(send-chat-update [[%delete affectedcir] str])
::
==
:: end of branching on dif.sto type
==
:: end of branching on sto type
==
:: end of i.wir branching
::
:: +lient arms
::
::
:: +bound: lient tells us we successfully bound our server to the ~chat url
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
:: +poke-handle-http-request: serve pages from file system based on URl path
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:http-server
^- (quip move _this)
::
=+ request-line=(parse-request-line url.request.inbound-request)
=/ name=@t
=+ back-path=(flop site.request-line)
?~ back-path
''
i.back-path
?: =(name 'tile')
[[ost.bol %http-response (js-response:app tile-js)]~ this]
?+ site.request-line
:_ this
[ost.bol %http-response not-found:app]~
::
:: styling
::
[%'~chat' %css %index ~]
:_ this
[ost.bol %http-response (css-response:app style)]~
::
:: javascript
::
[%'~chat' %js %index ~]
:_ this
[ost.bol %http-response (js-response:app script)]~
::
:: images
::
[%'~chat' %img *]
=/ img (as-octs:mimes:html (~(got by chat-png) `@ta`name))
:_ this
[ost.bol %http-response (png-response:app img)]~
::
:: paginated message data
::
[%'~chat' %scroll @t @t @t @t ~]
=/ cir/circle:hall [(slav %p &3:site.request-line) &4:site.request-line]
=/ start/@ud (need (rush &5:site.request-line dem))
=/ parsedend/@ud (need (rush &6:site.request-line dem))
=* messages messages.str.sta
=/ envs/(unit (list envelope:hall)) (~(get by messages) cir)
?~ envs
[~ this]
?: (gte start (lent u.envs))
[~ this]
=/ end/@
?: (gte parsedend (lent u.envs))
(dec (lent u.envs))
parsedend
=/ offset (sub end start)
=/ jon/json %- msg-to-json
:* %messages
cir
start
end
(swag [start offset] u.envs)
==
:_ this
[ost.bol %http-response (json-response:app (json-to-octs jon))]~
::
::
:: inbox page
::
[%'~chat' *]
:_ this
[ost.bol %http-response (html-response:app index)]~
==
::
::
:: +subscription-retry arms
::
::
:: +reap: recieve acknowledgement for peer, retry on failure
::
++ reap
|= [wir=wire err=(unit tang)]
^- (quip move _this)
?~ err
[~ this]
?~ wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
?+ i.wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
::
%circle
=/ shp/@p (slav %p &2:wir)
=/ pat /circle/[&3:wir]/config/group
?: =(&3:wir 'inbox')
:_ this
[ost.bol %peer wir [shp %hall] pat]~
?: (~(has in src.inbox.str.sta) [[shp &3:wir] ~])
:_ this
[ost.bol %peer wir [shp %hall] pat]~
[~ this]
::
%circles
:_ this
[ost.bol %peer wir [our.bol %hall] wir]~
==
::
:: +quit: subscription failed/quit at some point, retry
::
++ quit
|= wir=wire
^- (quip move _this)
?~ wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
?+ i.wir
(mean [leaf+"invalid wire for diff: {(spud wir)}"]~)
::
%circle
=/ shp/@p (slav %p &2:wir)
=/ pat /circle/[&3:wir]/config/group
?: =(&3:wir 'inbox')
:_ this
[ost.bol %peer wir [shp %hall] pat]~
?: (~(has in src.inbox.str.sta) [[shp &3:wir] ~])
:_ this
[ost.bol %peer wir [shp %hall] pat]~
[~ this]
::
%circles
:_ this
[ost.bol %peer wir [our.bol %hall] wir]~
==
::
--

2
app/chat/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
app/chat/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 255 B

BIN
app/chat/img/Icon-Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 255 B

BIN
app/chat/img/Send.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1010 B

BIN
app/chat/img/Tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

16
app/chat/index.html Normal file
View File

@ -0,0 +1,16 @@
<!doctype html>
<html>
<head>
<title>Chat</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~chat/css/index.css" />
</head>
<body>
<div id="root" />
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~chat/js/index.js"></script>
</body>
</html>

58098
app/chat/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

19399
app/chat/js/tile.js Normal file
View File

File diff suppressed because it is too large Load Diff

79
app/clock.hoon Normal file
View File

@ -0,0 +1,79 @@
/+ *server
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/clock/js/tile
/| /js/
/~ ~
==
=, format
::
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ poke
$% [%noun [@tas path @t]]
==
::
+$ card
$% [%poke wire dock poke]
[%http-response =http-event:http]
[%connect wire binding:http-server term]
[%diff %json json]
==
::
--
::
|_ [bol=bowl:gall ~]
::
++ this .
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ prep
|= old=(unit ~)
^- (quip move _this)
=/ launchnoun [%noun [%clock /tile '/~clock/js/tile.js']]
:_ this
:~
[ost.bol %connect / [~ /'~clock'] %clock]
[ost.bol %poke /clock [our.bol %launch] launchnoun]
==
::
++ peer-tile
|= pax=path
^- (quip move _this)
[[ost.bol %diff %json *json]~ this]
::
++ send-tile-diff
|= jon=json
^- (list move)
%+ turn (prey:pubsub:userlib /tile bol)
|= [=bone ^]
[bone %diff %json jon]
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:http-server
^- (quip move _this)
=/ request-line (parse-request-line url.request.inbound-request)
=/ back-path (flop site.request-line)
=/ name=@t
=/ back-path (flop site.request-line)
?~ back-path
''
i.back-path
::
?~ back-path
[[ost.bol %http-response not-found:app]~ this]
?: =(name 'tile')
[[ost.bol %http-response (js-response:app tile-js)]~ this]
[[ost.bol %http-response not-found:app]~ this]
::
--

2379
app/clock/js/tile.js Normal file
View File

File diff suppressed because it is too large Load Diff

14
app/curl.hoon
View File

@ -1,14 +0,0 @@
::
:::: /hoon/curl/app
::
/? 310
::
|_ {{^ ^ ost/@ ^} ~}
++ poke |*(a/{mark *} :_(+> [ost %hiss / `~ %wain a]~))
::++ poke-purl |=(a/purl :_(+> [ost %hiss / %wain %purl a]~))
++ poke-tape |=(a/tape (poke %purl (scan a auri:de-purl:html)))
++ poke-hiss |=(a/hiss:eyre (poke %hiss a))
++ poke-noun poke-hiss
++ sigh-wain |=({* a/wain} ~&(a `+>))
++ sigh-tang |=({* a/tang} (mean a))
--

895
app/dns-bind.hoon Normal file
View File

@ -0,0 +1,895 @@
/- *dns-bind, dns, hall
/+ tapp, stdio
::
:: tapp types and boilerplate
::
=> |%
++ collector-app `dock`[~zod %dns-collector]
+$ app-state
$: %0
:: nem: authoritative state
::
nem=(unit nameserver)
==
+$ peek-data _!!
+$ in-poke-data
$% [%dns-authority =authority]
[%dns-bind =ship =target]
[%handle-http-request =inbound-request:http-server]
==
+$ out-poke-data
$% [%dns-bind =ship =target]
[%dns-complete =ship =binding:dns]
[%drum-unlink =dock]
==
+$ in-peer-data
$% [%dns-request =request:dns]
==
+$ out-peer-data ~
++ tapp
%: ^tapp
app-state
peek-data
in-poke-data
out-poke-data
in-peer-data
out-peer-data
==
++ tapp-async tapp-async:tapp
++ stdio (^stdio out-poke-data out-peer-data)
--
::
:: oauth2 implementation
::
=> |%
:: +oauth2-config: as one would expect
::
+$ oauth2-config
$: auth-url=@t
exchange-url=@t
domain=turf
initial-path=path
redirect-path=path
scopes=(list @t)
==
:: +oauth2: library core
::
++ oauth2
|_ [our=@p now=@da config=oauth2-config code=@t =hart:eyre secrets=@t]
::
++ local-uri
|= [our=ship =path]
^- @t
:: XX can't scry in +mule
::
:: =/ =hart:eyre .^(hart:eyre %r /(scot %p our)/host/real)
(crip (en-purl:html [hart [~ path] ~]))
::
:: XX can't scry in +mule
::
:: ++ code
:: ^- @t
:: %- crip
:: +:(scow %p .^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our)))
::
:: to initialize these values: |init-oauth2 /com/googleapis
::
++ oauth2-secrets
^- [client-id=@t client-secret=@t]
=; =wain
?> ?=([@t @t ~] wain)
[i.wain i.t.wain]
::
%- to-wain:format
%- need
%+ de:crub:crypto code
%+ slav %uw
:: XX can't scry in +mule
::
:: .^(@ %cx :(weld /(scot %p our)/home/(scot %da now)/sec domain.config /atom))
secrets
::
++ initial-uri (local-uri our initial-path.config)
++ redirect-uri (local-uri our redirect-path.config)
::
++ redirect-to-provider
^- @t
=/ url (need (de-purl:html auth-url.config))
=. r.url
:* ['access_type' 'offline']
['response_type' 'code']
['prompt' 'consent']
['client_id' client-id:oauth2-secrets]
['redirect_uri' redirect-uri]
['scope' (rap 3 (join ' ' scopes.config))]
r.url
==
(crip (en-purl:html url))
::
++ retrieve-access-token
|= code=@t
^- request:http
=/ hed
:~ ['Accept' 'application/json']
['Content-Type' 'application/x-www-form-urlencoded']
==
=/ bod
%- some %- as-octt:mimes:html
%- tail %- tail:en-purl:html
:~ ['client_id' client-id:oauth2-secrets]
:: note: required, unused parameter
::
['redirect_uri' redirect-uri]
['client_secret' client-secret:oauth2-secrets]
['grant_type' 'authorization_code']
['code' code]
==
[%'POST' exchange-url.config hed bod]
::
++ parse-token-response
|= =octs
^- (unit [access=@t expires=@u refresh=@t])
%. q.octs
;~ biff
de-json:html
=, dejs-soft:format
(ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~)
==
:: XX implement
::
++ refresh-token !!
--
--
::
:: helpers
::
=> |%
:: +name: fully-qualified domain name for :ship
::
++ name
|= [=ship =turf]
(cat 3 (en-turf:html (weld turf /(crip +:(scow %p ship)))) '.')
:: +lame: domain name for :ship (without trailing '.')
::
++ lame
|= [=ship =turf]
(en-turf:html (weld turf /(crip +:(scow %p ship))))
:: +endpoint: append :path to :purl
::
++ endpoint
|= [=purl:eyre =path]
^+ purl
purl(q.q (weld q.q.purl path))
:: +params: append :params to :purl
::
++ params
|= [=purl:eyre =quay:eyre]
^+ purl
purl(r (weld r.purl quay))
:: +json-octs: deserialize json and apply reparser
::
++ json-octs
|* [bod=octs wit=fist:dejs:format]
=/ jon (de-json:html q.bod)
?~ jon ~
(wit u.jon)
:: +ship-turf: parse ship from first subdomain
::
++ ship-turf
|= [nam=@t aut-dom=turf]
^- (unit ship)
=/ dom=(unit host:eyre)
(rush nam ;~(sfix thos:de-purl:html dot))
?: ?| ?=(~ dom)
?=(%| -.u.dom)
?=(~ p.u.dom)
==
~
=/ who
(rush (head (flop p.u.dom)) fed:ag)
?~ who ~
?. =(aut-dom (flop (tail (flop p.u.dom))))
~
:: galaxies always excluded
::
?: ?=(%czar (clan:title u.who))
~
who
--
::
:: service providers
::
=> |%
:: +provider: initialize provider-specific core
::
++ provider
|= aut=authority
?- -.pro.aut
%fcloud ~(. fcloud aut)
%gcloud ~(. gcloud aut)
==
:: |fcloud: Cloudflare provider
::
++ fcloud
=> |%
++ parse-raw-record
|= aut-dom=turf
^- $- json
(unit [=ship id=@ta tar=target])
=, dejs:format
%+ cu
|= [id=@t typ=@t nam=@t dat=@t]
^- (unit [=ship id=@ta tar=target])
:: XX fix this
::
=/ him (ship-turf (cat 3 nam '.') aut-dom)
?: ?=(~ him)
~
?+ typ
~
::
%'A'
=/ adr (rush dat lip:ag)
?~ adr ~
`[u.him `@ta`id %direct %if u.adr]
::
%'CNAME'
:: XX fix this
::
=/ for (ship-turf (cat 3 dat '.') aut-dom)
?~ for ~
`[u.him `@ta`id %indirect u.for]
==
:: XX parse dates, proxied, ttl?
::
%- ot :~
'id'^so
'type'^so
'name'^so
'content'^so
==
--
::
|_ aut=authority
:: +base: provider service endpoint
::
++ base
^- purl:eyre
(need (de-purl:html 'https://api.cloudflare.com/client/v4'))
:: +headers: standard HTTP headers for all |fcloud requests
::
++ headers
|= aut=authority
?> ?=(%fcloud -.pro.aut)
%- ~(gas by *math:eyre)
:~ ['Content-Type' ['application/json' ~]]
['X-Auth-Email' [email.auth.pro.aut ~]]
['X-Auth-Key' [key.auth.pro.aut ~]]
==
:: +zone: provider-specific zone info request
::
++ zone
^- hiss:eyre
?> ?=(%fcloud -.pro.aut)
[(endpoint base /zones/[zone.pro.aut]) %get (headers aut) ~]
:: +record: JSON-formatted provider-specific dns record
::
++ record
|= [him=ship tar=target]
^- json
?> ?=(%fcloud -.pro.aut)
=/ type
?:(?=(%direct -.tar) 'A' 'CNAME')
=/ data
?: ?=(%direct -.tar)
(crip +:(scow %if p.tar))
(lame p.tar dom.aut)
:- %o
%- ~(gas by *(map @t json))
:~ ['name' %s (lame him dom.aut)]
['type' %s type]
['content' %s data]
:: XX make configureable?
::
['ttl' %n ~.1]
['proxied' %b %.n]
==
:: +create: provider-specific record-creation request
::
++ create
|= [him=ship tar=target pre=(unit [id=@ta tar=target])]
^- hiss:eyre
?> ?=(%fcloud -.pro.aut)
=/ bod=octs
%- as-octt:mimes:html
%- en-json:html
(record him tar)
?~ pre
:- (endpoint base /zones/[zone.pro.aut]/['dns_records'])
[%post (headers aut) `bod]
:- (endpoint base /zones/[zone.pro.aut]/['dns_records']/[id.u.pre])
[%put (headers aut) `bod]
:: +existing: list existing records stored by provider
::
++ existing
|= page=(unit @t)
^- hiss:eyre
?> ?=(%fcloud -.pro.aut)
:: XX more url params:
:: ?type ?per-page ?order ?direction
::
:- %+ params
(endpoint base /zones/[zone.pro.aut]/['dns_records'])
?~(page ~ ['page' u.page]~)
[%get (headers aut) ~]
:: +parse-list: existing records stored by provider
::
++ parse-list
^- $- json
(pair (list [=ship id=@ta tar=target]) (unit @t))
?> ?=(%fcloud -.pro.aut)
=, dejs:format
%+ cu
|= $: success=?
response=(list (unit [=ship id=@ta tar=target]))
paginate=[page=@ud per-page=@ud count=@ud total-count=@ud]
==
^- (pair (list [=ship id=@ta tar=target]) (unit @t))
?. success [~ ~]
:- (murn response same)
:: XX calculate next page number if applicable
::
~
:: XX parse errors and messages?
::
%- ot :~
'success'^bo
'result'^(ar (parse-raw-record dom.aut))
:- 'result_info'
%- ot :~
'page'^ni
'per_page'^ni
'count'^ni
'total_count'^ni
==
==
:: +parse-record: single record stored by provider
::
++ parse-record
^- $- json
(unit [=ship id=@ta tar=target])
?> ?=(%fcloud -.pro.aut)
=, dejs:format
%+ cu
|= [success=? response=(unit [=ship id=@ta tar=target])]
^- (unit [=ship id=@ta tar=target])
?. success ~
response
:: XX parse errors and messages?
::
%- ot :~
'success'^bo
'result'^(parse-raw-record dom.aut)
==
--
:: |gcloud: GCP provider
::
++ gcloud
|_ aut=authority
:: +base: provider service endpoint
::
++ base
^- purl:eyre
(need (de-purl:html 'https://www.googleapis.com/dns/v1/projects'))
:: +headers: standard HTTP headers for all |gcloud requests
::
++ headers
|= aut=authority
?> ?=(%gcloud -.pro.aut)
?. ?=(^ auth.pro.aut)
~| %gcloud-missing-auth !!
%- ~(gas by *math:eyre)
:~ ['Content-Type' ['application/json' ~]]
['Authorization' [`@t`(cat 3 'Bearer ' access.u.auth.pro.aut) ~]]
==
:: +zone: provider-specific zone info request
::
++ zone
^- hiss:eyre
?> ?=(%gcloud -.pro.aut)
:- (endpoint base /[project.pro.aut]/['managedZones']/[zone.pro.aut])
[%get (headers aut) ~]
:: +record: JSON-formatted provider-specific dns record
::
++ record
|= [him=ship tar=target]
^- json
?> ?=(%gcloud -.pro.aut)
=/ type
?:(?=(%direct -.tar) 'A' 'CNAME')
=/ data
?: ?=(%direct -.tar)
[%s (crip +:(scow %if p.tar))]
[%s (name p.tar dom.aut)]
:- %o
%- ~(gas by *(map @t json))
:~ ['name' %s (name him dom.aut)]
['type' %s type]
:: XX make configureable?
::
['ttl' %n ~.300]
['rrdatas' %a data ~]
==
:: +create: provider-specific record-creation request
::
++ create
=, eyre
|= [him=ship tar=target pre=(unit [id=@ta tar=target])]
^- hiss
?> ?=(%gcloud -.pro.aut)
=/ url=purl
%+ endpoint base
/[project.pro.aut]/['managedZones']/[zone.pro.aut]/changes
=/ bod=octs
%- as-octt:mimes:html
%- en-json:html
:- %o
%- ~(gas by *(map @t json))
:- ['additions' %a (record him tar) ~]
?~ pre ~
[['deletions' %a (record him tar.u.pre) ~] ~]
[url %post (headers aut) `bod]
:: +existing: list existing records stored by provider
::
++ existing
=, eyre
|= page=(unit @t)
^- hiss
?> ?=(%gcloud -.pro.aut)
=/ url=purl
%+ endpoint base
/[project.pro.aut]/['managedZones']/[zone.pro.aut]/rrsets
=/ hed=math (headers aut)
=? hed ?=(^ page)
(~(put by hed) 'pageToken' [u.page]~)
[url %get hed ~]
:: +parse-list: existing records stored by provider
::
++ parse-list
^- $- json
(pair (list [=ship id=@ta tar=target]) (unit @t))
?> ?=(%gcloud -.pro.aut)
=, dejs:format
=> |%
++ page (uf ~ (mu so))
++ records
%+ uf ~
%+ cu
|*(a=(list (unit)) (murn a same))
(ar parse-record)
--
:: XX parse but don't produce
:: 'kind'^(su (jest "dns#resourceRecordSetsListResponse'))
::
(ou 'rrsets'^records 'nextPageToken'^page ~)
:: +parse-record: single record stored by provider
::
++ parse-record
^- $- json
(unit [=ship id=@ta tar=target])
?> ?=(%gcloud -.pro.aut)
=, dejs:format
%+ cu
|= [typ=@t nam=@t dat=(list @t)]
^- (unit [=ship id=@ta tar=target])
:: gcloud doesn't expose UUIDs for bindings
::
=/ id %$
=/ him (ship-turf nam dom.aut)
?: |(?=(~ him) ?=(~ dat) ?=(^ t.dat))
~
?+ typ
~
::
%'A'
=/ adr (rush i.dat lip:ag)
?~ adr ~
`[u.him id %direct %if u.adr]
::
%'CNAME'
=/ for (ship-turf i.dat dom.aut)
?~ for ~
`[u.him id %indirect u.for]
==
::
%- ot :~
:: 'kind'^(su (jest "dns#resourceRecordSet'))
::
'type'^so
'name'^so
'rrdatas'^(ar so)
==
--
--
::
:: monadic helpers (XX move to stdio?)
::
=> |%
:: +backoff: exponential backoff timer
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (async:stdio ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy:stdio
;< now=@da bind:m get-time:stdio
%- wait:stdio
%+ add now
%+ min limit
?: =(0 try) ~s0
%+ add
(mul ~s1 (bex (dec try)))
(mul ~s0..0001 (~(rad og eny) 1.000))
::
++ request
|= =hiss:eyre
=/ m (async:stdio (unit httr:eyre))
^- form:m
;< ~ bind:m (send-hiss:stdio hiss)
take-maybe-sigh:stdio
::
++ request-retry
|= [=hiss:eyre max=@ud limit=@dr]
=/ m (async:stdio (unit httr:eyre))
=/ try=@ud 0
|- ^- form:m
=* loop $
?: =(try max)
(pure:m ~)
;< ~ bind:m (backoff try limit)
;< rep=(unit httr:eyre) bind:m (request hiss)
:: XX needs a better predicate. LTE will make this easier
::
?: &(?=(^ rep) =(200 p.u.rep))
(pure:m (some u.rep))
loop(try +(try))
--
::
:: application actions
::
=> |%
++ confirm-authority
|= =authority
=/ m (async:stdio ?)
^- form:m
;< rep=(unit httr:eyre) bind:m
(request-retry zone:(provider authority) 5 ~m10)
(pure:m &(?=(^ rep) =(200 p.u.rep)))
::
++ retrieve-existing
|= =authority
=/ m (async:stdio (map ship bound))
^- form:m
=| existing=(map ship bound)
=| next-page=(unit @t)
;< now=@da bind:m get-time:stdio
|- ^- form:m
=* loop $
;< rep=(unit httr:eyre) bind:m
(request-retry (existing:(provider authority) next-page) 5 ~m10)
?: ?| ?=(~ rep)
?=(~ r.u.rep)
==
(pure:m existing)
::
=* octs u.r.u.rep
=+ ^- [dat=(list [=ship id=@ta =target]) page=(unit @t)]
:: XX gross
::
=- ?~(- [~ ~] -)
(json-octs octs parse-list:(provider authority))
=. existing
|- ^+ existing
?~ dat
existing
=/ =bound [now id.i.dat target.i.dat ~]
$(dat t.dat, existing (~(put by existing) ship.i.dat bound))
?~ page
(pure:m existing)
loop(next-page page)
::
++ create-binding
|= [=authority =ship =target existing=(unit bound)]
=/ m (async:stdio (unit bound))
^- form:m
?: &(?=(^ existing) =(target cur.u.existing))
~| %bind-duplicate-wat-do !!
::
=/ pre=(unit [@ta ^target])
?~(existing ~ (some [id cur]:u.existing))
;< rep=(unit httr:eyre) bind:m
(request (create:(provider authority) ship target pre))
:: XX retryable?
::
?. &(?=(^ rep) =(200 p.u.rep))
(pure:m ~)
::
=* httr u.rep
=/ id=@ta
?. ?=(%fcloud -.pro.authority) ~.
?. ?=(^ r.httr)
~| [%authority-create-confirm-id rep] !!
=/ dat=(unit [^ship id=@ta ^target])
(json-octs u.r.httr parse-record:(provider authority))
?~(dat ~. id.u.dat)
::
=/ =address:dns
?>(?=(%direct -.target) +.target)
=/ =turf
(weld dom.authority /(crip +:(scow %p ship)))
;< ~ bind:m (poke-app:stdio collector-app [%dns-complete ship address turf])
;< now=@da bind:m get-time:stdio
=/ =bound
[now id target ?~(existing ~ [[wen cur] hit]:u.existing)]
(pure:m (some bound))
::
++ initialize-authority
|= [aut=authority state=app-state]
=/ m tapp-async
^- form:m
?> ?=(^ nem.state)
=* nam u.nem.state
;< good=? bind:m (confirm-authority aut)
?. good
~& %dns-authority-failed
(pure:m state(nem ~))
::
:: XX wait-effect
::
;< existing=(map ship bound) bind:m (retrieve-existing aut)
=. bon.nam (~(uni by bon.nam) existing)
=. nem.state (some nam)
::
:: XX wait-effect
::
;< ~ bind:m (peer-app:stdio collector-app /requests)
(pure:m state)
--
::
:: |oauth2-core: configured oauth functionality (for |gcloud only)
::
=> |%
++ oauth2-core
|= [=bowl:gall code=@t =hart:eyre secrets=@t]
=/ =oauth2-config
:* auth-url='https://accounts.google.com/o/oauth2/v2/auth'
exchange-url='https://www.googleapis.com/oauth2/v4/token'
domain=/com/googleapis
redirect-path=/dns/oauth
initial-path=/dns/oauth/result
:~ 'https://www.googleapis.com/auth/ndev.clouddns.readwrite'
'https://www.googleapis.com/auth/cloud-platform.read-only'
== ==
~(. oauth2 our.bowl now.bowl oauth2-config code hart secrets)
--
::
:: the app itself
::
=* default-tapp default-tapp:tapp
%- create-tapp-all:tapp
^- tapp-core-all:tapp
|_ [=bowl:gall state=app-state]
::
++ handle-peek handle-peek:default-tapp
++ handle-peer handle-peer:default-tapp
::
++ handle-init
=/ m tapp-async
^- form:m
;< success=? bind:m (bind-route:stdio [~ /dns/oauth] dap.bowl)
~| %dns-unable-to-bind-route
?> success
;< ~ bind:m (poke-app:stdio [[our %hood] [%drum-unlink our dap]]:bowl)
(pure:m state)
::
++ handle-poke
|= =in-poke-data
=/ m tapp-async
^- form:m
?. (team:title [our src]:bowl)
~| %bind-yoself !!
?- -.in-poke-data
::
%dns-authority
?. =(~ nem.state)
~| %authority-reset-wat-do !!
=* aut authority.in-poke-data
=/ nam=nameserver [aut ~ ~]
=. nem.state (some nam)
:: XX move this into the provider interface
::
?: ?& ?=(%gcloud -.pro.aut)
?=(~ auth.pro.aut)
==
~& %do-the-oauth-thing
~& initial-uri:(oauth2-core bowl scry.pro.aut)
(pure:m state)
::
(initialize-authority aut state)
::
%dns-bind
?~ nem.state
~| %bind-not-authority !!
=* nam u.nem.state
=* who ship.in-poke-data
=* tar target.in-poke-data
?. ?=(%indirect -.tar)
~| %indirect-unsupported !!
:: defer %indirect where target isn't yet bound
::
:: ?: ?& ?=(%indirect -.tar)
:: !(~(has by bon.nam) p.tar)
:: ==
:: =. dep.nam (~(put ju dep.nam) p.tar [who tar])
:: =. nem.state (some nam)
:: (pure:m state)
=/ existing (~(get by bon.nam) who)
;< new=(unit bound) bind:m (create-binding aut.nam who tar existing)
?~ new
~& [%bind-failed in-poke-data]
(pure:m state)
=. bon.nam (~(put by bon.nam) who u.new)
=. nem.state (some nam)
::
:: XX wait-effect
::
=/ dep=(list [=ship =target])
~(tap in (~(get ju dep.nam) who))
|- ^- form:m
=* loop $
?~ dep
=. dep.nam (~(del by dep.nam) who)
=. nem.state (some nam)
(pure:m state)
;< ~ bind:m (poke-app:stdio [our dap]:bowl [%dns-bind ship target]:i.dep)
loop(dep t.dep)
::
:: XX need to %handle-http-cancel as well
::
%handle-http-request
:: always stash request bone for giving response
::
=/ =bone ost.bowl
:: XX maybe always (set-raw-contract %request) so transaction failure is captured?
::
=* inbound-request inbound-request.in-poke-data
?~ nem.state
~& :* %not-an-authority
%http-request
=> inbound-request
[authenticated secure address [method url]:request]
==
;< ~ bind:m
(send-effect-on-bone:stdio bone [%http-response %start [%403 ~] ~ %.y])
(pure:m state)
::
=* nam u.nem.state
?> ?=(%gcloud -.pro.aut.nam)
::
=/ parsed=(unit (pair pork:eyre quay:eyre))
%+ rush
url.request.inbound-request
;~(plug ;~(pose apat:de-purl:html (easy *pork:eyre)) yque:de-purl:html)
::
?. ?=(^ parsed)
~| [%invalid-url url.request.inbound-request] !!
=* url q.p.u.parsed
=* ext p.p.u.parsed
=* params q.u.parsed
::
?+ url
;< ~ bind:m
(send-effect-on-bone:stdio bone [%http-response %start [%404 ~] ~ %.y])
(pure:m state)
::
[%dns %oauth ~]
=/ link (trip redirect-to-provider:(oauth2-core bowl scry.pro.aut.nam))
=/ bod=(unit octs)
%- some
%- as-octt:mimes:html
%- en-xml:html
;html
;head
;title: :dns oauth
==
;body
;p make sure that the oauth credential is configured
with a redirect uri of {(trip redirect-uri:(oauth2-core bowl scry.pro.aut.nam))}
==
;a(href link): {link}
==
==
;< ~ bind:m
(send-effect-on-bone:stdio bone [%http-response %start [%200 ~] bod %.y])
(pure:m state)
::
[%dns %oauth %result ~]
=/ code (~(got by (my params)) %code)
:: XX make path configurable
::
=/ hed [['Location' '/dns/oauth/success'] ~]
::
;< ~ bind:m
(send-request:stdio (retrieve-access-token:(oauth2-core bowl scry.pro.aut.nam) code))
;< rep=(unit client-response:http-client) bind:m
take-maybe-response:stdio
:: XX retry
::
?> ?& ?=(^ rep)
?=(%finished -.u.rep)
?=(^ full-file.u.rep)
==
=/ data (parse-token-response:oauth2 data.u.full-file.u.rep)
=. auth.pro.aut.nam (some [access refresh]:(need data))
=. nem.state (some nam)
:: XX use expiry to set refresh timer
::
:: XX may need to send this as a card so we don't wait
::
;< ~ bind:m
(send-effect-on-bone:stdio bone [%http-response %start [%301 hed] ~ %.y])
(initialize-authority aut.nam state)
::
[%dns %oauth %success ~]
=/ bod=(unit octs)
%- some
%- as-octt:mimes:html
%- en-xml:html
;html
;head
;title: :dns oauth
==
;body
;p: you may close the browser window
;p
;span: XX remove me
:: XX make path configurable
::
;a(href "/dns/oauth"): again
==
==
==
;< ~ bind:m (send-effect:stdio %http-response %start [%201 ~] bod %.y)
(pure:m state)
==
==
::
++ handle-diff
|= [=dock =path =in-peer-data]
=/ m tapp-async
^- form:m
?. =(dock collector-app)
(pure:m state)
=* req request.in-peer-data
=/ =target [%direct address.req]
;< ~ bind:m (poke-app:stdio [our dap]:bowl [%dns-bind ship.req target])
(pure:m state)
::
++ handle-take
|= =sign:tapp
=/ m tapp-async
^- form:m
?. ?=(%quit -.sign)
:: XX handle stuff
::
(pure:m state)
::
?. ?& =(dock.sign collector-app)
=(path.sign /requests)
==
~& [%unexpected-quit-wat-do [dock path]:sign]
(pure:m state)
::
;< ~ bind:m (peer-app:stdio collector-app /requests)
(pure:m state)
--

158
app/dns-collector.hoon Normal file
View File

@ -0,0 +1,158 @@
/- dns
::
:: app types and boilerplate
::
=> |%
+$ app-state
$: %0
requested=(map ship address:dns)
completed=(map ship binding:dns)
==
+$ peek-data [%noun (list (pair ship address:dns))]
+$ in-poke-data
$% [%dns-address =address:dns]
[%dns-complete =ship =binding:dns]
==
+$ out-poke-data
$% [%drum-unlink =dock]
==
+$ out-peer-data
$% [%dns-binding =binding:dns]
[%dns-request =request:dns]
==
+$ card
$% [%diff out-peer-data]
[%poke wire =dock out-poke-data]
==
+$ move [bone card]
--
::
=| moves=(list move)
|_ [=bowl:gall state=app-state]
::
++ this .
::
++ abet
^- (quip move _this)
[(flop moves) this(moves ~)]
::
++ emit
|= mov=move
^+ this
this(moves [mov moves])
::
++ emil
|= moz=(list move)
|- ^+ this
?~ moz
this
$(moz t.moz, ..this (emit i.moz))
::
++ poke-app
|= [=wire =dock =out-poke-data]
^+ this
(emit [ost.bowl %poke wire dock out-poke-data])
::
++ give-result
|= [=the=path =out-peer-data]
^+ this
%- emil
%+ turn
^- (list bone)
%+ murn ~(tap by sup.bowl)
|= [ost=bone =ship =sub=path]
`(unit bone)`?.(=(the-path sub-path) ~ (some ost))
|= =bone
[bone %diff out-peer-data]
::
++ prep
|= old=(unit app-state)
^- (quip move _this)
=< abet
?~ old
(poke-app /unlink [[our %hood] [%drum-unlink our dap]]:bowl)
this(state u.old)
::
++ poke
|= =in-poke-data
^- (quip move _this)
=< abet
?- -.in-poke-data
%dns-address
=* who src.bowl
=* adr address.in-poke-data
=/ rac (clan:title who)
?. ?=(?(%king %duke) rac)
~| [%dns-collector-bind-invalid who] !!
?: (reserved:eyre if.adr)
~| [%dns-collector-reserved-address who if.adr] !!
::
=/ req=(unit address:dns) (~(get by requested.state) who)
=/ dun=(unit binding:dns) (~(get by completed.state) who)
?: &(?=(^ dun) =(adr address.u.dun))
=. requested.state (~(del by requested.state) who)
(give-result /(scot %p who) %dns-binding u.dun)
::
?: &(?=(^ req) =(adr u.req))
this
:: XX check address?
=/ =request:dns [who adr]
=. requested.state (~(put by requested.state) request)
(give-result /requests %dns-request request)
::
%dns-complete
:: XX or confirm valid binding?
::
?. (team:title [our src]:bowl)
~| %complete-yoself !!
=* who ship.in-poke-data
=* adr address.binding.in-poke-data
=* tuf turf.binding.in-poke-data
=/ req=(unit address:dns) (~(get by requested.state) who)
:: ignore established bindings that don't match requested
::
?: ?& ?=(^ req)
!=(adr u.req)
==
this
=: requested.state (~(del by requested.state) who)
completed.state (~(put by completed.state) who [adr tuf])
==
(give-result /(scot %p who) %dns-binding adr tuf)
==
::
++ peek
|= =path
^- (unit (unit peek-data))
~& path
?+ path [~ ~]
[%x %requested ~]
[~ ~ %noun ~(tap by requested.state)]
==
::
++ peer
|= =path
^- (quip move _this)
=< abet
:: will be immediately unlinked, see +prep
::
?: ?=([%sole *] path)
this
?. ?=([@ ~] path)
~| %invalid-path !!
?: ?=(%requests i.path)
=/ requests ~(tap by requested.state)
|- ^+ this
=* loop $
?~ requests
this
=. ..this (give-result path %dns-request i.requests)
loop(requests t.requests)
::
=/ who (slaw %p i.path)
?~ who
~| %invalid-path !!
?~ dun=(~(get by completed.state) who)
this
(give-result path %dns-binding u.dun)
--

1342
app/dns.hoon
View File

File diff suppressed because it is too large Load Diff

112
app/dojo.hoon
View File

@ -48,8 +48,7 @@
{$file p/beam} :: save to clay
$: $http :: http outbound
p/?($post $put)
q/(unit knot)
r/purl:eyre
r/@t
==
{$poke p/goal} :: poke app
{$show p/?($0 $1 $2 $3 $4 $5)} :: val/type/hoon/xray
@ -61,7 +60,7 @@
== ::
++ dojo-build :: one arvo step
$~ [%ex *hoon]
$% {$ur p/(unit knot) q/purl:eyre} :: http GET request
$% {$ur p/@t} :: http GET request
{$ge p/dojo-model} :: generator
{$dv p/path} :: core from source
{$ex p/hoon} :: hoon expression
@ -107,12 +106,7 @@
++ card :: general card
$% {$diff $sole-effect sole-effect} ::
{$send wire {ship term} clap} ::
$: $hiss
wire
(unit knot)
mark
{$hiss hiss:eyre}
==
[%request wire request:http outbound-config:http-client] :: %l
[%build wire ? schematic:ford]
[%kill wire ~]
{$deal wire sock term club} ::
@ -211,8 +205,8 @@
;~(plug (cold %file tar) parse-beam)
;~(plug (cold %flat vat) (most net sym))
;~(plug (cold %pill dot) (most net sym))
;~(plug (cold %http lus) (stag %post parse-iden-url))
;~(plug (cold %http hep) (stag %put parse-iden-url))
;~(plug (cold %http lus) (stag %post parse-url))
;~(plug (cold %http hep) (stag %put parse-url))
(stag %show (cook $?($1 $2 $3 $4 $5) (cook lent (stun [1 5] wut))))
==
::
@ -245,7 +239,7 @@
++ parse-build
%+ knee *dojo-build |. ~+
;~ pose
;~(plug (cold %ur lus) parse-iden-url)
;~(plug (cold %ur lus) parse-url)
;~(plug (cold %ge lus) parse-model)
;~(plug (cold %as pad) sym ;~(pfix ace parse-source))
;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source))
@ -285,7 +279,12 @@
%+ cook
|=([a=(unit knot) b=purl:eyre] [`(fall a *knot) b])
auru:de-purl:html
::
::
++ parse-url
%+ cook
|=(a=purl:eyre (crip (en-purl:html a)))
auri:de-purl:html
::
++ parse-model ;~(plug parse-server parse-config)
++ parse-server (stag 0 (most net sym))
++ parse-hoon tall:hoon-parser
@ -360,11 +359,11 @@
::
(he-card(poy `+>+<(pux `way)) %build way live=%.n schematic)
::
++ dy-eyre :: send work to eyre
|= {way/wire usr/(unit knot) req/hiss:eyre}
++ dy-request
|= [way=wire =request:http]
^+ +>+>
?> ?=(~ pux)
(he-card(poy `+>+<(pux `way)) %hiss way usr %httr %hiss req)
(he-card(poy `+>+<(pux `way)) %request way request *outbound-config:http-client)
::
++ dy-stop :: stop work
^+ +>
@ -592,8 +591,12 @@
$http
?> ?=($mime p.cay)
=+ mim=;;(mime q.q.cay)
=+ maf=(~(add ja *math:eyre) %content-type (en-mite:mimes:html p.mim))
(dy-eyre /show q.p.mad [r.p.mad p.p.mad maf ~ q.mim])
%+ dy-request /show
:* ?:(=(%put p.p.mad) %'PUT' %'POST')
r.p.mad
~[['content-type' (en-mite:mimes:html p.mim)]]
`q.mim
==
::
$show
|^ (prnt cay note)
@ -702,7 +705,6 @@
:- ?+ -.q.q.cay ~|(%bad-gen ~_((sell (slot 2 q.cay)) !!))
$say /gent
$ask /dial
$get /scar
==
=+ gat=(slot 3 q.cay)
:+ %call [%$ %noun gat]
@ -756,37 +758,6 @@
[%pro pom(cad [':' ' ' cad.pom])]
==
::
++ dy-made-scar :: scraper product
|= cag/cage
^+ +>+>
?. ?=(^ q.q.cag)
(dy-errd ~ q.q.cag)
=+ tan=((list tank) +2.q.q.cag)
=. +>+>.$ (he-diff %tan tan)
=+ vax=(sped (slot 3 q.cag))
~_ (sell q.cag)
?+ -.q.vax !!
%&
?~ +.q.vax
~& %dy-made-scar-abort
(dy-rash %bel ~)
(dy-meal (slot 7 vax))
::
%|
=> .(vax (slap vax !,(*hoon ?>(?=(%| -) .)))) :: XX working sped #72
=+ typ={%| (unit knot) hiss:eyre *}
=+ [* usr hiz *]=((dy-cast typ !>($:typ)) vax)
=. ..dy (he-diff %tan leaf+"< {(en-purl:html p.hiz)}" ~)
(dy-eyre(pro `(slap (slot 15 vax) limb+%r)) /scar usr hiz)
==
::
++ dy-sigh-scar :: scraper result
|= dat/cage
?~ pro
~& %dy-no-scraper
(dy-show dat)
(dy-slam(pux ~) /scar u.pro q.dat)
::
++ dy-made-gent :: generator product
|= cag/cage
(dy-meal q.cag)
@ -800,7 +771,7 @@
?> ?=(^ cud)
=+ bil=q.u.cud :: XX =*
?: ?=($ur -.bil)
(dy-eyre /hand p.bil [q.bil %get ~ ~])
(dy-request /hand `request:http`[%'GET' p.bil ~ ~])
%- dy-ford
^- [path schematic:ford]
?- -.bil
@ -961,7 +932,6 @@
{$dial ~} dy-made-dial:dye
{$gent ~} dy-made-gent:dye
{$noun ~} dy-made-noun:dye
{$scar ~} dy-made-scar:dye
{$edit ~} dy-made-edit:dye
==
::
@ -969,19 +939,6 @@
(he-diff(poy ~) %tan message.build-result.result)
== ==
::
++ he-sigh :: result from eyre
|= {way/wire hit/httr:eyre}
^+ +>
?> ?=(^ poy)
=< he-pine
%. [%httr !>(hit)]
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
{$hand ~} dy-hand:dye
{$show ~} dy-show:dye
{$scar ~} dy-sigh-scar:dye
==
::
++ he-unto :: result from behn
|= {way/wire cit/cuft:gall}
^+ +>
@ -991,6 +948,24 @@
?~ p.cit
(he-diff %txt ">=")
(he-diff %tan u.p.cit)
:: +he-http-response: result from http-client
::
++ he-http-response
|= [way=wire response=client-response:http-client]
^+ +>
?> ?=(^ poy)
=< he-pine
?. ?=(%finished -.response)
~& %dojo-received-http-progress
+>
::
~! response
%. [%httr !>((to-httr:http-client response-header.response full-file.response))]
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
{$hand ~} dy-hand:dye
{$show ~} dy-show:dye
==
::
++ he-lens
|= com/command:lens
@ -1028,7 +1003,7 @@
%+ rash pax.source.com
rood:(vang | /(scot %p our.hid)/home/(scot %da now.hid))
::
$url [%ur `~. url.source.com]
$url [%ur (crip (en-purl:html url.source.com))]
$api !!
$get-api
:- %ex
@ -1071,7 +1046,7 @@
$output-file $(sink.com [%command (cat 3 '@' pax.sink.com)])
$output-pill $(sink.com [%command (cat 3 '.' pax.sink.com)])
$output-clay [%file (need (de-beam:format pax.sink.com))]
$url [%http %post `~. url.sink.com]
$url [%http %post (crip (en-purl:html url.sink.com))]
$to-api !!
$send-api [%poke our.hid api.sink.com]
$command (rash command.sink.com parse-sink:he-parser)
@ -1211,8 +1186,7 @@
[~ +>.$]
::
++ made (wrap he-made):arm
++ sigh-httr (wrap he-sigh):arm
++ sigh-tang |=({a/wire b/tang} ~|(`term`(cat 3 'sigh-' -.a) (mean b)))
++ http-response (wrap he-http-response):arm
++ lame (wrap he-lame):arm
++ unto (wrap he-unto):arm
++ pull

6
app/example-tapp-fetch.hoon
View File

@ -134,9 +134,13 @@
(pure:m top-comments)
::
++ handle-take
|= sign:tapp
|= =sign:tapp
=/ m tapp-async
^- form:m
:: ignore %poke/peer acknowledgements
::
?. ?=(%wake -.sign)
(pure:m top-comments)
;< =state bind:m (handle-poke %noun 'fetch')
=. top-comments state
(pure:m top-comments)

2
app/fora.hoon
View File

@ -37,7 +37,7 @@
^- move
[ost.bol %poke / [our.bol %hall] %hall-action a]
::
++ ra-base-hart .^(hart:eyre %e /(scot %p our.bol)/host/(scot %da now.bol))
++ ra-base-hart .^(hart:eyre %r /(scot %p our.bol)/host/(scot %da now.bol))
::
++ poke-fora-post
|= {pax/path sup/spur hed/@t txt/@t}

359
app/gmail.hoon
View File

@ -1,359 +0,0 @@
:: Three ways we interact 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
::::
::
|%
:: 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 $~}
==
--
::/- gmail
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
=, mimes:html
=, html
=> |% :: => 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:eyre}}
==
++ easy-ot
=, dejs-soft:format
|* {key/@t parser/fist}
(ot [key parser] ~)
++ sifo-google
|= a/cord ^- cord
=; fel (crip (scan (en-base64 a) fel))
(star ;~(pose (cold '-' (just '+')) (cold '_' (just '/')) next))
++ ofis-google
|= a/cord ^- cord
=; fel (de-base64 (crip (rash a fel)))
(star ;~(pose (cold '+' (just '-')) (cold '/' (just '_')) next))
--
::
=, gall
|_ $: 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:clay ^} pax) :: assert %u
=> (help i.pax i.t.pax t.t.pax)
=> scry
%= make-move
count +(count)
==
::
++ poke-email
|= {adr/@ta tyl/tape mez/wall} ^- (quip move _+>)
?> =(our.hid src.hid)
%- poke-gmail-req :*
%post
/messages/send
~['uploadType'^%simple]
['urbit' 'urbit.org'] :: [(crip "urbit+{<our.hid>}") 'urbit.org']
::
=- (rash adr -)
[;~((glue vat) . .)]:(cook crip (plus ;~(less vat next))) :: /[^@]+@[^@]+/
::
(crip tyl)
(of-wain:format (turn mez crip))
==
::
++ poke-gmail-req
|= $: method/meth:eyre endpoint/path quy/quay:eyre
mes/message:rfc
:: label-req:gmail-label
==
^- {(list move) _+>.$}
?> ?=(valid-get-endpoint endpoint)
?> =(our.hid src.hid)
:_ +>.$ :_ ~
^- move
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
^- purl:eyre
:+ [& ~ [%& /com/googleapis/www]]
[~ gmail+v1+users+me+`valid-get-endpoint`endpoint]
`quay:eyre`[[%alt %json] ~]
::
:+ method `math:eyre`(malt ~[content-type+['application/json']~])
=/ hoon-json-object
(frond:enjs:format %raw s+(sifo-google (message-to-rfc822:rfc mes)))
=+ request-body=(as-octt (en-json hoon-json-object))
(some request-body)
::(some (en-json 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:eyre}
^- {(list move) _+>.$}
:: ~& wir+wir
?. ?=({care:clay @ @ @ *} wir)
:: pokes don't return anything
~& sigh-poke+p.res
[~ +>.$]
=+ arg=(path (cue (slav %uv i.t.t.wir)))
:: ~& ittwir+i.t.t.wir
:_ +>.$ :_ ~
:+ ost.hid %diff
?+ i.wir null+~
$x
=, enjs:format
?~ r.res
json+(pairs err+s+%empty-response code+(numb p.res) ~)
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
json+(pairs err+s+%bad-json code+(numb p.res) body+s+q.u.r.res ~)
?. =(2 (div p.res 100))
json+(pairs err+s+%request-rejected code+(numb 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 ~)) ~):dejs-soft:format 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
=, dejs-soft:format
=+ ^= from-and-subject
|= a/(map @t @t) ^- {@t @t}
[(~(got by a) 'From') (~(got by a) 'Subject')]
=+ ^= text-body
|= a/(list {@t @t}) ^- wain
%- to-wain
%- 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:dejs-soft:format some) u.jon)
?~ dir json+(pairs:enjs:format 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+(numb:enjs:format p.res)]
arch+*arch
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
~& [err+s+%bad-json code+(numb:enjs:format p.res) body+s+q.u.r.res]
arch+*arch
?. =(2 (div p.res 100))
~& [err+s+%request-rejected code+(numb:enjs:format 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:dejs-soft:format 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 |=({a/wire b/tang} (mean >gmail+a< b))
++ sigh
|= a/*
~& a+a
:_ +>.$ ~
::
++ help
|= {ren/care:clay style/@tas pax/path}
=^ query pax
=+ xap=(flop pax)
?~ xap [~ ~]
=+ query=(rush i.xap ;~(pfix wut yquy:de-purl))
?~ 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:eyre
%+ scan
"https://www.googleapis.com/gmail/v1/users/me{<`path`endpoint>}"
auri:de-purl
:: Send an HTTP req
++ send-http
|= hiz/hiss:eyre
^+ +>
=+ 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.

70
app/gmail/split.hoon
View File

@ -1,70 +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 ~}
==
--
::

59
app/hall.hoon
View File

@ -2535,14 +2535,16 @@
%+ murn ~(tap by stories)
|= {n/name s/story}
^- (unit (pair name burden))
:: don't federate channels
~
:: only auto-federate channels for now.
?. ?=($channel sec.con.shape.s) ~
:+ ~ n
:: share no more than the last 100, for performance reasons.
:+ ?: (lte count.s 100) grams.s
(slag (sub count.s 100) grams.s)
[shape.s mirrors.s]
[locals.s remotes.s]
::?. ?=($channel sec.con.shape.s) ~
:::+ ~ n
:::: share no more than the last 100, for performance reasons.
:::+ ?: (lte count.s 100) grams.s
:: (slag (sub count.s 100) grams.s)
:: [shape.s mirrors.s]
::[locals.s remotes.s]
::
$report
::TODO gall note: need to be able to subscirbe to just changes... or just
@ -2769,6 +2771,7 @@
==
==
::
::
++ affection
:: rumors to interested
::
@ -2780,19 +2783,35 @@
^- (list move)
:: cache results for paths.
=| res/(map path (list move))
%- zing
%+ turn ~(tap by sup.bol)
|= {b/bone s/ship p/path}
^- (list move)
=+ mur=(~(get by res) p)
?^ mur u.mur
=- =. res (~(put by res) p -)
-
=+ qer=(path-to-query p)
%+ welp
=+ rum=(feel qer det)
?~ rum ~
[b %diff %hall-rumor u.rum]~
%- zing
%+ turn ~(tap by sup.bol)
|= {b/bone s/ship p/path}
^- (list move)
=+ mur=(~(get by res) p)
?^ mur u.mur
=- =. res (~(put by res) p -)
-
=+ qer=(path-to-query p)
%+ welp
=+ rum=(feel qer det)
?~ rum ~
?: ?&
?=(%burden -.u.rum)
?=(%config -.rum.u.rum)
?=(%read -.dif.rum.u.rum)
==
:: don't send read burdens
~
?: ?&
?!(=(s our.bol))
?=(%circle -.u.rum)
?=(%config -.rum.u.rum)
?=(%read -.dif.rum.u.rum)
==
:: don't send read circle events to other ships
~
[b %diff %hall-rumor u.rum]~
?. ?=($circle -.qer) ~
:: kill the subscription if we forgot the story.
?. (~(has by stories) nom.qer) (gentle-quit b s qer)

2
app/hood.hoon
View File

@ -204,4 +204,6 @@
++ writ-kiln-autoload (wrap take-writ-autoload):from-kiln
++ writ-kiln-find-ship (wrap take-writ-find-ship):from-kiln
++ writ-kiln-sync (wrap take-writ-sync):from-kiln
++ bound (wrap take-bound):from-helm
--

151
app/launch.hoon Normal file
View File

@ -0,0 +1,151 @@
/+ *server, collections
/= index
/^ $-(marl manx)
/: /===/app/launch/index /!noun/
/= script
/^ octs
/; as-octs:mimes:html
/: /===/app/launch/js/index
/| /js/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
/: /===/app/launch/css/index
/| /css/
/~ ~
==
/= launch-png
/^ (map knot @)
/: /===/app/launch/img /_ /png/
::
|%
::
+$ move [bone card]
::
+$ card
$% [%http-response =http-event:http]
[%connect wire binding:http-server term]
[%peer wire dock path]
[%diff %json json]
==
+$ tile [name=@tas subscribe=path]
+$ tile-data (map @tas [jon=json url=@t])
+$ state
$% [%0 tiles=(set tile) data=tile-data path-to-tile=(map path @tas)]
==
::
--
::
|_ [bol=bowl:gall sta=state]
::
++ this .
::
++ prep
|= old=(unit state)
^- (quip move _this)
~& 'launch prep'
?~ old
:_ this
[ost.bol %connect / [~ /] %launch]~
[~ this(sta u.old)]
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ poke-noun
|= [name=@tas subscribe=path url=@t]
^- (quip move _this)
=/ beforedata (~(get by data.sta) name)
=/ newdata
?~ beforedata
(~(put by data.sta) name [*json url])
(~(put by data.sta) name [jon.u.beforedata url])
:- [ost.bol %peer subscribe [our.bol name] subscribe]~
%= this
tiles.sta (~(put in tiles.sta) [name subscribe])
data.sta newdata
path-to-tile.sta (~(put by path-to-tile.sta) subscribe name)
==
::
++ diff-json
|= [pax=path jon=json]
^- (quip move _this)
=/ name/@tas (~(got by path-to-tile.sta) pax)
=/ data/(unit [json url=@t]) (~(get by data.sta) name)
?~ data
[~ this]
::
:-
%+ turn (prey:pubsub:userlib /main bol)
|= [=bone *]
[bone %diff %json (frond:enjs:format name jon)]
::
%= this
data.sta (~(put by data.sta) name [jon url.u.data])
==
::
++ peer-main
|= [pax=path]
^- (quip move _this)
=/ data/json
%- pairs:enjs:format
%+ turn ~(tap by data.sta)
|= [key=@tas [jon=json url=@t]]
[key jon]
:_ this
[ost.bol %diff %json data]~
::
++ generate-script-marl
|= data=tile-data
^- marl
%+ turn ~(tap by data)
|= [key=@tas [jon=json url=@t]]
^- manx
;script@"{(trip url)}";
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:http-server
^- (quip move _this)
::
=+ request-line=(parse-request-line url.request.inbound-request)
=/ name=@t
=+ back-path=(flop site.request-line)
?~ back-path
''
i.back-path
=/ site (flop site.request-line)
?~ site
=/ hym=manx (index (generate-script-marl data.sta))
:_ this
[ost.bol %http-response (manx-response:app hym)]~
?+ site.request-line
:_ this
[ost.bol %http-response not-found:app]~
::
:: styling
::
[%'~launch' %css %index ~]
:_ this
[ost.bol %http-response (css-response:app style)]~
::
:: javascript
::
[%'~launch' %js %index ~]
:_ this
[ost.bol %http-response (js-response:app script)]~
::
:: images
::
[%'~launch' %img *]
=/ img (as-octs:mimes:html (~(got by launch-png) `@ta`name))
:_ this
[ost.bol %http-response (png-response:app img)]~
==
::
--

2
app/launch/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
app/launch/img/Home.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 255 B

18
app/launch/index.hoon Normal file
View File

@ -0,0 +1,18 @@
|= scripts=marl
;html
;head
;title: Home
;meta(charset "utf-8");
;meta
=name "viewport"
=content "width=device-width, initial-scale=1, shrink-to-fit=no";
;link(rel "stylesheet", href "/~launch/css/index.css");
==
;body
;div#root;
;script@"/~/channel/channel.js";
;script@"/~modulo/session.js";
;* scripts
;script@"/~launch/js/index.js";
==
==

18
app/launch/index.html Normal file
View File

@ -0,0 +1,18 @@
|= scripts=marl
<!doctype html>
<html>
<head>
<title>Home</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~launch/css/index.css" />
</head>
<body>
<div id="root" />
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~launch/js/tiles.js"></script>
<script src="/~launch/js/index.js"></script>
</body>
</html>

49172
app/launch/js/index.js Normal file
View File

File diff suppressed because it is too large Load Diff

116
app/lens.hoon Normal file
View File

@ -0,0 +1,116 @@
/- lens
/+ *server
/= lens-mark /: /===/mar/lens/command
/!noun/
=, format
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ card
$% [%connect wire binding:http-server term]
[%http-response =http-event:http]
[%peel wire dock mark path]
[%poke wire dock poke]
[%pull wire dock ~]
==
::
+$ poke
$% [%lens-command command:lens]
==
::
+$ state
$% $: %0
job=(unit [=bone com=command:lens])
==
==
::
--
::
|_ [bow=bowl:gall state=state]
::
++ this .
::
++ prep
|= old=(unit *)
^- (quip move _this)
[~ this]
::
:: alerts us that we were bound. we need this because the vane calls back.
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ poke-handle-http-request
%- (require-authorization:app ost.bow move this)
|= =inbound-request:http-server
^- (quip move _this)
?^ job.state
:_ this
[ost.bow %http-response %start [%500 ~] ~ %.y]~
::
=/ request-line (parse-request-line url.request.inbound-request)
=/ site (flop site.request-line)
::
=/ jon=json
(need (de-json:html q:(need body.request.inbound-request)))
=/ com=command:lens
(json:grab:lens-mark jon)
:_ this(job.state (some [ost.bow com]))
[ost.bow %peel /sole [our.bow %dojo] %lens-json /sole]~
::
++ diff-lens-json
|= [=wire jon=json]
^- (quip move _this)
?~ jon
[~ this]
?> ?=(^ job.state)
:_ this(job.state ~)
[bone.u.job.state %http-response (json-response:app (json-to-octs jon))]~
::
++ quit
|= =wire
^- (quip move _this)
~& [%quit wire]
[~ this]
::
++ reap
|= [=wire saw=(unit tang)]
^- (quip move _this)
~& [%reap wire]
?^ saw
[((slog u.saw) ~) this]
?> ?=(^ job.state)
:_ this
:~ [ost.bow %poke /sole [our.bow %dojo] %lens-command com.u.job.state]
[ost.bow %pull /sole [our.bow %dojo] ~]
==
::
++ coup
|= [=wire saw=(unit tang)]
^- (quip move _this)
~& [%coup wire]
?^ saw
[((slog u.saw) ~) this]
[~ this]
::
:: +poke-handle-http-cancel: received when a connection was killed
::
++ poke-handle-http-cancel
|= =inbound-request:http-server
^- (quip move _this)
:: the only long lived connections we keep state about are the stream ones.
::
[~ this]
::
++ poke-noun
|= a=*
^- (quip move _this)
~& poke+a
[~ this]
::
--

51
app/modulo.hoon Normal file
View File

@ -0,0 +1,51 @@
/+ *server
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ card
$% [%connect wire binding:http-server term]
[%disconnect wire binding:http-server]
[%http-response =http-event:http]
==
::
--
::
|_ [bow=bowl:gall ~]
::
++ this .
::
++ prep
|= old=(unit *)
^- (quip move _this)
?~ old
:_ this
[ost.bow %connect / [~ /'~modulo'] %modulo]~
[~ this]
::
:: alerts us that we were bound. we need this because the vane calls back.
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ session-js
^- octs
%- as-octt:mimes:html
;: weld
"window.ship = '{+:(scow %p our.bow)}';"
"window.urb = new Channel();"
==
::
:: +poke-handle-http-request: received on a new connection established
::
++ poke-handle-http-request
%- (require-authorization:app ost.bow move this)
|= =inbound-request:http-server
^- (quip move _this)
[[ost.bow %http-response (js-response:app session-js)]~ this]
::
--

214
app/server.hoon Normal file
View File

@ -0,0 +1,214 @@
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ card
$% [%connect wire [(unit @t) (list @t)] %server]
[%wait wire @da]
[%http-response =http-event:http]
[%diff %json json]
==
--
:: utilities:
::
|%
::
++ parse-request-line
|= url=@t
^- [[(unit @ta) site=(list @t)] args=(list [key=@t value=@t])]
(fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
:: +hello:
::
++ hello
|= name=@t
^- octs
%- as-octs:mimes:html
%- crip
%- en-xml:html
;html
;head
;title:"Hello, {(trip name)}"
==
;body
;h1:"Hello, {(trip name)}"
;p
; Time is
;span#time:"?????"
==
;button#start:"Start Timer"
;button#poke:"Random Poke"
;script(type "module", src "/~server/hello.js");
==
==
::
++ hello-js
^- octs
%- as-octs:mimes:html
'''
import * as urb from '/~/channel/channel.js';
var c = urb.newChannel();
// The poke button just sends a poke
document.getElementById("poke").addEventListener("click", function(){
c.poke("zod", "server", "json", 5,
function() {
console.log("Poke worked");
},
function(err) {
console.log("Poke failed: " + err);
});
});
function doSubs() {
// The subscription sends the time which makes the thing work.
//
c.subscribe("zod", "server", "/timer",
function(err) {
console.log("Failed initial connection: " + err);
},
function(json) {
console.log("Subscription update: ", json);
var message = document.getElementById("time");
message.innerHTML = json;
},
function() {
console.log("Subscription quit");
// resubscribe because Gall is broken
//
// Galls queuing mechanism is broken and will
// break subscriptions whenever 20 messages have
// been sent.
//
doSubs();
});
}
doSubs();
'''
:: +require-authorization: redirect to the login page when unauthenticated
::
++ require-authorization
|* [=bone move=mold this=*]
|= handler=$-(inbound-request:http-server (quip move _this))
|= =inbound-request:http-server
^- (quip move _this)
::
?: authenticated.inbound-request
(handler inbound-request)
::
:_ this
^- (list move)
=/ redirect=cord
%- crip
"/~/login?redirect={(trip url.request.inbound-request)}"
[bone [%http-response %start [307 ['location' redirect]~] ~ %.y]]~
--
|%
::
+$ state
$: next-timer=(unit @da)
==
--
::
|_ [bow=bowl:gall state]
::
++ this .
::
++ prep
|= old=(unit state)
^- (quip move _this)
~& %prep
:- [`move`[ost.bow [%connect / [~ /'~server'] %server]] ~]
?~ old
this
this(+<+ u.old)
:: alerts us that we were bound. we need this because the vane calls back.
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
~& [%bound success]
[~ this]
::
:: +wake: responds to a %wait send from +handle-start-stream
::
++ wake
|= [wir=wire ~]
^- (quip move _this)
::
~& [%timer-tick wir now.bow]
::
=/ moves=(list move)
%+ turn (prey:pubsub:userlib /timer bow)
|= [=bone ^]
[bone %diff %json %s (scot %da now.bow)]
:: if we have outbound moves, say that we have another timer.
::
=. next-timer
?: ?=(^ moves)
`(add now.bow ~s1)
~
:: if we have any subscribers, add another timer for the future
::
=? moves ?=(^ moves)
[[ost.bow %wait /timer (add now.bow ~s1)] moves]
::
[moves this]
:: +poke-handle-http-request: received on a new connection established
::
++ poke-handle-http-request
%- (require-authorization ost.bow move this)
|= =inbound-request:http-server
^- (quip move _this)
::
=+ request-line=(parse-request-line url.request.inbound-request)
~& [%request-line request-line]
=/ name=@t
=+ back-path=(flop site.request-line)
?~ back-path
'World'
i.back-path
::
?: =(name 'hello')
:_ this
:~ ^- move
:- ost.bow
:* %http-response
[%start [200 ['content-type' 'application/javascript']~] [~ hello-js] %.y]
==
==
::
:_ this
:~ ^- move
:- ost.bow
:* %http-response
[%start [200 ['content-type' 'text/html']~] [~ (hello name)] %.y]
==
==
:: +poke-handle-http-cancel: received when a connection was killed
::
++ poke-handle-http-cancel
|= =inbound-request:http-server
^- (quip move _this)
:: the only long lived connections we keep state about are the stream ones.
::
[~ this]
::
++ poke-json
|= =json
^- (quip move _this)
~& [%poke-json json]
[~ this]
::
++ peer-timer
|= pax/path
^- (quip move _this)
:: if we don't have a timer, set a timer.
?: ?=(^ next-timer)
[~ this]
::
:- [ost.bow %wait /timer (add now.bow ~s1)]~
this(next-timer `(unit @da)`[~ (add now.bow ~s1)])
--

2
app/talk.hoon
View File

@ -1933,7 +1933,7 @@
"cap: {(trip cap.dif)}"
::
$read
"red: {(scow %ud red.dif)}"
""
::
$filter
;: weld

3
app/test.hoon
View File

@ -116,7 +116,7 @@
%cores [ost (build-core [- +]:(list-hoons p.a skip=(sy /sys /ren /tests ~)))]~
%names ~&((list-names p.a) ~)
%marks ~|(%stub !!) ::TODO restore historical handler
%renders [ost (build-rend [- +]:(list-names (weld /ren p.a)))]~
%renders ~&(%all-renderers-are-disabled ~)
==
::
++ list-names
@ -156,6 +156,7 @@
:- /ren/js "not meant to be called outside /web/pack"
:- /ren/run "not meant to be called except on a (different) hoon file"
:- /ren/collections "temporarily disabled"
:- /ren/rss-xml "scrys into eyre"
:- /ren/test-gen "temporarily disabled"
:- /ren/urb "temporarily disabled"
:- /ren/x-urb "temporarily disabled"

122
app/timer.hoon Normal file
View File

@ -0,0 +1,122 @@
/+ *server
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/timer/js/tile
/| /js/
/~ ~
==
/= timer-png
/^ (map knot @)
/: /===/app/timer/img /_ /png/
=, format
::
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ poke
$% [%noun [@tas path @t]]
==
::
+$ card
$% [%poke wire dock poke]
[%http-response =http-event:http]
[%connect wire binding:http-server term]
[%diff %json json]
[%wait wire @da]
[%rest wire @da]
==
::
--
::
|_ [bol=bowl:gall tim=@da]
::
++ this .
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ prep
|= old=(unit tim=@da)
^- (quip move _this)
=/ launchnoun [%noun [%timer /tile '/~timer/js/tile.js']]
:-
:~
[ost.bol %connect / [~ /'~timer'] %timer]
[ost.bol %poke /timer [our.bol %launch] launchnoun]
==
?~ old
this
%= this
tim tim.u.old
==
::
++ peer-tile
|= pax=path
^- (quip move _this)
?: =(tim *@da)
[[ost.bol %diff %json [%s '']]~ this]
[[ost.bol %diff %json [%s (scot %da tim)]]~ this]
::
++ send-tile-diff
|= jon=json
^- (list move)
%+ turn (prey:pubsub:userlib /tile bol)
|= [=bone ^]
[bone %diff %json jon]
::
++ poke-json
|= jon=json
^- (quip move _this)
?. ?=(%s -.jon)
[~ this]
=/ str/@t +.jon
?: =(str 'start')
=/ data/@da (add now.bol ~s10)
:_ this(tim data)
[[ost.bol %wait /timer data] (send-tile-diff [%s (scot %da data)])]
?: =(str 'stop')
:_ this(tim *@da)
[[ost.bol %rest /timer tim] (send-tile-diff [%s ''])]
[~ this]
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:http-server
^- (quip move _this)
=/ request-line (parse-request-line url.request.inbound-request)
=/ back-path (flop site.request-line)
=/ name=@t
=/ back-path (flop site.request-line)
?~ back-path
''
i.back-path
::
?+ site.request-line
[[ost.bol %http-response not-found:app]~ this]
::
:: tile
::
[%'~timer' %js %tile ~]
[[ost.bol %http-response (js-response:app tile-js)]~ this]
::
:: images
::
[%'~timer' %img *]
=/ img (as-octs:mimes:html (~(got by timer-png) `@ta`name))
:_ this
[ost.bol %http-response (png-response:app img)]~
==
::
++ wake
|= [wir=wire err=(unit tang)]
^- (quip move _this)
:- (send-tile-diff [%s 'alarm'])
this(tim *@da)
::
--

BIN
app/timer/img/example.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 20 KiB

BIN
app/timer/img/volume-high.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 15 KiB

BIN
app/timer/img/volume-mute.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 16 KiB

2592
app/timer/js/tile.js Normal file
View File

File diff suppressed because it is too large Load Diff

161
app/weather.hoon Normal file
View File

@ -0,0 +1,161 @@
/+ *server
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/weather/js/tile
/| /js/
/~ ~
==
/= weather-png
/^ (map knot @)
/: /===/app/weather/img /_ /png/
=, format
::
|%
:: +move: output effect
::
+$ move [bone card]
:: +card: output effect payload
::
+$ card
$% [%poke wire dock poke]
[%http-response =http-event:http]
[%diff %json json]
[%connect wire binding:http-server term]
[%request wire request:http outbound-config:http-client]
[%wait wire @da]
==
+$ poke
$% [%noun [@tas path @t]]
==
+$ state
$% [%0 data=json time=@da location=@t timer=(unit @da)]
==
--
::
|_ [bol=bowl:gall state]
::
++ this .
::
++ bound
|= [wir=wire success=? binding=binding:http-server]
^- (quip move _this)
[~ this]
::
++ prep
|= old=(unit state)
^- (quip move _this)
:-
:~
[ost.bol %connect / [~ /'~weather'] %weather]
[ost.bol %poke /weather [our.bol %launch] [%noun [%weather /weathertile '/~weather/js/tile.js']]]
==
?~ old
this
%= this
data data.u.old
time time.u.old
==
::
++ peer-weathertile
|= pax=path
^- (quip move _this)
[[ost.bol %diff %json data]~ this]
::
++ poke-json
|= jon=json
^- (quip move _this)
?. ?=(%s -.jon)
[~ this]
=/ str/@t +.jon
=/ req/request:http (request-darksky str)
=/ out *outbound-config:http-client
?~ timer
:- %+ weld
`(list move)`[ost.bol %wait /timer (add now.bol ~d1)]~
`(list move)`[ost.bol %request /[(scot %da now.bol)] req out]~
%= this
location str
timer `(add now.bol ~d1)
==
:- [ost.bol %request /[(scot %da now.bol)] req out]~
%= this
location str
==
::
++ request-darksky
|= location=@t
^- request:http
=/ url/@t
%- crip %+ weld
(trip 'https://api.darksky.net/forecast/634639c10670c7376dc66b6692fe57ca/')
(trip location)
=/ hed [['Accept' 'application/json']]~
[%'GET' url hed *(unit octs)]
::
++ send-tile-diff
|= jon=json
^- (list move)
%+ turn (prey:pubsub:userlib /weathertile bol)
|= [=bone ^]
[bone %diff %json jon]
::
++ http-response
|= [=wire response=client-response:http-client]
^- (quip move _this)
:: ignore all but %finished
?. ?=(%finished -.response)
[~ this]
=/ data/(unit mime-data:http-client) full-file.response
?~ data
:: data is null
[~ this]
=/ jon/(unit json) (de-json:html q.data.u.data)
?~ jon
[~ this]
?> ?=(%o -.u.jon)
=/ ayyy/json %- pairs:enjs:format :~
currently+(~(got by p.u.jon) 'currently')
daily+(~(got by p.u.jon) 'daily')
==
:- (send-tile-diff ayyy)
%= this
data ayyy
time now.bol
==
::
++ poke-handle-http-request
%- (require-authorization:app ost.bol move this)
|= =inbound-request:http-server
^- (quip move _this)
=+ request-line=(parse-request-line url.request.inbound-request)
=+ back-path=(flop site.request-line)
=/ name=@t
=+ back-path=(flop site.request-line)
?~ back-path
''
i.back-path
::
?~ back-path
:_ this ~
?: =(name 'tile')
[[ost.bol %http-response (js-response:app tile-js)]~ this]
?: (lte (lent back-path) 1)
[[ost.bol %http-response not-found:app]~ this]
?: =(&2:site.request-line 'img')
=/ img (as-octs:mimes:html (~(got by weather-png) `@ta`name))
[[ost.bol %http-response (png-response:app img)]~ this]
[~ this]
::
++ wake
|= [wir=wire err=(unit tang)]
^- (quip move _this)
=/ req/request:http (request-darksky location)
=/ lismov/(list move)
`(list move)`[ost.bol %request /[(scot %da now.bol)] req *outbound-config:http-client]~
?~ timer
:- (weld lismov `(list move)`[ost.bol %wait /timer (add now.bol ~h3)]~)
this(timer `(add now.bol ~h3))
[lismov this]
::
--

BIN
app/weather/img/chancerain.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 549 B

BIN
app/weather/img/clear-day.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

BIN
app/weather/img/clear-night.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

BIN
app/weather/img/cloudy.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
app/weather/img/fog.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 411 B

BIN
app/weather/img/high.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 960 B

BIN
app/weather/img/low.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 897 B

BIN
app/weather/img/partly-cloudy-day.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.3 KiB

BIN
app/weather/img/partly-cloudy-night.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.8 KiB

BIN
app/weather/img/rain.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.9 KiB

BIN
app/weather/img/sleet.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 593 B

BIN
app/weather/img/snow.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
app/weather/img/sunset.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 589 B

BIN
app/weather/img/wind.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.0 KiB

BIN
app/weather/img/winddirection.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 512 B

BIN
app/weather/img/windspeed.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 521 B

6946
app/weather/js/tile.js Normal file
View File

File diff suppressed because it is too large Load Diff

1439
app/write.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

2
app/write/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
app/write/img/tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

21
app/write/index.hoon Normal file
View File

@ -0,0 +1,21 @@
|= inject=json
^- manx
;html
::
;head
;title: Write
;meta(charset "utf-8");
;meta
=name "viewport"
=content "width=device-width, initial-scale=1, shrink-to-fit=no";
;link(rel "stylesheet", href "/~publish/index.css");
;script@"/~/channel/channel.js";
;script@"/~modulo/session.js";
;script: window.injectedState = {(en-json:html inject)}
==
::
;body
;div#root;
;script@"/~publish/index.js";
==
==

59494
app/write/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

2266
app/write/js/tile.js Normal file
View File

File diff suppressed because it is too large Load Diff

17
gen/curl-hiss.hoon
View File

@ -1,17 +0,0 @@
:: Make HTTP request(get only)
::
:::: /hoon/curl-hiss/gen
::
/? 310
/- sole
/+ generators
=, generators
=, eyre
:- %get |= {^ {a/hiss ~} usr/user}
^- (sole-request:sole (cask httr))
?. ?=($get p.q.a)
~| %only-get-requests-supported-in-generators :: XX enforced?
!!
:- *tang
:^ %| `usr `hiss`a
|=(hit/httr (produce %httr hit))

13
gen/curl.hoon
View File

@ -1,13 +0,0 @@
:: Fetch contents at url
::
:::: /hoon/curl/gen
::
/? 310
/- sole
/+ generators
=, [generators eyre]
:- %get |= {^ {a/tape ~} ~}
^- (sole-request:sole (cask httr))
%+ curl (scan a auri:de-purl:html)
|= hit/httr
(produce %httr hit)

11
gen/curl/url.hoon
View File

@ -1,11 +0,0 @@
:: Direct :curl to fetch contents at url
::
:::: /hoon/url/curl/gen
::
/? 310
::
:::::
::
:- %say
|= {^ {arg/tape ~} ~}
purl+(scan arg auri:de-purl:html)

18
gen/dns/authority.hoon → gen/dns-bind/authority.hoon
View File

@ -2,14 +2,26 @@
::
:::: /hoon/authority/dns/gen
::
/- *dns, *sole
/- *dns-bind, *sole
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[arg=$@(~ [dom=turf ~])]
~
==
^- (sole-result [%dns-command %authority authority])
^- (sole-result [%dns-authority authority])
=* our p.bec
:: XX must be evaluated outside tapp core due to +mule
::
=/ =hart:eyre .^(hart:eyre %r /(scot %p our)/host/real)
:: XX terrible
=/ domain /com/googleapis
=/ code
%- crip
+:(scow %p .^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our)))
=/ secrets
.^(@t %cx :(weld /(scot %p our)/home/(scot %da now)/sec domain /atom))
::
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ prompt
@ -27,4 +39,4 @@
%+ parse urs:ab
|= zone=@ta
%- produce
[%dns-command %authority [p.hot %gcloud project zone]]
[%dns-authority [p.hot %gcloud project zone [code hart secrets] ~]]

26
gen/dns/auto.hoon Normal file
View File

@ -0,0 +1,26 @@
:: DNS: configure automatically
::
:::: /hoon/auto/dns/gen
::
/- *sole
/+ *generators
:- %ask
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
^- (sole-result [%dns-auto ~])
=* our p.bec
=/ rac (clan:title our)
::
?: ?=(?(%earl %pawn) rac)
=/ msg1 "domain names are not provided for comets and moons"
=/ msg2 "see XX for BYOD"
%+ print leaf+msg2
(print leaf+msg1 no-product)
::
?. ?=(%czar rac)
=/ msg1 ":dns|auto is only supported for galaxies"
=/ msg2 "use :dns|request with your ship's public IP address"
=/ msg3 "see XX for more details, or to BYOD"
%+ print leaf+msg3
%+ print leaf+msg2
(print leaf+msg1 no-product)
(produce [%dns-auto ~])

25
gen/dns/ip.hoon
View File

@ -1,25 +0,0 @@
:: DNS: configure ip address
::
:::: /hoon/authority/dns/gen
::
/- *dns, *sole
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[arg=$@(~ [addr=@if ~])]
~
==
^- (sole-result [%dns-command command])
=* our p.bec
=- ?~ arg -
(fun.q.q addr.arg)
%+ prompt
[%& %dns-address "ipv4 address: "]
%+ parse
`$-(nail (like @if))`;~(pfix ;~(pose dot (easy ~)) lip:ag)
|= addr=@if
?: (reserved:eyre addr)
=/ msg "unable to bind reserved ipv4 address {(scow %if addr)}"
(print leaf+msg no-product)
%- produce
[%dns-command %ip %if addr]

43
gen/dns/request.hoon Normal file
View File

@ -0,0 +1,43 @@
:: DNS: configure ip address
::
:::: /hoon/request/dns/gen
::
/- *dns, *sole
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[arg=$@(~ [addr=@if ~])]
~
==
^- (sole-result [%dns-address address])
=* our p.bec
=/ rac (clan:title our)
::
?: ?=(%czar rac)
=/ msg1 "galaxy domain requests must be made out-of-band"
=/ msg2 "use :dns|auto if you already have an urbit domain"
=/ msg3 "see XX for more details or to BYOD"
%+ print leaf+msg3
%+ print leaf+msg2
(print leaf+msg1 no-product)
::
?: ?=(?(%earl %pawn) rac)
=/ msg1 "domain names are not provided for comets and moons"
=/ msg2 "see XX for BYOD"
%+ print leaf+msg2
(print leaf+msg1 no-product)
:: invoke parser with arg if present
::
=- ?~ arg -
(fun.q.q addr.arg)
%+ prompt
[%& %dns-address "ipv4 address: "]
%+ parse
^- $-(nail (like @if))
;~(pfix ;~(pose dot (easy ~)) lip:ag)
|= addr=@if
?: (reserved:eyre addr)
=/ msg "unable to bind reserved ipv4 address {(scow %if addr)}"
(print leaf+msg no-product)
%- produce
[%dns-address %if addr]

26
gen/frontpage.hoon Normal file
View File

@ -0,0 +1,26 @@
:: frontpage for your Urbit
::
:: outer gate is a standard generator
::
|= [[now=@da eny=@ bek=beak] $~ $~]
::
:: :- %build
|= [authorized=? request:http]
^- simple-payload:http
:- [200 ['content-type' 'text/html']~]
:- ~
%- as-octs:mimes:html
%- crip
%- en-xml:html
^- manx
;html
;head
;title:"Ran generator"
==
;body
;h1:"Ran generator"
:: ;p:"Executing on {<(scot %p our)>}."
;p:"The method was {<(trip method)>}."
;p:"The url was {<(trip url)>}."
==
==

19
gen/gmail/list.hoon
View File

@ -1,19 +0,0 @@
:: List [number] inbox messages XX may be broken
::
:::: /hoon/list/gmail/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ 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)]

15
gen/gmail/send.hoon
View File

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

14
gen/hood/default-serve.hoon Normal file
View File

@ -0,0 +1,14 @@
:: Eyre: set web root
::
:::: /hoon/serve/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
~
~
==
[%helm-serve [~ /] [%home /gen/frontpage/hoon ~]]

35
gen/hood/init-auth-basic.hoon
View File

@ -1,35 +0,0 @@
:: API: input basic auth credentials for domain
::
:::: /hoon/init-auth-basic/hood/gen
::
/? 314
/- sole
/+ generators
::
::::
::
=, generators
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$@(~ {dom/path ~})}
~
==
^- (sole-result:sole {$write-sec-atom p/host:eyre q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ prompt
[%& %oauth-hostname "api hostname: https://"]
%+ parse thos:de-purl:html
|= hot/host:eyre
?: ?=(%| -.hot)
~|(%ips-unsupported !!)
%+ prompt
[%& %auth-user "username: "]
%+ parse (boss 256 (star ;~(less col prn)))
|= usr/@t
%+ prompt
[%| %auth-passwd "password: "]
%+ parse (boss 256 (star prn))
|= pas/@t
%+ produce %write-sec-atom :: XX typed pair
[hot (crip (en-base64:mimes:html (rap 3 usr ':' pas ~)))]

36
gen/hood/init-oauth1.hoon
View File

@ -1,36 +0,0 @@
:: API: input oauth1 application credentials for domain
::
:::: /hoon/init-oauth1/hood/gen
::
/? 314
/- sole
/+ generators
::
::::
::
=, generators
=, eyre
:- %ask
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$@(~ {dom/path ~})}
~
==
^- (sole-result:sole {$write-sec-atom p/host q/@})
=- ?~ arg -
(fun.q.q [%& dom.arg])
%+ prompt
[%& %oauth-hostname "api hostname: https://"]
%+ parse thos:de-purl:html
|= hot/host
?: ?=(%| -.hot)
~|(%ips-unsupported !!)
%+ prompt
[%& %oauth-client "consumer key: "]
%+ parse (boss 256 (star prn))
|= key/@t
%+ prompt
[%& %oauth-secret "consumer secret: "]
%+ parse (boss 256 (star prn))
|= sec/@t
%+ produce %write-sec-atom :: XX typed pair
[hot (of-wain:format key sec ~)]

2
gen/hood/reboot.hoon
View File

@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ bec/beak}
{arg/~ ~}
==
[%helm-reload ~[%z %a %b %c %d %e %f %g %j]]
[%helm-reload ~[%z %a %b %c %d %f %g %j %l]]

12
gen/serving.hoon
View File

@ -1,12 +0,0 @@
:: Eyre: show web base path
::
:::: /hoon/serving/gen
::
/? 310
::
::::
::
:- %say
|= [[now=time @ our=ship ^] ~ ~]
:- %noun
.^(path %e (en-beam:format [our %serv da+now] /))

3
gen/tapp-admin/cancel.hoon Normal file
View File

@ -0,0 +1,3 @@
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
[%tapp-admin %cancel]

3
gen/tapp-admin/restart.hoon Normal file
View File

@ -0,0 +1,3 @@
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
[%tapp-admin %restart]

46
lib/async.hoon
View File

@ -17,12 +17,17 @@
:: fail: abort computation; don't send effects
:: done: finish computation; send effects
::
+$ contract-delta
$% [%gain =bone]
[%lose ~]
==
::
++ async-output-raw
|* a=mold
$~ [~ ~ ~ %done *a]
$: cards=(list card-type)
effects=(list async-move)
contracts=(set [add=? contract=contract-type])
contracts=(map contract-type contract-delta)
$= next
$% [%wait ~]
[%cont self=(async-form-raw a)]
@ -94,7 +99,7 @@
::
+$ eval-form
$: effects=(list async-move)
contracts=(set contract-type)
contracts=(map contract-type bone)
=form
==
::
@ -109,8 +114,8 @@
::
+$ eval-result
$% [%next ~]
[%fail contracts=(set contract-type) err=(pair term tang)]
[%done contracts=(set contract-type) value=a]
[%fail contracts=(map contract-type bone) err=(pair term tang)]
[%done contracts=(map contract-type bone) value=a]
==
::
:: Take a new sign and run the async against it
@ -140,30 +145,39 @@
(weld effects.eval-form effects.output)
:: add or remove contracts
::
=. .
=>
=* loop-result .
=/ new=(list [add=? contract=contract-type])
~(tap in contracts.output)
=/ new=(list [contract=contract-type delta=contract-delta])
~(tap by contracts.output)
|- ^+ loop-result
=* loop $
?~ new
loop-result
?: add.i.new
?: (~(has in contracts.eval-form) contract.i.new)
=/ exists=?
(~(has by contracts.eval-form) contract.i.new)
?- -.delta.i.new
:: add contract and bone
::
%gain
?: exists
%= loop-result
next.output [%fail %contract-already-exists >contract.i.new< ~]
==
%= loop
contracts.eval-form (~(put in contracts.eval-form) contract.i.new)
contracts.eval-form (~(put by contracts.eval-form) [contract bone.delta]:i.new)
new t.new
==
?: (~(has in contracts.eval-form) contract.i.new)
%= loop
contracts.eval-form (~(del in contracts.eval-form) contract.i.new)
new t.new
:: remove contract
::
%lose
?: exists
%= loop
contracts.eval-form (~(del by contracts.eval-form) contract.i.new)
new t.new
==
%= loop-result
next.output [%fail %contract-doesnt-exist >contract.i.new< ~]
==
%= loop-result
next.output [%fail %contract-doesnt-exist >contract.i.new< ~]
==
:: if done, produce effects
::

34
lib/basic-auth.hoon
View File

@ -1,34 +0,0 @@
:: Basic authentication
::
:::: /hoon/basic-auth/lib
::
=, eyre
|%
++ 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+(en-purl:html 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)]
--
--

140
lib/chat.hoon Normal file
View File

@ -0,0 +1,140 @@
/- hall
/+ hall-json
|%
::
+$ move [bone card]
::
+$ card
$% [%http-response =http-event:http]
[%connect wire binding:http-server term]
[%peer wire dock path]
[%quit ~]
[%poke wire dock poke]
[%peer wire dock path]
[%pull wire dock ~]
[%diff diff]
==
::
+$ diff
$% [%hall-rumor rumor:hall]
[%chat-update update]
[%chat-config streams]
[%json json]
==
::
+$ poke
$% [%hall-action action:hall]
[%noun [@tas path @t]]
==
::
+$ state
$% [%0 str=streams]
==
::
+$ streams
$: :: inbox config
::
inbox=config:hall
:: names and configs of all circles we know about
::
configs=(map circle:hall (unit config:hall))
:: messages for all circles we know about
::
messages=(map circle:hall (list envelope:hall))
::
::
circles=(set name:hall)
::
::
peers=(map circle:hall (set @p))
==
::
+$ update
$% [%inbox con=config:hall]
[%message cir=circle:hall env=envelope:hall]
[%messages cir=circle:hall start=@ud end=@ud env=(list envelope:hall)]
[%config cir=circle:hall con=config:hall]
[%circles cir=(set name:hall)]
[%peers cir=circle:hall per=(set @p)]
[%delete cir=circle:hall]
==
::
+$ action [%actions lis=(list action:hall)]
::
::
:: +utilities
::
++ msg-to-json
=, enjs:format
|= upd=update
^- json
?> ?=(%messages -.upd)
%+ frond %update
%- pairs
:~
:- %messages
%- pairs
:~
[%circle (circ:enjs:hall-json cir.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn env.upd enve:enjs:hall-json)]]
==
==
::
++ config-to-json
|= str=streams
=, enjs:format
^- json
%+ frond %chat
%- pairs
:~
::
[%inbox (conf:enjs:hall-json inbox.str)]
::
:- %configs
%- pairs
%+ turn ~(tap by configs.str)
|= [cir=circle:hall con=(unit config:hall)]
^- [@t json]
:- (crip (circ:en-tape:hall-json cir))
?~(con ~ (conf:enjs:hall-json u.con))
::
:- %circles :- %a
%+ turn ~(tap in circles.str)
|= nom=name:hall
[%s nom]
::
:- %peers
%- pairs
%+ turn ~(tap by peers.str)
|= [cir=circle:hall per=(set @p)]
^- [@t json]
:- (crip (circ:en-tape:hall-json cir))
[%a (turn ~(tap in per) ship)]
::
==
::
++ numbers-to-json
|= num=(list [circle:hall @ud])
^- json
=, enjs:format
%+ frond %chat
%- pairs
:~
::
:: %config
:- %numbers
:- %a
%+ turn num
|= [cir=circle:hall len=@ud]
^- json
%- pairs
:~
[%circle (circ:enjs:hall-json cir)]
[%length (numb len)]
==
==
::
--
::

168
lib/connector.hoon
View File

@ -1,168 +0,0 @@
:: 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:de-purl:html)
::
:: 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:clay 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 mapping them to
:: their handling, either `sigh-x` or `sigh-y`, in `places`.
::
++ sigh
=, html
=, eyre
|= {places/(list place) ren/care:clay pax/path res/httr:eyre}
^- 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:de-json)
?~ 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+(numb:enjs:format p.res) msg+u.jon]
(sub-result null+~)
u.-
::
++ sigh-y
?~ r.res
~& [err+s+%empty-response code+(numb:enjs:format p.res)]
arch+*arch
=+ jon=(rush q.u.r.res apex:de-json)
?~ jon
~& [err+s+%bad-json code+(numb:enjs:format p.res) body+s+q.u.r.res]
arch+*arch
?. =(2 (div p.res 100))
~& [err+s+%request-rejected code+(numb:enjs:format 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+(numb:enjs:format p.res) msg+u.jon]
arch+*arch
arch+u.-
--
--

217
lib/gh-parse.hoon
View File

@ -1,217 +0,0 @@
:: This library includes parsing functions for the json objects
:: that Github's API produces. In general, the conversion from
:: JSON to urbit types should be performed in marks, so those
:: marks should include this library.
::
/- gh
=, format
|%
++ repository
^- $-(json (unit repository:gh))
=+ dejs-soft
%- ot :~
'id'^id
'name'^so
'full_name'^so
'owner'^user
'private'^bo
'html_url'^so
'description'^so
'fork'^bo
'url'^so
'forks_url'^so
'keys_url'^so
'collaborators_url'^so
'teams_url'^so
'hooks_url'^so
'issue_events_url'^so
'events_url'^so
'assignees_url'^so
'branches_url'^so
'tags_url'^so
'blobs_url'^so
'git_tags_url'^so
'git_refs_url'^so
'trees_url'^so
'statuses_url'^so
'languages_url'^so
'stargazers_url'^so
'contributors_url'^so
'subscribers_url'^so
'subscription_url'^so
'commits_url'^so
'git_commits_url'^so
'comments_url'^so
'issue_comment_url'^so
'contents_url'^so
'compare_url'^so
'merges_url'^so
'archive_url'^so
'downloads_url'^so
'issues_url'^so
'pulls_url'^so
'milestones_url'^so
'notifications_url'^so
'labels_url'^so
'releases_url'^so
'created_at'^so
'updated_at'^so
'pushed_at'^so
'git_url'^so
'ssh_url'^so
'clone_url'^so
'svn_url'^so
'homepage'^some
'size'^ni
'stargazers_count'^ni
'watchers_count'^ni
'language'^some
'has_issues'^bo
'has_downloads'^bo
'has_wiki'^bo
'has_pages'^bo
'forks_count'^ni
'mirror_url'^some
'open_issues_count'^ni
'forks'^ni
'open_issues'^ni
'watchers'^ni
'default_branch'^so
==
++ commit
^- $-(json (unit commit:gh))
=+ dejs-soft
%- ot :~
'sha'^so
'url'^so
'author'^author
'committer'^author
'message'^so
'tree'^point
'parents'^(ar point)
'verification'^verification
==
++ user
^- $-(json (unit user:gh))
=+ dejs-soft
%- ot :~
'login'^so
'id'^id
'avatar_url'^so
'gravatar_id'^so
'url'^so
'html_url'^so
'followers_url'^so
'following_url'^so
'gists_url'^so
'starred_url'^so
'subscriptions_url'^so
'organizations_url'^so
'repos_url'^so
'events_url'^so
'received_events_url'^so
'type'^so
'site_admin'^bo
==
++ issue
^- $-(json (unit issue:gh))
|= jon/json
=- (bind - |*(issue/* `issue:gh`[jon issue]))
%. jon
=+ dejs-soft
%- ot :~
'url'^so
'labels_url'^so
'comments_url'^so
'events_url'^so
'html_url'^so
'id'^id
'number'^ni
'title'^so
'user'^user::|+(* (some *user:gh))
'labels'^(ar label)::|+(* (some *(list label:gh)))::(ar label)
'state'^so
'locked'^bo
'assignee'^(mu user)::|+(* (some *(unit user:gh)))::(mu user)
'milestone'^some
'comments'^ni
'created_at'^so
'updated_at'^so
'closed_at'^(mu so)
'body'^so
==
++ author
^- $-(json (unit author:gh))
=+ dejs-soft
%- ot :~
'date'^so
'name'^so
'email'^so
==
++ point
^- $-(json (unit point:gh))
=+ dejs-soft
%- ot :~
'url'^so
'sha'^so
==
++ verification
^- $-(json (unit verification:gh))
=+ dejs-soft
%- ot :~
'verified'^bo
'reason'^so
'signature'^(mu so)
'payload'^(mu so)
==
++ label
^- $-(json (unit label:gh))
=+ dejs-soft
%- ot :~
'url'^so
'name'^so
'color'^so
==
++ comment
^- $-(json (unit comment:gh))
=+ dejs-soft
%- ot :~
'url'^so
'html_url'^so
'issue_url'^so
'id'^id
'user'^user
'created_at'^so
'updated_at'^so
'body'^so
==
++ id no:dejs-soft
++ print-issue
|= issue:gh
=, format
^- 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 (to-wain body) :: strip carriage returns
|= l/@t
?: =('' l)
l
?. =('\0d' (rsh 3 (dec (met 3 l)) l))
l
(end 3 (dec (met 3 l)) l)
==
--

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

@ -1,25 +0,0 @@
:: 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:eyre ^+ a
%+ turn a
|=({p/@t q/@t} [(term p) q])
--

16
lib/hood/drum.hoon
View File

@ -79,13 +79,25 @@
=+ myr=(clan:title our)
::
?: ?=($pawn myr)
[[%base %collections] [%base %hall] [%base %talk] [%base %dojo] ~]
:~ [%home %collections]
:~ [%home %lens]
[%base %hall]
[%base %talk]
[%base %dojo]
[%base %modulo]
==
:~ [%home %lens]
[%home %acme]
[%home %dns]
[%home %dojo]
[%home %hall]
[%home %talk]
[%home %modulo]
[%home %launch]
[%home %chat]
[%home %write]
[%home %timer]
[%home %clock]
[%home %weather]
==
::
++ deft-fish :: default connects

14
lib/hood/helm.hoon
View File

@ -42,7 +42,7 @@
{$flog wire flog:dill} ::
[%mint wire p=ship q=safe:rights:jael]
{$nuke wire ship} ::
{$serv wire ?(desk beam)} ::
[%serve wire binding:http-server generator:http-server]
{$poke wire dock pear} ::
{$rest wire @da} ::
{$wait wire @da} ::
@ -135,10 +135,6 @@
|= mel/cord
abet
::
++ poke-serve
|= top/?(desk beam) =< abet
(emit %serv /helm/serv top)
::
++ poke-hi
|= mes/@t
~| %poke-hi-fail
@ -221,6 +217,14 @@
|= {way/wire her/ship cop/coop} =< abet
(emit %flog ~ %text "woot: {<[way cop]>}")
::
++ poke-serve
|= [=binding:http-server =generator:http-server] =< abet
(emit %serve /helm/serv binding generator)
::
++ take-bound
|= [wir=wire success=? binding=binding:http-server] =< abet
(emit %flog ~ %text "bound: {<success>}")
::
++ poke-tlon-init-stream
:: creates stream channel and makes it pull from
:: urbit-meta on {met}.

3
lib/hood/kiln.hoon
View File

@ -195,7 +195,8 @@
|%
++ emit |=(a/card +>(..autoload (^emit a)))
++ tracked-vanes
`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall %jael]
^- (list @tas)
~[%ames %behn %clay %dill %ford %gall %jael %lient %rver]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))

2
lib/hood/write.hoon
View File

@ -54,6 +54,8 @@
?. =(our src)
~|(foreign-write+[our=our src=src] !!)
=/ sev
:: XX this scry will always fail. wat do?
::
=+ .^(path %e /(scot %p our)/serv/(scot %da now))
?>(?=({@tas @tas *} -) -)
=; sob/soba:clay

35
lib/http.hoon
View File

@ -1,35 +0,0 @@
::
:::: /hoon/http/lib
::
::
::
/? 310
::
=, mimes:html
=, html
|%
++ request
$: domain/(list cord)
end-point/path
req-type/$?($get {$post p/json})
headers/math:eyre
queries/quay:eyre
==
++ send
|= {ost/bone pour-path/wire params/request}
:^ ost %them pour-path
`(unit hiss:eyre)`[~ (request-to-hiss params)]
::
++ request-to-hiss
|= request ^- hiss:eyre
=- ~& hiss=- -
:- ^- parsed-url/purl:eyre
:+ :+ security=%.y
port=~
host=[%.y [path=domain]]
endpoint=[extensions=~ point=end-point] :: ++pork,
q-strings=queries :: ++quay
?@ req-type
[%get headers ~]
[%post headers ~ (as-octt:mimes:html (en-json p.req-type))]
--

49
lib/interpolate.hoon
View File

@ -1,49 +0,0 @@
:: /foo/:bar/baz interpolation syntax
::
:::: /hoon/interpolate/lib
::
/? 310
::
:::: ~fyr
::
=, eyre
|%
++ parse-url
|= a/$@(cord:purl purl) ^- purl
?^ a a
~| bad-url+a
(rash a auri:de-purl:html)
::
++ 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]
--

338
lib/oauth1.hoon
View File

@ -1,338 +0,0 @@
:: OAuth 1.0 %authorization header
::
:::: /hoon/oauth1/lib
::
/+ interpolate, hep-to-cab
=, mimes:html
=, eyre
|%
++ keys cord:{key/@t sec/@t} :: app key pair
++ token :: user keys
$@ ~ :: none
$% {$request-token oauth-token/@t token-secret/@t} :: intermediate
{$access-token oauth-token/@t token-secret/@t} :: full
==
++ quay-enc (list tape) :: partially rendered query string
--
::
::::
::
|%
++ parse-url parse-url:interpolate
++ join
|= {a/cord b/(list cord)}
?~ b ''
(rap 3 |-([i.b ?~(t.b ~ [a $(b t.b)])]))
::
++ joint :: between every pair
|= {a/tape b/wall} ^- tape
?~ b b
|- ^- tape
?~ t.b i.b
:(weld i.b a $(b t.b))
::
++ join-en-urle |=(a/(list tape) (joint "&" (turn a en-urlt:html)))
:: query string in oauth1 'k1="v1", k2="v2"' form
++ to-header
|= a/quay ^- tape
%+ joint ", "
(turn a |=({k/@t v/@t} `tape`~[k '="' v '"'])) :: normalized later
::
:: partial tail:en-purl:html for sorting
++ encode-pairs
|= a/quay ^- quay-enc
%+ turn a
|= {k/@t v/@t} ^- tape
:(weld (en-urlt:html (trip k)) "=" (en-urlt:html (trip v)))
::
++ parse-pairs :: x-form-en-urlt:htmlncoded
|= bod/(unit octs) ^- quay-enc
~| %parsing-body
?~ bod ~
(rash q.u.bod (more pad (plus ;~(less pad prn))))
::
++ post-quay
|= {a/purl b/quay} ^- hiss
=. b (quay:hep-to-cab b)
=- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl:html b))))]
(my content-type+['application/x-www-form-urlencoded']~ ~)
::
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
=- (mean (flop `tang`[>a< -]))
(turn (to-wain:format (crip b)) |=(c/cord leaf+(trip c)))
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ quay-keys |-($@(knot {$ $})) :: improper tree
++ 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:de-purl:html)
~| grab-quay+[c b]
=+ all=(malt c)
%. b
|* b/quay-keys
?@ b ~|(b (~(got by all) b))
[(..$ -.b) (..$ +.b)]
--
::
::::
::
|_ {(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
;; {key/@t sec/@t ~}
(to-wain:format key)
%+ mean-wall %oauth-no-keys
"""
Run |init-oauth1 {<`path`dom>}
If necessary, obtain consumer keys configured for a oauth_callback of
{(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/real)
++ oauth-callback
~& [%oauth-warning "Make sure this urbit ".
"is running on {(en-purl:html our-host `~ ~)}"]
%- crip %- en-purl:html
%^ 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]~)
::
++ grab-token-response
|= a/httr ^- {tok/@t sec/@t}
(grab-quay r.a 'oauth_token' 'oauth_token_secret')
::
++ identity
%+ weld
?~(usr "default identity for " "{(trip usr)}@")
(trip (join '.' (flop dom)))
::
++ check-screen-name
|= a/httr ^- ?
=+ nam=(grab-quay r.a 'screen_name')
?~ usr &
?: =(usr nam) &
=< |
%- %*(. slog pri 1)
:: XX cgyarvin should figure out why we need to cast to ~
(flop p:(mule |.(~|(wrong-user+[req=usr got=nam] `~`!!))))
::
++ check-token-quay
|= a/quay ^+ %&
=. a (sort a aor)
?. ?=({{$'oauth_token' oauth-token/@t} {$'oauth_verifier' @t} ~} a)
~|(no-token+a !!)
?~ tok
%+ 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 !!)
%&
::
++ auth
|%
++ header
|= {auq/quay url/purl med/meth math bod/(unit octs)}
^- cord
=^ quy url [r.url url(r ~)] :: query string handled separately
=. 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))
=+ bay=(base-string med url qen)
=+ sig=(sign signing-key bay)
=. auq ['oauth_signature'^(crip (en-urlt:html sig)) auq]
(crip "OAuth {(to-header auq)}")
::
++ computed-query
^- quay
:~ oauth-consumer-key+consumer-key
oauth-nonce+(scot %uw (shaf %non eny))
oauth-signature-method+'HMAC-SHA1'
oauth-timestamp+(rsh 3 2 (scot %ui (unt:chrono:userlib now)))
oauth-version+'1.0'
==
++ base-string
|= {med/meth url/purl qen/quay-enc} ^- tape
=. qen (sort qen aor)
%- join-en-urle
:~ (cuss (trip `@t`med))
(en-purl:html url)
(joint "&" qen)
==
++ sign
|= {key/cord bay/tape} ^- tape
%- en-base64:mimes:html
%+ swp 3
(hmac-sha1t:hmac:crypto key (crip bay))
::
++ signing-key
%- crip
%- join-en-urle :~
(trip consumer-secret)
(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+(en-purl:html 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]
:: --
::

418
lib/oauth2.hoon
View File

@ -1,418 +0,0 @@
:: OAuth 2.0 %authorization
::
:::: /hoon/oauth2/lib
::
/+ hep-to-cab, interpolate
=, eyre
=, mimes:html
=, html
=, format
|%
++ 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 (as-octt +:(tail:en-purl b))))]
%^ my
:+ %accept
'application/json'
~
:+ %content-type
'application/x-www-form-urlencoded'
~
~
::
++ mean-wall !.
|= {a/term b/tape} ^+ !!
=- (mean (flop `tang`[>a< -]))
(turn (to-wain (crip b)) |=(c/cord leaf+(trip c)))
::
++ bad-response |=(a/@u ?:(=(2 (div a 100)) | ~&(bad-httr+a &)))
++ grab-json
|* {a/httr b/fist:dejs-soft:format}
~| bad-json+r.a
~| (de-json q:(need r.a))
(need (;~(biff de-json b) q:(need r.a)))
--
::
::::
::
:: XX belongs back in zuse
|%
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ pick :: light path decoding
=+ fel=(most cab (sear wick urt:ab))
|=(a/knot `(unit {p/term q/path})`(rush a fel))
::
--
::
::::
::
|%
++ token ?(~ @t)
++ refresh {tok/token expiry/@da pending/_`?`|}
++ both-tokens {token refresh}
++ keys cord:{cid/@t cis/@t}
--
::
::::
::
=+ state-usr=|
|_ {(bale:eyre keys) tok/token}
++ client-id cid:decode-keys
++ client-secret cis:decode-keys
++ decode-keys :: XX from bale:eyre w/ typed %jael
^- {cid/@t cis/@t ~}
?. =(~ `@`key)
~| %oauth-bad-keys
;; {cid/@t cis/@t ~}
(to-wain key)
%+ mean-wall %oauth-no-keys
"""
Run |init-oauth2 {<`path`dom>}
If necessary, obtain client keys configured for a redirect_uri of
{(trip redirect-uri)}
"""
::
++ auth-url
|= {scopes/(list @t) url/$@(@t purl)} ^- purl
~& [%oauth-warning "Make sure this urbit ".
"is running on {(en-purl our-host `~ ~)}"]
%+ add-query:interpolate url
%- quay:hep-to-cab
:~ state+?.(state-usr '' (pack usr /''))
client-id+client-id
redirect-uri+redirect-uri
scope+(join ' ' scopes)
==
::
:: XX duplicated from eyre
++ pack :: light path encoding
|= {a/term b/path} ^- knot
%+ rap 3 :- (wack a)
(turn b |=(c/knot (cat 3 '_' (wack c))))
::
++ our-host .^(hart %e /(scot %p our)/host/real)
++ redirect-uri
%- crip %- en-purl
%^ into-url:interpolate 'https://our-host/~/ac/:domain/:user/in'
`our-host
:~ domain+(join '.' (flop dom))
user+?:(state-usr '_state' (scot %ta usr))
==
::
::
++ 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
redirect-uri+redirect-uri
grant-type+grant-type
==
::
++ request-token-by-code
|=({a/$@(@t purl) b/@t} (request-token a 'authorization_code' code+b ~))
::
++ grab-token
|= a/httr ^- axs/@t
(grab-json a (ot 'access_token'^so ~):dejs-soft:format)
::
++ grab-expiring-token
|= a/httr ^- {axs/@t exp/@u}
(grab-json a (ot 'access_token'^so 'expires_in'^ni ~):dejs-soft:format)
::
++ grab-both-tokens
|= a/httr ^- {axs/@t exp/@u ref/@t}
%+ grab-json a
=, dejs-soft:format
(ot 'access_token'^so 'expires_in'^ni 'refresh_token'^so ~)
::
++ 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+(en-purl 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+(en-purl url.request)
request(r.url [[token-name query:auth] r.url.request])
::
++ re
|_ 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)))
::
++ 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
::
:: 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:eyre 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:eyre 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:eyre 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:eyre 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]
:: --
::

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