Merge branch 'lighter-than-eyre' into light-integration

* lighter-than-eyre:
  Actually have a 400 Bad Request page instead of reusing the 500 page incorrectly.
  Changed the generator interface so a generator can redirect and set headers.
  can't wake up
  A %coup failure from gall should return a 500 to the client.

gen/frontpage.hoon

@@ -6,8 +6,9 @@
 ::
 ::  :-  %build
 |=  [authorized=? request:http]
-^-  mime
+^-  simple-payload:http
-:-  ['text' 'html' ~]
+:-  [200 ['content-type' 'text/html']~]
+:-  ~
 %-  as-octs:mimes:html
 %-  crip
 %-  en-xml:html

sys/vane/rver.hoon

@@ -412,6 +412,28 @@
           ~
     ==
   ==
+::  +bad-request: 400 page, with an error string if logged in
+::
+++  bad-request
+  |=  [authorized=? url=@t t=tape]
+  ^-  octs
+  %-  as-octs:mimes:html
+  %-  crip
+  %-  en-xml:html
+  ;html
+    ;head
+      ;title:"400 Bad Request"
+    ==
+    ;body
+      ;h1:"Bad Request"
+      ;p:"There was an error while handling the request for {<(trip url)>}."
+      ;*  ?:  authorized
+            ;=
+              ;code:"{t}"
+            ==
+          ~
+    ==
+  ==
 ::  +channel-js: the urbit javascript interface
 ::
 ::    TODO: Must send 'acks' to the server.
@@ -659,8 +681,6 @@
       ::
       =-  [[duct %pass /run-build %f %build live=%.n schematic=-]~ state]
       ::
-      =-  [%cast [our desk.generator.action] %mime -]
-      ::
       :+  %call
         :+  %call
           [%core [[our desk.generator.action] (flop path.generator.action)]]
@@ -899,20 +919,16 @@
       ::    page; issuing a redirect won't help.
       ::
       ?.  authenticated
-        ~&  %unauthenticated
-        ::  TODO: Real 400 page.
-        ::
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error authenticated url.request ~)
+        (bad-request authenticated url.request "unauthenticated channel usage")
       ::  parse out the path key the subscription is on
       ::
       =+  request-line=(parse-request-line url.request)
       ?.  ?=([@t @t @t ~] site.request-line)
-        ~&  %bad-request-line
         ::  url is not of the form '/~/channel/'
         ::
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error authenticated url.request ~)
+        (bad-request authenticated url.request "malformed channel url")
       ::  channel-id: unique channel id parsed out of url
       ::
       =+  channel-id=i.t.t.site.request-line
@@ -1030,12 +1046,12 @@
       ::
       ?~  maybe-channel=(~(get by session.channel-state.state) channel-id)
         %^  return-static-data-on-duct  404  'text/html'
-        (internal-server-error %.y url.request ~)
+        (file-not-found-page url.request)
       ::  if there's already a duct listening to this channel, we must 400
       ::
       ?:  ?=([%| *] state.u.maybe-channel)
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error %.y url.request ~)
+        (bad-request %.y url.request "channel already bound")
       ::  when opening an event-stream, we must cancel our timeout timer
       ::
       =.  moves
@@ -1111,27 +1127,23 @@
       ::  error when there's no body
       ::
       ?~  body.request
-        ~&  %no-body
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error %.y url.request ~)
+        (bad-request %.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)
-        ~&  %no-json
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error %.y url.request ~)
+        (bad-request %.y url.request "put body not json")
       ::  parse the json into an array of +channel-request items
       ::
       ?~  maybe-requests=(parse-channel-request u.maybe-json)
-        ~&  [%no-parse u.maybe-json]
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error %.y url.request ~)
+        (bad-request %.y url.request "invalid channel json")
       ::  while weird, the request list could be empty
       ::
       ?:  =(~ u.maybe-requests)
-        ~&  %empty-list
         %^  return-static-data-on-duct  400  'text/html'
-        (internal-server-error %.y url.request ~)
+        (bad-request %.y url.request "empty list of actions")
       ::  check for the existence of the channel-id
       ::
       ::    if we have no session, create a new one set to expire in
@@ -1364,36 +1376,71 @@
     --
   ::  +handle-ford-response: translates a ford response for the outside world
   ::
-  ::    TODO: Get the authentication state and source url here.
-  ::
   ++  handle-ford-response
     |=  made-result=made-result:ford
     ^-  [(list move) server-state]
     ::
+    =+  connection=(~(got by connections.state) duct)
+    ::
     ?:  ?=(%incomplete -.made-result)
       %^  return-static-data-on-duct  500  'text/html'
-      ::  TODO: Thread original URL and authentication state here.
+      ::
-      (internal-server-error %.y 'http://' tang.made-result)
+      %-  internal-server-error  :*
+          authenticated.inbound-request.connection
+          url.request.inbound-request.connection
+          tang.made-result
+      ==
     ::
     ?:  ?=(%error -.build-result.made-result)
       %^  return-static-data-on-duct  500  'text/html'
-      (internal-server-error %.y 'http://' message.build-result.made-result)
+      ::
+      %-  internal-server-error  :*
+          authenticated.inbound-request.connection
+          url.request.inbound-request.connection
+          message.build-result.made-result
+      ==
     ::
     =/  =cage  (result-to-cage:ford build-result.made-result)
     ::
+    =/  result=simple-payload:http  ((hard simple-payload:http) q.q.cage)
+    ::  ensure we have a valid content-length header
+    ::
+    ::    We pass on the response and the headers the generator produces, but
+    ::    ensure that we have a single content-length header set correctly in
+    ::    the returned if this has a body, and has no content-length if there
+    ::    is no body returned to the client.
+    ::
+    =.  headers.response-header.result
+      ?~  data.result
+        (delete-header:http 'content-length' headers.response-header.result)
+      ::
+      %^  set-header:http  'content-length'
+        (crip (format-ud-as-integer p.u.data.result))
+      headers.response-header.result
+    ::
     %-  handle-response
-    =/  result=mime  ((hard mime) q.q.cage)
     ::
     ^-  http-event:http
     :*  %start
-        :-  200
+        response-header.result
-        ^-  header-list:http
+        data.result
-        :~  ['content-type' (en-mite:mimes:html p.result)]
-            ['content-length' (crip (format-ud-as-integer p.q.result))]
-        ==
-        `(unit octs)`[~ q.result]
         complete=%.y
     ==
+  ::  +handle-gall-error: a call to +poke-http-response resulted in a %coup
+  ::
+  ++  handle-gall-error
+    |=  =tang
+    ^-  [(list move) server-state]
+    ::
+    =+  connection=(~(got by connections.state) duct)
+    ::
+    %^  return-static-data-on-duct  500  'text/html'
+    ::
+    %-  internal-server-error  :*
+        authenticated.inbound-request.connection
+        url.request.inbound-request.connection
+        tang
+    ==
   ::  +handle-response: check a response for correctness and send to earth
   ::
   ::    All outbound responses including %http-server generated responses need to go
@@ -1737,11 +1784,23 @@
   ::
   ++  run-app
     ::
-    ?.  ?=([%g %unto %http-response *] sign)
+    ?>  ?=([%g %unto *] sign)
-      ::  entirely normal to get things other than http-response calls, but we
+    ::
-      ::  don't care.
+    ::
+    ?:  ?=([%coup *] p.sign)
+      ?~  p.p.sign
+        ::  received a positive acknowledgment: take no action
         ::
         [~ http-server-gate]
+      ::  we have an error; propagate it to the client
+      ::
+      =/  event-args  [[our eny duct now scry-gate] server-state.ax]
+      =/  handle-gall-error
+        handle-gall-error:(per-server-event event-args)
+      =^  moves  server-state.ax  (handle-gall-error u.p.p.sign)
+      [moves http-server-gate]
+    ::
+    ?>  ?=([%g %unto %http-response *] sign)
     ::
     =/  event-args  [[our eny duct now scry-gate] server-state.ax]
     =/  handle-response  handle-response:(per-server-event event-args)
@@ -1773,9 +1832,6 @@
       =^  moves  server-state.ax
         (on-channel-timeout i.t.t.wire)
       [moves http-server-gate]
-      ::    %wake
-      ::
-      ::  TODO: wake me up inside
     ::
         ?(%poke %subscription)
       ?>  ?=([%g %unto *] sign)

sys/zuse.hoon

