mirror of
https://github.com/urbit/shrub.git
synced 2024-09-11 20:27:19 +03:00
Merge branch 'next/kelvin/413' into i/5788/remote-scry
This commit is contained in:
Ted Blackman
commit
84cd948f30
1
.github/workflows/feature.yml
vendored
1
.github/workflows/feature.yml
vendored
@ -29,4 +29,5 @@ jobs:
|
||||
${{
|
||||
(github.ref_name == 'next/vere' && github.ref_type == 'branch')
|
||||
}}
|
||||
next: ${{ github.base_ref }}
|
||||
secrets: inherit
|
||||
|
||||
2
.github/workflows/next.yml
vendored
2
.github/workflows/next.yml
vendored
@ -27,5 +27,5 @@ jobs:
|
||||
uses: ./.github/workflows/shared.yml
|
||||
with:
|
||||
upload: true
|
||||
next: ${{ github.ref | replace('refs/heads/next/kelvin/', '') }}
|
||||
next: ${{ github.ref_name }}
|
||||
secrets: inherit
|
||||
|
||||
10
.github/workflows/shared.yml
vendored
10
.github/workflows/shared.yml
vendored
@ -15,7 +15,7 @@ on:
|
||||
default: 'edge'
|
||||
required: false
|
||||
next:
|
||||
description: 'next kelvin version'
|
||||
description: 'next kelvin version branch name'
|
||||
type: string
|
||||
default: null
|
||||
required: false
|
||||
@ -78,8 +78,12 @@ jobs:
|
||||
name: run urbit-tests
|
||||
run: |
|
||||
cp -RL tests pkg/arvo/tests
|
||||
if ${{ inputs.next != null }}; then
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${{ inputs.next }}"
|
||||
if [[ "${{ inputs.next }}" == "next/kelvin/"* ]]; then
|
||||
next=$(echo ${{ inputs.next }} | sed 's/[^0-9]//g')
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${next}"
|
||||
elif [[ "${{ github.head_ref }}" == "next/kelvin"* ]]; then
|
||||
next=$(echo ${{ github.head_ref }} | sed 's/[^0-9]//g')
|
||||
base="https://bootstrap.urbit.org/vere/next/kelvin/${next}"
|
||||
else
|
||||
base="https://bootstrap.urbit.org/vere/${{ inputs.pace }}"
|
||||
fi
|
||||
|
||||
@ -9,7 +9,6 @@
|
||||
::::
|
||||
::
|
||||
=, generators
|
||||
=, html
|
||||
=, format
|
||||
:- %ask
|
||||
|= $: [now=@da eny=@uvJ bec=beak]
|
||||
@ -23,7 +22,7 @@
|
||||
(fun.q.q jon.arg)
|
||||
%+ prompt
|
||||
[%& %oauth-json "json credentials: "]
|
||||
%+ parse apex:de-json
|
||||
%+ parse apex:de:json:html
|
||||
|= jon=json
|
||||
=+ ~| bad-json+jon
|
||||
=- `[cid=@t cis=@t]`(need (rep jon))
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
|_ mud=@
|
||||
++ grow
|
||||
|%
|
||||
++ mime [/application/octet-stream (as-octs mud)]
|
||||
++ mime [/application/x-urb-jam (as-octs mud)]
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
|
||||
@ -1 +1 @@
|
||||
[%zuse 414]
|
||||
[%zuse 413]
|
||||
|
||||
@ -1869,7 +1869,6 @@
|
||||
?~ a b
|
||||
[i=i.a t=$(a t.a)]
|
||||
--
|
||||
::
|
||||
:: 2n: functional hacks
|
||||
+| %functional-hacks
|
||||
::
|
||||
@ -2035,12 +2034,28 @@
|
||||
+$ knot @ta :: ASCII text
|
||||
+$ noun * :: any noun
|
||||
+$ path (list knot) :: like unix path
|
||||
+$ pith (list iota) :: typed urbit path
|
||||
+$ stud :: standard name
|
||||
$@ mark=@tas :: auth=urbit
|
||||
$: auth=@tas :: standards authority
|
||||
type=path :: standard label
|
||||
== ::
|
||||
+$ tang (list tank) :: bottom-first error
|
||||
:: ::
|
||||
+$ iota :: typed path segment
|
||||
$~ [%n ~]
|
||||
$@ @tas
|
||||
$% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui]
|
||||
[%ux @ux] [%uv @uv] [%uw @uw]
|
||||
[%sb @sb] [%sc @sc] [%sd @sd] [%si @si]
|
||||
[%sx @sx] [%sv @sv] [%sw @sw]
|
||||
[%da @da] [%dr @dr]
|
||||
[%f ?] [%n ~]
|
||||
[%if @if] [%is @is]
|
||||
[%t @t] [%ta @ta] :: @tas
|
||||
[%p @p] [%q @q]
|
||||
[%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq]
|
||||
==
|
||||
::
|
||||
:: $tank: formatted print tree
|
||||
::
|
||||
@ -5895,6 +5910,39 @@
|
||||
~
|
||||
;~(pfix fas (most fas urs:ab))
|
||||
::
|
||||
++ stip :: typed path parser
|
||||
=< swot
|
||||
|%
|
||||
++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
|
||||
::
|
||||
++ spot
|
||||
%+ sear (soft iota)
|
||||
%- stew
|
||||
^. stet ^. limo
|
||||
:~ :- 'a'^'z' (stag %tas sym)
|
||||
:- '$' (cold [%tas %$] buc)
|
||||
:- '0'^'9' bisk:so
|
||||
:- '-' tash:so
|
||||
:- '.' zust:so
|
||||
:- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~])))
|
||||
:- '\'' (stag %t qut)
|
||||
==
|
||||
--
|
||||
::
|
||||
++ pout
|
||||
|= =pith
|
||||
^- path
|
||||
%+ turn pith
|
||||
|= i=iota
|
||||
?@(i i (scot i))
|
||||
::
|
||||
++ pave
|
||||
|= =path
|
||||
^- pith
|
||||
%+ turn path
|
||||
|= i=@ta
|
||||
(fall (rush i spot:stip) [%ta i])
|
||||
::
|
||||
:: 4n: virtualization
|
||||
+| %virtualization
|
||||
::
|
||||
@ -11695,6 +11743,45 @@
|
||||
(stag %clsg poor)
|
||||
==
|
||||
::
|
||||
++ reed
|
||||
;~ pfix fas
|
||||
(stag %clsg (more fas stem))
|
||||
==
|
||||
::
|
||||
++ stem
|
||||
%+ knee *hoon |. ~+
|
||||
%+ cook
|
||||
|= iota=$%([%hoon =hoon] iota)
|
||||
?@ iota [%rock %tas iota]
|
||||
?: ?=(%hoon -.iota) hoon.iota
|
||||
[%clhp [%rock %tas -.iota] [%sand iota]]
|
||||
|^ %- stew
|
||||
^. stet ^. limo
|
||||
:~ :- 'a'^'z' ;~ pose
|
||||
(spit (stag %cncl (ifix [pal par] (most ace wide))))
|
||||
(spit (ifix [sel ser] wide))
|
||||
(slot sym)
|
||||
==
|
||||
:- '$' (cold %$ buc)
|
||||
:- '0'^'9' (slot bisk:so)
|
||||
:- '-' (slot tash:so)
|
||||
:- '.' ;~(pfix dot zust:so)
|
||||
:- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~]))))
|
||||
:- '\'' (stag %t qut)
|
||||
:- '[' (slip (ifix [sel ser] wide))
|
||||
:- '(' (slip (stag %cncl (ifix [pal par] (most ace wide))))
|
||||
==
|
||||
::
|
||||
++ slip |*(r=rule (stag %hoon r))
|
||||
++ slot |*(r=rule (sear (soft iota) r))
|
||||
++ spit
|
||||
|* r=rule
|
||||
%+ stag %hoon
|
||||
%+ cook
|
||||
|*([a=term b=*] `hoon`[%clhp [%rock %tas a] b])
|
||||
;~((glue lus) sym r)
|
||||
--
|
||||
::
|
||||
++ rupl
|
||||
%+ cook
|
||||
|= [a=? b=(list hoon) c=?]
|
||||
@ -12941,6 +13028,8 @@
|
||||
(ifix [gal gar] (stag %tell (most ace wide)))
|
||||
:- '>'
|
||||
(ifix [gar gal] (stag %yell (most ace wide)))
|
||||
:- '#'
|
||||
;~(pfix hax reed)
|
||||
==
|
||||
++ soil
|
||||
;~ pose
|
||||
@ -13021,6 +13110,68 @@
|
||||
(rune col %cncl exqz)
|
||||
==
|
||||
==
|
||||
:- '#'
|
||||
;~ pfix hax fas
|
||||
%+ stag %bccl
|
||||
%+ cook
|
||||
|= [[i=spec t=(list spec)] e=spec]
|
||||
[i (snoc t e)]
|
||||
;~ plug
|
||||
%+ most ;~(less ;~(plug fas tar) fas)
|
||||
%- stew
|
||||
^. stet ^. limo
|
||||
:~ :- ['a' 'z']
|
||||
;~ pose
|
||||
:: /name=@aura
|
||||
::
|
||||
%+ cook
|
||||
|= [=term =aura]
|
||||
^- spec
|
||||
:+ %bccl
|
||||
[%leaf %tas aura]
|
||||
:_ ~
|
||||
:+ %bcts term
|
||||
?+ aura [%base %atom aura]
|
||||
%f [%base %flag]
|
||||
%n [%base %null]
|
||||
==
|
||||
;~(plug sym ;~(pfix tis pat mota))
|
||||
::
|
||||
:: /constant
|
||||
::
|
||||
(stag %leaf (stag %tas ;~(pose sym (cold %$ buc))))
|
||||
==
|
||||
::
|
||||
:: /@aura
|
||||
::
|
||||
:- '@'
|
||||
%+ cook
|
||||
|= =aura
|
||||
^- spec
|
||||
:+ %bccl
|
||||
[%leaf %tas aura]
|
||||
[%base %atom aura]~
|
||||
;~(pfix pat mota)
|
||||
::
|
||||
:: /?
|
||||
::
|
||||
:- '?'
|
||||
(cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut)
|
||||
::
|
||||
:: /~
|
||||
::
|
||||
:- '~'
|
||||
(cold [%bccl [%leaf %tas %n] [%base %null] ~] sig)
|
||||
==
|
||||
::
|
||||
:: open-ended or fixed-length
|
||||
::
|
||||
;~ pose
|
||||
(cold [%base %noun] ;~(plug fas tar))
|
||||
(easy %base %null)
|
||||
==
|
||||
==
|
||||
==
|
||||
==
|
||||
++ expression
|
||||
%- stew
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
=> ..part
|
||||
~% %lull ..part ~
|
||||
|%
|
||||
++ lull %325
|
||||
++ lull %324
|
||||
:: :: ::
|
||||
:::: :: :: (1) models
|
||||
:: :: ::
|
||||
@ -2354,6 +2354,11 @@
|
||||
:: ::::
|
||||
++ eyre ^?
|
||||
|%
|
||||
+$ cache-entry
|
||||
$: auth=?
|
||||
$= body
|
||||
$% [%payload =simple-payload:http]
|
||||
== ==
|
||||
+$ gift
|
||||
$% :: set-config: configures the external http server
|
||||
::
|
||||
@ -2373,6 +2378,9 @@
|
||||
:: not allowed.
|
||||
::
|
||||
[%bound accepted=? =binding]
|
||||
:: notification that a cache entry has changed
|
||||
::
|
||||
[%grow =path]
|
||||
==
|
||||
::
|
||||
+$ task
|
||||
@ -2428,6 +2436,9 @@
|
||||
:: %spew: set verbosity toggle
|
||||
::
|
||||
[%spew veb=@]
|
||||
:: remember (or update) a cache mapping
|
||||
::
|
||||
[%set-response url=@t entry=(unit cache-entry)]
|
||||
==
|
||||
:: +origin: request origin as specified in an Origin header
|
||||
::
|
||||
@ -2525,7 +2536,8 @@
|
||||
:: events since then.
|
||||
::
|
||||
+$ channel
|
||||
$: :: channel-state: expiration time or the duct currently listening
|
||||
$: mode=?(%json %jam)
|
||||
:: 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
|
||||
|
||||
@ -67,8 +67,12 @@
|
||||
:: more structures
|
||||
::
|
||||
|%
|
||||
+$ axle
|
||||
$: %~2023.2.17
|
||||
++ axle
|
||||
$: :: date: date at which http-server's state was updated to this data structure
|
||||
::
|
||||
date=%~2023.4.11
|
||||
:: server-state: state of inbound requests
|
||||
::
|
||||
=server-state
|
||||
==
|
||||
:: +server-state: state relating to open inbound HTTP connections
|
||||
@ -84,6 +88,9 @@
|
||||
:: the :binding into a (map (unit @t) (trie knot =action)).
|
||||
::
|
||||
bindings=(list [=binding =duct =action])
|
||||
:: cache: mapping from url to versioned entry
|
||||
::
|
||||
cache=(map url=@t [aeon=@ud val=(unit cache-entry)])
|
||||
:: cors-registry: state used and managed by the +cors core
|
||||
::
|
||||
=cors-registry
|
||||
@ -118,9 +125,12 @@
|
||||
$% :: %ack: acknowledges that the client has received events up to :id
|
||||
::
|
||||
[%ack event-id=@ud]
|
||||
:: %poke: pokes an application, translating :json to :mark.
|
||||
:: %poke: pokes an application, validating :noun against :mark
|
||||
::
|
||||
[%poke request-id=@ud ship=@p app=term mark=@tas =json]
|
||||
[%poke request-id=@ud ship=@p app=term mark=@tas =noun]
|
||||
:: %poke-json: pokes an application, translating :json to :mark
|
||||
::
|
||||
[%poke-json request-id=@ud ship=@p app=term mark=@tas =json]
|
||||
:: %watch: subscribes to an application path
|
||||
::
|
||||
[%subscribe request-id=@ud ship=@p app=term =path]
|
||||
@ -197,13 +207,44 @@
|
||||
%+ ~(put by unacked) rid
|
||||
?: (lte u.sus ack) 0
|
||||
(sub u.sus ack)
|
||||
:: +find-channel-mode: deduce requested mode from headers
|
||||
::
|
||||
++ find-channel-mode
|
||||
|= [met=method:http hes=header-list:http]
|
||||
^- ?(%json %jam)
|
||||
=+ ^- [hed=@t jam=@t]
|
||||
?: ?=(%'GET' met) ['x-channel-format' 'application/x-urb-jam']
|
||||
['content-type' 'application/x-urb-jam']
|
||||
=+ typ=(bind (get-header:http hed hes) :(cork trip cass crip))
|
||||
?:(=(`jam typ) %jam %json)
|
||||
:: +parse-channel-request: parses a list of channel-requests
|
||||
::
|
||||
++ parse-channel-request
|
||||
|= [mode=?(%json %jam) body=octs]
|
||||
^- (each (list channel-request) @t)
|
||||
?- mode
|
||||
%json
|
||||
?~ maybe-json=(de-json:html q.body)
|
||||
|+'put body not json'
|
||||
?~ maybe-requests=(parse-channel-request-json u.maybe-json)
|
||||
|+'invalid channel json'
|
||||
&+u.maybe-requests
|
||||
::
|
||||
%jam
|
||||
?~ maybe-noun=(bind (slaw %uw q.body) cue)
|
||||
|+'invalid request format'
|
||||
?~ maybe-reqs=((soft (list channel-request)) u.maybe-noun)
|
||||
~& [%miss u.maybe-noun]
|
||||
|+'invalid request data'
|
||||
&+u.maybe-reqs
|
||||
==
|
||||
:: +parse-channel-request-json: parses a json list of channel-requests
|
||||
::
|
||||
:: Parses a json array into a list of +channel-request. If any of the items
|
||||
:: in the list fail to parse, the entire thing fails so we can 400 properly
|
||||
:: to the client.
|
||||
::
|
||||
++ parse-channel-request
|
||||
++ parse-channel-request-json
|
||||
|= request-list=json
|
||||
^- (unit (list channel-request))
|
||||
:: parse top
|
||||
@ -219,7 +260,9 @@
|
||||
?: =('ack' u.maybe-key)
|
||||
((pe %ack (ot event-id+ni ~)) item)
|
||||
?: =('poke' u.maybe-key)
|
||||
((pe %poke (ot id+ni ship+(su fed:ag) app+so mark+(su sym) json+some ~)) item)
|
||||
%. item
|
||||
%+ pe %poke-json
|
||||
(ot id+ni ship+(su fed:ag) app+so mark+(su sym) json+some ~)
|
||||
?: =('subscribe' u.maybe-key)
|
||||
%. item
|
||||
%+ pe %subscribe
|
||||
@ -672,6 +715,11 @@
|
||||
=- (fall - '*')
|
||||
(get-header:http 'access-control-request-headers' headers)
|
||||
==
|
||||
:: handle requests to the cache
|
||||
::
|
||||
=/ entry (~(get by cache.state) url.request)
|
||||
?: &(?=(^ entry) ?=(%'GET' method.request))
|
||||
(handle-cache-req authenticated request val.u.entry)
|
||||
::
|
||||
?- -.action
|
||||
%gen
|
||||
@ -771,6 +819,32 @@
|
||||
%^ return-static-data-on-duct status 'text/html'
|
||||
(error-page status authenticated url.request tape)
|
||||
--
|
||||
:: +handle-cache-req: respond with cached value, 404 or 500
|
||||
::
|
||||
++ handle-cache-req
|
||||
|= [authenticated=? =request:http entry=(unit cache-entry)]
|
||||
|^ ^- (quip move server-state)
|
||||
?~ entry
|
||||
(error-response 404 "cache entry for that binding was deleted")
|
||||
?: &(auth.u.entry !authenticated)
|
||||
(error-response 403 ~)
|
||||
=* body body.u.entry
|
||||
?- -.body
|
||||
%payload
|
||||
%- handle-response
|
||||
:* %start
|
||||
response-header.simple-payload.body
|
||||
data.simple-payload.body
|
||||
complete=%.y
|
||||
==
|
||||
==
|
||||
::
|
||||
++ error-response
|
||||
|= [status=@ud =tape]
|
||||
^- (quip move server-state)
|
||||
%^ return-static-data-on-duct status 'text/html'
|
||||
(error-page status authenticated url.request tape)
|
||||
--
|
||||
:: +handle-scry: respond with scry result, 404 or 500
|
||||
::
|
||||
++ handle-scry
|
||||
@ -1200,7 +1274,7 @@
|
||||
:: state.
|
||||
::
|
||||
++ update-timeout-timer-for
|
||||
|= channel-id=@t
|
||||
|= [mode=?(%json %jam) channel-id=@t]
|
||||
^+ ..update-timeout-timer-for
|
||||
:: when our callback should fire
|
||||
::
|
||||
@ -1212,7 +1286,7 @@
|
||||
%_ ..update-timeout-timer-for
|
||||
session.channel-state.state
|
||||
%+ ~(put by session.channel-state.state) channel-id
|
||||
[[%& expiration-time duct] 0 now ~ ~ ~ ~]
|
||||
[mode [%& expiration-time duct] 0 now ~ ~ ~ ~]
|
||||
::
|
||||
moves
|
||||
[(set-timeout-move channel-id expiration-time) moves]
|
||||
@ -1267,10 +1341,19 @@
|
||||
|= [channel-id=@t =request:http]
|
||||
^- [(list move) server-state]
|
||||
:: if there's no channel-id, we must 404
|
||||
::TODO but arm description says otherwise?
|
||||
::
|
||||
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
|
||||
%^ return-static-data-on-duct 404 'text/html'
|
||||
(error-page 404 %.y url.request ~)
|
||||
:: find the requested "mode" and make sure it doesn't conflict
|
||||
::
|
||||
=/ mode=?(%json %jam)
|
||||
(find-channel-mode %'GET' header-list.request)
|
||||
?. =(mode mode.u.maybe-channel)
|
||||
%^ return-static-data-on-duct 406 'text/html'
|
||||
=; msg=tape (error-page 406 %.y url.request msg)
|
||||
"channel already established in {(trip mode.u.maybe-channel)} mode"
|
||||
:: when opening an event-stream, we must cancel our timeout timer
|
||||
:: if there's no duct already bound. Else, kill the old request
|
||||
:: and replace it
|
||||
@ -1315,8 +1398,10 @@
|
||||
=/ sign
|
||||
(channel-event-to-sign u.maybe-channel request-id channel-event)
|
||||
?~ sign $
|
||||
?~ jive=(sign-to-json u.maybe-channel request-id u.sign) $
|
||||
$(events [(event-json-to-wall id +.u.jive) events])
|
||||
=/ said
|
||||
(sign-to-tape u.maybe-channel request-id u.sign)
|
||||
?~ said $
|
||||
$(events [(event-tape-to-wall id +.u.said) events])
|
||||
:: send the start event to the client
|
||||
::
|
||||
=^ http-moves state
|
||||
@ -1354,7 +1439,11 @@
|
||||
=. session.channel-state.state
|
||||
%+ ~(jab by session.channel-state.state) channel-id
|
||||
|= =channel
|
||||
channel(state [%| duct], heartbeat (some [heartbeat-time duct]))
|
||||
%_ channel
|
||||
mode mode
|
||||
state [%| duct]
|
||||
heartbeat (some [heartbeat-time duct])
|
||||
==
|
||||
::
|
||||
[[heartbeat :(weld http-moves cancel-moves moves)] state]
|
||||
:: +acknowledge-events: removes events before :last-event-id on :channel-id
|
||||
@ -1386,19 +1475,19 @@
|
||||
?~ body.request
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "no put body")
|
||||
:: if the incoming body isn't json, this is a bad request, 400.
|
||||
::
|
||||
?~ maybe-json=(de-json:html q.u.body.request)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "put body not json")
|
||||
:: parse the json into an array of +channel-request items
|
||||
=/ mode=?(%json %jam)
|
||||
(find-channel-mode %'PUT' header-list.request)
|
||||
:: if we cannot parse requests from the body, give an error
|
||||
::
|
||||
?~ maybe-requests=(parse-channel-request u.maybe-json)
|
||||
=/ maybe-requests=(each (list channel-request) @t)
|
||||
(parse-channel-request mode u.body.request)
|
||||
?: ?=(%| -.maybe-requests)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "invalid channel json")
|
||||
(error-page 400 & url.request (trip p.maybe-requests))
|
||||
:: while weird, the request list could be empty
|
||||
::
|
||||
?: =(~ u.maybe-requests)
|
||||
?: =(~ p.maybe-requests)
|
||||
%^ return-static-data-on-duct 400 'text/html'
|
||||
(error-page 400 %.y url.request "empty list of actions")
|
||||
:: check for the existence of the channel-id
|
||||
@ -1407,10 +1496,10 @@
|
||||
:: :channel-timeout from now. if we have one which has a timer, update
|
||||
:: that timer.
|
||||
::
|
||||
=. ..on-put-request (update-timeout-timer-for channel-id)
|
||||
=. ..on-put-request (update-timeout-timer-for mode channel-id)
|
||||
:: for each request, execute the action passed in
|
||||
::
|
||||
=+ requests=u.maybe-requests
|
||||
=+ requests=p.maybe-requests
|
||||
:: gall-moves: put moves here first so we can flop for ordering
|
||||
::
|
||||
:: TODO: Have an error state where any invalid duplicate subscriptions
|
||||
@ -1441,7 +1530,7 @@
|
||||
requests t.requests
|
||||
==
|
||||
::
|
||||
%poke
|
||||
?(%poke %poke-json)
|
||||
::
|
||||
=. gall-moves
|
||||
:_ gall-moves
|
||||
@ -1449,7 +1538,12 @@
|
||||
:^ duct %pass /channel/poke/[channel-id]/(scot %ud request-id.i.requests)
|
||||
=, i.requests
|
||||
:* %g %deal `sock`[our ship] app
|
||||
`task:agent:gall`[%poke-as mark %json !>(json)]
|
||||
^- task:agent:gall
|
||||
:+ %poke-as mark
|
||||
?- -.i.requests
|
||||
%poke [%noun !>(noun)]
|
||||
%poke-json [%json !>(json)]
|
||||
==
|
||||
==
|
||||
::
|
||||
$(requests t.requests)
|
||||
@ -1584,18 +1678,16 @@
|
||||
:: if conversion succeeds, we *can* send it. if the client is actually
|
||||
:: connected, we *will* send it immediately.
|
||||
::
|
||||
=/ jive=(unit (quip move json))
|
||||
(sign-to-json u.channel request-id sign)
|
||||
=/ json=(unit json)
|
||||
?~(jive ~ `+.u.jive)
|
||||
=? moves ?=(^ jive)
|
||||
(weld moves -.u.jive)
|
||||
=* sending &(?=([%| *] state.u.channel) ?=(^ json))
|
||||
=/ said=(unit (quip move tape))
|
||||
(sign-to-tape u.channel request-id sign)
|
||||
=? moves ?=(^ said)
|
||||
(weld moves -.u.said)
|
||||
=* sending &(?=([%| *] state.u.channel) ?=(^ said))
|
||||
::
|
||||
=/ next-id next-id.u.channel
|
||||
:: if we can send it, store the event as unacked
|
||||
::
|
||||
=? events.u.channel ?=(^ json)
|
||||
=? events.u.channel ?=(^ said)
|
||||
%- ~(put to events.u.channel)
|
||||
[next-id request-id (sign-to-channel-event sign)]
|
||||
:: if it makes sense to do so, send the event to the client
|
||||
@ -1611,11 +1703,11 @@
|
||||
::
|
||||
^= data
|
||||
%- wall-to-octs
|
||||
(event-json-to-wall next-id (need json))
|
||||
(event-tape-to-wall next-id +:(need said))
|
||||
::
|
||||
complete=%.n
|
||||
==
|
||||
=? next-id ?=(^ json) +(next-id)
|
||||
=? next-id ?=(^ said) +(next-id)
|
||||
:: update channel's unacked counts, find out if clogged
|
||||
::
|
||||
=^ clogged unacked.u.channel
|
||||
@ -1623,7 +1715,7 @@
|
||||
:: and of course don't count events we can't send as unacked.
|
||||
::
|
||||
?: ?| !?=(%fact -.sign)
|
||||
?=(~ json)
|
||||
?=(~ said)
|
||||
==
|
||||
[| unacked.u.channel]
|
||||
=/ num=@ud
|
||||
@ -1639,7 +1731,7 @@
|
||||
=/ kicking=?
|
||||
?: clogged
|
||||
((trace 0 |.("clogged {msg}")) &)
|
||||
?. ?=(~ json) |
|
||||
?. ?=(~ said) |
|
||||
((trace 0 |.("can't serialize event, kicking {msg}")) &)
|
||||
=? moves kicking
|
||||
:_ moves
|
||||
@ -1671,8 +1763,8 @@
|
||||
::
|
||||
^= data
|
||||
%- wall-to-octs
|
||||
%+ event-json-to-wall next-id
|
||||
+:(need (sign-to-json u.channel request-id %kick ~))
|
||||
%+ event-tape-to-wall next-id
|
||||
+:(need (sign-to-tape u.channel request-id %kick ~))
|
||||
::
|
||||
complete=%.n
|
||||
==
|
||||
@ -1725,6 +1817,17 @@
|
||||
?: ?=(%| -.res)
|
||||
((trace 0 |.("stale fact of mark {(trip have)}")) ~)
|
||||
`[%fact have p.res]
|
||||
:: +sign-to-tape: render sign from request-id in specified mode
|
||||
::
|
||||
++ sign-to-tape
|
||||
|= [=channel request-id=@ud =sign:agent:gall]
|
||||
^- (unit (quip move tape))
|
||||
?- mode.channel
|
||||
%json %+ bind (sign-to-json channel request-id sign)
|
||||
|=((quip move json) [+<- (en-json:html +<+)])
|
||||
%jam =- `[~ (scow %uw (jam -))]
|
||||
[request-id (sign-to-channel-event sign)]
|
||||
==
|
||||
:: +sign-to-json: render sign from request-id as json channel event
|
||||
::
|
||||
++ sign-to-json
|
||||
@ -1793,12 +1896,12 @@
|
||||
==
|
||||
==
|
||||
::
|
||||
++ event-json-to-wall
|
||||
~% %eyre-json-to-wall ..part ~
|
||||
|= [event-id=@ud =json]
|
||||
++ event-tape-to-wall
|
||||
~% %eyre-tape-to-wall ..part ~
|
||||
|= [event-id=@ud =tape]
|
||||
^- wall
|
||||
:~ (weld "id: " (format-ud-as-integer event-id))
|
||||
(weld "data: " (en-json:html json))
|
||||
(weld "data: " tape)
|
||||
""
|
||||
==
|
||||
::
|
||||
@ -2007,7 +2110,7 @@
|
||||
::
|
||||
=. connections.state
|
||||
%. (~(del by connections.state) duct)
|
||||
(trace 2 |.("{<duct>} completed"))
|
||||
(trace 2 |.("{<duct>} completed"))
|
||||
state
|
||||
::
|
||||
++ error-connection
|
||||
@ -2032,6 +2135,15 @@
|
||||
%leave ~
|
||||
==
|
||||
--
|
||||
:: +set-response: remember (or update) a cache mapping
|
||||
::
|
||||
++ set-response
|
||||
|= [url=@t entry=(unit cache-entry)]
|
||||
^- [(list move) server-state]
|
||||
=/ aeon ?^(prev=(~(get by cache.state) url) +(aeon.u.prev) 1)
|
||||
=. cache.state (~(put by cache.state) url [aeon entry])
|
||||
:_ state
|
||||
[outgoing-duct.state %give %grow /cache/(scot %ud aeon)/(scot %t url)]~
|
||||
:: +add-binding: conditionally add a pairing between binding and action
|
||||
::
|
||||
:: Adds =binding =action if there is no conflicting bindings.
|
||||
@ -2109,6 +2221,8 @@
|
||||
::
|
||||
=/ request-line (parse-request-line url)
|
||||
=/ parsed-url=(list @t) site.request-line
|
||||
=? parsed-url ?=([%'~' %channel-jam *] parsed-url)
|
||||
parsed-url(i.t %channel)
|
||||
::
|
||||
=/ bindings bindings.state
|
||||
|-
|
||||
@ -2318,6 +2432,12 @@
|
||||
:: save duct for future %give to unix
|
||||
::
|
||||
=. outgoing-duct.server-state.ax duct
|
||||
:: send all cache mappings to runtime
|
||||
::
|
||||
=/ cache-moves=(list move)
|
||||
%+ turn ~(tap by cache.server-state.ax)
|
||||
|= [url=@t cache-val=[aeon=@ud val=(unit cache-entry)]]
|
||||
[duct %give %grow /cache/(scot %u aeon.cache-val)/(scot %t url)]
|
||||
::
|
||||
:_ http-server-gate
|
||||
:* :: hand back default configuration for now
|
||||
@ -2328,7 +2448,7 @@
|
||||
=< give-session-tokens
|
||||
(per-server-event [eny duct now rof] server-state.ax)
|
||||
::
|
||||
closed-connections
|
||||
(zing ~[closed-connections cache-moves])
|
||||
==
|
||||
::
|
||||
?: ?=(%code-changed -.task)
|
||||
@ -2447,6 +2567,10 @@
|
||||
%spew
|
||||
=. verb.server-state.ax veb.task
|
||||
`http-server-gate
|
||||
::
|
||||
%set-response
|
||||
=^ moves server-state.ax (set-response:server +.task)
|
||||
[moves http-server-gate]
|
||||
==
|
||||
::
|
||||
++ take
|
||||
@ -2595,6 +2719,9 @@
|
||||
::
|
||||
?^ error.sign
|
||||
[[duct %slip %d %flog %crud %wake u.error.sign]~ http-server-gate]
|
||||
::NOTE we are not concerned with expiring channels that are still in
|
||||
:: use. we require acks for messages, which bump their session's
|
||||
:: timer. channels have their own expiry timer, too.
|
||||
:: remove cookies that have expired
|
||||
::
|
||||
=* sessions sessions.authentication-state.server-state.ax
|
||||
@ -2636,67 +2763,111 @@
|
||||
++ load
|
||||
=> |%
|
||||
+$ axle-any
|
||||
$% [%~2020.10.18 =server-state-0]
|
||||
[%~2022.7.26 =server-state-0]
|
||||
[%~2023.2.17 =server-state]
|
||||
$% [date=%~2020.10.18 server-state=server-state-0]
|
||||
[date=%~2022.7.26 server-state=server-state-0]
|
||||
[date=%~2023.2.17 server-state=server-state-1]
|
||||
[date=%~2023.3.16 server-state=server-state-2]
|
||||
[date=%~2023.4.11 =server-state]
|
||||
==
|
||||
::
|
||||
+$ server-state-0
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
=channel-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
==
|
||||
::
|
||||
+$ server-state-1
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
verb=@ :: <- new
|
||||
==
|
||||
::
|
||||
+$ server-state-2
|
||||
$: bindings=(list [=binding =duct =action])
|
||||
cache=(map url=@t [aeon=@ud val=(unit cache-entry)]) :: <- new
|
||||
=cors-registry
|
||||
connections=(map duct outstanding-connection)
|
||||
=authentication-state
|
||||
channel-state=channel-state-2
|
||||
domains=(set turf)
|
||||
=http-config
|
||||
ports=[insecure=@ud secure=(unit @ud)]
|
||||
outgoing-duct=duct
|
||||
verb=@
|
||||
==
|
||||
+$ channel-state-2
|
||||
$: session=(map @t channel-2)
|
||||
duct-to-key=(map duct @t)
|
||||
==
|
||||
+$ channel-2
|
||||
$: state=(each timer duct)
|
||||
next-id=@ud
|
||||
last-ack=@da
|
||||
events=(qeu [id=@ud request-id=@ud =channel-event])
|
||||
unacked=(map @ud @ud)
|
||||
subscriptions=(map @ud [ship=@p app=term =path duc=duct])
|
||||
heartbeat=(unit timer)
|
||||
==
|
||||
--
|
||||
|= old=axle-any
|
||||
^+ ..^$
|
||||
^+ http-server-gate
|
||||
?- -.old
|
||||
::
|
||||
:: adds /~/name
|
||||
::
|
||||
%~2020.10.18
|
||||
=, server-state-0.old
|
||||
%= ..^$
|
||||
ax ^- axle
|
||||
:* %~2023.2.17
|
||||
(insert-binding [[~ /~/name] outgoing-duct [%name ~]] bindings)
|
||||
cors-registry
|
||||
connections
|
||||
authentication-state
|
||||
channel-state
|
||||
domains
|
||||
http-config
|
||||
ports
|
||||
outgoing-duct
|
||||
0
|
||||
== ==
|
||||
%= $
|
||||
date.old %~2022.7.26
|
||||
::
|
||||
bindings.server-state.old
|
||||
%+ insert-binding
|
||||
[[~ /~/name] outgoing-duct.server-state.old [%name ~]]
|
||||
bindings.server-state.old
|
||||
==
|
||||
::
|
||||
:: enables https redirects if certificate configured
|
||||
:: inits .verb
|
||||
::
|
||||
%~2022.7.26
|
||||
=, server-state-0.old
|
||||
%= ..^$
|
||||
ax ^- axle
|
||||
:* %~2023.2.17
|
||||
bindings
|
||||
cors-registry
|
||||
connections
|
||||
authentication-state
|
||||
channel-state
|
||||
domains
|
||||
http-config
|
||||
ports
|
||||
outgoing-duct
|
||||
0
|
||||
== ==
|
||||
::
|
||||
%~2023.2.17
|
||||
:: enable https redirects if certificate configured
|
||||
::
|
||||
=. redirect.http-config.server-state.old
|
||||
?& ?=(^ secure.ports.server-state.old)
|
||||
?=(^ secure.http-config.server-state.old)
|
||||
==
|
||||
..^$(ax old)
|
||||
$(old [%~2023.2.17 server-state.old(|8 [|8 verb=0]:server-state.old)])
|
||||
::
|
||||
:: inits .cache
|
||||
::
|
||||
%~2023.2.17
|
||||
$(old [%~2023.3.16 [bindings ~ +]:server-state.old])
|
||||
::
|
||||
:: inits channel mode
|
||||
::
|
||||
%~2023.3.16
|
||||
%= $
|
||||
date.old %~2023.4.11
|
||||
::
|
||||
server-state.old
|
||||
%= server-state.old
|
||||
session.channel-state
|
||||
(~(run by session.channel-state.server-state.old) (lead %json))
|
||||
==
|
||||
==
|
||||
::
|
||||
%~2023.4.11
|
||||
http-server-gate(ax old)
|
||||
==
|
||||
:: +stay: produce current state
|
||||
::
|
||||
@ -2757,6 +2928,14 @@
|
||||
%- =< request-is-logged-in:authentication
|
||||
(per-server-event [eny *duct now rof] server-state.ax)
|
||||
%*(. *request:http header-list ['cookie' u.cookies]~)
|
||||
::
|
||||
[%cache @ @ ~]
|
||||
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
|
||||
?~ url=(slaw %t i.t.t.tyl) [~ ~]
|
||||
?~ entry=(~(get by cache) u.url) [~ ~]
|
||||
?. =(u.aeon aeon.u.entry) [~ ~]
|
||||
?~ val=val.u.entry [~ ~]
|
||||
``noun+!>(u.val)
|
||||
==
|
||||
?. ?=(%$ ren)
|
||||
[~ ~]
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
=> ..lull
|
||||
~% %zuse ..part ~
|
||||
|%
|
||||
++ zuse %414
|
||||
++ zuse %413
|
||||
:: :: ::
|
||||
:::: :: :: (2) engines
|
||||
:: :: ::
|
||||
@ -4324,157 +4324,393 @@
|
||||
(cook |=(a=@ (sub a 49)) (shim '1' '9'))
|
||||
==
|
||||
-- ::mimes
|
||||
:: :: ++en-json:html
|
||||
++ en-json :: print json
|
||||
|^ |=(val=json (apex val ""))
|
||||
:: :: ++apex:en-json:html
|
||||
++ apex
|
||||
|= [val=json rez=tape]
|
||||
^- tape
|
||||
?~ val (weld "null" rez)
|
||||
?- -.val
|
||||
%a
|
||||
:- '['
|
||||
=. rez [']' rez]
|
||||
!.
|
||||
?~ p.val rez
|
||||
|-
|
||||
?~ t.p.val ^$(val i.p.val)
|
||||
^$(val i.p.val, rez [',' $(p.val t.p.val)])
|
||||
::
|
||||
%b (weld ?:(p.val "true" "false") rez)
|
||||
%n (weld (trip p.val) rez)
|
||||
%s
|
||||
:- '"'
|
||||
=. rez ['"' rez]
|
||||
=+ viz=(trip p.val)
|
||||
!.
|
||||
|- ^- tape
|
||||
?~ viz rez
|
||||
=+ hed=(jesc i.viz)
|
||||
?: ?=([@ ~] hed)
|
||||
[i.hed $(viz t.viz)]
|
||||
(weld hed $(viz t.viz))
|
||||
::
|
||||
%o
|
||||
:- '{'
|
||||
=. rez ['}' rez]
|
||||
=+ viz=~(tap by p.val)
|
||||
?~ viz rez
|
||||
!.
|
||||
|- ^+ rez
|
||||
?~ t.viz ^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
|
||||
=. rez [',' $(viz t.viz)]
|
||||
^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
|
||||
==
|
||||
:: :: ++jesc:en-json:html
|
||||
++ jesc :: escaped
|
||||
=+ utf=|=(a=@ ['\\' 'u' ((x-co 4):co a)])
|
||||
|= a=@ ^- tape
|
||||
?+ a ?:((gth a 0x1f) [a ~] (utf a))
|
||||
%10 "\\n"
|
||||
%34 "\\\""
|
||||
%92 "\\\\"
|
||||
==
|
||||
-- ::en-json
|
||||
:: :: ++de-json:html
|
||||
++ de-json :: parse JSON
|
||||
=< |=(a=cord `(unit json)`(rush a apex))
|
||||
:: ::
|
||||
:::: ++json:html :: (2e2) JSON
|
||||
:: ::::
|
||||
++ json ^?
|
||||
~% %json ..part ~
|
||||
|%
|
||||
:: :: ++abox:de-json:html
|
||||
++ abox :: array
|
||||
%+ stag %a
|
||||
(ifix [sel (wish ser)] (more (wish com) apex))
|
||||
:: :: ++apex:de-json:html
|
||||
++ apex :: any value
|
||||
%+ knee *json |. ~+
|
||||
%+ ifix [spac spac]
|
||||
;~ pose
|
||||
(cold ~ (jest 'null'))
|
||||
(stag %b bool)
|
||||
(stag %s stri)
|
||||
(cook |=(s=tape [%n p=(rap 3 s)]) numb)
|
||||
abox
|
||||
obox
|
||||
==
|
||||
:: :: ++bool:de-json:html
|
||||
++ bool :: boolean
|
||||
;~ pose
|
||||
(cold & (jest 'true'))
|
||||
(cold | (jest 'false'))
|
||||
==
|
||||
:: :: ++digs:de-json:html
|
||||
++ digs :: digits
|
||||
(star (shim '0' '9'))
|
||||
:: :: ++esca:de-json:html
|
||||
++ esca :: escaped character
|
||||
;~ pfix bas
|
||||
=* loo
|
||||
=* lip
|
||||
^- (list (pair @t @))
|
||||
[b+8 t+9 n+10 f+12 r+13 ~]
|
||||
=* wow `(map @t @)`(malt lip)
|
||||
(sear ~(get by wow) low)
|
||||
=* tuf ;~(pfix (just 'u') (cook tuft qix:ab))
|
||||
;~(pose doq fas soq bas loo tuf)
|
||||
==
|
||||
:: :: ++expo:de-json:html
|
||||
++ expo :: exponent
|
||||
;~ (comp twel)
|
||||
(piec (mask "eE"))
|
||||
(mayb (piec (mask "+-")))
|
||||
digs
|
||||
==
|
||||
:: :: ++frac:de-json:html
|
||||
++ frac :: fraction
|
||||
;~(plug dot digs)
|
||||
:: :: ++jcha:de-json:html
|
||||
++ jcha :: string character
|
||||
;~(pose ;~(less doq bas prn) esca)
|
||||
:: :: ++mayb:de-json:html
|
||||
++ mayb :: optional
|
||||
|*(bus=rule ;~(pose bus (easy ~)))
|
||||
:: :: ++numb:de-json:html
|
||||
++ numb :: number
|
||||
;~ (comp twel)
|
||||
(mayb (piec hep))
|
||||
;~ pose
|
||||
(piec (just '0'))
|
||||
;~(plug (shim '1' '9') digs)
|
||||
:: :: ++en:json:html
|
||||
++ en :: encode JSON to tape
|
||||
~% %en +>+ ~
|
||||
|^ |= jon=^json
|
||||
^- cord
|
||||
(rap 3 (flop (onto jon ~)))
|
||||
:: :: ++onto:en:json:html
|
||||
++ onto
|
||||
|= [val=^json out=(list @t)]
|
||||
^+ out
|
||||
?~ val ['null' out]
|
||||
?- -.val
|
||||
%a
|
||||
?~ p.val ['[]' out]
|
||||
=. out ['[' out]
|
||||
!.
|
||||
|- ^+ out
|
||||
=. out ^$(val i.p.val)
|
||||
?~(t.p.val [']' out] $(p.val t.p.val, out [',' out]))
|
||||
::
|
||||
%b
|
||||
[?:(p.val 'true' 'false') out]
|
||||
::
|
||||
%n
|
||||
[p.val out]
|
||||
::
|
||||
%s
|
||||
[(scap p.val) out]
|
||||
::
|
||||
%o
|
||||
=/ viz ~(tap by p.val)
|
||||
?~ viz ['{}' out]
|
||||
=. out ['{' out]
|
||||
!.
|
||||
|- ^+ out
|
||||
=. out ^$(val q.i.viz, out [':' [(scap p.i.viz) out]])
|
||||
?~(t.viz ['}' out] $(viz t.viz, out [',' out]))
|
||||
==
|
||||
(mayb frac)
|
||||
(mayb expo)
|
||||
==
|
||||
:: :: ++obje:de-json:html
|
||||
++ obje :: object list
|
||||
%+ ifix [(wish kel) (wish ker)]
|
||||
(more (wish com) pear)
|
||||
:: :: ++obox:de-json:html
|
||||
++ obox :: object
|
||||
(stag %o (cook malt obje))
|
||||
:: :: ++pear:de-json:html
|
||||
++ pear :: key-value
|
||||
;~(plug ;~(sfix (wish stri) (wish col)) apex)
|
||||
:: :: ++piec:de-json:html
|
||||
++ piec :: listify
|
||||
|* bus=rule
|
||||
(cook |=(a=@ [a ~]) bus)
|
||||
:: :: ++stri:de-json:html
|
||||
++ stri :: string
|
||||
(cook crip (ifix [doq doq] (star jcha)))
|
||||
:: :: ++tops:de-json:html
|
||||
++ tops :: strict value
|
||||
;~(pose abox obox)
|
||||
:: :: ++spac:de-json:html
|
||||
++ spac :: whitespace
|
||||
(star (mask [`@`9 `@`10 `@`13 ' ' ~]))
|
||||
:: :: ++twel:de-json:html
|
||||
++ twel :: tape weld
|
||||
|=([a=tape b=tape] (weld a b))
|
||||
:: :: ++wish:de-json:html
|
||||
++ wish :: with whitespace
|
||||
|*(sef=rule ;~(pfix spac sef))
|
||||
-- ::de-json
|
||||
:: :: ++scap:en:json:html
|
||||
++ scap
|
||||
|= val=@t
|
||||
^- @t
|
||||
=/ out=(list @t) ['"' ~]
|
||||
=/ len (met 3 val)
|
||||
=| [i=@ud pos=@ud]
|
||||
|- ^- @t
|
||||
?: =(len i)
|
||||
(rap 3 (flop ['"' (rsh [3 pos] val) out]))
|
||||
=/ car (cut 3 [i 1] val)
|
||||
?: ?& (gth car 0x1f)
|
||||
!=(car 0x22)
|
||||
!=(car 0x5C)
|
||||
!=(car 0x7F)
|
||||
==
|
||||
$(i +(i))
|
||||
=/ cap
|
||||
?+ car (crip '\\' 'u' ((x-co 4):co car))
|
||||
%10 '\\n'
|
||||
%'"' '\\"'
|
||||
%'\\' '\\\\'
|
||||
==
|
||||
$(i +(i), pos +(i), out [cap (cut 3 [pos (sub i pos)] val) out])
|
||||
-- ::en
|
||||
:: :: ++de:json:html
|
||||
++ de :: parse cord to JSON
|
||||
~% %de +>+ ~
|
||||
|^ |= txt=cord
|
||||
^- (unit ^json)
|
||||
(rush txt apex)
|
||||
:: :: ++abox:de-json:html
|
||||
++ abox :: array
|
||||
%+ stag %a
|
||||
(ifix [sel (wish ser)] (more (wish com) apex))
|
||||
:: :: ++apex:de-json:html
|
||||
++ apex :: any value
|
||||
%+ knee *^json |. ~+
|
||||
%+ ifix [spac spac]
|
||||
;~ pose
|
||||
(cold ~ (jest 'null'))
|
||||
(stag %b bool)
|
||||
(stag %s stri)
|
||||
(cook |=(s=tape [%n p=(rap 3 s)]) numb)
|
||||
abox
|
||||
obox
|
||||
==
|
||||
:: :: ++bool:de-json:html
|
||||
++ bool :: boolean
|
||||
;~ pose
|
||||
(cold & (jest 'true'))
|
||||
(cold | (jest 'false'))
|
||||
==
|
||||
:: :: ++esca:de-json:html
|
||||
++ esca :: escaped character
|
||||
;~ pfix bas
|
||||
=* loo
|
||||
=* lip
|
||||
^- (list (pair @t @))
|
||||
[b+8 t+9 n+10 f+12 r+13 ~]
|
||||
=* wow
|
||||
^~
|
||||
^- (map @t @)
|
||||
(malt lip)
|
||||
(sear ~(get by wow) low)
|
||||
;~(pose doq fas bas loo unic)
|
||||
==
|
||||
:: :: ++expo:de-json:html
|
||||
++ expo :: exponent
|
||||
;~ (comp weld)
|
||||
(piec (mask "eE"))
|
||||
(mayb (piec (mask "+-")))
|
||||
(plus nud)
|
||||
==
|
||||
:: :: ++frac:de-json:html
|
||||
++ frac :: fraction
|
||||
;~(plug dot (plus nud))
|
||||
:: :: ++jcha:de-json:html
|
||||
++ jcha :: string character
|
||||
;~(pose ;~(less doq bas (shim 32 255)) esca)
|
||||
:: :: ++mayb:de-json:html
|
||||
++ mayb :: optional
|
||||
|*(bus=rule ;~(pose bus (easy ~)))
|
||||
:: :: ++numb:de-json:html
|
||||
++ numb :: number
|
||||
;~ (comp weld)
|
||||
(mayb (piec hep))
|
||||
;~ pose
|
||||
(piec (just '0'))
|
||||
;~(plug (shim '1' '9') (star nud))
|
||||
==
|
||||
(mayb frac)
|
||||
(mayb expo)
|
||||
==
|
||||
:: :: ++obje:de-json:html
|
||||
++ obje :: object list
|
||||
%+ ifix [(wish kel) (wish ker)]
|
||||
(more (wish com) pear)
|
||||
:: :: ++obox:de-json:html
|
||||
++ obox :: object
|
||||
(stag %o (cook malt obje))
|
||||
:: :: ++pear:de-json:html
|
||||
++ pear :: key-value
|
||||
;~(plug ;~(sfix (wish stri) (wish col)) apex)
|
||||
:: :: ++piec:de-json:html
|
||||
++ piec :: listify
|
||||
|* bus=rule
|
||||
(cook |=(a=@ [a ~]) bus)
|
||||
:: :: ++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 :: whitespace
|
||||
(star (mask [`@`9 `@`10 `@`13 ' ' ~]))
|
||||
:: :: ++unic:de-json:html
|
||||
++ unic :: escaped UTF16
|
||||
=* lob 0x0
|
||||
=* hsb 0xd800
|
||||
=* lsb 0xdc00
|
||||
=* hib 0xe000
|
||||
=* hil 0x1.0000
|
||||
|^
|
||||
%+ cook
|
||||
|= a=@
|
||||
^- @t
|
||||
(tuft a)
|
||||
;~ pfix (just 'u')
|
||||
;~(pose solo pair)
|
||||
==
|
||||
++ quad :: parse num from 4 hex
|
||||
(bass 16 (stun [4 4] hit))
|
||||
++ meat :: gen gate for sear:
|
||||
|= [bot=@ux top=@ux flp=?] :: accept num in range,
|
||||
|= sur=@ux :: optionally reduce
|
||||
^- (unit @)
|
||||
?. &((gte sur bot) (lth sur top))
|
||||
~
|
||||
%- some
|
||||
?. flp sur
|
||||
(sub sur bot)
|
||||
++ solo :: single valid UTF16
|
||||
;~ pose
|
||||
(sear (meat lob hsb |) quad)
|
||||
(sear (meat hib hil |) quad)
|
||||
==
|
||||
++ pair :: UTF16 surrogate pair
|
||||
%+ cook
|
||||
|= [hig=@ low=@]
|
||||
^- @t
|
||||
:(add hil low (lsh [1 5] hig))
|
||||
;~ plug
|
||||
(sear (meat hsb lsb &) quad)
|
||||
;~ pfix (jest '\\u')
|
||||
(sear (meat lsb hib &) quad)
|
||||
==
|
||||
==
|
||||
--
|
||||
:: :: ++utfe:de-json:html
|
||||
++ utfe :: UTF-8 sequence
|
||||
;~ less doq bas
|
||||
=* qua
|
||||
%+ cook
|
||||
|= [a=@ b=@ c=@ d=@]
|
||||
(rap 3 a b c d ~)
|
||||
;~ pose
|
||||
;~ plug
|
||||
(shim 241 243)
|
||||
(shim 128 191)
|
||||
(shim 128 191)
|
||||
(shim 128 191)
|
||||
==
|
||||
;~ plug
|
||||
(just '\F0')
|
||||
(shim 144 191)
|
||||
(shim 128 191)
|
||||
(shim 128 191)
|
||||
==
|
||||
;~ plug
|
||||
(just '\F4')
|
||||
(shim 128 143)
|
||||
(shim 128 191)
|
||||
(shim 128 191)
|
||||
==
|
||||
==
|
||||
=* tre
|
||||
%+ cook
|
||||
|= [a=@ b=@ c=@]
|
||||
(rap 3 a b c ~)
|
||||
;~ pose
|
||||
;~ plug
|
||||
;~ pose
|
||||
(shim 225 236)
|
||||
(shim 238 239)
|
||||
==
|
||||
(shim 128 191)
|
||||
(shim 128 191)
|
||||
==
|
||||
;~ plug
|
||||
(just '\E0')
|
||||
(shim 160 191)
|
||||
(shim 128 191)
|
||||
==
|
||||
;~ plug
|
||||
(just '\ED')
|
||||
(shim 128 159)
|
||||
(shim 128 191)
|
||||
==
|
||||
==
|
||||
=* dos
|
||||
%+ cook
|
||||
|= [a=@ b=@]
|
||||
(cat 3 a b)
|
||||
;~ plug
|
||||
(shim 194 223)
|
||||
(shim 128 191)
|
||||
==
|
||||
;~(pose qua tre dos)
|
||||
==
|
||||
:: :: ++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 :: cord UTF-8 sanity
|
||||
|= b=@t
|
||||
^- ?
|
||||
?: =(0 b) &
|
||||
?. (sung b) |
|
||||
$(b (rsh [3 (teff b)] b))
|
||||
:: :: ++sung:de-json:html
|
||||
++ sung :: char UTF-8 sanity
|
||||
|^ |= b=@t
|
||||
^- ?
|
||||
=+ len=(teff b)
|
||||
?: =(4 len) (quad b)
|
||||
?: =(3 len) (tres b)
|
||||
?: =(2 len) (dos b)
|
||||
(lte (end 3 b) 127)
|
||||
::
|
||||
++ dos
|
||||
|= b=@t
|
||||
^- ?
|
||||
=+ :- one=(cut 3 [0 1] b)
|
||||
two=(cut 3 [1 1] b)
|
||||
?& (rang one 194 223)
|
||||
(cont two)
|
||||
==
|
||||
::
|
||||
++ tres
|
||||
|= b=@t
|
||||
^- ?
|
||||
=+ :+ one=(cut 3 [0 1] b)
|
||||
two=(cut 3 [1 1] b)
|
||||
tre=(cut 3 [2 1] b)
|
||||
?&
|
||||
?|
|
||||
?& |((rang one 225 236) (rang one 238 239))
|
||||
(cont two)
|
||||
==
|
||||
::
|
||||
?& =(224 one)
|
||||
(rang two 160 191)
|
||||
==
|
||||
::
|
||||
?& =(237 one)
|
||||
(rang two 128 159)
|
||||
==
|
||||
==
|
||||
::
|
||||
(cont tre)
|
||||
==
|
||||
::
|
||||
++ quad
|
||||
|= b=@t
|
||||
^- ?
|
||||
=+ :^ one=(cut 3 [0 1] b)
|
||||
two=(cut 3 [1 1] b)
|
||||
tre=(cut 3 [2 1] b)
|
||||
for=(cut 3 [3 1] b)
|
||||
?&
|
||||
?|
|
||||
?& (rang one 241 243)
|
||||
(cont two)
|
||||
==
|
||||
::
|
||||
?& =(240 one)
|
||||
(rang two 144 191)
|
||||
==
|
||||
::
|
||||
?& =(244 one)
|
||||
(rang two 128 143)
|
||||
==
|
||||
==
|
||||
::
|
||||
(cont tre)
|
||||
(cont for)
|
||||
==
|
||||
::
|
||||
++ cont
|
||||
|= a=@
|
||||
^- ?
|
||||
(rang a 128 191)
|
||||
::
|
||||
++ rang
|
||||
|= [a=@ bot=@ top=@]
|
||||
^- ?
|
||||
?> (lte bot top)
|
||||
&((gte a bot) (lte a top))
|
||||
--
|
||||
:: XX: This +teff should overwrite the existing +teff
|
||||
:: :: ++teff:de-json:html
|
||||
++ teff :: UTF-8 length
|
||||
|= a=@t
|
||||
^- @
|
||||
=+ b=(end 3 a)
|
||||
?: =(0 b)
|
||||
?> =(`@`0 a) 0
|
||||
?: (lte b 127) 1
|
||||
?: (lte b 223) 2
|
||||
?: (lte b 239) 3
|
||||
4
|
||||
-- ::de
|
||||
-- ::json
|
||||
:: +en-json:html: encode json to tape
|
||||
::
|
||||
:: XX: deprecated; use +en:json:html
|
||||
::
|
||||
++ en-json
|
||||
|= jon=^json
|
||||
^- tape
|
||||
(trip (en:json jon))
|
||||
:: +de-json:html: parse cord to (unit json)
|
||||
::
|
||||
:: XX: deprecated; use +de:json:html
|
||||
::
|
||||
++ de-json
|
||||
|= txt=cord
|
||||
^- (unit ^json)
|
||||
(de:json txt)
|
||||
:: :: ++en-xml:html
|
||||
++ en-xml :: xml printer
|
||||
=< |=(a=manx `tape`(apex a ~))
|
||||
|
||||
@ -33,7 +33,6 @@
|
||||
|^ |=([sor=$-(^ ?) val=json] (apex val sor ""))
|
||||
:: :: ++apex:en-json:html
|
||||
++ apex
|
||||
=, en-json:html
|
||||
|= [val=json sor=$-(^ ?) rez=tape]
|
||||
^- tape
|
||||
?~ val (weld "null" rez)
|
||||
@ -46,7 +45,7 @@
|
||||
|-
|
||||
?~ t.p.val ^$(val i.p.val)
|
||||
^$(val i.p.val, rez [',' $(p.val t.p.val)])
|
||||
::
|
||||
::
|
||||
%b (weld ?:(p.val "true" "false") rez)
|
||||
%n (weld (trip p.val) rez)
|
||||
%s
|
||||
@ -60,7 +59,7 @@
|
||||
?: ?=([@ ~] hed)
|
||||
[i.hed $(viz t.viz)]
|
||||
(weld hed $(viz t.viz))
|
||||
::
|
||||
::
|
||||
%o
|
||||
:- '{'
|
||||
=. rez ['}' rez]
|
||||
@ -74,6 +73,15 @@
|
||||
=. rez [',' $(viz t.viz)]
|
||||
^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
|
||||
==
|
||||
::
|
||||
++ jesc
|
||||
=+ utf=|=(a=@ ['\\' 'u' ((x-co 4):co a)])
|
||||
|= a=@ ^- tape
|
||||
?+ a ?:(&((gth a 0x1f) !=(a 0x7f)) [a ~] (utf a))
|
||||
%10 "\\n"
|
||||
%34 "\\\""
|
||||
%92 "\\\\"
|
||||
==
|
||||
--
|
||||
:: %/lib/jose
|
||||
::
|
||||
|
||||
@ -5,12 +5,11 @@
|
||||
::
|
||||
=, eyre
|
||||
=, format
|
||||
=, html
|
||||
|_ hit=httr
|
||||
++ grad %noun
|
||||
++ grow |% ++ wall (turn wain trip)
|
||||
++ wain (to-wain cord)
|
||||
++ json (need (de-json cord))
|
||||
++ json (need (de:json:html cord))
|
||||
++ cord q:octs
|
||||
++ noun hit
|
||||
++ octs
|
||||
|
||||
@ -8,17 +8,17 @@
|
||||
=, eyre
|
||||
=, format
|
||||
=, html
|
||||
|_ jon=json
|
||||
|_ jon=^json
|
||||
::
|
||||
++ grow :: convert to
|
||||
|%
|
||||
++ mime [/application/json (as-octs:mimes -:txt)] :: convert to %mime
|
||||
++ txt [(crip (en-json jon))]~
|
||||
++ txt [(en:json jon)]~
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de-json) *json))
|
||||
++ noun json :: clam from %noun
|
||||
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de:json) *^json))
|
||||
++ noun ^json :: clam from %noun
|
||||
++ numb numb:enjs
|
||||
++ time time:enjs
|
||||
--
|
||||
|
||||
@ -16,11 +16,10 @@
|
||||
^- response
|
||||
~| hit
|
||||
?: ?=(%2 (div p.hit 100))
|
||||
=, html
|
||||
%- json
|
||||
?~ r.hit
|
||||
a+~
|
||||
(need (de-json q:u.r.hit))
|
||||
(need (de:json:html q:u.r.hit))
|
||||
fail+hit
|
||||
++ json :: from json
|
||||
=, dejs-soft:format
|
||||
|
||||
@ -305,7 +305,7 @@
|
||||
=/ =mime-data:iris u.full-file.client-response.sign-arvo
|
||||
?> =('application/json' type.mime-data)
|
||||
=/ jon=json
|
||||
(fall (rush (@t q.data.mime-data) apex:de-json:html) *json)
|
||||
(fall (de:json:html (@t q.data.mime-data)) *json)
|
||||
=/ [sid=@t message=@t]
|
||||
%. jon
|
||||
%- ot:dejs:format
|
||||
|
||||
@ -643,17 +643,30 @@
|
||||
!> (rush '192.168.1.1' simplified-url-parser:eyre-gate)
|
||||
==
|
||||
::
|
||||
++ test-parse-channel-request
|
||||
++ test-parse-channel-request-jam
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> `[%ack 5]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
(need (de-json:html '[{"action": "ack", "event-id": 5}]'))
|
||||
!> &+[%ack 5]~
|
||||
!> %+ parse-channel-request:eyre-gate %jam
|
||||
(as-octs:mimes:html (scot %uw (jam [%ack 5]~)))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%poke 0 ~nec %app1 %app-type [%n '5']]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid request data'
|
||||
!> %+ parse-channel-request:eyre-gate %jam
|
||||
(as-octs:mimes:html (scot %uw (jam [%not %a %chanreq %list])))
|
||||
==
|
||||
::
|
||||
++ test-parse-channel-request-json
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> &+[%ack 5]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
(as-octs:mimes:html '[{"action": "ack", "event-id": 5}]')
|
||||
::
|
||||
%+ expect-eq
|
||||
!> &+[%poke-json 0 ~nec %app1 %app-type [%n '5']]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "poke",
|
||||
"id": 0,
|
||||
@ -664,9 +677,9 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%subscribe 1 ~sampyl-sipnym %hall /this/path]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> &+[%subscribe 1 ~sampyl-sipnym %hall /this/path]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "subscribe",
|
||||
"id": 1,
|
||||
@ -676,9 +689,9 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> `[%unsubscribe 2 1]~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> &+[%unsubscribe 2 1]~
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "unsubscribe",
|
||||
"id": 2,
|
||||
@ -686,30 +699,30 @@
|
||||
'''
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"noaction": "noaction"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"action": "bad-action"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> |+'invalid channel json'
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'[{"action": "ack", "event-id": 5}, {"action": "bad-action"}]'
|
||||
::
|
||||
%+ expect-eq
|
||||
!> :- ~
|
||||
!> :- %&
|
||||
:~ [%ack 9]
|
||||
[%poke 3 ~bud %wut %wut-type [%a [%n '2'] [%n '1'] ~]]
|
||||
[%poke-json 3 ~bud %wut %wut-type [%a [%n '2'] [%n '1'] ~]]
|
||||
==
|
||||
!> %- parse-channel-request:eyre-gate
|
||||
%- need %- de-json:html
|
||||
!> %+ parse-channel-request:eyre-gate %json
|
||||
%- as-octs:mimes:html
|
||||
'''
|
||||
[{"action": "ack", "event-id": 9},
|
||||
{"action": "poke",
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user