add +wrap-test-http

This commit is contained in:
Philip Monk 2019-03-26 18:07:42 -07:00
parent 7590a4fc38
commit 42bcfd6f92
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
5 changed files with 114 additions and 33 deletions

View File

@ -57,8 +57,9 @@ Most parts of Arvo have dedicated maintainers.
* `/app/dns`: @joemfb (~master-morzod)
* `/app/hall`: @fang- (~palfun-foslup)
* `/app/talk`: @fang- (~palfun-foslup)
* `/app/aqua`: @philipcmonk (~wicdev-wisryt)
* `/lib/test`: @eglaysher (~littel-ponnys)
## Contact
We are using our new UI, Landscape, to run a few experimental cities. If you have an Azimuth point, please send us your planet name at [support@urbit.org](mailto:support@urbit.org) to request access.
We are using our new UI, Landscape, to run a few experimental cities. If you have an Azimuth point, please send us your planet name at [support@urbit.org](mailto:support@urbit.org) to request access.

View File

@ -458,6 +458,8 @@
%event
~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae))
raw-event=[who.ae -.q.ue.ae]
~? &(debug=& ?=(%they -.q.ue.ae))
raw-event=[who.ae ue.ae]
(push-events:(pe who.ae) [ue.ae]~)
==
::

View File

@ -40,12 +40,12 @@
+$ test-core-state
$: hers=(list ship)
cor=raw-test-core
effect-log=(list [who=ship uf=unix-effect])
==
::
+$ other-state
$: test-qeu=(qeu term)
results=(list (pair term ?))
effect-log=(list [who=ship uf=unix-effect])
==
--
=, gall
@ -150,14 +150,24 @@
=, test-lib
^- (list (pair term raw-test-core))
:~ :- %boot-from-azimuth
%- compose-tests
:_ *raw-test-core
%^ wrap-test-http
'http://localhost:8545'
%- malt
^- (list [@t @t])
:~ :- '{"params":[],"id":"block number","jsonrpc":"2.0","method":"eth_blockNumber"}'
'response-1'
:- '{"params":[{"fromBlock":"0x0","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381","toBlock":"0x7"}],"id":"catch up","jsonrpc":"2.0","method":"eth_getLogs"}'
'response-1'
:- '{"params":[{"fromBlock":"0x0","address":"0x863d9c2e5c4c133596cfac29d55255f0d0f86381"}],"id":"new filter","jsonrpc":"2.0","method":"eth_newFilter"}'
'response-1'
:- '{"params":["0x07"],"id":"filter logs","jsonrpc":"2.0","method":"eth_getFilterLogs"}'
'response-1'
==
%+ compose-tests
%+ compose-tests
(raw-ship ~bud `(dawn:azimuth ~bud))
(touch-file ~bud %home)
:: %- assert-happens
:: :~
:: ==
*raw-test-core
(raw-ship ~bud `(dawn:azimuth ~bud))
(touch-file ~bud %home)
::
:- %simple-add
%+ compose-tests (galaxy ~bud)
@ -309,10 +319,11 @@
`this(results ~)
=^ lab test-qeu ~(get to test-qeu)
~& [running-test=lab test-qeu]
=. effect-log ~
=/ res=[events=(list ph-event) new-state=raw-test-core]
~(start (~(got by raw-test-cores) lab) now.hid)
=> .(test-core `(unit test-core-state)`test-core)
=. test-core `[ships . ~]:new-state.res
=. test-core `[ships .]:new-state.res
=^ moves-1 this (subscribe-to-effects lab ships.new-state.res)
=^ moves-2 this (run-events lab events.res)
[:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this]
@ -411,9 +422,8 @@
[:(weld moves-1 moves-2) this]
::
%print
=/ log effect-log:(need test-core)
~& lent=(lent log)
~& %+ roll log
~& lent=(lent effect-log)
~& %+ roll effect-log
|= [[who=ship uf=unix-effect] ~]
?: ?=(?(%blit %doze) -.q.uf)
~
@ -439,21 +449,22 @@
=+ |- ^- $: thru-effects=(list unix-effect)
events=(list ph-event)
cor=_u.test-core
log=_effect-log
==
?~ ufs.afs
[~ ~ u.test-core]
=. effect-log.u.test-core
[[who i.ufs]:afs effect-log.u.test-core]
[~ ~ u.test-core ~]
=+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-core]
(~(route cor.u.test-core now.hid) who.afs i.ufs.afs)
=. cor.u.test-core cor
=+ $(ufs.afs t.ufs.afs)
:+ ?: thru
[i.ufs.afs thru-effects]
thru-effects
(weld events-1 events)
cor
:^ ?: thru
[i.ufs.afs thru-effects]
thru-effects
(weld events-1 events)
cor
[[who i.ufs]:afs log]
=. test-core `cor
=. effect-log (weld log effect-log)
=> .(test-core `(unit test-core-state)`test-core)
=/ moves-1 (publish-aqua-effects who.afs thru-effects)
=^ moves-2 this (run-events lab events)

