From 13fc795c6c4d8a2e58ea265ebe0d6e419344aad0 Mon Sep 17 00:00:00 2001
From: Liam Fitzgerald <liam.fitzgerald@urbit.org>
Date: Tue, 28 May 2024 06:41:03 -0400
Subject: [PATCH] neo: add eyre shane

---
 pkg/arvo/app/neo.hoon | 68 +++++++++++++++++++++++++++++++++++++++++++
 pkg/arvo/sur/neo.hoon | 19 ++++++++++++
 2 files changed, 87 insertions(+)

diff --git a/pkg/arvo/app/neo.hoon b/pkg/arvo/app/neo.hoon
index 99686449f5..b886b38c6e 100644
--- a/pkg/arvo/app/neo.hoon
+++ b/pkg/arvo/app/neo.hoon
@@ -3,6 +3,7 @@
 /+  default-agent
 /+  dbug
 /+  libverb=verb
+/+  serv=server
 /*  txt-hoon-imp    %hoon   /neo/cod/std/src/imp/hoon/hoon
 /*  txt-term-imp    %hoon   /neo/cod/std/src/imp/term/hoon
 /*  txt-ford-same   %hoon   /neo/cod/std/src/imp/ford-same/hoon
@@ -246,6 +247,7 @@
   ::
     %noun            (on-noun q.vase)
     %neo-raw-poke    (on-move (poke:harden !<(raw-poke:neo vase)))
+    %handle-http-request  (handle-http-request:sttp !<([@ta inbound-request:eyre] vase))
   ==
 ++  on-noun
   |=  non=*
@@ -302,6 +304,7 @@
   ?+  pole   ~|  bad-watch-path/pole  !!
     [%sync rest=*]  (on-peer-sync (pave:neo rest.pole) stop)
     [%fetch rest=*]  ?:(stop run (on-peer-fetch (pave:neo rest.pole)))
+    [%http-response *]   run
   ==
 ::
 ++  on-peer-fetch
@@ -1808,6 +1811,7 @@
       [%iris *]  (call:cttp src t.dst note)
       [%behn *]  (call:bide src t.dst note)
       [%gall *]  (call:rile src t.dst note)
+      [%eyre *]  (call:sttp src t.dst note)
     ==
   ++  take-arvo
     |=  [=(pole knot) syn=sign-arvo]
@@ -1990,6 +1994,70 @@
     =/  =res:behn:neo  +.syn
     (emit (do-move src i.timers %poke behn-res/!>(res)))
   --
+++  sttp
+  |%
+  ++  call
+    |=  [src=pith:neo dst=pith:neo =note:neo]
+    ?>  ?=(%poke -.note) :: XX: all shanes should be virtualised and hand deliver acks
+    ?+  p.pail.note  ~|(bad-eyre-call/p.pail.note !!)
+      %eyre-req    (on-eyre-req !<(req:eyre:neo q.pail.note))
+      %eyre-sign  (on-eyre-sign src !<(sign:eyre:neo q.pail.note))
+    ==
+    +$  request-line
+      $:  [ext=(unit @ta) site=(list @t)]
+          args=(list [key=@t value=@t])
+      ==
+    ::  +parse-request-line: take a cord and parse out a url
+    ::
+    ++  parse-request-line
+      |=  url=@t
+      ^-  request-line
+      (fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
+    ::
+    ++  on-eyre-req
+      |=  [%connect =binding:eyre =pith:neo]
+      ?>  =(~ site.binding)
+      =.  bind.eyre.unix  (~(put by bind.eyre.unix) binding pith)
+      =/  wir=wire  (welp /sys/eyre/bind (pout pith))
+      (emit %pass wir %arvo %e %connect binding dap.bowl)
+    ::
+    ++  on-eyre-sign
+      |=  [src=pith:neo eyre-id=@ta =gift:eyre:neo]
+      ^+  run
+      ?>  =(src (~(got by by-id.eyre.unix) eyre-id))
+      =/  =path  /http-response/[eyre-id]
+      =;  cag=(unit cage)
+        ?~  cag  (give %kick ~[path] ~)
+        (give %fact ~[path] u.cag)
+      ?-  -.gift
+        %head  `http-response-header/!>(response-header.gift)
+        %data  `http-response-data/!>(dat.gift)
+        %done  ~
+      ==
+    ++  match-binding
+      =|  test=(list @t)
+      |=  site=(list @t)
+      ^-  (unit pith:neo)
+      ?^  res=(~(get by bind.eyre.unix) [~ test])
+        `u.res
+      =/  nex  (slag (lent test) site)
+      ?~  nex
+        ~
+      $(test (snoc test i.nex))
+    ::
+    ++  handle-http-request
+      |=  [eyre-id=@ta req=inbound-request:eyre]
+      ^+  run
+      =/  lin=request-line   (parse-request-line url.request.req)
+      ?~  bin=(match-binding site.lin)
+        (emil (give-simple-payload:app:serv eyre-id not-found:gen:serv))
+      =.  by-id.eyre.unix     (~(put by by-id.eyre.unix) eyre-id u.bin)
+      =.  by-pith.eyre.unix  (~(put by by-pith.eyre.unix) u.bin eyre-id)
+      =/  =card:neo  [u.bin %poke eyre-task/!>([eyre-id req])]
+      =/  =move:neo  [#/[p/our.bowl]/$/eyre card]
+      (emit (do-move move))
+    --
+
 ++  cttp
   |%
   ++  call
diff --git a/pkg/arvo/sur/neo.hoon b/pkg/arvo/sur/neo.hoon
index 3996d6e938..fb5f8c33ef 100644
--- a/pkg/arvo/sur/neo.hoon
+++ b/pkg/arvo/sur/neo.hoon
@@ -1158,6 +1158,19 @@
   ::
   +$  res  $>(%wake gift:^behn)
   --
+++  eyre
+  |%
+  +$  req  [%connect =binding:^eyre =pith]
+  +$  res  [%bound ~]
+  +$  sign  (pair @ta gift)
+  +$  gift
+    $%  [%head =response-header:http]
+        [%data dat=(unit octs)]
+        [%done ~]
+    ==
+  +$  task
+    (pair @ta inbound-request:^eyre)
+  --
 ::  +clay: Filesystem overlay
 ::
 ++  clay
@@ -1659,12 +1672,18 @@
         =iris
         =behn
         =gall
+        =eyre
     ==
   +$  behn  (jug @da pith)
   +$  clay
     (map [src=pith hand=pith] [case=@ud =desk =path as=(unit mark)])
   +$  iris
     (set [src=pith hand=pith])
+  +$  eyre
+    $:  by-id=(map @ta pith)
+        by-pith=(map pith @ta)
+        bind=(map binding:^^eyre pith)
+    ==
   ++  gall
     =<  gall
     |%