docket: hash-based glob-ames, handle within app

Instead of going through the thread. This works around a mark
definition issue and lets the docket file be more precise about
version selection. (Though older globs likely won't be kept around.)
This commit is contained in:
Fang 2021-09-21 16:15:57 +02:00
parent 976a071e5c
commit 4e453a9051
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
5 changed files with 88 additions and 34 deletions

View File

@ -8,7 +8,7 @@
info=(unit @t)
color=(unit @ux)
glob-http=(unit url)
glob-ames=(unit =ship)
glob-ames=(unit [=ship hash=@uv])
base=(unit term)
site=(unit path)
image=(unit url)
@ -61,7 +61,7 @@
%info draft(info `info.clause)
%color draft(color `color.clause)
%glob-http draft(glob-http `url.clause)
%glob-ames draft(glob-ames `ship:clause)
%glob-ames draft(glob-ames `[ship hash]:clause)
%base draft(base `base.clause)
%site draft(site `path.clause)
%image draft(image `url.clause)
@ -88,7 +88,7 @@
:~ base+base.href.d
?- -.loc
%http [%glob-http url.loc]
%ames [%glob-ames ship.loc]
%ames [%glob-ames ship.loc hash.loc]
== == ==
::
++ spit-clause
@ -98,7 +98,9 @@
?+ -.clause "'{(trip +.clause)}'"
%color (scow %ux color.clause)
%site (spud path.clause)
%glob-ames (scow %p ship.clause)
::
%glob-ames
"[{(scow %p ship.clause)} {(scow %uv hash.clause)}]"
::
%version
=, version.clause
@ -127,10 +129,10 @@
?- -.u
%del-charge s+desk.u
::
%initial
%initial
%- pairs
%+ turn ~(tap by initial.u)
|=([=desk c=^charge] [desk (charge c)])
|=([=desk c=^charge] [desk (charge c)])
::
%add-charge
%- pairs
@ -177,7 +179,7 @@
%+ frond -.loc
?- -.loc
%http (pairs url+s+url.loc ~)
%ames (ship ship.loc)
%ames (pairs ship+(ship ship.loc) hash+s+(scot %uv hash.loc) ~)
==
::
++ charge

View File

@ -10,7 +10,7 @@
::
+$ glob-location
$% [%http =url]
[%ames =ship]
[%ames =ship hash=@uvH]
==
:: $href: Where a tile links to
::
@ -24,9 +24,9 @@
$% :: Done
[%glob =glob]
[%site ~]
:: Waiting
:: Waiting
[%install ~]
[%suspend ~]
[%suspend glob=(unit glob)]
:: Error
[%hung err=cord]
==
@ -47,7 +47,7 @@
[%info info=@t]
[%color color=@ux]
[%glob-http url=cord]
[%glob-ames =ship]
[%glob-ames =ship hash=@uv]
[%image =url]
[%site =path]
[%base base=term]
@ -62,7 +62,7 @@
$: %1
title=@t
info=@t
color=@ux
color=@ux
=href
image=(unit url)
=version

View File

@ -123,10 +123,13 @@
?> (team:title [our src]:bowl)
`state
::
[%glob @ ~]
[%glob @ @ ~]
=* base i.t.path
=* hash (slav %uv i.t.t.path)
=/ desk ~|(path/path (~(got by by-base) i.t.path))
=/ =charge ~|(desk/desk (~(got by charges) desk))
?> ?=(%glob -.chad.charge)
?> =(hash (hash-glob:cc glob.chad.charge))
:_ state
:~ [%give %fact ~[path] %glob !>(`glob`glob.chad.charge)]
[%give %kick ~[path] ~]
@ -192,11 +195,22 @@
::
%commit
=* cha ~(. ch desk.diff)
=/ pre=(unit href)
?~ cho=(~(get by charges) desk.diff) ~
`href.docket.u.cho
?. docket-exists:cha `state
=/ =docket docket:cha
:: if the new chad is a site, we're instantly done
::
?: ?=(%site -.href.docket)
:_ state(charges (~(put by charges) desk.diff [docket [%site ~]]))
~[add-fact:cha]
:- ~[add-fact:cha]
state(charges (~(put by charges) desk.diff [docket [%site ~]]))
:: if the glob is unchanged, keep it
::
?: =(pre `href.docket)
[~[add-fact:cha] state]
:: if the glob changed, forget the old and fetch the new
::
=. charges (~(put by charges) desk.diff [docket %install ~])
=. by-base (~(put by by-base) base.href.docket desk.diff)
:_ state
@ -204,7 +218,11 @@
::
%suspend
?. (~(has by charges) desk.diff) `state
=. charges (new-chad:cha %suspend ~)
=/ glob=(unit glob)
=/ =chad
chad:(~(got by charges) desk.diff)
?:(?=(%glob -.chad) `glob.chad ~)
=. charges (new-chad:cha %suspend glob)
:_(state ~[add-fact:cha])
::
%revive
@ -213,7 +231,11 @@
?. ?=(%glob -.href.docket.charge)
=. charges (new-chad:cha %site ~)
:_(state ~[add-fact:cha])
=. charges (new-chad:cha %install ~)
=. charges
%- new-chad:cha
?. ?=([%suspend ~ *] chad.charge)
[%install ~]
[%glob u.glob.chad.charge]
:_(state [add-fact fetch-glob]:cha)
==
==
@ -237,7 +259,35 @@
?~ p.sign `state
((slog leaf+"Failed to uninstall %{(trip desk)}" u.p.sign) `state)
::
[%glob ~]
[%glob-ames ~]
?- -.sign
%kick `state
%poke-ack ~&([dap.bowl %unexpected-poke-ack] `state)
::
%watch-ack
?~ p.sign `state
%- %- slog
leaf+"docket: failed to fetch glob over ames for {(trip desk)}"
::TODO maybe we want to retry, but with delay?
`state
::
%fact
?. =(%glob p.cage.sign)
~& [dap.bowl %unexpected-fact from=src.bowl p.cage.sign]
`state
=+ !<(=glob q.cage.sign)
=/ =docket docket:(~(got by charges) desk)
?. ?=([%glob * %ames *] href.docket)
`state
?. =(hash.glob-location.href.docket (hash-glob glob))
~& [dap.bowl %glob-hash-mismatch on=desk from=src.bowl]
`state
=. charges (new-chad:cha glob+glob)
=. by-base (~(put by by-base) base.href.docket desk)
[~[add-fact:cha] state]
==
::
[%glob-http ~]
?- -.sign
%kick `state
::
@ -293,6 +343,8 @@
++ pass pass:io
++ def ~(. (default-agent state %|) bowl)
::
++ hash-glob sham
::
++ handle-http-request
|= [eyre-id=@ta inbound-request:eyre]
^- (quip card _state)
@ -418,6 +470,7 @@
[[400 ~] `(upload-page err)]
:- [[200 ~] `(upload-page 'successfully globbed' ~)]
::
::TODO update docket file with new hash if it was [%ames our x]
=. charges (new-chad:cha glob+glob)
=. by-base
=- (~(put by by-base) - desk)
@ -520,16 +573,25 @@
(poke-our:(pass %uninstall) %hood kiln-uninstall+!>(desk))
++ new-chad |=(c=chad (~(jab by charges) desk |=(charge +<(chad c))))
++ fetch-glob
^- (list card)
=/ =charge
~| desk/desk
(~(got by charges) desk)
=/ tid=@t (cat 3 'docket-' (scot %uv (sham (mix eny.bowl desk))))
?> ?=(%glob -.href.docket.charge)
=* loc glob-location.href.docket.charge
=/ loc glob-location.href.docket.charge
?: ?=(%ames -.loc)
?: =(our.bowl ship.loc)
~> %slog.0^leaf/"docket: awaiting manual glob for {<desk>} desk"
~
:_ ~
%+ watch:(pass %glob-ames)
[ship.loc %docket]
/glob/[base.href.docket.charge]/(scot %uv hash.loc)
~> %slog.0^leaf/"docket: fetching glob for {<desk>} desk"
=/ =cage spider-start+!>([~ `tid byk.bowl(r da+now.bowl) %glob !>(`[loc desk])])
:~ (watch-our:(pass %glob) %spider /thread-result/[tid])
(poke-our:(pass %glob) %spider cage)
:~ (watch-our:(pass %glob-http) %spider /thread-result/[tid])
(poke-our:(pass %glob-http) %spider cage)
==
++ docket-exists .^(? %cu (scry:io desk /desk/docket))
++ docket .^(^docket %cx (scry:io desk /desk/docket))

View File

@ -1,8 +1,8 @@
:~ title+'Garden'
info+'An app launcher for Urbit.'
color+0xee.5432
glob-http+'https://bootstrap.urbit.org/glob-0v3.559ah.r8cjf.oau66.a9sjf.m8fh3.glob'
::glob-ames+~zod
glob-http+'https://bootstrap.urbit.org/glob-0v2.dne76.9hibl.1o442.h6l11.cn7os.glob'
::glob-ames+~zod^0v0
base+'grid'
version+[0 0 1]
website+'https://tlon.io'

View File

@ -9,7 +9,7 @@
|^
?- -.loc
%http (fetch-http url.loc)
%ames (fetch-ames ship.loc base)
%ames !! ::NOTE done within docket itself
==
::
++ fetch-http
@ -24,14 +24,4 @@
|.
;;(=glob:docket (cue cord))
(pure:m !>(glob))
::
:: download from ship's docket state
++ fetch-ames
|= [=ship base=term]
^- form:m
;< =bowl:spider bind:m get-bowl:strandio
;< =cage bind:m
(watch-one:strandio /glob/(scot %da now.bowl) [ship %docket] /glob/[base])
?> ?=(%glob p.cage)
(pure:m q.cage)
--