Merge pull request #6744 from urbit/develop

Merge develop into next/kelvin/412
This commit is contained in:
Pyry Kovanen 2023-07-28 16:32:35 +03:00 committed by GitHub
commit c35aabcebf
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
22 changed files with 397 additions and 83 deletions

View File

@ -460,7 +460,7 @@
:- ~
^- octs
=; pro=json
(as-octt:mimes:html (en-json:html (sign:jws key.act pro bod)))
(as-octs:mimes:html (en:json:html (sign:jws key.act pro bod)))
:- %o %- my :~
nonce+s+non
url+s+(crip (en-purl:html url))
@ -487,7 +487,7 @@
::
?. =(400 p.rep) |
?~ r.rep |
=/ jon=(unit json) (de-json:html q.u.r.rep)
=/ jon=(unit json) (de:json:html q.u.r.rep)
?~ jon |
=('urn:ietf:params:acme:error:badNonce' type:(error:grab u.jon))
:: +rate-limited: handle Acme service rate-limits
@ -496,7 +496,7 @@
|= [try=@ud act=@tas spur=wire bod=(unit octs)]
^+ this
=/ jon=(unit json)
?~(bod ~ (de-json:html q.u.bod))
?~(bod ~ (de:json:html q.u.bod))
?~ jon
:: no details, back way off
:: XX specifically based on wire
@ -839,7 +839,7 @@
?: (lth try 10)
(retry:effect try %directory / (min ~m30 (backoff try)))
(emil (notify (failure-message directory-base) [(sell !>(rep)) ~]))
=. dir (directory:grab (need (de-json:html q:(need r.rep))))
=. dir (directory:grab (need (de:json:html q:(need r.rep))))
?~(reg.act register:effect this)
:: +nonce: accept new nonce and trigger next effect
::
@ -883,7 +883,7 @@
?~ r.rep
(scot %da now.bow)
=/ bod=acct:body
(acct:grab (need (de-json:html q.u.r.rep)))
(acct:grab (need (de:json:html q.u.r.rep)))
?> ?=(%valid sas.bod)
wen.bod
=. reg.act `[wen loc]
@ -913,7 +913,7 @@
:: XX check status
::
=/ bod=order:body
(order:grab (need (de-json:html q:(need r.rep))))
(order:grab (need (de:json:html q:(need r.rep))))
=/ dom=(set turf) ~(key by dom.u.next-order)
:: XX maybe generate key here?
::
@ -956,7 +956,7 @@
::
(emil (notify (failure-message ego.u.rod) [(sell !>(rep)) ~]))
=/ bod=order:body
(order:grab (need (de-json:html q:(need r.rep))))
(order:grab (need (de:json:html q:(need r.rep))))
?+ sas.bod
~& [%check-order-status-unknown sas.bod]
this
@ -1063,7 +1063,7 @@
::
(emil (notify (failure-message i.pending.aut.u.rod) [(sell !>(rep)) ~]))
=/ bod=auth:body
(auth:grab (need (de-json:html q:(need r.rep))))
(auth:grab (need (de:json:html q:(need r.rep))))
=/ cal=trial
:: XX parse token to verify url-safe base64?
::
@ -1147,7 +1147,7 @@
:: XX get challenge, confirm urn:ietf:params:acme:error:connection
::
:: =/ err=error:body
:: (error:grab (need (de-json:html q:(need r.rep))))
:: (error:grab (need (de:json:html q:(need r.rep))))
:: ?: =('urn:ietf:params:acme:error:malformed' status.err)
::
=< cancel-order:effect
@ -1155,7 +1155,7 @@
'unable to finalize domain validation challenge'
(emil (notify msg [(sell !>(rep)) ~]))
=/ bod=challenge:body
(challenge:grab (need (de-json:html q:(need r.rep))))
(challenge:grab (need (de:json:html q:(need r.rep))))
:: XX check for other possible values in 200 response
:: note: may have already been validated
::

View File

@ -269,7 +269,7 @@
|= reg=cord
^- (list [=ship rights])
~| %registration-json-insane
=+ jon=(need (de-json:html reg))
=+ jon=(need (de:json:html reg))
~| %registration-json-invalid
?> ?=(%o -.jon)
=. p.jon (~(del by p.jon) 'idCode')

View File

@ -115,7 +115,7 @@
:: |parser-at: parsers for dojo expressions using :dir as working directory
::
++ parser-at
|= [our=ship dir=beam]
|= [our=ship now=@da dir=beam]
|%
++ default-app %hood
++ hoon-parser (vang | (en-beam dir))
@ -129,7 +129,7 @@
=/ =desk
::TODO maybe should recognize if the user specified a desk explicitly.
:: currently eats the :app|desk#gen case.
=+ gop=(en-beam dir(q q.gol, s /$))
=+ gop=/(scot %p our)/[q.gol]/(scot %da now)/$
?. .^(? %gu gop)
q.dir
.^(desk %gd gop)
@ -365,7 +365,7 @@
dir(r [%da now.hid])
::
++ he-beak `beak`[p q r]:he-beam
++ he-parser (parser-at our.hid he-beam)
++ he-parser (parser-at our.hid now.hid he-beam)
::
++ dy :: project work
|_ dojo-project ::
@ -846,7 +846,6 @@
:: kev: key-value named arguments
:: kuv: default keyword arguments
:: sam: fully populated sample
:: rog: default gat sample
::
|. ^- vase
=/ gat=vase (slot 3 q.cay)
@ -870,9 +869,11 @@
!(~(has by q.cig) %drum-session)
==
[[%drum-session !>(ses.id)] soz] ::TODO does the who matter?
?: =(~ soz)
?~ soz
(fall kuv !>(~))
~| keyword-arg-failure+~(key by q.cig)
~_ 'dojo: bad-keyword (supplied sample incorrect)'
~_ 'dojo: keywords allowed'
~_ (skol p:(fall kuv !>(~)))
%+ slap
(with-faces kuv+(need kuv) rep+(with-faces soz) ~)
:+ %cncb [%kuv]~
@ -882,13 +883,57 @@
[[var]~ [%wing var %rep ~]]
::
=/ sam=vase :(slop ven poz kev)
?. (~(nest ut p.som) | p.sam)
~> %slog.1^leaf+"dojo: nest-need"
~> %slog.0^(skol p.som)
~> %slog.1^leaf+"dojo: nest-have"
~> %slog.0^(skol p.sam)
!!
(slam gat sam)
?: (~(nest ut p.som) | p.sam)
(slam gat sam)
:: something is wrong
::
%- mean
^- (list tank)
=/ cez=type [%cell %noun [%cell %noun %noun]]
?. (~(nest ut cez) | p.som)
:: [ven poz kev] can't nest in som
::
:~ 'dojo: nest-need'
(skol p.som)
'dojo: nest-have'
(skol p.sam)
'dojo: bad gate lost-argument (generator incorrect)'
==
::
=/ hed=vase (slot 2 som)
?. (~(nest ut p.hed) | p.ven)
:: ven can't nest in head
::
:~ 'dojo: nest-need'
(skol p.hed)
'dojo: nest-have'
(skol p.ven)
'dojo: bad gate event-sample (generator incorrect)'
==
::
=/ zop=vase (slot 6 som)
=/ lon=vase !>(*(lest))
?: ?& !(~(nest ut p.zop) | -:!>(~))
!(~(nest ut p.lon) | p.zop)
!(~(nest ut p.zop) | -:!>((slop zop !>(~))))
==
:: argument required, but nothing can nest
::
:~ 'dojo: nest-need'
(skol p.zop)
'dojo: nest-have'
(skol p.poz)
'dojo: bad gate impossible-nest (generator incorrect)'
==
:: poz doesn't nest in zop
::
?< (~(nest ut p.zop) | p.poz)
:~ 'dojo: nest-need'
(skol p.zop)
'dojo: nest-have'
(skol p.poz)
'dojo: bad-argument (supplied sample incorrect)'
==
::
++ dy-made-dial :: dialog product
|= cag=cage

View File

@ -70,7 +70,7 @@
^- card:agent:gall
[%pass /import-all %agent [our.bowl app] %poke %import !>(data)]
=/ jon=json
(need (de-json:html body))
(need (de:json:html body))
=/ com=command:lens
(json:grab:lens-mark jon)
::

View File

@ -315,7 +315,7 @@
::
=/ tube (convert-tube %json input-mark desk bowl)
?> ?=(^ body.request.inbound-request)
=/ body=json (need (de-json:html q.u.body.request.inbound-request))
=/ body=json (need (de:json:html q.u.body.request.inbound-request))
=/ input=vase (slop !>(~) (tube !>(body)))
=/ boc bec
=/ =start-args:spider [~ `tid boc(q desk, r da+now.bowl) thread input]

