urbit/pkg/arvo/sys/vane/fine.hoon
fang 207dc91c8c
fine: wip, add packet deserializing logic
Also stub our some flows, add todos, etc. Bit of a mess, follow-up soon.
2022-01-19 12:35:54 +01:00

484 lines
13 KiB
Plaintext

:: %fine, remote scries
!:
::
::TODO jael does ames-specific behavior for %public-keys gifts(?).
:: should it do something similar for fine?
::
=, fine
|= our=ship
=> |%
+$ move [p=duct q=(wite note gift)]
+$ note :: out request $->
$% $: %b
$% $>(%wait task:behn)
$>(%rest task:behn)
== ==
$: %j
$% $>(%private-keys task:jael)
$>(%public-keys task:jael)
== == ==
+$ sign
$% $: %behn
$% $>(%wake gift:behn)
== ==
$: %fine
$% $>(%tune gift)
$>(%hoot gift)
$>(%howl gift)
== ==
$: %jael
$% $>(%private-keys gift:jael)
$>(%public-keys gift:jael)
== == ==
::
::TODO get pubkeys from jael in the same way ames does
::
+$ fine-state
$: %0
hear=(jug path duct) :: awaiting existence
want=(jug path duct) :: awaiting response
part=(map path [siz=@ud pac=(map @ud @)]) :: partial responses
==
::
::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:keys 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:keys ~)
=/ 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=@ (full:keys 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:keys dat) :: signature
32^size :: number of fragments
16^wid :: response data size in bytes ::REVIEW
(mul 8 wid)^dat :: response data
==
::
++ keys
|%
++ full
|= [=path mess=*]
(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)
::
++ lyfe
|= who=ship
(jael (unit ^life) %lyfe /(scot %p our))
::
::TODO don't scry! subscribe & get from state instead
++ pass
|= [who=ship lyf=^life]
::TODO but might fail need checks?
:: (jael * %deed )
!!
--
::
::
::TODO copied from ames
+$ dyad [sndr=ship rcvr=ship]
+$ packet
$: dyad
sndr-tick=@ubC
rcvr-tick=@ubC
origin=(unit @uxaddress)
content=@uxcontent
==
::
::TODO copied from ames, only req parsing added
++ decode-packet
~/ %decode-packet
|= blob=@ux
^- [req=? packet]
~| %decode-packet-fail
:: first 32 (2^5) bits are header; the rest is body
::
=/ header (end 5 blob)
=/ body (rsh 5 blob)
:: read header; first two bits are reserved
::
:- req==(0 (cut 0 [2 1] header))
=/ is-ames (cut 0 [3 1] header)
?: =(& is-ames)
~| %fine-but-ames !!
::
=/ version (cut 0 [4 3] header)
?. =(protocol-version version)
~| fine-protocol-version+version !!
::
=/ sndr-size (decode-ship-size (cut 0 [7 2] header))
=/ rcvr-size (decode-ship-size (cut 0 [9 2] header))
=/ checksum (cut 0 [11 20] header)
=/ relayed (cut 0 [31 1] header)
:: origin, if present, is 6 octets long, at the end of the body
::
=^ origin=(unit @) body
?: =(| relayed)
[~ body]
=/ len (sub (met 3 body) 6)
[`(end [3 6] body) (rsh [3 6] body)]
:: .checksum does not apply to the origin
::
?. =(checksum (end [0 20] (mug body)))
~| %ames-checksum !!
:: read fixed-length sndr and rcvr life data from body
::
:: These represent the last four bits of the sender and receiver
:: life fields, to be used for quick dropping of honest packets to
:: or from the wrong life.
::
=/ sndr-tick (cut 0 [0 4] body)
=/ rcvr-tick (cut 0 [4 4] body)
:: read variable-length .sndr and .rcvr addresses
::
=/ off 1
=^ sndr off [(cut 3 [off sndr-size] body) (add off sndr-size)]
?. (is-valid-rank sndr sndr-size)
~| ames-sender-impostor+[sndr sndr-size] !!
::
=^ rcvr off [(cut 3 [off rcvr-size] body) (add off rcvr-size)]
?. (is-valid-rank rcvr rcvr-size)
~| ames-receiver-impostor+[rcvr rcvr-size] !!
:: read variable-length .content from the rest of .body
::
=/ content (cut 3 [off (sub (met 3 body) off)] body)
[[sndr rcvr] sndr-tick rcvr-tick origin content]
:: +decode-ship-size: decode a 2-bit ship type specifier into a byte width
::
:: Type 0: galaxy or star -- 2 bytes
:: Type 1: planet -- 4 bytes
:: Type 2: moon -- 8 bytes
:: Type 3: comet -- 16 bytes
::
++ decode-ship-size
~/ %decode-ship-size
|= rank=@ubC
^- @
::
?+ rank !!
%0b0 2
%0b1 4
%0b10 8
%0b11 16
==
:: +is-valid-rank: does .ship match its stated .size?
::
++ is-valid-rank
~/ %is-valid-rank
|= [=ship size=@ubC]
^- ?
.= size
?- (clan:title ship)
%czar 2
%king 2
%duke 4
%earl 8
%pawn 16
==
::
+$ twit :: signed request
$: signature=@
peep
==
::
+$ peep :: request data
$: =path
num=@ud
==
::
+$ rawr :: response data
$: sig=@
siz=@ud
wid=@ud
dat=@
==
::
++ decode-request
|= =hoot
^- twit
:- sig=(cut 0 [0 512] hoot)
-:(decode-request-info (rsh [0 512] hoot))
::
++ decode-request-info
|= =hoot
^- [=peep =purr]
=+ num=(cut 0 [0 32] hoot)
=+ len=(cut 0 [32 16] hoot)
=+ pat=(cut 3 [6 len] hoot)
:- [(stab pat) num]
:: if there is data remaining, it's the response
(rsh [3 (add 6 len)] hoot)
::
++ decode-response
|= =purr
=; =rawr
~? !=(wid.rawr (met 3 dat.rawr)) [%fine %unexpected-dat-size]
rawr
:* sig=(cut 0 [0 512] purr)
siz=(cut 0 [512 32] purr)
wid=(cut 0 [544 16] purr)
dat=(rsh 0^560 purr)
==
::
++ verify-response
|= rawr
!!
--
^?
|%
:: +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
state(want (~(put ju want) path.task hen))
::
%yawn
[~ state(want (~(del ju want) path.task hen))]
::
%purr
=/ [req=? =packet] (decode-packet purr.task)
?: req
=/ =twit (decode-request `@ux`content.packet)
::TODO verify request signature
::TODO handle twit
!!
=/ [=peep =purr] (decode-request-info `@ux`content.packet)
=/ =rawr (decode-response purr)
::TODO validate response signature
?: =(0 siz.rawr)
::TODO complete instantly
::TODO (~(del by part) path.peep) for safety?
!!
!!
:: =/ have=(list @) (~(get ja part) path.peep)
:: ::TODO if we get fancier, we could receive in any order
:: ?> =((lent have) (dec num.peep))
:: =. have [[wid dat]:rawr have]
:: :: if we have all the parts now, construct the response
:: ::
:: ?> (lte num.peep siz.rawr)
:: ?: =(num.peep siz.rawr)
:: ?. =((lent have) siz.rawr)
:: ::TODO wtf! start over?
:: !!
:: ::TODO need to flop first y/n?
:: !!
:: :: otherwise, store the part, and send out the next request
:: ::
:: =. part (~(put by part) path.peep have)
:: ::TODO emit properly
:: :+ %hoot
:: !! ::TODO get lane, from response or ames?
:: ::TODO needs header, prelude
:: (packetize-request path.peep +(num.peep))
::
%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]
--