@@ -0,0 +1,812 @@
3+=, strand=strand:libstrand
4+=, strand-fail=strand-fail:libstrand
7+ |= cards=(list =card:agent:gall)
10+ |= strand-input:strand
17+ (send-raw-cards card ~)
20+ |= tin=strand-input:strand
24+ =/ m (strand ,bowl:strand)
26+ |= tin=strand-input:strand
32+ |= tin=strand-input:strand
33+ `[%done [our q.byk da+now]:bowl.tin]
38+ |= tin=strand-input:strand
39+ `[%done now.bowl.tin]
44+ |= tin=strand-input:strand
45+ `[%done our.bowl.tin]
50+ |= tin=strand-input:strand
51+ `[%done eny.bowl.tin]
53+:: Convert skips to %ignore failures.
55+:: This tells the main loop to try the next handler.
62+ |= tin=strand-input:strand
64+ =? next.res ?=(%skip -.next.res)
68+:: Wait for a poke with a particular mark
74+ |= tin=strand-input:strand
80+ ?. =(mark p.cage.u.in.tin)
82+ `[%done q.cage.u.in.tin]
86+ =/ m (strand ,[wire sign-arvo])
88+ |= tin=strand-input:strand
94+ `[%done [wire sign-arvo]:u.in.tin]
97+:: Wait for a subscription update on a wire
101+ =/ m (strand ,[path cage])
103+ |= tin=strand-input:strand
104+ ?+ in.tin `[%skip ~]
106+ [~ %agent * %fact *]
107+ ?. =(watch+wire (scag +((lent wire)) wire.u.in.tin))
109+ `[%done (slag (lent wire) wire.u.in.tin) cage.sign.u.in.tin]
112+:: Wait for a subscription update on a wire
118+ |= tin=strand-input:strand
119+ ?+ in.tin `[%skip ~]
121+ [~ %agent * %fact *]
122+ ?. =(watch+wire wire.u.in.tin)
124+ `[%done cage.sign.u.in.tin]
127+:: Wait for a subscription close
133+ |= tin=strand-input:strand
134+ ?+ in.tin `[%skip ~]
136+ [~ %agent * %kick *]
137+ ?. =(watch+wire wire.u.in.tin)
148+ ;< =vase bind:m ((handle ,vase) (take-poke %echo))
149+ =/ message=tape !<(tape vase)
150+ %- (slog leaf+"{message}..." ~)
151+ ;< ~ bind:m (sleep ~s2)
152+ %- (slog leaf+"{message}.." ~)
157+ ;< =vase bind:m ((handle ,vase) (take-poke %over))
158+ %- (slog leaf+"over..." ~)
164+ |= tin=strand-input:strand
165+ ?+ in.tin `[%skip ~]
168+ `[%done path.u.in.tin]
175+ |= tin=strand-input:strand
176+ ?+ in.tin `[%skip ~]
178+ [~ %sign [%wait @ ~] %behn %wake *]
179+ ?. |(?=(~ until) =(`u.until (slaw %da i.t.wire.u.in.tin)))
181+ ?~ error.sign-arvo.u.in.tin
183+ `[%fail %timer-error u.error.sign-arvo.u.in.tin]
188+ =/ m (strand ,[spar:ames (unit roar:ames)])
190+ |= tin=strand-input:strand
191+ ?+ in.tin `[%skip ~]
194+ [~ %sign * %ames %tune ^ *]
195+ ?. =(wire wire.u.in.tin)
197+ `[%done +>.sign-arvo.u.in.tin]
204+ |= tin=strand-input:strand
205+ ?+ in.tin `[%skip ~]
207+ [~ %agent * %poke-ack *]
208+ ?. =(wire wire.u.in.tin)
212+ `[%fail %poke-fail u.p.sign.u.in.tin]
219+ |= tin=strand-input:strand
220+ ?+ in.tin `[%skip ~]
222+ [~ %agent * %watch-ack *]
223+ ?. =(watch+wire wire.u.in.tin)
227+ `[%fail %watch-ack-fail u.p.sign.u.in.tin]
234+ =/ =card:agent:gall [%pass /poke %agent dock %poke cage]
235+ ;< ~ bind:m (send-raw-card card)
236+ (take-poke-ack /poke)
242+ =/ =card:agent:gall [%pass /poke %agent dock %poke cage]
243+ ;< ~ bind:m (send-raw-card card)
246+ |= tin=strand-input:strand
247+ ?+ in.tin `[%skip ~]
251+ [~ %agent * %poke-ack *]
252+ ?. =(/poke wire.u.in.tin)
261+ ;< =bowl:spider bind:m get-bowl
262+ (raw-poke [our.bowl app] cage)
268+ ;< our=@p bind:m get-our
269+ (poke [our term] cage)
272+ |= [=wire =dock =path]
275+ =/ =card:agent:gall [%pass watch+wire %agent dock %watch path]
276+ ;< ~ bind:m (send-raw-card card)
277+ (take-watch-ack wire)
280+ |= [=wire =dock =path]
283+ ;< ~ bind:m (watch wire dock path)
284+ ;< =cage bind:m (take-fact wire)
285+ ;< ~ bind:m (take-kick wire)
289+ |= [=wire =term =path]
292+ ;< our=@p bind:m get-our
293+ (watch wire [our term] path)
301+ ;< =bowl:spider bind:m get-bowl
303+ .^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path)
309+ =/ =card:agent:gall [%pass watch+wire %agent dock %leave ~]
310+ (send-raw-card card)
316+ ;< our=@p bind:m get-our
317+ (leave wire [our term])
320+ |= [=wire =dock =path]
322+ ;< ~ bind:m ((handle ,~) (take-kick wire))
323+ ;< ~ bind:m (flog-text "rewatching {<dock>} {<path>}")
324+ ;< ~ bind:m (watch wire dock path)
331+ ;< ~ bind:m (send-wait until)
335+ |= [=wire =spar:ames]
338+ (send-raw-card %pass wire %arvo %a %keen spar)
344+ ;< now=@da bind:m get-time
345+ (wait (add now for))
352+ [%pass /wait/(scot %da until) %arvo %b %wait until]
353+ (send-raw-card card)
356+ |* computation-result=mold
357+ =/ m (strand ,computation-result)
358+ |= [f=$-([term tang] [term tang]) computation=form:m]
360+ |= tin=strand-input:strand
362+ =/ c-res (computation tin)
363+ ?: ?=(%cont -.next.c-res)
364+ c-res(self.next ..loop(computation self.next.c-res))
365+ ?. ?=(%fail -.next.c-res)
367+ c-res(err.next (f err.next.c-res))
370+ |* computation-result=mold
371+ =/ m (strand ,computation-result)
372+ |= [time=@dr computation=form:m]
374+ ;< now=@da bind:m get-time
375+ =/ when (add now time)
377+ [%pass /timeout/(scot %da when) %arvo %b %wait when]
378+ ;< ~ bind:m (send-raw-card card)
379+ |= tin=strand-input:strand
381+ ?: ?& ?=([~ %sign [%timeout @ ~] %behn %wake *] in.tin)
382+ =((scot %da when) i.t.wire.u.in.tin)
385+ =/ c-res (computation tin)
386+ ?: ?=(%cont -.next.c-res)
387+ c-res(self.next ..loop(computation self.next.c-res))
388+ ?: ?=(%done -.next.c-res)
390+ [%pass /timeout/(scot %da when) %arvo %b %rest when]
391+ c-res(cards [card cards.c-res])
398+ (send-raw-card %pass /request %arvo %i %request request *outbound-config:iris)
400+++ send-cancel-request
403+ (send-raw-card %pass /request %arvo %i %cancel-request ~)
405+++ take-client-response
406+ =/ m (strand ,client-response:iris)
408+ |= tin=strand-input:strand
409+ ?+ in.tin `[%skip ~]
412+ [~ %sign [%request ~] %iris %http-response %cancel *]
413+ ::NOTE iris does not (yet?) retry after cancel, so it means failure
416+ %http-request-cancelled
417+ ['http request was cancelled by the runtime']~
419+ [~ %sign [%request ~] %iris %http-response %finished *]
420+ `[%done client-response.sign-arvo.u.in.tin]
423+:: Wait until we get an HTTP response or cancelation and unset contract
426+ =/ m (strand ,(unit httr:eyre))
428+ ;< rep=(unit client-response:iris) bind:m
432+ :: XX s/b impossible
434+ ?. ?=(%finished -.u.rep)
436+ (pure:m (some (to-httr:iris +.u.rep)))
438+++ take-maybe-response
439+ =/ m (strand ,(unit client-response:iris))
441+ |= tin=strand-input:strand
442+ ?+ in.tin `[%skip ~]
444+ [~ %sign [%request ~] %iris %http-response %cancel *]
446+ [~ %sign [%request ~] %iris %http-response %finished *]
447+ `[%done `client-response.sign-arvo.u.in.tin]
451+ |= =client-response:iris
454+ ?> ?=(%finished -.client-response)
456+ ?~ full-file.client-response ''
457+ q.data.u.full-file.client-response
463+ =/ =request:http [%'GET' (crip url) ~ ~]
464+ ;< ~ bind:m (send-request request)
465+ ;< =client-response:iris bind:m take-client-response
466+ (extract-body client-response)
472+ ;< =cord bind:m (fetch-cord url)
473+ =/ json=(unit json) (de:json:html cord)
475+ (strand-fail %json-parse-error ~)
480+ =/ m (strand ,(unit httr:eyre))
482+ ;< ~ bind:m (send-request (hiss-to-request:html hiss))
485+:: +build-file: build the source file at the specified $beam
488+ |= [[=ship =desk =case] =spur]
490+ =/ m (strand ,(unit vase))
492+ ;< =riot:clay bind:m
493+ (warp ship desk ~ %sing %a case spur)
496+ ?> =(%vase p.r.u.riot)
497+ (pure:m (some !<(vase q.r.u.riot)))
500+ |= [[=ship =desk =case] =spur]
506+ (warp ship desk ~ %sing %a case spur)
508+ ?> ?=(%vase p.r.u.riot)
509+ (pure:m !<(vase q.r.u.riot))
510+:: +build-mark: build a mark definition to a $dais
513+ |= [[=ship =desk =case] mak=mark]
515+ =/ m (strand ,dais:clay)
517+ ;< =riot:clay bind:m
518+ (warp ship desk ~ %sing %b case /[mak])
520+ (strand-fail %build-mark >arg< ~)
521+ ?> =(%dais p.r.u.riot)
522+ (pure:m !<(dais:clay q.r.u.riot))
523+:: +build-tube: build a mark conversion gate ($tube)
526+ |= [[=ship =desk =case] =mars:clay]
528+ =/ m (strand ,tube:clay)
530+ ;< =riot:clay bind:m
531+ (warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
533+ (strand-fail %build-tube >arg< ~)
534+ ?> =(%tube p.r.u.riot)
535+ (pure:m !<(tube:clay q.r.u.riot))
537+:: +build-nave: build a mark definition to a $nave
540+ |= [[=ship =desk =case] mak=mark]
544+ ;< =riot:clay bind:m
545+ (warp ship desk ~ %sing %e case /[mak])
547+ (strand-fail %build-nave >arg< ~)
548+ ?> =(%nave p.r.u.riot)
550+:: +build-cast: build a mark conversion gate (static)
553+ |= [[=ship =desk =case] =mars:clay]
557+ ;< =riot:clay bind:m
558+ (warp ship desk ~ %sing %f case /[a.mars]/[b.mars])
560+ (strand-fail %build-cast >arg< ~)
561+ ?> =(%cast p.r.u.riot)
567+ |= [=ship =riff:clay]
568+ =/ m (strand ,riot:clay)
569+ ;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
573+ |= [[=ship =desk =case] =spur]
576+ ;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur)
578+ (strand-fail %read-file >arg< ~)
582+ |= [[=ship =desk =case] =spur]
584+ ;< =riot:clay bind:m (warp ship desk ~ %sing %u case spur)
586+ (pure:m !<(? q.r.u.riot))
589+ |= [[=ship =desk =case] =spur]
591+ =/ m (strand ,(list path))
592+ ;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur)
594+ (strand-fail %list-tree >arg< ~)
595+ (pure:m !<((list path) q.r.u.riot))
597+:: Take Clay read result
601+ =/ m (strand ,riot:clay)
603+ |= tin=strand-input:strand
604+ ?+ in.tin `[%skip ~]
606+ [~ %sign * ?(%behn %clay) %writ *]
607+ ?. =(wire wire.u.in.tin)
609+ `[%done +>.sign-arvo.u.in.tin]
611+:: +check-online: require that peer respond before timeout
614+ |= [who=ship lag=@dr]
617+ %+ (map-err ,~) |=(* [%offline *tang])
618+ %+ (set-timeout ,~) lag
620+ (poke [who %hood] %helm-hi !>(~))
624+ |= [gen=hoon bez=(list beam)]
627+ =/ sut=vase !>(..zuse)
630+ (pure:m (slap sut gen))
631+ ;< vax=vase bind:m (build-file-hard i.bez)
632+ $(bez t.bez, sut (slop vax sut))
635+ |= [=bear:khan =shed:khan =wire]
638+ (send-raw-card %pass wire %arvo %k %lard bear shed)
640+:: Queue on skip, try next on fail %ignore
646+ =| queue=(qeu (unit input:strand))
647+ =| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))])
649+ |= forms=(lest $-(a form:m-a))
651+ |= tin=strand-input:strand
653+ =. queue (~(put to queue) in.tin)
654+ |^ (continue bowl.tin)
662+ =^ in=(unit input:strand) queue ~(get to queue)
664+ =. active `[in (i.forms state) t.forms]
670+ |= tin=strand-input:strand
673+ =/ res (form.u.active tin)
677+ %skip `[%cont ..$(queue (~(put to queue) in.tin))]
678+ %cont `[%cont ..$(active `[in.u.active self.next.res forms.u.active])]
679+ %done (continue(active ~, state value.next.res) bowl.tin)
681+ ?: &(?=(^ forms.u.active) ?=(%ignore p.err.next.res))
683+ active `[in.u.active (i.forms.u.active state) t.forms.u.active]
686+ `[%fail err.next.res]
688+ [(weld cards.res cards.output) next.output]
693+ |= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
694+ =/ m (strand ,result)
698+ ?: =(crash-after `try)
699+ (strand-fail %retry-too-many ~)
700+ ;< ~ bind:m (backoff try ~m1)
701+ ;< res=(unit result) bind:m computation
707+ |= [try=@ud limit=@dr]
710+ ;< eny=@uvJ bind:m get-entropy
715+ (mul ~s1 (bex (dec try)))
716+ (mul ~s0..0001 (~(rad og eny) 1.000))
726+ (send-raw-card %pass / %arvo %d %flog flog)
739+ (zing (turn (flop tang) (cury wash [0 80])))
744+ ;< ~ bind:m (flog-text i.wall)
751+ (pure:m ((slog tang) ~))
754+ |= [app=term =cord =tang]
757+ =/ msg=tape :(weld (trip app) ": " (trip cord))
758+ ;< ~ bind:m (flog-text msg)
769+ (send-raw-card %pass / %arvo %e %rule %turf %put turf)
777+ =/ m (strand ,tid:spider)
778+ ;< =bowl:spider bind:m get-bowl
779+ (start-thread-with-args byk.bowl file *vase)
781+++ start-thread-with-args
782+ |= [=beak file=term args=vase]
783+ =/ m (strand ,tid:spider)
785+ ;< =bowl:spider bind:m get-bowl
787+ (scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl))))
788+ =/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args])
789+ ;< ~ bind:m (poke-our %spider %spider-start poke-vase)
790+ ;< ~ bind:m (sleep ~s0) :: wait for thread to start
794+ (each vase [term tang])
797+ |= [file=term args=vase]
798+ =/ m (strand ,thread-result)
800+ ;< =bowl:spider bind:m get-bowl
801+ =/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
802+ =/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args])
803+ ;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
804+ ;< ~ bind:m (poke-our %spider %spider-start poke-vase)
805+ ;< ~ bind:m (sleep ~s0) :: wait for thread to start
806+ ;< =cage bind:m (take-fact /awaiting/[tid])
807+ ;< ~ bind:m (take-kick /awaiting/[tid])
808+ ?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
809+ %thread-done (pure:m %& q.cage)
810+ %thread-fail (pure:m %| ;;([term tang] q.q.cage))