View File

@ -57,7 +57,7 @@
++ get-single-req
|= req=@t
=/ batch
((ar:dejs:format same) (need (de-json:html req)))
((ar:dejs:format same) (need (de:json:html req)))
?> ?=([* ~] batch)
i.batch
::
@ -110,8 +110,7 @@
|= [req=@t result=json]
^- card:agent:gall
=/ resp
%- crip
%- en-json:html
%- en:json:html
:- %a :_ ~
%- pairs
:~ id+s+(get-id req)

View File

@ -10,8 +10,8 @@
%- ~(gas in *math:eyre)
~['Content-Type'^['application/json']~]
%- some
%- as-octt:mimes:html
(en-json:html (request-to-json req))
%- as-octs:mimes:html
(en:json:html (request-to-json req))
::
++ request-to-json
|= request
@ -65,7 +65,7 @@
|= body=(unit octs)
^- (unit batch-request)
?~ body ~
?~ jon=(de-json:html q.u.body) ~
?~ jon=(de:json:html q.u.body) ~
=, dejs-soft:format
=; reparser
?: ?=([%a *] u.jon)

View File

@ -49,8 +49,8 @@
::
++ czar
^- octs
%- as-octt:mimes:html
%- en-json:html
%- as-octs:mimes:html
%- en:json:html
:- %a
%+ turn (gulf 0 255)
|= gal=@
@ -63,8 +63,8 @@
++ point
|= who=ship
^- octs
%- as-octt:mimes:html
%- en-json:html
%- as-octs:mimes:html
%- en:json:html
%+ request-to-json
~.
:- 'getPoint'
@ -73,8 +73,8 @@
::
++ turf
^- octs
%- as-octt:mimes:html
%- en-json:html
%- as-octs:mimes:html
%- en:json:html
%+ request-to-json
'turf'
['getDns' ~]
@ -106,7 +106,7 @@
++ czar
|= rep=octs
^- (unit (map ship [=rift =life =pass]))
=/ jon=(unit json) (de-json:html q.rep)
=/ jon=(unit json) (de:json:html q.rep)
?~ jon
~&([%czar-take-dawn %invalid-json] ~)
=/ res=(unit (list [@t @ud @ud @]))
@ -142,7 +142,7 @@
|= [who=ship rep=octs]
^- (unit point:azimuth)
~! *point:azimuth
=/ jon=(unit json) (de-json:html q.rep)
=/ jon=(unit json) (de:json:html q.rep)
?~ jon
~&([%point-take-dawn %invalid-json] ~)
=- ?~ res
@ -202,7 +202,7 @@
++ turf
|= rep=octs
^- (unit (list ^turf))
=/ jon=(unit json) (de-json:html q.rep)
=/ jon=(unit json) (de:json:html q.rep)
?~ jon
~&([%turf-take-dawn %invalid-json] ~)
=/ res=(unit (list @t))