View File

@ -80,11 +80,11 @@
::
?: ?=($pawn myr)
[[%base %collections] [%base %hall] [%base %talk] [%base %dojo] ~]
:~ [%home %collections]
[%home %acme]
[%home %dns]
:~ :: [%home %collections]
:: [%home %acme]
:: [%home %dns]
:: [%home %hall]
[%home %dojo]
[%home %hall]
[%home %talk]
==
::

View File

@ -123,7 +123,7 @@
^- (list ph-event)
[%init-ship who keys]~
::
:: factor out send-events-to
:: Send dojo command
::
++ dojo
|= [who=ship what=tape]
@ -181,6 +181,16 @@
?=(%ergo -.q.uf)
==
::
:: Check if given effect is an http request; extract
::
++ extract-thus-to
|= [uf=unix-effect dest=@t]
^- (unit [num=@ud mot=moth:eyre])
?. ?=(%thus -.q.uf) ~
?~ q.q.uf ~
?. =(p.u.q.q.uf (rash dest auri:de-purl:html)) ~
`[p.q.uf q.u.q.q.uf]
::
++ azimuth
|%
++ dawn
@ -272,13 +282,13 @@
^- (quip ph-event _..start)
=/ have-cache
(scry-aqua ? now /fleet-snap/[label:a]/noun)
?: have-cache
~& [%caching-in label:a label]
=. done-with-a &
=/ restore-event [%restore-snap label:a]
=^ events-start b ~(start b now)
=^ events ..filter-a (filter-a now restore-event events-start)
[events ..start]
:: ?: have-cache
:: ~& [%caching-in label:a label]
:: =. done-with-a &
:: =/ restore-event [%restore-snap label:a]
:: =^ events-start b ~(start b now)
:: =^ events ..filter-a (filter-a now restore-event events-start)
:: [events ..start]
=^ events a ~(start a now)
[events ..start]
::
@ -304,6 +314,63 @@
[thru events ..start]
--
::
:: Wrap a test with an effect filter.
::
:: This allows intercepting particular effects for special
:: handling.
::
++ wrap-test
|= $: lab=@ta
filter=$-([ship unix-effect] [thru=? pe=(list ph-event)])
cor=raw-test-core
==
^- raw-test-core
|_ now=@da
++ label :((cury cat 3) label:cor '--w--' lab)
++ ships ships:cor
++ start
=^ events cor ~(start cor now)
[events ..start]
::
++ route
|= [who=ship uf=unix-effect]
^- [? (quip ph-event _^|(..start))]
=+ ^- [thru-test=? events-test=(list ph-event) cor-test=_cor]
(~(route cor now) who uf)
=. cor cor-test
?. thru-test
[| events-test ..start]
=+ ^- [thru-filter=? events-filter=(list ph-event)]
(filter who uf)
[thru-filter (weld events-test events-filter) ..start]
--
::
:: Mock HTTP responses to particular requests
::
++ wrap-test-http
|= [url=@t responses=(map @t @t) cor=raw-test-core]
%^ wrap-test
(cat 3 'http-' (scot %uw (mug url responses)))
|= [who=ship uf=unix-effect]
^- [? (list ph-event)]
=/ thus (extract-thus-to uf url)
?~ thus
[& ~]
?~ r.mot.u.thus
[& ~]
=/ resp (~(get by responses) q.u.r.mot.u.thus)
?~ resp
[& ~]
:- | :_ ~
:* %event
who
//http/0v1n.2m9vh
%they
num.u.thus
[200 ~ `(as-octs:mimes:html u.resp)]
==
cor
::
:: Don't use directly unless you've already started any parent.
::
:: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors.