feat: node backend

.gitignore

@@ -1,4 +1,3 @@
-
 bower_components/
 node_modules/
 .pulp-cache/
@@ -10,3 +9,4 @@ generated-docs/
 .purs*
 .psa*
 .spago
+index.js

README.md

@@ -30,12 +30,14 @@ postPerson _ _ _ person = ...
 ```
 
 Then these can be rolled up into a `/persons` resource with `Handler.or`:
+
 ```purs
 persons :: Handler Aff Response
 persons = getPerson `Handler.or` postPerson `Handler.or` deletePerson `Handler.or` getPersonAddress ...
 ```
 
 Then run with:
+
 ```purs
 Axon.serveNode {port: 10000, hostname: "0.0.0.0"} persons
 ```

src/Axon.Bun.purs

@@ -0,0 +1,20 @@
+module Axon.Serve.Bun where
+
+import Axon.Request.Handler (Handler)
+import Axon.Response (Response)
+import Axon.Runtime as Runtime
+import Axon.Runtime.Bun as Runtime.Bun
+import Axon.Serve (Serve)
+import Axon.Serve as Serve
+import Effect.Aff (Aff, Fiber)
+import Prim.Row (class Nub, class Union)
+
+serve ::
+  forall opts optsMissing optsMerged.
+  Union opts optsMissing (Serve Aff) =>
+  Union opts (Serve Aff) optsMerged =>
+  Nub optsMerged (Serve Aff) =>
+  Record opts ->
+  Handler Aff Response ->
+  Aff (Runtime.Handle Aff Fiber Runtime.Bun.Bun)
+serve = Serve.serve

src/Axon.Node.purs

@@ -1 +1,19 @@
-module Axon.Node where
+module Axon.Serve.Node where
+
+import Axon.Request.Handler (Handler)
+import Axon.Response (Response)
+import Axon.Runtime as Runtime
+import Axon.Runtime.Node as Runtime.Node
+import Axon.Serve (Serve, serve)
+import Effect.Aff (Aff, Fiber)
+import Prim.Row (class Nub, class Union)
+
+serveHTTP1 ::
+  forall opts optsMissing optsMerged.
+  Union opts optsMissing (Serve Aff) =>
+  Union opts (Serve Aff) optsMerged =>
+  Nub optsMerged (Serve Aff) =>
+  Record opts ->
+  Handler Aff Response ->
+  Aff (Runtime.Handle Aff Fiber Runtime.Node.Server)
+serveHTTP1 = serve

src/Axon.Request.Parts.Class.purs

@@ -62,6 +62,7 @@ import Data.Map as Map
 import Data.Maybe (Maybe)
 import Data.Show.Generic (genericShow)
 import Data.String.Lower as String.Lower
+import Data.Traversable (for)
 import Data.Tuple.Nested (type (/\), (/\))
 import Data.URL as URL
 import Effect.Aff (Aff)
@@ -139,12 +140,13 @@ instance TypedHeader a => RequestParts (Header a) where
     value <-
       Request.headers r
         # Map.lookup (String.Lower.fromString $ headerName @a)
+        >>= Array.head
         # liftMaybe ExtractNext
     runParser value (headerValueParser @a)
       # bimap
-          ( ExtractBadRequest <<< Array.intercalate "\n" <<< parseErrorHuman
-              value
-              5
+          ( ExtractBadRequest
+              <<< Array.intercalate "\n"
+              <<< parseErrorHuman value 5
           )
           Header
       # liftEither

src/Axon.Request.Parts.Header.purs

@@ -15,7 +15,7 @@ derive newtype instance (Eq a) => Eq (Header a)
 derive newtype instance (Ord a) => Ord (Header a)
 derive newtype instance (Show a) => Show (Header a)
 
-newtype HeaderMap = HeaderMap (Map StringLower String)
+newtype HeaderMap = HeaderMap (Map StringLower (Array String))
 
 derive instance Generic HeaderMap _
 derive instance Newtype HeaderMap _

src/Axon.Request.purs

@@ -23,14 +23,16 @@ module Axon.Request
 import Prelude
 
 import Axon.Request.Method (Method)
+import Axon.Response.Body (empty)
 import Control.Monad.Error.Class (throwError, try)
 import Control.Monad.Except (ExceptT(..), runExceptT)
 import Control.Monad.Trans.Class (lift)
 import Data.Argonaut.Core (Json)
 import Data.Argonaut.Core (stringify) as JSON
 import Data.Argonaut.Parser (jsonParser) as JSON
+import Data.Array as Array
 import Data.Bifunctor (lmap)
-import Data.Either (Either)
+import Data.Either (Either(..))
 import Data.FoldableWithIndex (foldlWithIndex)
 import Data.Generic.Rep (class Generic)
 import Data.Int as Int
@@ -38,14 +40,14 @@ import Data.MIME (MIME)
 import Data.MIME as MIME
 import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe, fromMaybe, maybe)
 import Data.Net.SocketAddress (SocketAddress)
 import Data.Show.Generic (genericShow)
 import Data.String.Lower (StringLower)
 import Data.String.Lower as String.Lower
 import Data.URL (URL)
 import Effect (Effect)
-import Effect.Aff (Aff)
+import Effect.Aff (Aff, makeAff)
 import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (Error)
@@ -55,6 +57,7 @@ import Effect.Ref as Ref
 import Node.Buffer (Buffer)
 import Node.Buffer as Buffer
 import Node.Encoding (Encoding(..))
+import Node.EventEmitter as Event
 import Node.Stream as Stream
 import Node.Stream.Aff as Stream.Aff
 
@@ -109,7 +112,7 @@ data Body
 
 data Request =
   Request
-    { headers :: Map StringLower String
+    { headers :: Map StringLower (Array String)
     , address :: SocketAddress
     , url :: URL
     , method :: Method
@@ -117,7 +120,7 @@ data Request =
     }
 
 make ::
-  { headers :: Map String String
+  { headers :: Map String (Array String)
   , address :: SocketAddress
   , url :: URL
   , method :: Method
@@ -137,20 +140,22 @@ make a = do
     , method: a.method
     }
 
-headers :: Request -> Map StringLower String
+headers :: Request -> Map StringLower (Array String)
 headers (Request a) = a.headers
 
-lookupHeader :: String -> Request -> Maybe String
-lookupHeader k (Request a) = Map.lookup (String.Lower.fromString k) a.headers
+lookupHeader :: String -> Request -> Array String
+lookupHeader k (Request a) = fromMaybe [] $ Map.lookup
+  (String.Lower.fromString k)
+  a.headers
 
-contentType :: Request -> Maybe MIME
+contentType :: Request -> Array MIME
 contentType = lookupHeader "content-type" >>> map MIME.fromString
 
-accept :: Request -> Maybe MIME
+accept :: Request -> Array MIME
 accept = lookupHeader "accept" >>> map MIME.fromString
 
 contentLength :: Request -> Maybe Int
-contentLength = lookupHeader "content-length" >=> Int.fromString
+contentLength = lookupHeader "content-length" >>> Array.head >=> Int.fromString
 
 method :: Request -> Method
 method (Request a) = a.method
@@ -184,13 +189,13 @@ bodyBuffer r@(Request { bodyRef }) =
         # liftEffect
         <#> lmap BodyBufferErrorReadable
         # ExceptT
-    readAll s =
-      Stream.Aff.readAll s
-        # liftAff
-        # try
-        <#> lmap BodyBufferErrorReading
-        # ExceptT
-        >>= (liftEffect <<< Buffer.concat)
+    readAll s = do
+      bufs <- liftEffect $ Ref.new []
+      liftEffect $ Event.on_ Stream.dataH
+        (\chunk -> Ref.modify_ (_ <> [ chunk ]) bufs)
+        s
+      makeAff \res -> Event.once Stream.endH (res $ Right unit) s $> mempty
+      liftEffect $ Ref.read bufs >>= Buffer.concat
   in
     runExceptT do
       body <- Ref.read bodyRef # liftEffect
@@ -200,7 +205,7 @@ bodyBuffer r@(Request { bodyRef }) =
         BodyCachedJSON json -> Buffer.fromString (JSON.stringify json) UTF8 #
           liftEffect
         _ -> do
-          buf <- stream >>= readAll
+          buf <- stream >>= (lift <<< readAll)
           Ref.write (BodyCached buf) bodyRef $> buf # liftEffect
 
 bodyString :: Request -> Aff (Either BodyStringError String)

src/Axon.Response.Construct.purs

@@ -661,4 +661,5 @@ typedHeaderToResponse =
   pure
     <<< Response.response Status.ok Response.BodyEmpty
     <<< Map.singleton (headerName @a)
+    <<< pure
     <<< headerValueEncode

src/Axon.Response.purs

@@ -25,7 +25,7 @@ import Data.String.Lower (StringLower)
 import Data.String.Lower as String.Lower
 
 data Response = Response
-  { body :: Body, headers :: Map StringLower String, status :: Status }
+  { body :: Body, headers :: Map StringLower (Array String), status :: Status }
 
 derive instance Generic Response _
 instance Semigroup Response where
@@ -38,7 +38,7 @@ instance Semigroup Response where
 instance Show Response where
   show = genericShow
 
-response :: Status -> Body -> Map String String -> Response
+response :: Status -> Body -> Map String (Array String) -> Response
 response s b h = Response
   { status: s
   , body: b
@@ -53,12 +53,13 @@ status (Response a) = a.status
 body :: Response -> Body
 body (Response a) = a.body
 
-headers :: Response -> Map StringLower String
+headers :: Response -> Map StringLower (Array String)
 headers (Response a) = a.headers
 
 withHeader :: String -> String -> Response -> Response
 withHeader k v (Response a) = Response $ a
-  { headers = Map.insert (String.Lower.fromString k) v a.headers }
+  { headers = Map.insertWith append (String.Lower.fromString k) [ v ] a.headers
+  }
 
 withStatus :: Status -> Response -> Response
 withStatus s (Response a) = Response $ a { status = s }

src/Axon.Runtime.Bun.js

@@ -3,9 +3,9 @@ import * as Net from 'node:net'
 
 /*
 type Serve =
-  { port :: Nullable Int
-  , hostname :: Nullable String
-  , idleTimeout :: Nullable Number
+  { port :: Int
+  , hostname :: String
+  , idleTimeout :: Number
   , fetch :: WebRequest -> Bun -> Effect (Promise WebResponse)
   }
 

src/Axon.Runtime.Bun.purs

@@ -30,9 +30,9 @@ import Effect.Exception (error)
 foreign import data Bun :: Type
 
 type Serve =
-  { port :: Nullable Int
-  , hostname :: Nullable String
-  , idleTimeout :: Nullable Number
+  { port :: Int
+  , hostname :: String
+  , idleTimeout :: Number
   , fetch :: WebRequest -> Bun -> Effect (Promise WebResponse)
   }
 
@@ -80,9 +80,9 @@ instance Runtime Bun where
 
     let
       o' =
-        { port: Null.toNullable o.port
-        , hostname: Null.toNullable o.hostname
-        , idleTimeout: Null.toNullable $ unwrap <$> o.idleTimeout
+        { port: o.port
+        , hostname: o.hostname
+        , idleTimeout: unwrap o.idleTimeout
         , fetch
         }
 

src/Axon.Runtime.Node.js

@@ -0,0 +1,138 @@
+import { IncomingMessage, ServerResponse, Server } from 'node:http'
+import * as HTTP from 'node:http'
+import { Readable } from 'node:stream'
+
+/**
+type CreateServer =
+  { keepAliveTimeout :: Nullable Number
+  , fetch :: IncomingMessage -> ServerResponse -> Effect Unit
+  }
+
+foreign import createServer :: CreateServer -> Effect Server
+
+  @type {(o: {keepAliveTimeout: number | null, fetch: (req: IncomingMessage) => (rep: ServerResponse) => () => void}) => () => Server}
+*/
+export const createServer = o => () =>
+  HTTP.createServer(
+    {
+      keepAliveTimeout:
+        o.keepAliveTimeout === null ? undefined : o.keepAliveTimeout,
+    },
+    (req, res) => o.fetch(req)(res)(),
+  )
+
+/**
+ * foreign import serverClose :: Effect Unit -> Server -> Effect Unit
+ * @type {(onClose: () => void) => (s: Server) => () => void}
+ */
+export const serverClose = f => s => () => s.close(f)
+
+/**
+ * foreign import serverListen :: String -> Int -> Server -> Effect Unit
+ * @type {(onListening: () => void) => (addr: string ) => (port: number ) => (s: Server) => () => void}
+ */
+export const serverListen = f => hostname => port => s => () => {
+  s.listen(port, hostname, f)
+}
+
+/**
+ * requestBody :: IncomingMessage -> Readable ()
+ * @type {(req: IncomingMessage) => Readable}
+ */
+export const requestBody = req => req
+
+/**
+ * requestHeaders :: IncomingMessage -> Effect (Object String)
+ * @type {(req: IncomingMessage) => () => Record<string, string[]>}
+ */
+export const requestHeaders = req => () => {
+  /** @type {Record<string, string[]>} */
+  const o = {}
+
+  for (const [k, v] of Object.entries(req.headers)) {
+    if (!o[k]) {
+      o[k] = []
+    }
+
+    if (v instanceof Array) {
+      o[k].push(...v)
+    } else if (v !== undefined) {
+      o[k].push(v)
+    }
+  }
+
+  return o
+}
+
+/**
+ * requestMethod :: IncomingMessage -> Effect String
+ * @type {(req: IncomingMessage) => () => string | undefined}
+ */
+export const requestMethod = req => () => req.method
+
+/**
+ * requestURL :: IncomingMessage -> Effect String
+ * @type {(req: IncomingMessage) => () => string | undefined}
+ */
+export const requestURL = req => () => req.url
+
+/**
+ * foreign import requestAddr ::
+ *   { ipv4 :: String -> Int -> SocketAddress
+ *   , ipv6 :: String -> Int -> SocketAddress
+ *   } ->
+ *   IncomingMessage ->
+ *   Effect SocketAddress
+ * @type {(
+ *   (addr: {ipv4: (a: string) => (b: number) => unknown, ipv6: (a: string) =>
+ *           (b: number) => unknown}) =>
+ *   (req: IncomingMessage) =>
+ *   () =>
+ *   unknown
+ * )}
+ */
+export const requestAddr =
+  ({ ipv4, ipv6 }) =>
+  req =>
+  () => {
+    const addr = req.socket.address()
+    if (!('family' in addr)) throw new Error('Request has no socket')
+
+    if (addr.family.toLowerCase() === 'ipv4') {
+      return ipv4(addr.address)(addr.port)
+    } else {
+      return ipv6(addr.address)(addr.port)
+    }
+  }
+
+/**
+ * responseEnd :: ServerResponse -> Effect Unit
+ * @type {(req: ServerResponse) => () => void}
+ */
+export const responseEnd = rep => () => rep.end()
+
+/**
+ * responseWriteHead :: Int -> Object (Array String) -> ServerResponse -> Effect Unit
+ * @type {(status: number) => (o: Record<string, string[]>) => (req: ServerResponse) => () => void}
+ */
+export const responseWriteHead = status => headers => rep => () =>
+  rep.writeHead(status, headers)
+
+/**
+ * responseWriteString :: String -> ServerResponse -> Effect Unit
+ * @type {(body: string) => (req: ServerResponse) => () => void}
+ */
+export const responseWriteString = body => rep => () => rep.write(body)
+
+/**
+ * responseWriteBuffer :: Buffer -> ServerResponse -> Effect Unit
+ * @type {(body: Buffer) => (req: ServerResponse) => () => void}
+ */
+export const responseWriteBuffer = body => rep => () => rep.write(body)
+
+/**
+ * responseWriteStream :: Readable () -> ServerResponse -> Effect Unit
+ * @type {(body: Readable) => (req: ServerResponse) => () => void}
+ */
+export const responseWriteStream = body => rep => () =>
+  body.pipe(rep, { end: false })

src/Axon.Runtime.Node.purs

@@ -0,0 +1,160 @@
+module Axon.Runtime.Node where
+
+import Prelude
+
+import Axon.Request (Body(..), Request)
+import Axon.Request as Request
+import Axon.Request.Method as Method
+import Axon.Response (Response(..))
+import Axon.Response as Rep
+import Axon.Runtime (class Runtime)
+import Control.Monad.Error.Class (liftMaybe)
+import Control.Monad.Fork.Class (fork)
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
+import Data.Map as Map
+import Data.Net.SocketAddress (SocketAddress)
+import Data.Net.SocketAddress as SocketAddress
+import Data.Newtype (unwrap)
+import Data.Nullable (Nullable)
+import Data.Nullable as Null
+import Data.String.Lower as String.Lower
+import Data.Tuple.Nested (type (/\))
+import Data.URL (URL)
+import Data.URL as URL
+import Effect (Effect)
+import Effect.Aff (launchAff_, makeAff)
+import Effect.Aff.Class (liftAff)
+import Effect.Aff.Unlift (class MonadUnliftAff, UnliftAff(..), askUnliftAff)
+import Effect.Class (liftEffect)
+import Effect.Exception (error)
+import Foreign.Object (Object)
+import Foreign.Object as Object
+import Node.Buffer (Buffer)
+import Node.EventEmitter (EventHandle(..))
+import Node.EventEmitter as Event
+import Node.EventEmitter.UtilTypes (EventHandle0)
+import Node.Stream (Readable)
+
+foreign import data Server :: Type
+foreign import data IncomingMessage :: Type
+foreign import data ServerResponse :: Type
+
+type CreateServer =
+  { keepAliveTimeout :: Nullable Number
+  , fetch :: IncomingMessage -> ServerResponse -> Effect Unit
+  }
+
+foreign import createServer :: CreateServer -> Effect Server
+foreign import serverClose :: Effect Unit -> Server -> Effect Unit
+foreign import serverListen ::
+  Effect Unit -> String -> Int -> Server -> Effect Unit
+
+foreign import requestBody :: IncomingMessage -> Readable ()
+foreign import requestHeaders ::
+  IncomingMessage -> Effect (Object (Array String))
+
+foreign import requestMethod :: IncomingMessage -> Effect String
+foreign import requestURL :: IncomingMessage -> Effect String
+foreign import requestAddr ::
+  { ipv4 :: String -> Int -> SocketAddress
+  , ipv6 :: String -> Int -> SocketAddress
+  } ->
+  IncomingMessage ->
+  Effect SocketAddress
+
+foreign import responseEnd :: ServerResponse -> Effect Unit
+foreign import responseWriteHead ::
+  Int -> Object (Array String) -> ServerResponse -> Effect Unit
+
+foreign import responseWriteString :: String -> ServerResponse -> Effect Unit
+foreign import responseWriteBuffer :: Buffer -> ServerResponse -> Effect Unit
+foreign import responseWriteStream ::
+  Readable () -> ServerResponse -> Effect Unit
+
+closeH :: EventHandle0 Server
+closeH = EventHandle "close" identity
+
+toRequest :: URL -> IncomingMessage -> Effect Request
+toRequest baseURI req = do
+  let
+    body = BodyReadable $ requestBody req
+  headers <-
+    requestHeaders req
+      <#>
+        ( Map.fromFoldable
+            <<< (Object.toUnfoldable :: _ (Array (String /\ Array String)))
+        )
+  url <- requestURL req <#> URL.addSegment baseURI
+  method <- do
+    methodString <- requestMethod req
+    liftMaybe (error $ "unknown request method: " <> methodString)
+      $ Method.fromString methodString
+  address <- requestAddr { ipv4: SocketAddress.IPv4, ipv6: SocketAddress.IPv6 }
+    req
+
+  Request.make { address, body, headers, url, method }
+
+writeResponse :: ServerResponse -> Response -> Effect Unit
+writeResponse node rep = do
+  responseWriteHead
+    (unwrap $ Rep.status rep)
+    ( Rep.headers rep
+        #
+          ( Map.toUnfoldable ::
+              _ (Array (String.Lower.StringLower /\ Array String))
+          )
+        <#> lmap String.Lower.toString
+        # Object.fromFoldable
+    )
+    node
+
+  case Rep.body rep of
+    Rep.BodyEmpty -> pure unit
+    Rep.BodyBuffer b -> responseWriteBuffer b node
+    Rep.BodyString s -> responseWriteString s node
+    Rep.BodyReadable r -> responseWriteStream r node
+
+  responseEnd node
+
+fetchImpl ::
+  forall m.
+  MonadUnliftAff m =>
+  String ->
+  (Request -> m Response) ->
+  m (IncomingMessage -> ServerResponse -> Effect Unit)
+fetchImpl hostname f = do
+  baseURI <- liftAff $ liftMaybe (error $ "invalid hostname " <> hostname)
+    $ URL.fromString
+    $ "http://"
+    <> hostname
+  UnliftAff toAff <- askUnliftAff
+  pure \req' rep' ->
+    launchAff_
+      $ toAff
+      $ liftEffect (toRequest baseURI req')
+      >>= f
+      >>= (liftEffect <<< writeResponse rep')
+
+instance Runtime Server where
+  serve o = do
+    fetch <- fetchImpl o.hostname o.fetch
+    server <- liftEffect $ createServer
+      { keepAliveTimeout: Null.notNull $ unwrap o.idleTimeout, fetch }
+    liftAff
+      $ makeAff \res ->
+          serverListen
+            (res $ Right unit)
+            o.hostname
+            o.port
+            server
+            $> mempty
+    join' <- fork $ liftAff $ makeAff \res ->
+      Event.on closeH (res $ Right unit) server $> mempty
+
+    pure
+      { server
+      , join: join'
+      , stop: liftAff $ makeAff \res -> serverClose (res $ Right unit) server $>
+          mempty
+      }

src/Axon.Runtime.purs

@@ -13,9 +13,9 @@ import Effect.Aff.Unlift (class MonadUnliftAff)
 
 type Init m =
   { fetch :: Request -> m Response
-  , port :: Maybe Int
-  , hostname :: Maybe String
-  , idleTimeout :: Maybe Seconds
+  , port :: Int
+  , hostname :: String
+  , idleTimeout :: Seconds
   }
 
 type Handle m f a =

src/Axon.Serve.purs

@@ -1,4 +1,4 @@
-module Axon where
+module Axon.Serve where
 
 import Prelude
 
@@ -11,14 +11,12 @@ import Axon.Response as Rep
 import Axon.Response.Status as Status
 import Axon.Runtime (class Runtime)
 import Axon.Runtime as Runtime
-import Axon.Runtime.Bun as Runtime.Bun
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Fork.Class (class MonadFork)
 import Data.Either (Either(..))
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Time.Duration (Milliseconds(..), convertDuration)
-import Effect.Aff (Aff, Fiber)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Aff.Unlift (class MonadUnliftAff)
 import Effect.Class (liftEffect)
@@ -37,23 +35,41 @@ type Serve m =
   , handleUnmatched :: Handler m Response
   )
 
+defaultHandleError :: forall m. MonadAff m => Request -> Error -> m Response
+defaultHandleError _ e =
+  let
+    rep = Rep.response Status.internalServerError (Rep.BodyString $ show e)
+      Map.empty
+  in
+    liftEffect $ Console.error (show e) $> rep
+
+defaultHandleBadRequest ::
+  forall m. MonadAff m => Request -> String -> m Response
+defaultHandleBadRequest _ e =
+  let
+    rep = Rep.response Status.badRequest (Rep.BodyString $ show e) Map.empty
+  in
+    pure rep
+
+defaultHandleBadRequestDebug ::
+  forall m. MonadAff m => Request -> String -> m Response
+defaultHandleBadRequestDebug _ e =
+  let
+    rep = Rep.response Status.badRequest (Rep.BodyString $ show e) Map.empty
+  in
+    liftEffect $ Console.error (show e) $> rep
+
+defaultHandleUnmatched :: forall m. MonadAff m => Handler m Response
+defaultHandleUnmatched = Handler.Default.notFound
+
 serveDefaults :: forall m. MonadAff m => Record (Serve m)
 serveDefaults =
   { port: 8000
   , hostname: "127.0.0.1"
   , idleTimeout: Milliseconds 30000.0
-  , handleError: \_ e ->
-      let
-        rep = Rep.response Status.internalServerError (Rep.BodyString $ show e)
-          Map.empty
-      in
-        liftEffect $ Console.error (show e) $> rep
-  , handleBadRequest: \_ e ->
-      let
-        rep = Rep.response Status.badRequest (Rep.BodyString $ show e) Map.empty
-      in
-        pure rep
-  , handleUnmatched: Handler.Default.notFound
+  , handleError: defaultHandleError
+  , handleBadRequest: defaultHandleBadRequest
+  , handleUnmatched: defaultHandleUnmatched
   }
 
 serveToRuntime ::
@@ -77,34 +93,11 @@ serveToRuntime h o =
           Right rep -> pure rep
   in
     { fetch: fetch false h
-    , port: Just o.port
-    , hostname: Just o.hostname
-    , idleTimeout: Just $ convertDuration o.idleTimeout
+    , port: o.port
+    , hostname: o.hostname
+    , idleTimeout: convertDuration o.idleTimeout
     }
 
--- | `serve` using `Bun` in `Aff`
-serveBun ::
-  forall opts optsMissing optsMerged.
-  Union opts optsMissing (Serve Aff) =>
-  Union opts (Serve Aff) optsMerged =>
-  Nub optsMerged (Serve Aff) =>
-  Record opts ->
-  Handler Aff Response ->
-  Aff (Runtime.Handle Aff Fiber Runtime.Bun.Bun)
-serveBun = serve
-
--- | `serve` in `Aff`
-serveAff ::
-  forall @rt opts optsMissing optsMerged.
-  Runtime rt =>
-  Union opts optsMissing (Serve Aff) =>
-  Union opts (Serve Aff) optsMerged =>
-  Nub optsMerged (Serve Aff) =>
-  Record opts ->
-  Handler Aff Response ->
-  Aff (Runtime.Handle Aff Fiber rt)
-serveAff = serve
-
 -- | Runs the server using the given `runtime`.
 -- |
 -- | First argument (`Record opts`) must be a partial record of `Serve m`.

src/Axon.Web.Headers.purs

@@ -2,6 +2,7 @@ module Axon.Web.Headers where
 
 import Prelude
 
+import Data.Bifunctor (rmap)
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Tuple.Nested (type (/\), (/\))
@@ -13,6 +14,8 @@ foreign import headerEntries ::
   WebHeaders ->
   Effect (Array (String /\ String))
 
-toMap :: WebHeaders -> Effect (Map String String)
+toMap :: WebHeaders -> Effect (Map String (Array String))
 toMap hs =
-  headerEntries { tuple: (/\) } hs <#> Map.fromFoldable
+  headerEntries { tuple: (/\) } hs
+    <#> map (rmap pure)
+    <#> Map.fromFoldableWith append

src/Axon.Web.Response.purs

@@ -6,6 +6,7 @@ import Axon.Response (Response(..))
 import Axon.Response as Response
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.FoldableWithIndex (foldlWithIndex)
+import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (unwrap)
 import Data.String.Lower as String.Lower
 import Effect (Effect)
@@ -19,7 +20,7 @@ import Unsafe.Coerce (unsafeCoerce)
 foreign import data WebResponse :: Type
 
 foreign import make ::
-  { body :: WebResponseBody, status :: Int, headers :: Object String } ->
+  { body :: WebResponseBody, status :: Int, headers :: Object (Array String) } ->
   Effect WebResponse
 
 foreign import data WebResponseBody :: Type

test/Example/Bun.purs

@@ -0,0 +1,58 @@
+module Example.Bun where
+
+import Prelude
+
+import Axon.Serve.Bun as Axon
+import Axon.Request.Handler as Handler
+import Axon.Request.Parts.Class (Delete, Get, Path(..), Post)
+import Axon.Request.Parts.Path (type (/))
+import Axon.Response (Response)
+import Axon.Response.Construct (Json(..), toResponse)
+import Axon.Response.Status as Status
+import Data.Filterable (filter)
+import Data.Foldable (elem)
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_, joinFiber)
+import Effect.Class (liftEffect)
+import Effect.Ref (Ref)
+import Effect.Ref as Ref
+
+main :: Effect Unit
+main = launchAff_ do
+  cheeses :: Ref (Array String) <- liftEffect $ Ref.new
+    [ "cheddar", "swiss", "gouda" ]
+
+  let
+    getCheeses :: Get -> Path "cheeses" _ -> Aff Response
+    getCheeses _ _ = liftEffect do
+      cheeses' <- Ref.read cheeses
+      toResponse $ Status.ok /\ Json cheeses'
+
+    deleteCheese :: Delete -> Path ("cheeses" / String) _ -> Aff Response
+    deleteCheese _ (Path id) = liftEffect do
+      cheeses' <- Ref.read cheeses
+      if not $ elem id cheeses' then
+        toResponse Status.notFound
+      else
+        Ref.modify_ (filter (_ /= id)) cheeses
+          *> toResponse Status.accepted
+
+    postCheese :: Post -> Path "cheeses" _ -> String -> Aff Response
+    postCheese _ _ cheese =
+      let
+        tryInsert as
+          | elem cheese as = { state: as, value: false }
+          | otherwise = { state: as <> [ cheese ], value: true }
+      in
+        liftEffect
+          $ Ref.modify' tryInsert cheeses
+          >>=
+            if _ then toResponse Status.accepted else toResponse Status.conflict
+
+  handle <-
+    Axon.serve
+      { port: 8080, hostname: "localhost" }
+      (getCheeses `Handler.or` postCheese `Handler.or` deleteCheese)
+
+  joinFiber handle.join

test/Example/Node.purs

@@ -0,0 +1,62 @@
+module Example.Node where
+
+import Prelude
+
+import Axon.Request.Handler as Handler
+import Axon.Request.Parts.Class (Delete, Get, Path(..), Post)
+import Axon.Request.Parts.Path (type (/))
+import Axon.Response (Response)
+import Axon.Response.Construct (Json(..), toResponse)
+import Axon.Response.Status as Status
+import Axon.Serve as Axon.Serve
+import Axon.Serve.Node as Axon
+import Data.Filterable (filter)
+import Data.Foldable (elem)
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_, joinFiber)
+import Effect.Class (liftEffect)
+import Effect.Ref (Ref)
+import Effect.Ref as Ref
+
+main :: Effect Unit
+main = launchAff_ do
+  cheeses :: Ref (Array String) <- liftEffect $ Ref.new
+    [ "cheddar", "swiss", "gouda" ]
+
+  let
+    getCheeses :: Get -> Path "cheeses" _ -> Aff Response
+    getCheeses _ _ = liftEffect do
+      cheeses' <- Ref.read cheeses
+      toResponse $ Status.ok /\ Json cheeses'
+
+    deleteCheese :: Delete -> Path ("cheeses" / String) _ -> Aff Response
+    deleteCheese _ (Path id) = liftEffect do
+      cheeses' <- Ref.read cheeses
+      if not $ elem id cheeses' then
+        toResponse Status.notFound
+      else
+        Ref.modify_ (filter (_ /= id)) cheeses
+          *> toResponse Status.accepted
+
+    postCheese :: Post -> Path "cheeses" _ -> String -> Aff Response
+    postCheese _ _ cheese =
+      let
+        tryInsert as
+          | elem cheese as = { state: as, value: false }
+          | otherwise = { state: as <> [ cheese ], value: true }
+      in
+        liftEffect
+          $ Ref.modify' tryInsert cheeses
+          >>=
+            if _ then toResponse Status.accepted else toResponse Status.conflict
+
+  handle <-
+    Axon.serveHTTP1
+      { port: 8080
+      , hostname: "localhost"
+      , handleBadRequest: Axon.Serve.defaultHandleBadRequestDebug
+      }
+      (getCheeses `Handler.or` postCheese `Handler.or` deleteCheese)
+
+  joinFiber handle.join

test/Test/Axon.Request.Handler.purs

@@ -30,7 +30,7 @@ import Test.Spec (Spec, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 
 defaultRequest ::
-  { headers :: Map String String
+  { headers :: Map String (Array String)
   , address :: SocketAddress
   , url :: URL
   , method :: Method
@@ -39,7 +39,7 @@ defaultRequest ::
 defaultRequest =
   { body: Request.BodyEmpty
   , url: URL.fromString "http://localhost:80/" # unsafePartial fromJust
-  , headers: Map.singleton "content-type" "application/json"
+  , headers: Map.singleton "content-type" (pure "application/json")
   , address: SocketAddress.IPv4 "127.0.0.1" 81
   , method: GET
   }

test/Test/Axon.Request.Parts.purs

@@ -45,7 +45,7 @@ spec = describe "Parts" do
     req <- liftEffect $ Request.make
       { body: Request.BodyEmpty
       , url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust
-      , headers: Map.singleton "content-type" "application/json"
+      , headers: Map.singleton "content-type" (pure "application/json")
       , address: SocketAddress.IPv4 "127.0.0.1" 81
       , method: GET
       }
@@ -61,7 +61,7 @@ spec = describe "Parts" do
       { body: Request.BodyReadable stream
       , url: URL.fromString "http://localhost:80/users/12" # unsafePartial
           fromJust
-      , headers: Map.singleton "content-type" "application/json"
+      , headers: Map.singleton "content-type" (pure "application/json")
       , address: SocketAddress.IPv4 "127.0.0.1" 81
       , method: PATCH
       }

test/Test/Main.purs

@@ -2,7 +2,6 @@ module Test.Main where
 
 import Prelude
 
-import Axon as Axon
 import Axon.Request.Handler as Handler
 import Axon.Request.Parts.Class (Delete, Get, Path(..), Post)
 import Axon.Request.Parts.Path (type (/))
@@ -27,44 +26,3 @@ main :: Effect Unit
 main = runSpecAndExitProcess [ specReporter ] $ describe "Axon" do
   Test.Request.spec
   Test.Header.spec
-
-  pending' "example" do
-    cheeses :: Ref.Ref (Array String) <- liftEffect $ Ref.new
-      [ "cheddar", "swiss", "gouda" ]
-
-    let
-      getCheeses :: Get -> Path ("cheeses") _ -> Aff Response
-      getCheeses _ _ = liftEffect do
-        cheeses' <- Ref.read cheeses
-        toResponse $ Status.ok /\ Json cheeses'
-
-      deleteCheese :: Delete -> Path ("cheeses" / String) _ -> Aff Response
-      deleteCheese _ (Path id) = liftEffect do
-        cheeses' <- Ref.read cheeses
-        if (not $ elem id cheeses') then
-          toResponse $ Status.notFound
-        else do
-          Ref.modify_ (filter (_ /= id)) cheeses
-          toResponse $ Status.accepted
-
-      postCheese :: Post -> Path "cheeses" _ -> String -> Aff Response
-      postCheese _ _ cheese =
-        let
-          tryInsert as
-            | elem cheese as = { state: as, value: false }
-            | otherwise = { state: as <> [ cheese ], value: true }
-        in
-          liftEffect
-            $ Ref.modify' tryInsert cheeses
-            >>=
-              if _ then
-                toResponse $ Status.accepted
-              else
-                toResponse $ Status.conflict
-
-    handle <-
-      Axon.serveBun
-        { port: 8080, hostname: "localhost" }
-        (getCheeses `Handler.or` postCheese `Handler.or` deleteCheese)
-
-    Aff.joinFiber $ handle.join