View File

@ -197,7 +197,7 @@
^- (each (list channel-request) @t)
?- mode
%json
?~ maybe-json=(de-json:html q.body)
?~ maybe-json=(de:json:html q.body)
|+'put body not json'
?~ maybe-requests=(parse-channel-request-json u.maybe-json)
|+'invalid channel json'
@ -2676,7 +2676,7 @@
^- (unit (quip move tape))
?- mode.channel
%json %+ bind (channel-event-to-json channel request-id channel-event)
|=((quip move json) [+<- (en-json:html +<+)])
|=((quip move json) [+<- (trip (en:json:html +<+))])
%jam =- `[~ (scow %uw (jam -))]
[request-id channel-event]
==

View File

@ -4332,7 +4332,7 @@
~% %json ..part ~
|%
:: :: ++en:json:html
++ en :: encode JSON to tape
++ en :: encode JSON to cord
~% %en +>+ ~
|^ |= jon=^json
^- cord
@ -4400,11 +4400,11 @@
|^ |= txt=cord
^- (unit ^json)
(rush txt apex)
:: :: ++abox:de-json:html
:: :: ++abox:de:json:html
++ abox :: array
%+ stag %a
(ifix [sel (wish ser)] (more (wish com) apex))
:: :: ++apex:de-json:html
:: :: ++apex:de:json:html
++ apex :: any value
%+ knee *^json |. ~+
%+ ifix [spac spac]
@ -4416,13 +4416,13 @@
abox
obox
==
:: :: ++bool:de-json:html
:: :: ++bool:de:json:html
++ bool :: boolean
;~ pose
(cold & (jest 'true'))
(cold | (jest 'false'))
==
:: :: ++esca:de-json:html
:: :: ++esca:de:json:html
++ esca :: escaped character
;~ pfix bas
=* loo
@ -4436,23 +4436,23 @@
(sear ~(get by wow) low)
;~(pose doq fas bas loo unic)
==
:: :: ++expo:de-json:html
:: :: ++expo:de:json:html
++ expo :: exponent
;~ (comp weld)
(piec (mask "eE"))
(mayb (piec (mask "+-")))
(plus nud)
==
:: :: ++frac:de-json:html
:: :: ++frac:de:json:html
++ frac :: fraction
;~(plug dot (plus nud))
:: :: ++jcha:de-json:html
:: :: ++jcha:de:json:html
++ jcha :: string character
;~(pose ;~(less doq bas (shim 32 255)) esca)
:: :: ++mayb:de-json:html
:: :: ++mayb:de:json:html
++ mayb :: optional
|*(bus=rule ;~(pose bus (easy ~)))
:: :: ++numb:de-json:html
:: :: ++numb:de:json:html
++ numb :: number
;~ (comp weld)
(mayb (piec hep))
@ -4463,31 +4463,31 @@
(mayb frac)
(mayb expo)
==
:: :: ++obje:de-json:html
:: :: ++obje:de:json:html
++ obje :: object list
%+ ifix [(wish kel) (wish ker)]
(more (wish com) pear)
:: :: ++obox:de-json:html
:: :: ++obox:de:json:html
++ obox :: object
(stag %o (cook malt obje))
:: :: ++pear:de-json:html
:: :: ++pear:de:json:html
++ pear :: key-value
;~(plug ;~(sfix (wish stri) (wish col)) apex)
:: :: ++piec:de-json:html
:: :: ++piec:de:json:html
++ piec :: listify
|* bus=rule
(cook |=(a=@ [a ~]) bus)
:: :: ++stri:de-json:html
:: :: ++stri:de:json:html
++ stri :: string
%+ sear
|= a=cord
?. (sune a) ~
(some a)
(cook crip (ifix [doq doq] (star jcha)))
:: :: ++spac:de-json:html
:: :: ++spac:de:json:html
++ spac :: whitespace
(star (mask [`@`9 `@`10 `@`13 ' ' ~]))
:: :: ++unic:de-json:html
:: :: ++unic:de:json:html
++ unic :: escaped UTF16
=* lob 0x0
=* hsb 0xd800
@ -4530,7 +4530,7 @@
==
==
--
:: :: ++utfe:de-json:html
:: :: ++utfe:de:json:html
++ utfe :: UTF-8 sequence
;~ less doq bas
=* qua
@ -4591,18 +4591,18 @@
==
;~(pose qua tre dos)
==
:: :: ++wish:de-json:html
:: :: ++wish:de:json:html
++ wish :: with whitespace
|*(sef=rule ;~(pfix spac sef))
:: XX: These gates should be moved to hoon.hoon
:: :: ++sune:de-json:html
:: :: ++sune:de:json:html
++ sune :: cord UTF-8 sanity
|= b=@t
^- ?
?: =(0 b) &
?. (sung b) |
$(b (rsh [3 (teff b)] b))
:: :: ++sung:de-json:html
:: :: ++sung:de:json:html
++ sung :: char UTF-8 sanity
|^ |= b=@t
^- ?
@ -4683,7 +4683,7 @@
&((gte a bot) (lte a top))
--
:: XX: This +teff should overwrite the existing +teff
:: :: ++teff:de-json:html
:: :: ++teff:de:json:html
++ teff :: UTF-8 length
|= a=@t
^- @

View File

@ -114,7 +114,7 @@
++ get-single-req
|= req=@t
=/ batch
((ar:dejs:format same) (need (de-json:html req)))
((ar:dejs:format same) (need (de:json:html req)))
?> ?=([* ~] batch)
i.batch
::
@ -167,8 +167,7 @@
|= [req=@t result=json]
^- card:agent:gall
=/ resp
%- crip
%- en-json:html
%- en:json:html
:- %a :_ ~
%- pairs
:~ id+s+(get-id req)

View File

@ -137,7 +137,7 @@
=(chain-id 1)
==
fallback
?~ jon=(de-json:html q.data.u.full-file.u.rep)
?~ jon=(de:json:html q.data.u.full-file.u.rep)
fallback
=; res=(unit @ud)
?~ res fallback

View File

@ -43,8 +43,8 @@
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
%- some %- as-octs:mimes:html
%- en:json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:strandio request)
@ -62,7 +62,7 @@
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
=/ jon=(unit json) (de:json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format

View File

@ -652,7 +652,7 @@
:^ url %post
%- ~(gas in *math)
~['Content-Type'^['application/json']~]
(some (as-octt (en-json:html jon)))
(some (as-octs (en:json:html jon)))
:: +light-json-request: like json-request, but for %l
::
:: TODO: Exorcising +purl from our system is a much longer term effort;
@ -665,7 +665,7 @@
:* %'POST'
(crip (en-purl:html url))
~[['content-type' 'application/json']]
(some (as-octt (en-json:html jon)))
(some (as-octs (en:json:html jon)))
==
::
++ batch-read-request

View File

@ -76,8 +76,8 @@
header-list=['Content-Type'^'application/json' ~]
::
^= body
%- some %- as-octt:mimes:html
%- en-json:html
%- some %- as-octs:mimes:html
%- en:json:html
a+(turn reqs request-to-json:rpc:ethereum)
==
;< ~ bind:m
@ -96,7 +96,7 @@
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
=/ jon=(unit json) (de:json:html body)
?~ jon
(pure:m ~)
=/ array=(unit (list response:rpc))

View File

@ -0,0 +1,213 @@
=<
|%
++ diff
|= [old=* new=*]
^- patch
=/ del (extract-del (oracle old new) old)
=/ ins (extract-ins (oracle old new) new)
=/ allowed-holes (~(int in (find-del-holes del)) (find-ins-holes ins))
=. del (filter-del-holes allowed-holes del)
=/ ins (filter-ins-holes allowed-holes ins)
=/ closed-patch (closure (gcp [del ins]))
?> =(& +.closed-patch)
-.closed-patch
++ apply
|= [patch=_id noun=*]
?- -.patch
%diff
=/ var-map (del del.patch noun)
(ins ins.patch var-map)
::
%cell
?> ?=(^ noun)
[$(patch lhs.patch, noun -.noun) $(patch rhs.patch, noun +.noun)]
==
++ id
^- patch
[%diff [%hole ~] [%hole ~]]
+$ patch
$% [%cell lhs=patch rhs=patch]
[%diff ^diff]
==
--
::
|%
+$ del-diff
$% [%hole @]
[%cell lhs=del-diff rhs=del-diff]
[%ignore ~]
==
+$ ins-diff
$% [%hole @ original=*]
[%cell lhs=ins-diff rhs=ins-diff]
[%atom @]
==
+$ final-ins-diff
$% [%hole @]
[%cell lhs=final-ins-diff rhs=final-ins-diff]
[%atom @]
==
+$ diff [del=del-diff ins=final-ins-diff]
+$ patch
$% [%cell lhs=patch rhs=patch]
[%diff diff]
==
++ insify-noun
|= noun=*
^- final-ins-diff
?- noun
^ [%cell $(noun -.noun) $(noun +.noun)]
@ [%atom noun]
==
++ empty-set (silt `(list @)`~)
++ find-del-holes
|= diff=del-diff
~+
^- (set @)
?- -.diff
%hole (silt ~[+.diff])
%cell (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
%ignore empty-set
==
++ find-final-ins-holes
|= diff=final-ins-diff
~+
^- (set @)
?- -.diff
%hole (silt ~[+.diff])
%cell (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
%atom empty-set
==
++ find-ins-holes
|= diff=ins-diff
~+
^- (set @)
?- -.diff
%hole (silt ~[+<.diff])
%cell (~(uni in $(diff lhs.diff)) $(diff rhs.diff))
%atom empty-set
==
++ filter-del-holes
|= [allowed-holes=(set @) diff=del-diff]
^- del-diff
?: ?=(%ignore -.diff) diff
?- -.diff
%hole ?:((~(has in allowed-holes) +.diff) diff [%ignore ~])
%cell [%cell $(diff +<.diff) $(diff +>.diff)]
==
++ filter-ins-holes
|= [allowed-holes=(set @) diff=ins-diff]
^- final-ins-diff
?- -.diff
%cell [%cell $(diff +<.diff) $(diff +>.diff)]
%atom diff
%hole
?: (~(has in allowed-holes) +<.diff) [%hole +<.diff]
(insify-noun original:diff)
==
++ gcp
|= diff=diff
^- patch
?- -.ins.diff
%atom [%diff diff]
%hole [%diff diff]
%cell
?. ?=(%cell -.del.diff)
[%diff diff]
[%cell $(diff [+<.del.diff +<.ins.diff]) $(diff [+>.del.diff +>.ins.diff])]
==
++ closure
|= =patch
^- [^patch ?]
?- -.patch
%diff
=/ del-holes (find-del-holes del:patch)
=/ ins-holes (find-final-ins-holes ins:patch)
=/ difference (~(dif in ins-holes) del-holes)
[patch =(difference empty-set)]
::
%cell
=/ lhs $(patch lhs:patch)
=/ rhs $(patch rhs:patch)
?: ?&(+.lhs +.rhs) [[%cell -.lhs -.rhs] &]
$(patch (pull-diff [%cell -.lhs -.rhs]))
==
++ pull-diff
|= =patch
^- [%diff del=del-diff ins=final-ins-diff]
?- -.patch
%diff patch
%cell
=/ pulled-lhs $(patch lhs:patch)
=/ pulled-rhs $(patch rhs:patch)
:+ %diff
[%cell del:pulled-lhs del:pulled-rhs]
[%cell ins:pulled-lhs ins:pulled-rhs]
==
++ is-subtree
|= [tree=* subtree=*]
~+
^- ?
?: =(tree subtree) &
?@ tree |
?| (is-subtree -.tree subtree)
(is-subtree +.tree subtree)
==
++ oracle
|= [a=* b=*]
|= subtree=*
^- (unit @)
?: ?& (is-subtree a subtree)
(is-subtree b subtree)
==
`(mug subtree)
~
++ extract-del
|= [oracle=$-(* (unit @)) subtree=*]
~+
^- del-diff
=/ hash (oracle subtree)
?^ hash [%hole +.hash]
?@ subtree [%ignore ~]
[%cell (extract-del oracle -.subtree) (extract-del oracle +.subtree)]
++ extract-ins
|= [oracle=$-(* (unit @)) subtree=*]
~+
^- ins-diff
=/ hash (oracle subtree)
?^ hash [%hole +.hash subtree]
?@ subtree [%atom subtree]
[%cell (extract-ins oracle -.subtree) (extract-ins oracle +.subtree)]
++ ins
|= [diff=final-ins-diff var-map=(map @ *)]
^- *
?- -.diff
%atom +.diff
%cell [$(diff +<.diff) $(diff +>.diff)]
%hole (~(got by var-map) +.diff)
==
++ del
|= [diff=del-diff noun=*]
^- (map @ *)
|^ (go diff noun ((map @ *) ~))
++ go
|= [diff=del-diff noun=* var-map=(map @ *)]
^- (map @ *)
?- -.diff
%ignore
var-map
::
%hole
=/ subtree (~(get by var-map) +.diff)
?~ subtree (~(put by var-map) +.diff noun)
?> =(+.subtree noun)
var-map
::
%cell
?> ?=(^ noun)
=/ lhs-var-map $(diff +<.diff, noun -.noun)
=/ rhs-var-map $(diff +>.diff, noun +.noun, var-map lhs-var-map)
rhs-var-map
==
--
--