@@ -296,6 +296,47 @@
       `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:http]
+    ^-  header-list:http
+    ::
+    ?~  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:http]
+    ^-  header-list:http
+    ::
+    ?~  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)]
+  ::  +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

tests/sys/vane/rver.hoon

@@ -285,6 +285,96 @@
     results4
   ==
 ::
+++  test-app-error
+  ::
+  =^  results1  http-server-gate
+    %-  http-server-call  :*
+      http-server-gate
+      now=~1111.1.1
+      scry=scry-provides-code
+      call-args=[duct=~[/init] ~ [%init ~nul]]
+      expected-moves=~
+    ==
+  ::  app1 binds successfully
+  ::
+  =^  results2  http-server-gate
+    %-  http-server-call  :*
+      http-server-gate
+      now=~1111.1.2
+      scry=scry-provides-code
+      call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
+      expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
+    ==
+  ::  outside requests a path that app1 has bound to
+  ::
+  =^  results3  http-server-gate
+    %-  http-server-call-with-comparator  :*
+      http-server-gate
+      now=~1111.1.3
+      scry=scry-provides-code
+      ^=  call-args
+        :*  duct=~[/http-blah]  ~
+            %request
+            %.n
+            [%ipv4 .192.168.1.1]
+            [%'GET' '/' ~ ~]
+        ==
+      ^=  comparator
+        |=  moves=(list move:http-server-gate)
+        ^-  tang
+        ::
+        ?.  ?=([* ~] moves)
+          [%leaf "wrong number of moves: {<(lent moves)>}"]~
+        ::
+        ::
+        =/  move=move:http-server-gate                              i.moves
+        =/  =duct                                             duct.move
+        =/  card=(wind note:http-server-gate gift:able:http-server-gate)  card.move
+        ::
+        %+  weld
+          (expect-eq !>(~[/http-blah]) !>(duct))
+        ::
+        %+  expect-gall-deal
+          :+  /run-app/app1  [~nul ~nul]
+              ^-  cush:gall
+              :*  %app1  %poke  %handle-http-request
+                  !>([%.n %.n [%ipv4 .192.168.1.1] [%'GET' '/' ~ ~]])
+              ==
+          card
+    ==
+  ::  the poke fails. we should relay this to the client
+  ::
+  =^  results4  http-server-gate
+    %-  http-server-take  :*
+      http-server-gate
+      now=~1111.1.4
+      scry=scry-provides-code
+      ^=  take-args
+        :*  wire=/run-app/app1  duct=~[/http-blah]
+            ^-  (hypo sign:http-server-gate)
+            :-  *type
+            :*  %g  %unto  %coup  ~
+                :~  [%leaf "/~zod/...../app1:<[1 1].[1 20]>"]
+            ==  ==
+         ==
+      ^=  expected-move
+        :~  :*  duct=~[/http-blah]  %give  %response
+                %start
+                :-  500
+                :~  ['content-type' 'text/html']
+                    ['content-length' '180']
+                ==
+                [~ (internal-server-error:http-server-gate %.n '/' ~)]
+                complete=%.y
+    ==  ==  ==
+  ::
+  ;:  weld
+    results1
+    results2
+    results3
+    results4
+  ==
+::
 ++  test-multipart-app-request
   ::
   =^  results1  http-server-gate
@@ -592,7 +682,6 @@
             !>  p.card
         ::
         %+  expect-schematic
-          :^  %cast  [~nul %home]  %mime
           :+  %call
             :+  %call
               [%core [[~nul %home] /hoon/handler/gen]]
@@ -616,8 +705,10 @@
             ^-  made-result:ford
             :-  %complete
             ^-  build-result:ford
-            :-  %success
+            :^  %success  %cast  %mime
-            [%cast %mime !>([['text' 'plain' ~] (as-octs:mimes:html 'one two three')])]
+            !>
+            :-  [200 ['content-type' 'text/plain']~]
+            `(as-octs:mimes:html 'one two three')
          ==
       ^=  expected-move
         :~  :*  duct=~[/http-blah]  %give  %response
@@ -759,11 +850,11 @@
                 %start
                 :-  400
                 :~  ['content-type' 'text/html']
-                    ['content-length' '206']
+                    ['content-length' '186']
                 ==
               ::
                 :-  ~
-                %^  internal-server-error:http-server-gate  %.n
+                %^  bad-request:http-server-gate  %.n
                 '/~/channel/1234567890abcdef'  ~
               ::
                 complete=%.y