shrub/pkg/arvo/sys/lull.hoon

2150 lines
81 KiB
Plaintext
Raw Normal View History

2020-12-08 06:31:13 +03:00
:: /sys/lull
:: %lull: arvo structures
::
=> ..part
2020-12-03 03:16:59 +03:00
|%
2020-12-08 09:56:01 +03:00
++ lull %330
2020-12-08 06:31:13 +03:00
:: :: ::
:::: :: :: (1) models
:: :: ::
:: # %misc
::
:: miscellaneous systems types
::+|
:: +capped-queue: a +qeu with a maximum number of entries
::
++ capped-queue
|$ [item-type]
$: queue=(qeu item-type)
size=@ud
max-size=_64
==
:: +clock: polymorphic cache type for use with the clock replacement algorithm
::
:: The +by-clock core wraps interface arms for manipulating a mapping from
:: :key-type to :val-type. Detailed docs for this type can be found there.
::
++ clock
|$ :: key-type: mold of keys
:: val-type: mold of values
::
[key-type val-type]
$: lookup=(map key-type [val=val-type fresh=@ud])
queue=(qeu key-type)
size=@ud
max-size=_2.048
depth=_1
==
::
+$ deco ?(~ %bl %br %un) :: text decoration
+$ json :: normal json value
$@ ~ :: null
$% [%a p=(list json)] :: array
[%b p=?] :: boolean
[%o p=(map @t json)] :: object
[%n p=@ta] :: number
[%s p=@t] :: string
== ::
+$ life @ud :: ship key revision
+$ rift @ud :: ship continuity
+$ mime (pair mite octs) :: mimetyped data
+$ octs (pair @ud @) :: octet-stream
+$ sock (pair ship ship) :: outgoing [our his]
+$ stub (list (pair stye (list @c))) :: styled unicode
+$ stye (pair (set deco) (pair tint tint)) :: decos/bg/fg
+$ styl %+ pair (unit deco) :: cascading style
(pair (unit tint) (unit tint)) ::
+$ styx (list $@(@t (pair styl styx))) :: styled text
+$ tint $@ ?(%r %g %b %c %m %y %k %w %~) :: text color
[r=@uxD g=@uxD b=@uxD] :: 24bit true color
+$ turf (list @t) :: domain, tld first
:: ::::
:::: ++ethereum-types :: eth surs for jael
:: ::::
++ ethereum-types
|%
:: ethereum address, 20 bytes.
::
++ address @ux
:: event location
::
+$ event-id [block=@ud log=@ud]
::
++ events (set event-id)
--
:: ::::
:::: ++azimuth-types :: az surs for jael
:: ::::
++ azimuth-types
=, ethereum-types
|%
++ point
$: :: ownership
::
$= own
$: owner=address
management-proxy=address
voting-proxy=address
transfer-proxy=address
==
::
:: networking
::
$= net
%- unit
$: =life
=pass
continuity-number=@ud
sponsor=[has=? who=@p]
escape=(unit @p)
==
::
:: spawning
::
$= kid
%- unit
$: spawn-proxy=address
spawned=(set @p) ::TODO sparse range, pile, see old jael ++py
==
==
::
+$ dnses [pri=@t sec=@t ter=@t]
::
++ diff-azimuth
$% [%point who=@p dif=diff-point]
[%dns dnses]
==
::
++ diff-point
$% [%full new=point] ::
[%owner new=address] :: OwnerChanged
[%activated who=@p] :: Activated
[%spawned who=@p] :: Spawned
[%keys =life =pass] :: ChangedKeys
[%continuity new=@ud] :: BrokeContinuity
[%sponsor new=[has=? who=@p]] :: EscapeAcc/LostSpons
[%escape new=(unit @p)] :: EscapeReq/Can
[%management-proxy new=address] :: ChangedManagementPro
[%voting-proxy new=address] :: ChangedVotingProxy
[%spawn-proxy new=address] :: ChangedSpawnProxy
[%transfer-proxy new=address] :: ChangedTransferProxy
==
--
:: +vane-task: general tasks shared across vanes
::
+$ vane-task
$~ [%born ~]
$% :: i/o device replaced (reset state)
::
[%born ~]
:: boot completed (XX legacy)
::
[%init ~]
:: trim state (in response to memory pressure)
::
[%trim p=@ud]
:: kernel upgraded
::
[%vega ~]
:: receive message via %ames
::
:: TODO: move .vane from $plea to here
::
[%plea =ship =plea:ames]
==
:: ::::
:::: ++http ::
:: ::::
:: http: shared representations of http concepts
::
++ http ^?
|%
:: +header-list: an ordered list of http headers
::
+$ header-list
(list [key=@t value=@t])
:: +method: exhaustive list of http verbs
::
+$ method
$? %'CONNECT'
%'DELETE'
%'GET'
%'HEAD'
%'OPTIONS'
%'POST'
%'PUT'
%'TRACE'
==
:: +request: a single http request
::
+$ request
$: :: method: http method
::
method=method
:: url: the url requested
::
:: The url is not escaped. There is no escape.
::
url=@t
:: header-list: headers to pass with this request
::
=header-list
:: body: optionally, data to send with this request
::
body=(unit octs)
==
:: +response-header: the status code and header list on an http request
::
:: We separate these away from the body data because we may not wait for
:: the entire body before we send a %progress to the caller.
::
+$ response-header
$: :: status: http status code
::
status-code=@ud
:: headers: http headers
::
headers=header-list
==
:: +http-event: packetized http
::
:: Urbit treats Earth's HTTP servers as pipes, where Urbit sends or
:: receives one or more %http-events. The first of these will always be a
:: %start or an %error, and the last will always be %cancel or will have
:: :complete set to %.y to finish the connection.
::
:: Calculation of control headers such as 'Content-Length' or
:: 'Transfer-Encoding' should be performed at a higher level; this structure
:: is merely for what gets sent to or received from Earth.
::
+$ http-event
$% :: %start: the first packet in a response
::
$: %start
:: response-header: first event information
::
=response-header
:: data: data to pass to the pipe
::
data=(unit octs)
:: whether this completes the request
::
complete=?
==
:: %continue: every subsequent packet
::
$: %continue
:: data: data to pass to the pipe
::
data=(unit octs)
:: complete: whether this completes the request
::
complete=?
==
:: %cancel: represents unsuccessful termination
::
[%cancel ~]
==
:: +get-header: returns the value for :header, if it exists in :header-list
::
++ get-header
|= [header=@t =header-list]
^- (unit @t)
::
?~ header-list
~
::
?: =(key.i.header-list header)
`value.i.header-list
::
$(header-list t.header-list)
:: +set-header: sets the value of an item in the header list
::
:: This adds to the end if it doesn't exist.
::
++ set-header
|= [header=@t value=@t =header-list]
^- ^header-list
::
?~ header-list
:: we didn't encounter the value, add it to the end
::
[[header value] ~]
::
?: =(key.i.header-list header)
[[header value] t.header-list]
::
[i.header-list $(header-list t.header-list)]
:: +delete-header: removes the first instance of a header from the list
::
++ delete-header
|= [header=@t =header-list]
^- ^header-list
::
?~ header-list
~
:: if we see it in the list, remove it
::
?: =(key.i.header-list header)
t.header-list
::
[i.header-list $(header-list t.header-list)]
:: +unpack-header: parse header field values
::
++ unpack-header
|^ |= value=@t
^- (unit (list (map @t @t)))
(rust (cass (trip value)) values)
::
++ values
%+ more
(ifix [. .]:(star ;~(pose ace (just '\09'))) com)
pairs
::
++ pairs
%+ cook
~(gas by *(map @t @t))
%+ most (ifix [. .]:(star ace) mic)
;~(plug token ;~(pose ;~(pfix tis value) (easy '')))
::
++ value
;~(pose token quoted-string)
::
++ token :: 7230 token
%+ cook crip
::NOTE this is ptok:de-purl:html, but can't access that here
%- plus
;~ pose
aln zap hax buc cen pam soq tar lus
hep dot ket cab tic bar sig
==
::
++ quoted-string :: 7230 quoted string
%+ cook crip
%+ ifix [. .]:;~(less (jest '\\"') doq)
%- star
;~ pose
;~(pfix bas ;~(pose (just '\09') ace prn))
;~(pose (just '\09') ;~(less (mask "\22\5c\7f") (shim 0x20 0xff)))
==
--
:: +simple-payload: a simple, one event response used for generators
::
+$ simple-payload
$: :: response-header: status code, etc
::
=response-header
:: data: the data returned as the body
::
data=(unit octs)
==
--
:: ::::
:::: ++ames :: (1a) network
:: ::::
++ ames ^?
|%
:: $task: job for ames
::
:: Messaging Tasks
::
:: %hear: packet from unix
:: %heed: track peer's responsiveness; gives %clog if slow
:: %jilt: stop tracking peer's responsiveness
:: %plea: request to send message
::
:: System and Lifecycle Tasks
::
:: %born: process restart notification
:: %init: vane boot
:: %sift: limit verbosity to .ships
:: %spew: set verbosity toggles
:: %trim: release memory
:: %vega: kernel reload notification
::
+$ task
$% [%hear =lane =blob]
[%heed =ship]
[%jilt =ship]
$>(%plea vane-task)
::
$>(%born vane-task)
$>(%init vane-task)
[%sift ships=(list ship)]
[%spew veb=(list verb)]
[%stir arg=@t]
$>(%trim vane-task)
$>(%vega vane-task)
==
:: $gift: effect from ames
::
:: Messaging Gifts
::
:: %boon: response message from remote ship
:: %clog: notify vane that %boon's to peer are backing up locally
:: %done: notify vane that peer (n)acked our message
:: %lost: notify vane that we crashed on %boon
:: %send: packet to unix
::
:: System and Lifecycle Gifts
::
:: %turf: domain report, relayed from jael
::
+$ gift
$% [%boon payload=*]
[%clog =ship]
[%done error=(unit error)]
[%lost ~]
[%send =lane =blob]
::
[%turf turfs=(list turf)]
==
::
:::: :: (1a2)
::
++ acru $_ ^? :: asym cryptosuite
|% :: opaque object
++ as ^? :: asym ops
|% ++ seal |~([a=pass b=@] *@) :: encrypt to a
++ sign |~(a=@ *@) :: certify as us
++ sure |~(a=@ *(unit @)) :: authenticate from us
++ tear |~([a=pass b=@] *(unit @)) :: accept from a
-- ::as ::
++ de |~([a=@ b=@] *(unit @)) :: symmetric de, soft
++ dy |~([a=@ b=@] *@) :: symmetric de, hard
++ en |~([a=@ b=@] *@) :: symmetric en
++ ex ^? :: export
|% ++ fig *@uvH :: fingerprint
++ pac *@uvG :: default passcode
++ pub *pass :: public key
++ sec *ring :: private key
-- ::ex ::
++ nu ^? :: reconstructors
|% ++ pit |~([a=@ b=@] ^?(..nu)) :: from [width seed]
++ nol |~(a=ring ^?(..nu)) :: from ring
++ com |~(a=pass ^?(..nu)) :: from pass
-- ::nu ::
-- ::acru ::
:: $address: opaque atomic transport address to or from unix
::
+$ address @uxaddress
:: $verb: verbosity flag for ames
::
+$ verb ?(%snd %rcv %odd %msg %ges %for %rot)
:: $blob: raw atom to or from unix, representing a packet
::
+$ blob @uxblob
:: $error: tagged diagnostic trace
::
+$ error [tag=@tas =tang]
:: $lane: ship transport address; either opaque $address or galaxy
::
:: The runtime knows how to look up galaxies, so we don't need to
:: know their transport addresses.
::
+$ lane (each @pC address)
:: $plea: application-level message, as a %pass
::
:: vane: destination vane on remote ship
:: path: internal route on the receiving ship
:: payload: semantic message contents
::
+$ plea [vane=@tas =path payload=*]
::
:: +| %atomics
::
+$ bone @udbone
+$ fragment @uwfragment
+$ fragment-num @udfragmentnum
+$ message-blob @udmessageblob
+$ message-num @udmessagenum
+$ public-key @uwpublickey
+$ symmetric-key @uwsymmetrickey
::
:: +| %kinetics
:: $ack: positive ack, nack packet, or nack trace
::
+$ ack
$% [%ok ~]
[%nack ~]
[%naxplanation =error]
==
::
:: +| %statics
:: $ship-state: all we know about a peer
::
:: %alien: no PKI data, so enqueue actions to perform once we learn it
:: %known: we know their life and public keys, so we have a channel
::
+$ ship-state
$% [%alien alien-agenda]
[%known peer-state]
==
:: $alien-agenda: what to do when we learn a peer's life and keys
::
:: messages: pleas local vanes have asked us to send
:: packets: packets we've tried to send
:: heeds: local tracking requests; passed through into $peer-state
::
+$ alien-agenda
$: messages=(list [=duct =plea])
packets=(set =blob)
heeds=(set duct)
==
:: $peer-state: state for a peer with known life and keys
::
:: route: transport-layer destination for packets to peer
:: qos: quality of service; connection status to peer
:: ossuary: bone<->duct mapper
:: snd: per-bone message pumps to send messages as fragments
:: rcv: per-bone message sinks to assemble messages from fragments
:: nax: unprocessed nacks (negative acknowledgments)
:: Each value is ~ when we've received the ack packet but not a
:: nack-trace, or an error when we've received a nack-trace but
:: not the ack packet.
::
:: When we hear a nack packet or an explanation, if there's no
:: entry in .nax, we make a new entry. Otherwise, if this new
:: information completes the packet+nack-trace, we remove the
:: entry and emit a nack to the local vane that asked us to send
:: the message.
:: heeds: listeners for %clog notifications
::
+$ peer-state
$: $: =symmetric-key
=life
=public-key
sponsor=ship
==
route=(unit [direct=? =lane])
=qos
=ossuary
snd=(map bone message-pump-state)
rcv=(map bone message-sink-state)
nax=(set [=bone =message-num])
heeds=(set duct)
==
:: $qos: quality of service; how is our connection to a peer doing?
::
:: .last-contact: last time we heard from peer, or if %unborn, when
:: we first started tracking time
::
+$ qos
$~ [%unborn *@da]
[?(%live %dead %unborn) last-contact=@da]
:: $ossuary: bone<->duct bijection and .next-bone to map to a duct
::
:: The first bone is 0. They increment by 4, since each flow includes
:: a bit for each message determining forward vs. backward and a
:: second bit for whether the message is on the normal flow or the
:: associated diagnostic flow (for naxplanations).
::
:: The least significant bit of a $bone is:
:: 1 if "forward", i.e. we send %plea's on this flow, or
:: 0 if "backward", i.e. we receive %plea's on this flow.
::
:: The second-least significant bit is 1 if the bone is a
:: naxplanation bone, and 0 otherwise. Only naxplanation
:: messages can be sent on a naxplanation bone, as %boon's.
::
+$ ossuary
$: =next=bone
by-duct=(map duct bone)
by-bone=(map bone duct)
==
:: $message-pump-state: persistent state for |message-pump
::
:: Messages queue up in |message-pump's .unsent-messages until they
:: can be packetized and fed into |packet-pump for sending. When we
:: pop a message off .unsent-messages, we push as many fragments as
:: we can into |packet-pump, which sends every packet it eats.
:: Packets rejected by |packet-pump are placed in .unsent-fragments.
::
:: When we hear a packet ack, we send it to |packet-pump to be
:: removed from its queue of unacked packets.
::
:: When we hear a message ack (positive or negative), we treat that
:: as though all fragments have been acked. If this message is not
:: .current, then this ack is for a future message and .current has
:: not yet been acked, so we place the ack in .queued-message-acks.
::
:: If we hear a message ack before we've sent all the fragments for
:: that message, clear .unsent-fragments and have |packet-pump delete
:: all sent fragments from the message. If this early message ack was
:: positive, print it out because it indicates the peer is not
:: behaving properly.
::
:: If the ack is for the current message, have |packet-pump delete
:: all packets from the message, give the message ack back
:: to the client vane, increment .current, and check if this next
:: message is in .queued-message-acks. If it is, emit the message
:: (n)ack, increment .current, and check the next message. Repeat
:: until .current is not fully acked.
::
:: The following equation is always true:
:: .next - .current == number of messages in flight
::
:: At the end of a task, |message-pump sends a %halt task to
:: |packet-pump, which can trigger a timer to be set or cleared based
:: on congestion control calculations. When the timer fires, it will
:: generally cause a packet to be re-sent.
::
:: Message sequence numbers start at 1 so that the first message will
:: be greater than .last-acked.message-sink-state on the receiver.
::
:: current: sequence number of earliest message sent or being sent
:: next: sequence number of next message to send
:: unsent-messages: messages to be sent after current message
:: unsent-fragments: fragments of current message waiting for sending
:: queued-message-acks: future message acks to be applied after current
:: packet-pump-state: state of corresponding |packet-pump
::
+$ message-pump-state
$: current=_`message-num`1
next=_`message-num`1
unsent-messages=(qeu message-blob)
unsent-fragments=(list static-fragment)
queued-message-acks=(map message-num ack)
=packet-pump-state
==
+$ static-fragment
$: =message-num
num-fragments=fragment-num
=fragment-num
=fragment
==
:: $packet-pump-state: persistent state for |packet-pump
::
:: next-wake: last timer we've set, or null
:: live: packets in flight; sent but not yet acked
:: metrics: congestion control information
::
+$ packet-pump-state
$: next-wake=(unit @da)
live=(tree [live-packet-key live-packet-val])
metrics=pump-metrics
==
:: $pump-metrics: congestion control state for a |packet-pump
::
:: This is an Ames adaptation of TCP's Reno congestion control
:: algorithm. The information signals and their responses are
:: identical to those of the "NewReno" variant of Reno; the
:: implementation differs because Ames acknowledgments differ from
:: TCP's, because this code uses functional data structures, and
:: because TCP's sequence numbers reset when a peer becomes
:: unresponsive, whereas Ames sequence numbers only change when a
:: ship breaches.
::
:: A deviation from Reno is +fast-resend-after-ack, which re-sends
:: timed-out packets when a peer starts responding again after a
:: period of unresponsiveness.
::
:: If .skips reaches 3, we perform a fast retransmit and fast
:: recovery. This corresponds to Reno's handling of "three duplicate
:: acks".
::
:: rto: retransmission timeout
:: rtt: roundtrip time estimate, low-passed using EWMA
:: rttvar: mean deviation of .rtt, also low-passed with EWMA
:: num-live: how many packets sent, awaiting ack
:: ssthresh: slow-start threshold
:: cwnd: congestion window; max unacked packets
::
+$ pump-metrics
$: rto=_~s1
rtt=_~s1
rttvar=_~s1
ssthresh=_10.000
cwnd=_1
num-live=@ud
counter=@ud
==
+$ live-packet
$: key=live-packet-key
val=live-packet-val
==
+$ live-packet-key
$: =message-num
=fragment-num
==
+$ live-packet-val
$: packet-state
num-fragments=fragment-num
=fragment
==
+$ packet-state
$: last-sent=@da
retries=@ud
skips=@ud
==
:: $message-sink-state: state of |message-sink to assemble messages
::
:: last-acked: highest $message-num we've fully acknowledged
:: last-heard: highest $message-num we've heard all fragments on
:: pending-vane-ack: heard but not processed by local vane
:: live-messages: partially received messages
::
+$ message-sink-state
$: last-acked=message-num
last-heard=message-num
pending-vane-ack=(qeu [=message-num message=*])
live-messages=(map message-num partial-rcv-message)
nax=(set message-num)
==
:: $partial-rcv-message: message for which we've received some fragments
::
:: num-fragments: total number of fragments in this message
:: num-received: how many fragments we've received so far
:: fragments: fragments we've received, eventually producing a $message
::
+$ partial-rcv-message
$: num-fragments=fragment-num
num-received=fragment-num
fragments=(map fragment-num fragment)
==
::
-- ::ames
:: ::::
:::: ++behn :: (1b) timekeeping
:: ::::
++ behn ^?
|%
+$ gift :: out result <-$
$% [%doze p=(unit @da)] :: next alarm
[%wake error=(unit tang)] :: wakeup or failed
[%meta p=vase]
[%heck syn=sign-arvo] :: response to %huck
==
+$ task :: in request ->$
$~ [%vega ~] ::
$% $>(%born vane-task) :: new unix process
[%rest p=@da] :: cancel alarm
[%drip p=vase] :: give in next event
[%huck syn=sign-arvo] :: give back
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
[%wait p=@da] :: set alarm
[%wake ~] :: timer activate
==
-- ::behn
:: ::::
:::: ++clay :: (1c) versioning
:: ::::
++ clay ^?
|%
+$ gift :: out result <-$
$% [%boon payload=*] :: ames response
[%croz rus=(map desk [r=regs w=regs])] :: rules for group
[%cruz cez=(map @ta crew)] :: permission groups
[%dirk p=@tas] :: mark mount dirty
[%ergo p=@tas q=mode] :: version update
[%hill p=(list @tas)] :: mount points
[%done error=(unit error:ames)] :: ames message (n)ack
[%mere p=(each (set path) (pair term tang))] :: merge result
[%note p=@tD q=tank] :: debug message
[%ogre p=@tas] :: delete mount point
[%rule red=dict wit=dict] :: node r+w permissions
[%writ p=riot] :: response
[%wris p=[%da p=@da] q=(set (pair care path))] :: many changes
== ::
+$ task :: in request ->$
$~ [%vega ~] ::
$% [%boat ~] :: pier rebooted
[%cred nom=@ta cew=crew] :: set permission group
[%crew ~] :: permission groups
[%crow nom=@ta] :: group usage
[%drop des=desk] :: cancel pending merge
[%info des=desk dit=nori] :: internal edit
$>(%init vane-task) :: report install
[%into des=desk all=? fis=mode] :: external edit
$: %merg :: merge desks
des=desk :: target
her=@p dem=desk cas=case :: source
how=germ :: method
== ::
[%mont pot=term bem=beam] :: mount to unix
[%dirk des=desk] :: mark mount dirty
[%ogre pot=$@(desk beam)] :: delete mount point
[%park des=desk yok=yoki ran=rang] :: synchronous commit
[%perm des=desk pax=path rit=rite] :: change permissions
[%pork ~] :: resume commit
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
[%warp wer=ship rif=riff] :: internal file req
[%werp who=ship wer=ship rif=riff-any] :: external file req
$>(%plea vane-task) :: ames request
== ::
::
:::: :: (1c2)
::
+$ aeon @ud :: version number
+$ ankh :: fs node (new)
$~ [~ ~]
$: fil=(unit [p=lobe q=cage]) :: file
dir=(map @ta ankh) :: folders
== ::
+$ beam [[p=ship q=desk r=case] s=path] :: global name
+$ beak [p=ship q=desk r=case] :: path prefix
+$ blob :: fs blob
$% [%delta p=lobe q=[p=mark q=lobe] r=page] :: delta on q
[%direct p=lobe q=page] :: immediate
== ::
:: +cable: a reference to something on the filesystem
:: face: the face to wrap around the imported file
:: file-path: location in clay
+$ cable
$: face=(unit term)
file-path=term
==
+$ care ?(%a %b %c %d %p %r %s %t %u %v %w %x %y %z) :: clay submode
+$ case :: ship desk case spur
$% [%da p=@da] :: date
[%tas p=@tas] :: label
[%ud p=@ud] :: number
== ::
+$ cass [ud=@ud da=@da] :: cases for revision
+$ crew (set ship) :: permissions group
+$ dict [src=path rul=real] :: effective permission
+$ dome :: project state
$: ank=ankh :: state
let=@ud :: top id
hit=(map @ud tako) :: changes by id
lab=(map @tas @ud) :: labels
== ::
+$ germ :: merge style
$? %init :: new desk
%fine :: fast forward
%meet :: orthogonal files
%mate :: orthogonal changes
%meld :: force merge
%only-this :: ours with parents
%only-that :: hers with parents
%take-this :: ours unless absent
%take-that :: hers unless absent
%meet-this :: ours if conflict
%meet-that :: hers if conflict
== ::
+$ lobe @uvI :: blob ref
+$ maki [p=@ta q=@ta r=@ta s=path] ::
+$ miso :: ankh delta
$% [%del ~] :: delete
[%ins p=cage] :: insert
[%dif p=cage] :: mutate from diff
[%mut p=cage] :: mutate from raw
== ::
+$ misu :: computed delta
$% [%del ~] :: delete
[%ins p=cage] :: insert
[%dif p=lobe q=cage] :: mutate from diff
== ::
+$ mizu [p=@u q=(map @ud tako) r=rang] :: new state
+$ moar [p=@ud q=@ud] :: normal change range
+$ moat [from=case to=case =path] :: change range
+$ mode (list [path (unit mime)]) :: external files
+$ mood [=care =case =path] :: request in desk
+$ mool [=case paths=(set (pair care path))] :: requests in desk
+$ nori :: repository action
$% [%& p=soba] :: delta
[%| p=@tas] :: label
== ::
+$ nuri :: repository action
$% [%& p=suba] :: delta
[%| p=@tas] :: label
== ::
+$ open $-(path vase) :: get prelude
+$ page (cask *) :: untyped cage
+$ plop blob :: unvalidated blob
+$ rang :: repository
$: hut=(map tako yaki) :: changes
lat=(map lobe blob) :: data
== ::
+$ rant :: response to request
$: p=[p=care q=case r=desk] :: clade release book
q=path :: spur
r=cage :: data
== ::
+$ rave :: general request
$% [%sing =mood] :: single request
[%next =mood] :: await next version
[%mult =mool] :: next version of any
[%many track=? =moat] :: track range
== ::
+$ real :: resolved permissions
$: mod=?(%black %white) ::
who=(pair (set ship) (map @ta crew)) ::
== ::
+$ regs (map path rule) :: rules for paths
+$ riff [p=desk q=(unit rave)] :: request+desist
+$ riff-any
$% [%1 =riff]
==
+$ rite :: new permissions
$% [%r red=(unit rule)] :: for read
[%w wit=(unit rule)] :: for write
[%rw red=(unit rule) wit=(unit rule)] :: for read and write
== ::
+$ riot (unit rant) :: response+complete
+$ rule [mod=?(%black %white) who=(set whom)] :: node permission
+$ rump [p=care q=case r=@tas s=path] :: relative path
+$ saba [p=ship q=@tas r=moar s=dome] :: patch+merge
+$ soba (list [p=path q=miso]) :: delta
+$ suba (list [p=path q=misu]) :: delta
+$ tako @ :: yaki ref
+$ toro [p=@ta q=nori] :: general change
++ unce :: change part
|* a=mold ::
$% [%& p=@ud] :: skip[copy]
[%| p=(list a) q=(list a)] :: p -> q[chunk]
== ::
++ urge |*(a=mold (list (unce a))) :: list change
+$ whom (each ship @ta) :: ship or named crew
+$ yoki (each yuki yaki) :: commit
+$ yuki :: proto-commit
$: p=(list tako) :: parents
q=(map path (each page lobe)) :: namespace
== ::
+$ yaki :: commit
$: p=(list tako) :: parents
q=(map path lobe) :: namespace
r=tako :: self-reference
t=@da :: date
== ::
::
:: +page-to-lobe: hash a page to get a lobe.
::
++ page-to-lobe |=(page (shax (jam +<)))
::
:: +make-yaki: make commit out of a list of parents, content, and date.
::
++ make-yaki
|= [p=(list tako) q=(map path lobe) t=@da]
^- yaki
=+ ^= has
%^ cat 7 (sham [%yaki (roll p add) q t])
(sham [%tako (roll p add) q t])
[p q has t]
:: $pile: preprocessed hoon source file
::
:: /- sur-file :: surface imports from /sur
:: /+ lib-file :: library imports from /lib
:: /= face /path :: imports built hoon file at path
:: /* face %mark /path :: unbuilt file imports, as mark
::
+$ pile
$: sur=(list taut)
lib=(list taut)
raw=(list [face=term =path])
bar=(list [face=term =mark =path])
=hoon
==
:: $taut: file import from /lib or /sur
::
+$ taut [face=(unit term) pax=term]
:: $mars: mark conversion request
:: $tube: mark conversion gate
::
+$ mars [a=mark b=mark]
+$ tube $-(vase vase)
:: $dais: processed mark core
::
+$ dais
$_ ^|
|_ sam=vase
++ bunt sam
++ diff |~(new=_sam *vase)
++ form *mark
++ join |~([a=vase b=vase] *(unit (unit vase)))
++ mash
|~ [a=[ship desk diff=vase] b=[ship desk diff=vase]]
*(unit vase)
++ pact |~(diff=vase sam)
++ vale |~(noun sam)
++ volt |~(noun sam)
--
::
++ get-fit
|= [bek=beak pre=@tas pax=@tas]
^- (unit path)
=/ paz (segments pax)
|- ^- (unit path)
?~ paz
~
=/ puz=path (snoc `path`[pre i.paz] %hoon)
=+ .^(=arch cy+[(scot %p p.bek) q.bek (scot r.bek) puz])
?^ fil.arch
`puz
$(paz t.paz)
:: +segments: compute all paths from :path-part, replacing some `/`s with `-`s
::
:: For example, when passed a :path-part of 'foo-bar-baz',
:: the product will contain:
:: ```
:: dojo> (segments 'foo-bar-baz')
:: ~[/foo-bar-baz /foo-bar/baz /foo/bar-baz /foo/bar/baz]
:: ```
::
++ segments
|= suffix=@tas
^- (list path)
=/ parser
(most hep (cook crip ;~(plug low (star ;~(pose low nud)))))
=/ torn=(list @tas) (fall (rush suffix parser) ~[suffix])
%- flop
|- ^- (list (list @tas))
?< ?=(~ torn)
?: ?=([@ ~] torn)
~[torn]
%- zing
%+ turn $(torn t.torn)
|= s=(list @tas)
^- (list (list @tas))
?> ?=(^ s)
~[[i.torn s] [(crip "{(trip i.torn)}-{(trip i.s)}") t.s]]
-- ::clay
:: ::::
:::: ++dill :: (1d) console
:: ::::
++ dill ^?
|%
+$ gift :: out result <-$
$% [%bbye ~] :: reset prompt
[%blit p=(list blit)] :: terminal output
[%burl p=@t] :: activate url
[%logo ~] :: logout
[%meld ~] :: unify memory
[%pack ~] :: compact memory
[%trim p=@ud] :: trim kernel state
== ::
+$ task :: in request ->$
$~ [%vega ~] ::
$% [%belt p=belt] :: terminal input
[%blew p=blew] :: terminal config
[%boot lit=? p=*] :: weird %dill boot
[%crop p=@ud] :: trim kernel state
[%crud p=@tas q=(list tank)] :: print error
[%flee session=~] :: unwatch session
[%flog p=flog] :: wrapped error
[%flow p=@tas q=(list gill:gall)] :: terminal config
[%hail ~] :: terminal refresh
[%heft ~] :: memory report
[%hook ~] :: this term hung up
[%harm ~] :: all terms hung up
$>(%init vane-task) :: after gall ready
[%meld ~] :: unify memory
[%noop ~] :: no operation
[%pack ~] :: compact memory
[%talk p=tank] ::
[%text p=tape] ::
[%view session=~] :: watch session blits
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
[%verb ~] :: verbose mode
[%knob tag=term level=?(%hush %soft %loud)] :: error verbosity
== ::
::
:::: :: (1d2)
::
+$ blew [p=@ud q=@ud] :: columns rows
+$ belt :: old belt
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%ret ~] :: return
[%txt p=(list @c)] :: utf32 text
== ::
+$ blit :: old blit
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%klr p=stub] :: set styled line
[%lin p=(list @c)] :: set current line
[%mor ~] :: newline
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
[%url p=@t] :: activate url
== ::
+$ dill-belt :: new belt
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%cru p=@tas q=(list tank)] :: echo error
[%ctl p=@] :: control-key
[%del ~] :: true delete
[%hey ~] :: refresh
[%met p=@] :: meta-key
[%ret ~] :: return
[%rez p=@ud q=@ud] :: resize, cols, rows
[%txt p=(list @c)] :: utf32 text
[%yow p=gill:gall] :: connect to app
== ::
+$ dill-blit :: new blit
$% [%bel ~] :: make a noise
[%clr ~] :: clear the screen
[%hop p=@ud] :: set cursor position
[%klr p=stub] :: styled text
[%mor p=(list dill-blit)] :: multiple blits
[%pom p=stub] :: styled prompt
[%pro p=(list @c)] :: show as cursor+line
[%qit ~] :: close console
[%out p=(list @c)] :: send output line
[%sag p=path q=*] :: save to jamfile
[%sav p=path q=@] :: save to file
[%url p=@t] :: activate url
== ::
+$ flog :: sent to %dill
$% [%crop p=@ud] :: trim kernel state
[%crud p=@tas q=(list tank)] ::
[%heft ~] ::
[%meld ~] :: unify memory
[%pack ~] :: compact memory
[%text p=tape] ::
[%verb ~] :: verbose mode
== ::
-- ::dill
:: ::::
:::: ++eyre :: (1e) http-server
:: ::::
++ eyre ^?
|%
+$ gift
$% :: set-config: configures the external http server
::
:: TODO: We need to actually return a (map (unit @t) http-config)
:: so we can apply configurations on a per-site basis
::
[%set-config =http-config]
:: response: response to an event from earth
::
[%response =http-event:http]
:: response to a %connect or %serve
::
:: :accepted is whether :binding was valid. Duplicate bindings are
:: not allowed.
::
[%bound accepted=? =binding]
==
::
+$ task
$~ [%vega ~]
$% :: initializes ourselves with an identity
::
$>(%init vane-task)
:: new unix process
::
$>(%born vane-task)
:: trim state (in response to memory pressure)
::
$>(%trim vane-task)
:: report upgrade
::
$>(%vega vane-task)
:: notifies us of the ports of our live http servers
::
[%live insecure=@ud secure=(unit @ud)]
:: update http configuration
::
[%rule =http-rule]
:: starts handling an inbound http request
::
[%request secure=? =address =request:http]
:: starts handling an backdoor http request
::
[%request-local secure=? =address =request:http]
:: cancels a previous request
::
[%cancel-request ~]
:: connects a binding to an app
::
[%connect =binding app=term]
:: connects a binding to a generator
::
[%serve =binding =generator]
:: disconnects a binding
::
:: This must be called with the same duct that made the binding in
:: the first place.
::
[%disconnect =binding]
:: notifies us that web login code changed
::
[%code-changed ~]
:: start responding positively to cors requests from origin
::
[%approve-origin =origin]
:: start responding negatively to cors requests from origin
::
[%reject-origin =origin]
==
:: +origin: request origin as specified in an Origin header
::
+$ origin @torigin
:: +cors-registry: origins categorized by approval status
::
+$ cors-registry
$: requests=(set origin)
approved=(set origin)
rejected=(set origin)
==
:: +outstanding-connection: open http connections not fully complete:
::
:: This refers to outstanding connections where the connection to
:: outside is opened and we are currently waiting on an app to
:: produce the results.
::
+$ outstanding-connection
$: :: action: the action that had matched
::
=action
:: inbound-request: the original request which caused this connection
::
=inbound-request
:: response-header: set when we get our first %start
::
response-header=(unit response-header:http)
:: bytes-sent: the total bytes sent in response
::
bytes-sent=@ud
==
:: +authentication-state: state used in the login system
::
+$ authentication-state
$: :: sessions: a mapping of session cookies to session information
::
sessions=(map @uv session)
==
:: +session: server side data about a session
::
+$ session
$: :: expiry-time: when this session expires
::
:: We check this server side, too, so we aren't relying on the browser
:: to properly handle cookie expiration as a security mechanism.
::
expiry-time=@da
:: channels: channels opened by this session
::
channels=(set @t)
::
:: TODO: We should add a system for individual capabilities; we should
:: mint some sort of long lived cookie for mobile apps which only has
:: access to a single application path.
==
:: channel-state: state used in the channel system
::
+$ channel-state
$: :: session: mapping between an arbitrary key to a channel
::
session=(map @t channel)
:: by-duct: mapping from ducts to session key
::
duct-to-key=(map duct @t)
==
:: +timer: a reference to a timer so we can cancel or update it.
::
+$ timer
$: :: date: time when the timer will fire
::
date=@da
:: duct: duct that set the timer so we can cancel
::
=duct
==
:: channel-event: unacknowledged channel event, vaseless sign
::
+$ channel-event
$% $>(%poke-ack sign:agent:gall)
$>(%watch-ack sign:agent:gall)
$>(%kick sign:agent:gall)
[%fact =mark =noun]
==
:: channel: connection to the browser
::
:: Channels are the main method where a webpage communicates with Gall
:: apps. Subscriptions and pokes are issues with PUT requests on a path,
:: while GET requests on that same path open a persistent EventSource
:: channel.
::
:: The EventSource API is a sequence number based API that browser provide
:: which allow the server to push individual events to the browser over a
:: connection held open. In case of reconnection, the browser will send a
:: 'Last-Event-Id: ' header to the server; the server then resends all
:: events since then.
::
+$ channel
$: :: channel-state: expiration time or the duct currently listening
::
:: For each channel, there is at most one open EventSource
:: connection. A 400 is issues on duplicate attempts to connect to the
:: same channel. When an EventSource isn't connected, we set a timer
:: to reap the subscriptions. This timer shouldn't be too short
:: because the
::
state=(each timer duct)
:: next-id: next sequence number to use
::
next-id=@ud
:: last-ack: time of last client ack
::
:: used for clog calculations, in combination with :unacked
::
last-ack=@da
:: events: unacknowledged events
::
:: We keep track of all events where we haven't received a
:: 'Last-Event-Id: ' response from the client or a per-poke {'ack':
:: ...} call. When there's an active EventSource connection on this
:: channel, we send the event but we still add it to events because we
:: can't assume it got received until we get an acknowledgment.
::
events=(qeu [id=@ud request-id=@ud =channel-event])
:: unacked: unacknowledged event counts by request-id
::
:: used for clog calculations, in combination with :last-ack
::
unacked=(map @ud @ud)
:: subscriptions: gall subscriptions by request-id
::
:: We maintain a list of subscriptions so if a channel times out, we
:: can cancel all the subscriptions we've made.
::
subscriptions=(map @ud [ship=@p app=term =path duc=duct])
:: heartbeat: sse heartbeat timer
::
heartbeat=(unit timer)
==
:: +binding: A rule to match a path.
::
:: A +binding is a system unique mapping for a path to match. A +binding
:: must be system unique because we don't want two handlers for a path;
:: what happens if there are two different actions for [~ /]?
::
+$ binding
$: :: site: the site to match.
::
:: A ~ will match the Urbit's identity site (your.urbit.org). Any
:: other value will match a domain literal.
::
site=(unit @t)
:: path: matches this prefix path
::
:: /~myapp will match /~myapp or /~myapp/longer/path
::
path=(list @t)
==
:: +action: the action to take when a binding matches an incoming request
::
+$ action
$% :: dispatch to a generator
::
[%gen =generator]
:: dispatch to an application
::
[%app app=term]
:: internal authentication page
::
[%authentication ~]
:: internal logout page
::
[%logout ~]
:: gall channel system
::
[%channel ~]
:: gall scry endpoint
::
[%scry ~]
:: respond with the default file not found page
::
[%four-oh-four ~]
==
:: +generator: a generator on the local ship that handles requests
::
:: This refers to a generator on the local ship, run with a set of
:: arguments. Since http requests are time sensitive, we require that the
:: generator be on the current ship.
::
+$ generator
$: :: desk: desk on current ship that contains the generator
::
=desk
:: path: path on :desk to the generator's hoon file
::
path=(list @t)
:: args: arguments passed to the gate
::
args=*
==
:: +http-config: full http-server configuration
::
+$ http-config
$: :: secure: PEM-encoded RSA private key and cert or cert chain
::
secure=(unit [key=wain cert=wain])
:: proxy: reverse TCP proxy HTTP(s)
::
proxy=_|
:: log: keep HTTP(s) access logs
::
log=?
:: redirect: send 301 redirects to upgrade HTTP to HTTPS
::
:: Note: requires certificate.
::
redirect=?
==
:: +http-rule: update configuration
::
+$ http-rule
$% :: %cert: set or clear certificate and keypair
::
[%cert cert=(unit [key=wain cert=wain])]
:: %turf: add or remove established dns binding
::
[%turf action=?(%put %del) =turf]
==
:: +address: client IP address
::
+$ address
$% [%ipv4 @if]
[%ipv6 @is]
:: [%ames @p]
==
:: +inbound-request: +http-request and metadata
::
+$ inbound-request
$: :: authenticated: has a valid session cookie
::
authenticated=?
:: secure: whether this request was encrypted (https)
::
secure=?
:: address: the source address of this request
::
=address
:: request: the http-request itself
::
=request:http
==
::
+$ cred :: credential
$: hut=hart :: client host
aut=(jug @tas @t) :: client identities
orx=oryx :: CSRF secret
acl=(unit @t) :: accept-language
cip=(each @if @is) :: client IP
cum=(map @tas *) :: custom dirt
== ::
+$ epic :: FCGI parameters
$: qix=(map @t @t) :: query
ced=cred :: client credentials
bem=beam :: original path
== ::
::
+$ hart [p=? q=(unit @ud) r=host] :: http sec+port+host
+$ hate [p=purl q=@p r=moth] :: semi-cooked request
+$ hiss [p=purl q=moth] :: outbound request
+$ host (each turf @if) :: http host
+$ hoke %+ each [%localhost ~] :: local host
?(%.0.0.0.0 %.127.0.0.1) ::
+$ httq :: raw http request
$: p=meth :: method
q=@t :: unparsed url
r=(list [p=@t q=@t]) :: headers
s=(unit octs) :: body
== ::
+$ httr [p=@ud q=mess r=(unit octs)] :: raw http response
+$ math (map @t (list @t)) :: semiparsed headers
+$ mess (list [p=@t q=@t]) :: raw http headers
+$ meth :: http methods
$? %conn :: CONNECT
%delt :: DELETE
%get :: GET
%head :: HEAD
%opts :: OPTIONS
%post :: POST
%put :: PUT
%trac :: TRACE
== ::
+$ moth [p=meth q=math r=(unit octs)] :: http operation
+$ oryx @t :: CSRF secret
+$ pork [p=(unit @ta) q=(list @t)] :: fully parsed url
:: +prox: proxy notification
::
:: Used on both the proxy (ward) and upstream sides for
:: sending/receiving proxied-request notifications.
::
+$ prox
$: :: por: tcp port
::
por=@ud
:: sek: secure?
::
sek=?
:: non: authentication nonce
::
non=@uvJ
==
+$ purf (pair purl (unit @t)) :: url with fragment
+$ purl [p=hart q=pork r=quay] :: parsed url
+$ quay (list [p=@t q=@t]) :: parsed url query
++ quer |-($@(~ [p=@t q=@t t=$])) :: query tree
+$ quri :: request-uri
$% [%& p=purl] :: absolute
[%| p=pork q=quay] :: relative
== ::
:: +reserved: check if an ipv4 address is in a reserved range
::
++ reserved
|= a=@if
^- ?
=/ b (flop (rip 3 a))
:: 0.0.0.0/8 (software)
::
?. ?=([@ @ @ @ ~] b) &
?| :: 10.0.0.0/8 (private)
::
=(10 i.b)
:: 100.64.0.0/10 (carrier-grade NAT)
::
&(=(100 i.b) (gte i.t.b 64) (lte i.t.b 127))
:: 127.0.0.0/8 (localhost)
::
=(127 i.b)
:: 169.254.0.0/16 (link-local)
::
&(=(169 i.b) =(254 i.t.b))
:: 172.16.0.0/12 (private)
::
&(=(172 i.b) (gte i.t.b 16) (lte i.t.b 31))
:: 192.0.0.0/24 (protocol assignment)
::
&(=(192 i.b) =(0 i.t.b) =(0 i.t.t.b))
:: 192.0.2.0/24 (documentation)
::
&(=(192 i.b) =(0 i.t.b) =(2 i.t.t.b))
:: 192.18.0.0/15 (reserved, benchmark)
::
&(=(192 i.b) |(=(18 i.t.b) =(19 i.t.b)))
:: 192.51.100.0/24 (documentation)
::
&(=(192 i.b) =(51 i.t.b) =(100 i.t.t.b))
:: 192.88.99.0/24 (reserved, ex-anycast)
::
&(=(192 i.b) =(88 i.t.b) =(99 i.t.t.b))
:: 192.168.0.0/16 (private)
::
&(=(192 i.b) =(168 i.t.b))
:: 203.0.113/24 (documentation)
::
&(=(203 i.b) =(0 i.t.b) =(113 i.t.t.b))
:: 224.0.0.0/8 (multicast)
:: 240.0.0.0/4 (reserved, future)
:: 255.255.255.255/32 (broadcast)
::
(gte i.b 224)
==
:: +ipa: parse ip address
::
++ ipa
;~(pose (stag %ipv4 ip4) (stag %ipv6 ip6))
:: +ip4: parse ipv4 address
::
++ ip4
=+ byt=(ape:ag ted:ab)
(bass 256 ;~(plug byt (stun [3 3] ;~(pfix dot byt))))
:: +ip6: parse ipv6 address
::
++ ip6
%+ bass 0x1.0000
%+ sear
|= hexts=(list $@(@ [~ %zeros]))
^- (unit (list @))
:: not every list of hextets is an ipv6 address
::
=/ legit=?
=+ l=(lent hexts)
=+ c=|=(a=* ?=([~ %zeros] a))
?| &((lth l 8) ?=([* ~] (skim hexts c)))
&(=(8 l) !(lien hexts c))
==
?. legit ~
%- some
:: expand zeros
::
%- zing
%+ turn hexts
|= hext=$@(@ [~ %zeros])
?@ hext [hext]~
(reap (sub 9 (lent hexts)) 0)
:: parse hextets, producing cell for shorthand zeroes
::
|^ %+ cook
|= [a=(list @) b=(list [~ %zeros]) c=(list @)]
:(welp a b c)
;~ plug
(more col het)
(stun [0 1] cel)
(more col het)
==
++ cel (cold `%zeros ;~(plug col col))
++ het (bass 16 (stun [1 4] six:ab))
--
::
+$ rout [p=(list host) q=path r=oryx s=path] :: http route (new)
+$ user knot :: username
-- ::eyre
:: ::::
:::: ++gall :: (1g) extensions
:: ::::
++ gall ^?
|%
+$ gift :: outgoing result
$% [%boon payload=*] :: ames response
[%done error=(unit error:ames)] :: ames message (n)ack
[%onto p=(each suss tang)] :: about agent
[%unto p=sign:agent] ::
== ::
+$ task :: incoming request
$~ [%vega ~] ::
$% [%conf dap=term] :: start agent
[%deal p=sock q=term r=deal] :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
[%sear =ship] :: clear pending queues
[%fade dap=term style=?(%slay %idle %jolt)] :: put app to sleep
$>(%init vane-task) :: set owner
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
$>(%plea vane-task) :: network request
== ::
+$ bitt (map duct (pair ship path)) :: incoming subs
+$ boat :: outgoing subs
%+ map [=wire =ship =term] ::
[acked=? =path] ::
+$ bowl :: standard app state
$: $: our=ship :: host
src=ship :: guest
dap=term :: agent
== ::
$: wex=boat :: outgoing subs
sup=bitt :: incoming subs
== ::
$: act=@ud :: change number
eny=@uvJ :: entropy
now=@da :: current time
byk=beak :: load source
== == ::
+$ dude term :: server identity
+$ gill (pair ship term) :: general contact
+$ scar :: opaque duct
$: p=@ud :: bone sequence
q=(map duct bone) :: by duct
r=(map bone duct) :: by bone
== ::
+$ suss (trel dude @tas @da) :: config report
+$ well (pair desk term) ::
+$ neat
$% [%arvo =note-arvo]
[%agent [=ship name=term] =deal]
==
+$ deal
$% [%raw-poke =mark =noun]
task:agent
==
::
:: +agent: app core
::
++ agent
=< form
|%
+$ step (quip card form)
+$ card (wind note gift)
+$ note
$% [%arvo =note-arvo]
[%agent [=ship name=term] =task]
==
+$ task
$% [%watch =path]
[%watch-as =mark =path]
[%leave ~]
[%poke =cage]
[%poke-as =mark =cage]
==
+$ gift
$% [%fact paths=(list path) =cage]
[%kick paths=(list path) ship=(unit ship)]
[%watch-ack p=(unit tang)]
[%poke-ack p=(unit tang)]
==
+$ sign
$% [%poke-ack p=(unit tang)]
[%watch-ack p=(unit tang)]
[%fact =cage]
[%kick ~]
==
++ form
$_ ^|
|_ bowl
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ old-state=vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
--
-- ::gall
:: %iris http-client interface
::
++ iris ^?
|%
:: +gift: effects the client can emit
::
+$ gift
$% :: %request: outbound http-request to earth
::
:: TODO: id is sort of wrong for this interface; the duct should
:: be enough to identify which request we're talking about?
::
[%request id=@ud request=request:http]
:: %cancel-request: tell earth to cancel a previous %request
::
[%cancel-request id=@ud]
:: %response: response to the caller
::
[%http-response =client-response]
==
::
+$ task
$~ [%vega ~]
$% :: system started up; reset open connections
::
$>(%born vane-task)
:: trim state (in response to memory pressure)
::
$>(%trim vane-task)
:: report upgrade
::
$>(%vega vane-task)
:: fetches a remote resource
::
[%request =request:http =outbound-config]
:: cancels a previous fetch
::
[%cancel-request ~]
:: receives http data from outside
::
[%receive id=@ud =http-event:http]
==
:: +client-response: one or more client responses given to the caller
::
+$ client-response
$% :: periodically sent as an update on the duct that sent %fetch
::
$: %progress
:: http-response-header: full transaction header
::
:: In case of a redirect chain, this is the target of the
:: final redirect.
::
=response-header:http
:: bytes-read: bytes fetched so far
::
bytes-read=@ud
:: expected-size: the total size if response had a content-length
::
expected-size=(unit @ud)
:: incremental: data received since the last %http-progress
::
incremental=(unit octs)
==
:: final response of a download, parsed as mime-data if successful
::
[%finished =response-header:http full-file=(unit mime-data)]
:: canceled by the runtime system
::
[%cancel ~]
==
:: mime-data: externally received but unvalidated mimed data
::
+$ mime-data
[type=@t data=octs]
:: +outbound-config: configuration for outbound http requests
::
+$ outbound-config
$: :: number of times to follow a 300 redirect before erroring
::
:: Common values for this will be 3 (the limit most browsers use), 5
:: (the limit recommended by the http standard), or 0 (let the
:: requester deal with 300 redirects).
::
redirects=_5
:: number of times to retry before failing
::
:: When we retry, we'll automatically try to use the 'Range' header
:: to resume the download where we left off if we have the
:: 'Accept-Range: bytes' in the original response.
::
retries=_3
==
:: +to-httr: adapts to old eyre interface
::
++ to-httr
|= [header=response-header:http full-file=(unit mime-data)]
^- httr:eyre
::
=/ data=(unit octs)
?~(full-file ~ `data.u.full-file)
::
[status-code.header headers.header data]
--
:: ::::
:::: ++jael :: (1h) security
:: ::::
++ jael ^?
|%
+$ public-keys-result
$% [%full points=(map ship point)]
[%diff who=ship =diff:point]
[%breach who=ship]
==
:: ::
+$ gift :: out result <-$
$% [%done error=(unit error:ames)] :: ames message (n)ack
[%boon payload=*] :: ames response
[%private-keys =life vein=(map life ring)] :: private keys
[%public-keys =public-keys-result] :: ethereum changes
[%turf turf=(list turf)] :: domains
== ::
:: +seed: private boot parameters
::
+$ seed [who=ship lyf=life key=ring sig=(unit oath:pki)]
::
+$ task :: in request ->$
$~ [%vega ~] ::
$% [%dawn dawn-event] :: boot from keys
[%fake =ship] :: fake boot
[%listen whos=(set ship) =source] :: set ethereum source
::TODO %next for generating/putting new private key
[%meet =ship =life =pass] :: met after breach
[%moon =ship =udiff:point] :: register moon keys
[%nuke whos=(set ship)] :: cancel tracker from
[%private-keys ~] :: sub to privates
[%public-keys ships=(set ship)] :: sub to publics
[%rekey =life =ring] :: update private keys
$>(%trim vane-task) :: trim state
[%turf ~] :: view domains
$>(%vega vane-task) :: report upgrade
$>(%plea vane-task) :: ames request
[%step ~] :: reset web login code
== ::
::
+$ dawn-event
$: =seed
spon=(list [=ship point:azimuth-types])
czar=(map ship [=rift =life =pass])
turf=(list turf)
bloq=@ud
node=(unit purl:eyre)
==
::
++ block
=< block
|%
+$ hash @uxblockhash
+$ number @udblocknumber
+$ id [=hash =number]
+$ block [=id =parent=hash]
--
::
:: Azimuth points form a groupoid, where the objects are all the
:: possible values of +point and the arrows are the possible values
:: of (list point-diff). Composition of arrows is concatenation,
:: and you can apply the diffs to a +point with +apply.
::
:: It's simplest to consider +point as the coproduct of three
:: groupoids, Rift, Keys, and Sponsor. Recall that the coproduct
:: of monoids is the free monoid (Kleene star) of the coproduct of
:: the underlying sets of the monoids. The construction for
:: groupoids is similar. Thus, the objects of the coproduct are
:: the product of the objects of the underlying groupoids. The
:: arrows are a list of a sum of the diff types of the underlying
:: groupoids. Given an arrow=(list diff), you can project to the
:: underlying arrows with +skim filtering on the head of each diff.
::
:: The identity element is ~. Clearly, composing this with any
:: +diff gives the original +diff. Since this is a category,
:: +compose must be associative (true, because concatenation is
:: associative). This is a groupoid, so we must further have that
:: every +point-diff has an inverse. These are given by the
:: +inverse operation.
::
++ point
=< point
|%
+$ point
$: =rift
=life
keys=(map life [crypto-suite=@ud =pass])
sponsor=(unit @p)
==
::
+$ key-update [=life crypto-suite=@ud =pass]
::
:: Invertible diffs
::
+$ diffs (list diff)
+$ diff
$% [%rift from=rift to=rift]
[%keys from=key-update to=key-update]
[%spon from=(unit @p) to=(unit @p)]
==
::
:: Non-invertible diffs
::
+$ udiffs (list [=ship =udiff])
+$ udiff
$: =id:block
$% [%rift =rift]
[%keys key-update]
[%spon sponsor=(unit @p)]
[%disavow ~]
== ==
::
++ udiff-to-diff
|= [=a=udiff =a=point]
^- (unit diff)
?- +<.a-udiff
%disavow ~|(%udiff-to-diff-disavow !!)
%spon `[%spon sponsor.a-point sponsor.a-udiff]
%rift
?. (gth rift.a-udiff rift.a-point)
~
~? !=(rift.a-udiff +(rift.a-point))
[%udiff-to-diff-skipped-rift a-udiff a-point]
`[%rift rift.a-point rift.a-udiff]
::
%keys
?. (gth life.a-udiff life.a-point)
~
~? !=(life.a-udiff +(life.a-point))
[%udiff-to-diff-skipped-life a-udiff a-point]
:^ ~ %keys
[life.a-point (~(gut by keys.a-point) life.a-point *[@ud pass])]
[life crypto-suite pass]:a-udiff
==
::
++ inverse
|= diffs=(list diff)
^- (list diff)
%- flop
%+ turn diffs
|= =diff
^- ^diff
?- -.diff
%rift [%rift to from]:diff
%keys [%keys to from]:diff
%spon [%spon to from]:diff
==
::
++ compose
(bake weld ,[(list diff) (list diff)])
::
++ apply
|= [diffs=(list diff) =a=point]
(roll diffs (apply-diff a-point))
::
++ apply-diff
|= a=point
|: [*=diff a-point=a]
^- point
?- -.diff
%rift
?> =(rift.a-point from.diff)
a-point(rift to.diff)
::
%keys
?> =(life.a-point life.from.diff)
?> =((~(get by keys.a-point) life.a-point) `+.from.diff)
%_ a-point
life life.to.diff
keys (~(put by keys.a-point) life.to.diff +.to.diff)
==
::
%spon
?> =(sponsor.a-point from.diff)
a-point(sponsor to.diff)
==
--
:: ::
:::: ::
:: ::
+$ source (each ship term)
+$ source-id @udsourceid
::
:: +state-eth-node: state of a connection to an ethereum node
::
+$ state-eth-node :: node config + meta
$: top-source-id=source-id
sources=(map source-id source)
sources-reverse=(map source source-id)
default-source=source-id
ship-sources=(map ship source-id)
ship-sources-reverse=(jug source-id ship)
== ::
:: ::
:::: ++pki:jael :: (1h2) certificates
:: ::::
++ pki ^?
|%
::TODO update to fit azimuth-style keys
:: the urbit meta-certificate (++will) is a sequence
:: of certificates (++cert). each cert in a will
:: revokes and replaces the previous cert. the
:: version number of a ship is a ++life.
::
:: the deed contains an ++arms, a definition
:: of cosmetic identity; a semi-trusted parent,
:: which signs the initial certificate and provides
:: routing services; and a dirty bit. if the dirty
:: bit is set, the new life of this ship may have
:: lost information that the old life had.
::
+$ hand @uvH :: 128-bit hash
+$ mind [who=ship lyf=life] :: key identifier
+$ name (pair @ta @t) :: ascii / unicode
+$ oath @ :: signature
-- :: pki
-- :: jael
::
+$ gift-arvo :: out result <-$
$~ [%doze ~]
$% gift:ames
gift:behn
gift:clay
gift:dill
gift:eyre
gift:gall
gift:iris
gift:jael
==
+$ task-arvo :: in request ->$
$% task:ames
task:clay
task:behn
task:dill
task:eyre
task:gall
task:iris
task:jael
==
+$ note-arvo :: out request $->
$~ [%b %wake ~]
$% [%a task:ames]
[%b task:behn]
[%c task:clay]
[%d task:dill]
[%e task:eyre]
[%g task:gall]
[%i task:iris]
[%j task:jael]
[@tas %meta vase]
==
:: full vane names are required in vanes
::
+$ sign-arvo :: in result $<-
$% [%ames gift:ames]
$: %behn
$% gift:behn
$>(%wris gift:clay)
$>(%writ gift:clay)
$>(%mere gift:clay)
$>(%unto gift:gall)
==
==
[%clay gift:clay]
[%dill gift:dill]
[%eyre gift:eyre]
[%gall gift:gall]
[%iris gift:iris]
[%jael gift:jael]
==
:: $unix-task: input from unix
::
+$ unix-task :: input from unix
$~ [%wake ~]
$% :: %dill: keyboard input
::
$>(%belt task:dill)
:: %dill: configure terminal (resized)
::
$>(%blew task:dill)
:: %clay: new process
::
$>(%boat task:clay)
:: %behn/%eyre/%iris: new process
::
$>(%born vane-task)
:: %eyre: cancel request
::
[%cancel-request ~]
:: %dill: reset terminal configuration
::
$>(%hail task:dill)
:: %ames: hear packet
::
$>(%hear task:ames)
:: %dill: hangup
::
$>(%hook task:dill)
:: %clay: external edit
::
$>(%into task:clay)
:: %eyre: learn ports of live http servers
::
$>(%live task:eyre)
:: %iris: hear (partial) http response
::
$>(%receive task:iris)
:: %eyre: starts handling an inbound http request
::
$>(%request task:eyre)
:: %eyre: starts handling an backdoor http request
::
$>(%request-local task:eyre)
:: %behn: wakeup
::
$>(%wake task:behn)
==
-- ::