View File

@ -19,7 +19,7 @@
++ json-to-octs
|= jon=json
^- octs
(as-octt:mimes:html (en-json:html jon))
(as-octs:mimes:html (en:json:html jon))
::
++ app
|%

View File

@ -0,0 +1,26 @@
/+ noun-diff
|%
++ clog
|$ [stut]
$%
[%flush stut]
[%drain patch:noun-diff]
==
++ sink
|* pats=(list path)
|* stat=*
|@
++ sync
|= [stat=_stat]
^- [card:agent:gall _..sync]
=/ dif
%+ diff:noun-diff ^stat stat
:-
[%give %fact pats %noun !>(^-((clog) [%drain dif]))]
..sync(stat stat)
++ paths pats
++ flush
^- card:agent:gall
[%give %fact pats %noun !>(^-((clog) [%flush stat]))]
--
--

View File

@ -470,7 +470,7 @@
=/ m (strand ,json)
^- form:m
;< =cord bind:m (fetch-cord url)
=/ json=(unit json) (de-json:html cord)
=/ json=(unit json) (de:json:html cord)
?~ json
(strand-fail %json-parse-error ~)
(pure:m u.json)

View File

@ -0,0 +1,32 @@
::
:::: /hoon/noun/mar
::
/? 310
/+ noun-diff
!:
|_ non=*
++ grab |%
++ noun *
--
++ grow |%
++ mime [/application/x-urb-jam (as-octs:mimes:html (jam non))]
--
++ grad
|%
++ form %noun
++ diff
|= new=*
^- (list diff:noun-diff)
~[(diff:noun-diff non new)]
++ pact
|= patches=(list patch:noun-diff)
(roll patches |=([=patch:noun-diff n=_non] (apply:noun-diff patch n)))
:: A poor mans' version of merging patches. Just apply them in sequence.
++ join
|= [old=(list patch:noun-diff) new=(list patch:noun-diff)]
`(weld new old)
++ mash
|= [[ship desk old=(list patch:noun-diff)] [ship desk new=(list patch:noun-diff)]]
(weld new old)
--
--

View File

@ -120,7 +120,7 @@
?~ data
:: data is null
[~ state]
=/ ujon=(unit json) (de-json:html q.data.u.data)
=/ ujon=(unit json) (de:json:html q.data.u.data)
?~ ujon
[~ state]
?> ?=(%o -.u.ujon)

View File

@ -110,8 +110,8 @@
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
%- some %- as-octs:mimes:html
%- en:json:html
%: pairs:enjs:format
:- 'grant_type'
s+'urn:ietf:params:oauth:grant-type:jwt-bearer'
@ -125,7 +125,7 @@
?~ full-file.rep
(strand-fail:strandio %gcp-no-response ~)
=/ body=@t q.data.u.full-file.rep
=/ jon=(unit json) (de-json:html body)
=/ jon=(unit json) (de:json:html body)
?~ jon
~| body
(strand-fail:strandio %gcp-bad-body ~)