urbit/pkg/arvo/sys/vane/fine.hoon
fang 355f05753f
fine: remote scry
Implements a WIP version of %fine, the remote scry vane. Plenty of work
remains to be done here, marked by TODOs and REVIEWs.
2022-01-14 00:22:56 +01:00

260 lines
7.2 KiB
Plaintext

:: %fine, remote scries
!:
::
=, fine
|= our=ship
=> |%
+$ move [p=duct q=(wite note gift)]
+$ note :: out request $->
$% $: %b ::TODO to self
$>(%wait task:behn) :: set timer
== == ::
+$ sign
$% [%fine $>(%tune gift)]
[%fine $>(%hoot gift)]
[%fine $>(%howl gift)]
==
::
+$ fine-state
$: %0
hear=(jug path duct) :: awaiting existence
want=(jug path duct) :: awaiting response
part=(map path [size=@ud =song]) :: partial responses
::TODO cache? full=(map path (cask *))
==
::
::TODO types for unpacked packets?
::
+$ bits [w=@ud d=@]
++ protocol-version %0
--
::
~% %fine ..part ~
::
=| fine-state
=* state -
|= [now=@da eny=@uvJ rof=roof]
=* fine-gate .
=> |%
++ spit
|= =path
^- [pat=@t wid=@ud]
=+ pat=(spat path)
=+ wid=(met 3 pat)
?> (lte wid 384) ::TODO check when we handle %keen, instead of here?
[pat wid]
::
++ meet ::NOTE from ames, but bits instead of bytes
|= =ship
^- [size=@ rank=@ub]
=/ size=@ (met 3 ship)
?: (lte size 2) [16 %0b0]
?: (lte size 4) [32 %0b1]
?: (lte size 8) [64 %0b10]
[128 %0b11]
::
++ header
|= [for=ship req=? bod=@ rel=?]
^- bits
=+ him=(meet our)
=+ her=(meet for)
=+ sum=(end [0 20] (mug bod))
:- 32
%+ can 0
:~ 2^0 :: reserved
1^req :: request or response
1^| :: not ames
3^protocol-version :: protocol version
2^size.him :: sender address size
2^size.her :: receiver address size
20^sum :: checksum
1^rel :: relayed
==
::
++ prelude
|= [for=[=ship =life] =life origin=(unit lane:ames)]
^- bits
=+ him=(meet our)
=+ her=(meet ship.for)
=/ ore=bits
?. ?=([~ %| *] origin) 0^0
(mul 8 (met 3 p.u.origin))^p.u.origin
:- :(add 4 4 size.him size.her w.ore)
%+ can 0
:~ 4^(mod life 16) :: sender life
4^(mod life.for 16) :: receiver life
size.him^our :: sender
size.her^ship.for :: receiver
ore
==
::
++ request-body
|= [=path num=@ud]
^- bits
?> (lth num (bex 32))
=+ (spit path)
:- :(add 32 16 (mul 8 wid))
%+ can 0
:~ 32^num :: fragment number
16^wid :: path size
(mul 8 wid)^`@`pat :: namespace path
==
::
++ packetize-request
|= [=path num=@ud]
^- hoot
=+ bod=(request-body path num)
(can 0 512^(sign:sign d.bod) bod ~)
::
++ packetize-response
|= [=path data=(unit (cask *))]
^- song
:: prepend request descriptions to each response packet
::
=; pacs=(list bits)
%- head
%^ spin pacs 1
|= [pac=bits num=@ud]
^- [purr _num]
:_ +(num)
::NOTE we stub out the receiver & origin details,
:: runtime should replace them as appropriate.
=/ pre=bits (prelude [*ship *life] life:sign ~)
=/ req=bits (request-body path num)
=/ bod=bits [:(add w.pre w.req w.pac) (can 0 pre req pac ~)]
=/ hed=bits (header *ship | +.bod |)
(can 0 hed bod ~)
:: prepend a signature and split the data into 1024-byte fragments
::
=/ frag=(list @)
=/ sig=@ (sign path (fall data ~))
?~ data [sig]~
%+ rip 3^1.024 ::TODO prints "rip: stub"
(cat 3 sig (jam u.data)) ::REVIEW
=/ size=@ud
?~(data 0 (lent frag)) ::REVIEW
:: sign & packetize the fragments
::
%+ turn frag
|= dat=@
=/ wid=@ud (met 3 dat)
:- :(add 512 32 16 (mul 8 wid))
%+ can 0
:~ 512^(sign:sign dat) :: signature
32^size :: number of fragments
16^wid :: response data size in bytes ::REVIEW
(mul 8 wid)^dat :: response data
==
::
++ sign
|^ |= [=path mess=*]
!!
::TODO compiler bug here?
:: (sign (shax (jam [our life path mess])))
::
++ life ~+ (jael ^life %life /[(scot %p our)])
++ ring ~+ (jael ^ring %vein /[(scot %ud life)])
++ sign sign:as:(nol:nu:crub:crypto ring)
::
++ jael
|* [=mold =desk =path]
!< mold
%- tail %- need %- need
(rof `[our ~ ~] [%jael %$] [our desk da+now] path)
--
--
^?
|%
:: +call: handle a +task:fine request
::
++ call
~% %fine-call ..part ~
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
==
^- [(list move) _fine-gate]
::
=/ =task ((harden task) wrapped-task)
::
?^ dud
~|(%fine-call-dud (mean -.task tang.u.dud))
::
=^ moves state
?- -.task
%keen !! ::TODO emit request packet
%yawn !!
::
%purr !!
%bide [~ state(hear (~(put ju hear) path.task hen))]
::
%born [~ state(hear ~)] ::REVIEW assuming this is for runtime use only?
%trim [~ state] ::TODO maybe clear part?
%vega [~ state]
==
[~ fine-gate]
:: +load: migrate an old state to a new fine version
::
++ load
|= old=fine-state
^+ fine-gate
fine-gate(state old)
:: +scry: get packets
::
:: /fx/message/[full-scry-path] song all packets for some scry path
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
::TODO don't special-case whey scry
::
?: &(=(car %$) =(s.bem /whey))
=/ maz=(list mass)
:~ state+&+state
==
``mass+!>(maz)
:: only respond for the local identity, %$ desk, current timestamp
::
?. ?& =(our p.bem)
=(%$ q.bem)
=([%da now] r.bem)
==
~
::
?. ?=(%x car) ~
?. ?=([%message @ *] s.bem) ~
:: s.bem is expected to be a scry path of the shape /vc/desk/rev/etc,
:: so we need to give it the right shape
::
=/ pax=path
[i.t.s.bem (scot %p our) t.t.s.bem]
?~ nom=(de-omen pax) [~ ~]
:: we only support scrying into clay, and only if the data is fully public
::
?. =(%c (end 3 (snag 0 pax))) ~
=+ pem=(rof lyc (need (de-omen %cp (slag 1 pax))))
?~ pem ~
?~ u.pem ~
=+ per=!<([r=dict:clay w=dict:clay] q.u.u.pem)
?. =([%black ~ ~] rul.r.per) ~
:: scry out the data from clay and packetize it as appropriate
::
=+ res=(rof lyc u.nom)
?- res
~ ~
[~ ~] ``noun+!>((packetize-response pax ~))
[~ ~ *] ``noun+!>((packetize-response pax `[p q.q]:u.u.res))
==
::
++ stay state
++ take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^- [(list move) _fine-gate]
?^ dud
~|(%fine-take-dud (mean tang.u.dud))
::
::TODO
[~ fine-gate]
--