feat: bun runtime

.tool-versions

@@ -1,2 +1,2 @@
 purescript 0.15.16-4
-bun 1.1.38
+bun 1.2.4

README.md

@@ -1,4 +1,5 @@
 # axon
+
 **WIP**
 
 HTTP server library inspired by [`axum`](https://docs.rs/latest/axum), allowing best-in-class
@@ -16,51 +17,45 @@ main = Axon.serve (root `Handle.or` Handle.Default.notFound)
 ```
 
 ## Request Handlers
+
 Request handler functions have any number of parameters that are `RequestParts` and return an `Aff Response` (or any `MonadAff`).
 
 <details>
 <summary>
 
 `RequestParts`
+
 </summary>
 
-  - `Request`
-    - Always succeeds; provides the entire request
-  - **Combinators**
-    - `Unit`
-      - Always succeeds
-    - `a /\ b`
-      - Tuple of `a` and `b`, where `a` and `b` are `RequestParts`.
-    - `Maybe a`
-      - `a` must be `RequestParts`. If `a` can't be extracted, the handler will still succeed and this will be `Nothing`. If `a` was extracted, it's wrapped in `Just`.
-    - `Either a b`
-      - `a` and `b` must be `RequestParts`. Succeeds if either `a` or `b` succeeds (preferring `a`). Fails if both fail.
-  - **Body**
-    - `String`
-      - succeeds when request has a non-empty body that is valid UTF-8
-    - `Json a`
-      - succeeds when request has a `String` body (see above) that can be parsed into `a` using `DecodeJson`.
-    - `Buffer`
-      - succeeds when request has a nonempty body.
-    - `Stream`
-      - succeeds when request has a nonempty body.
-  - **Headers**
-    - `Header a`
-      - `a` must be `TypedHeader` from `Axon.Header.Typed`. Allows statically (ex. `ContentType Type.MIME.Json`) or dynamically (ex. `ContentType String`) matching request headers.
-    - `HeaderMap`
-      - All headers provided in the request
-  - **Path**
-    - `Path a c`
-      - Statically match the path of the request, and extract parameters. See `Axon.Request.Parts.Path`. (TODO: this feels too magical, maybe follow axum's prior art of baking paths into the router declaration?)
-  - **Method**
-    - `Get`
-    - `Post`
-    - `Put`
-    - `Patch`
-    - `Delete`
-    - `Options`
-    - `Connect`
-    - `Trace`
+- `Request`
+  - Always succeeds; provides the entire request
+- **Combinators**
+  - `Unit`
+    - Always succeeds
+  - `a /\ b`
+    - Tuple of `a` and `b`, where `a` and `b` are `RequestParts`.
+  - `Maybe a`
+    - `a` must be `RequestParts`. If `a` can't be extracted, the handler will still succeed and this will be `Nothing`. If `a` was extracted, it's wrapped in `Just`.
+  - `Either a b`
+    - `a` and `b` must be `RequestParts`. Succeeds if either `a` or `b` succeeds (preferring `a`). Fails if both fail.
+- **Body**
+  - `String`
+    - succeeds when request has a non-empty body that is valid UTF-8
+  - `Json a`
+    - succeeds when request has a `String` body (see above) that can be parsed into `a` using `DecodeJson`.
+  - `Buffer`
+    - succeeds when request has a nonempty body.
+  - `Stream`
+    - succeeds when request has a nonempty body.
+- **Headers**
+  - `Header a`
+    - `a` must be `TypedHeader` from `Axon.Header.Typed`. Allows statically (ex. `ContentType Type.MIME.Json`) or dynamically (ex. `ContentType String`) matching request headers.
+  - `HeaderMap`
+    - All headers provided in the request
+- **Path**
+  - `Path a c`
+    - Statically match the path of the request, and extract parameters. See `Axon.Request.Parts.Path`. (TODO: this feels too magical, maybe follow axum's prior art of baking paths into the router declaration?)
+- **Method** - `Get` - `Post` - `Put` - `Patch` - `Delete` - `Options` - `Connect` - `Trace`
 </details>
 
 Similarly to the structural extraction of request parts; handlers can use `Axon.Response.Construct.ToResponse` for easily constructing responses.
@@ -69,6 +64,7 @@ Similarly to the structural extraction of request parts; handlers can use `Axon.
 <summary>
 
 `ToResponse`
+
 </summary>
 
 - **Combinators**
@@ -88,4 +84,4 @@ Similarly to the structural extraction of request parts; handlers can use `Axon.
 - **Headers**
   - `ToResponse` is implemented for all implementors of `TypedHeader`
   - TODO: `Map String String`
-</details>
+  </details>

package.json

@@ -11,7 +11,7 @@
     "lint:fix": "bun run scripts/fmt.js"
   },
   "devDependencies": {
-    "bun-types": "1.1.4",
+    "bun-types": "^1.2.4",
     "purs-tidy": "^0.10.0",
     "typescript": "^5.0.0"
   },

spago.lock

@@ -8,6 +8,7 @@
             {
               "aff": ">=8.0.0 <9.0.0"
             },
+            "aff-promise",
             {
               "argonaut-codecs": ">=9.1.0 <10.0.0"
             },
@@ -94,6 +95,7 @@
           ],
           "build_plan": [
             "aff",
+            "aff-promise",
             "argonaut-codecs",
             "argonaut-core",
             "arraybuffer-types",
@@ -792,6 +794,15 @@
         "unsafe-coerce"
       ]
     },
+    "aff-promise": {
+      "type": "registry",
+      "version": "4.0.0",
+      "integrity": "sha256-Kq5EupbUpXeUXx4JqGQE7/RTTz/H6idzWhsocwlEFhM=",
+      "dependencies": [
+        "aff",
+        "foreign"
+      ]
+    },
     "ansi": {
       "type": "registry",
       "version": "7.0.0",

spago.yaml

@@ -1,6 +1,7 @@
 package:
   name: axon
   dependencies:
+    - aff-promise
     - b64
     - parsing
     - aff: '>=8.0.0 <9.0.0'

src/Axon.Request.Method.purs

@@ -47,4 +47,4 @@ fromString =
     go "CONNECT" = Just CONNECT
     go _ = Nothing
   in
-    go
+    go <<< String.toUpper

src/Axon.Runtime.Bun.js

@@ -0,0 +1,59 @@
+import Bun from 'bun'
+import * as Net from 'node:net'
+
+/*
+type Serve =
+  { port :: Nullable Int
+  , hostname :: Nullable String
+  , idleTimeout :: Nullable Number
+  , fetch :: WebRequest -> Bun -> Effect (Promise WebResponse)
+  }
+
+foreign import serve :: Serve -> Effect Bun
+foreign import stop :: Bun -> Promise Unit
+foreign import ref :: Bun -> Effect Unit
+foreign import unref :: Bun -> Effect Unit
+foreign import requestAddr ::
+  {left :: forall a b. a -> Either a b, right :: forall a b. b -> Either a b}
+  -> WebRequest
+  -> Bun
+  -> Effect (Either (SocketAddress IPv4) (SocketAddress IPv6))
+*/
+
+/** @typedef {{port: number | null, hostname: string | null, idleTimeout: number | null, fetch: (req: Request) => (bun: Bun.Server) => () => Promise<Response>}} ServeOptions */
+
+/**
+ * @template A
+ * @template B
+ * @typedef {unknown} Either
+ */
+
+/** @type {(s: ServeOptions) => () => Bun.Server} */
+export const serve = opts => () =>
+  Bun.serve({
+    development: true,
+    port: opts.port === null ? undefined : opts.port,
+    hostname: opts.hostname === null ? undefined : opts.hostname,
+    idleTimeout: opts.idleTimeout === null ? undefined : opts.idleTimeout,
+    fetch: (req, server) => opts.fetch(req)(server)(),
+  })
+
+/** @type {(s: Bun.Server) => () => void} */
+export const ref = s => () => s.ref()
+
+/** @type {(s: Bun.Server) => () => void} */
+export const unref = s => () => s.unref()
+
+/** @type {(s: Bun.Server) => () => Promise<void>} */
+export const stop = s => () => s.stop()
+
+/** @type {(_: {left: <A, B>(a: A) => Either<A, B>, right: <A, B>(b: B) => Either<A, B>}) => (req: Request) => (s: Bun.Server) => () => Either<Net.SocketAddress, Net.SocketAddress>} */
+export const requestAddr =
+  ({ left, right }) =>
+  req =>
+  s =>
+  () => {
+    const ip = s.requestIP(req)
+    if (!ip) throw new Error('Request closed')
+    return ip.family === 'IPv4' ? left(ip) : right(ip)
+  }

src/Axon.Runtime.Bun.purs

@@ -0,0 +1,76 @@
+module Axon.Runtime.Bun where
+
+import Prelude
+
+import Axon.Request (Request)
+import Axon.Response (Response)
+import Axon.Runtime (class Runtime)
+import Axon.Web.Request (WebRequest)
+import Axon.Web.Request as WebRequest
+import Axon.Web.Response (WebResponse)
+import Axon.Web.Response as WebResponse
+import Control.Monad.Error.Class (try)
+import Control.Promise (Promise)
+import Control.Promise as Promise
+import Data.Either (Either(..))
+import Data.Newtype (unwrap)
+import Data.Nullable (Nullable)
+import Data.Nullable as Null
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Aff as Aff
+import Effect.Class (liftEffect)
+import Effect.Exception (error)
+import Node.Net.Types (IPv4, IPv6, SocketAddress)
+
+foreign import data Bun :: Type
+
+type Serve =
+  { port :: Nullable Int
+  , hostname :: Nullable String
+  , idleTimeout :: Nullable Number
+  , fetch :: WebRequest -> Bun -> Effect (Promise WebResponse)
+  }
+
+foreign import serve :: Serve -> Effect Bun
+foreign import stop :: Bun -> Promise Unit
+foreign import ref :: Bun -> Effect Unit
+foreign import unref :: Bun -> Effect Unit
+foreign import requestAddr ::
+  { left :: forall a b. a -> Either a b, right :: forall a b. b -> Either a b } ->
+  WebRequest ->
+  Bun ->
+  Effect (Either (SocketAddress IPv4) (SocketAddress IPv6))
+
+fetchImpl ::
+  (Request -> Aff Response) -> WebRequest -> Bun -> Effect (Promise WebResponse)
+fetchImpl f req bun =
+  Promise.fromAff do
+    addr <- liftEffect $ requestAddr { left: Left, right: Right } req bun
+    req' <- liftEffect $ WebRequest.toRequest addr req
+    f req' >>= (liftEffect <<< WebResponse.fromResponse)
+
+instance Runtime Bun where
+  serve o = do
+    -- Killing `stopSignal` causes `stopFiber` to complete
+    stopSignal <- Aff.forkAff Aff.never
+    stopFiber <- Aff.forkAff $ void $ try $ Aff.joinFiber stopSignal
+
+    let
+      o' =
+        { port: Null.toNullable o.port
+        , hostname: Null.toNullable o.hostname
+        , idleTimeout: Null.toNullable $ unwrap <$> o.idleTimeout
+        , fetch: fetchImpl o.fetch
+        }
+
+    bun <- liftEffect $ serve o'
+    liftEffect $ ref bun
+
+    pure
+      { server: bun
+      , join: stopFiber
+      , stop: do
+          Promise.toAff $ stop bun
+          Aff.killFiber (error "") stopSignal
+      }

src/Axon.Runtime.purs

@@ -0,0 +1,27 @@
+module Axon.Runtime (Init, Handle, class Runtime, serve) where
+
+import Prelude
+
+import Axon.Request (Request)
+import Axon.Response (Response)
+import Data.Maybe (Maybe)
+import Data.Time.Duration (Seconds)
+import Effect (Effect)
+import Effect.Aff (Aff, Fiber)
+
+type Init =
+  { fetch :: Request -> Aff Response
+  , port :: Maybe Int
+  , hostname :: Maybe String
+  , idleTimeout :: Maybe Seconds
+  }
+
+type Handle a =
+  { server :: a
+  , join :: Fiber Unit
+  , stop :: Aff Unit
+  }
+
+class Runtime :: Type -> Constraint
+class Runtime a where
+  serve :: Init -> Aff (Handle a)

src/Axon.Web.Headers.purs

@@ -1,6 +1,10 @@
 module Axon.Web.Headers where
 
-import Data.Tuple.Nested (type (/\))
+import Prelude
+
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Tuple.Nested (type (/\), (/\))
 import Effect (Effect)
 
 foreign import data WebHeaders :: Type
@@ -8,3 +12,7 @@ foreign import headerEntries ::
   { tuple :: forall a b. a -> b -> a /\ b } ->
   WebHeaders ->
   Effect (Array (String /\ String))
+
+toMap :: WebHeaders -> Effect (Map String String)
+toMap hs =
+  headerEntries { tuple: (/\) } hs <#> Map.fromFoldable

src/Axon.Web.Request.purs

@@ -1,9 +1,24 @@
 module Axon.Web.Request where
 
-import Data.ArrayBuffer.Types (Uint8Array)
+import Prelude
+
+import Axon.Request (Request)
+import Axon.Request as Request
+import Axon.Request.Method as Method
 import Axon.Web.Headers (WebHeaders)
+import Axon.Web.Headers as WebHeaders
+import Control.Monad.Error.Class (liftMaybe)
+import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
+import Control.Monad.Trans.Class (lift)
+import Data.ArrayBuffer.Types (Uint8Array)
+import Data.Either (Either)
+import Data.Maybe (fromMaybe)
 import Data.Nullable (Nullable)
+import Data.Nullable as Null
+import Data.URL as URL
 import Effect (Effect)
+import Effect.Exception (error)
+import Node.Net.Types (IPv4, IPv6, IpFamily(..), SocketAddress)
 import Node.Stream as Stream
 import Web.Streams.ReadableStream (ReadableStream)
 
@@ -20,3 +35,33 @@ foreign import headers :: WebRequest -> Effect WebHeaders
 
 foreign import readableFromWeb ::
   ReadableStream Uint8Array -> Effect (Stream.Readable ())
+
+toRequest ::
+  Either (SocketAddress IPv4) (SocketAddress IPv6) ->
+  WebRequest ->
+  Effect Request
+toRequest address req =
+  let
+    body' =
+      fromMaybe Request.BodyEmpty <$> runMaybeT do
+        readable <- MaybeT $ Null.toMaybe <$> body req
+        lift $ Request.BodyReadable <$> readableFromWeb readable
+    headers' = headers req >>= WebHeaders.toMap
+    url' = do
+      urlString <- url req
+      liftMaybe (error $ "invalid URL: " <> urlString) $ URL.fromString
+        urlString
+    method' = do
+      methodString <- method req
+      liftMaybe (error $ "unknown request method: " <> methodString) $
+        Method.fromString methodString
+  in
+    join
+      $ pure
+          ( \b h u m -> Request.make
+              { body: b, headers: h, address, url: u, method: m }
+          )
+      <*> body'
+      <*> headers'
+      <*> url'
+      <*> method'

src/Axon.Web.Response.js

@@ -0,0 +1,12 @@
+// foreign import response :: {body :: WebResponseBody, status :: Int} -> WebResponse
+
+/** @typedef {string | null | ArrayBuffer | ReadableStream} Body */
+
+/** @type {(_: {body: Body, status: number, headers: Record<string, string>}) => () => Response} */
+export const make =
+  ({ body, status, headers }) =>
+  () =>
+    new Response(body, { status, headers })
+
+/** @type {Body} */
+export const bodyEmpty = null

src/Axon.Web.Response.purs

@@ -1 +1,54 @@
 module Axon.Web.Response where
+
+import Prelude
+
+import Axon.Response (Response(..))
+import Axon.Response as Response
+import Data.ArrayBuffer.Types (ArrayBuffer)
+import Data.FoldableWithIndex (foldlWithIndex)
+import Data.Newtype (unwrap)
+import Data.String.Lower as String.Lower
+import Effect (Effect)
+import Foreign.Object (Object)
+import Foreign.Object as Object
+import Node.Buffer (Buffer)
+import Node.Buffer as Buffer
+import Node.Stream as Stream
+import Unsafe.Coerce (unsafeCoerce)
+
+foreign import data WebResponse :: Type
+
+foreign import make ::
+  { body :: WebResponseBody, status :: Int, headers :: Object String } ->
+  Effect WebResponse
+
+foreign import data WebResponseBody :: Type
+
+foreign import bodyEmpty :: WebResponseBody
+
+bodyArrayBuffer :: ArrayBuffer -> WebResponseBody
+bodyArrayBuffer = unsafeCoerce
+
+bodyReadable :: forall r. Stream.Readable r -> WebResponseBody
+bodyReadable = unsafeCoerce
+
+bodyString :: String -> WebResponseBody
+bodyString = unsafeCoerce
+
+bodyBuffer :: Buffer -> Effect WebResponseBody
+bodyBuffer = map bodyArrayBuffer <<< Buffer.toArrayBuffer
+
+fromResponse :: Response -> Effect WebResponse
+fromResponse rep = do
+  body' <- case Response.body rep of
+    Response.BodyEmpty -> pure bodyEmpty
+    Response.BodyBuffer buf -> bodyBuffer buf
+    Response.BodyReadable s -> pure $ bodyReadable s
+    Response.BodyString s -> pure $ bodyString s
+  make
+    { body: body'
+    , status: unwrap $ Response.status rep
+    , headers:
+        foldlWithIndex (\k o v -> Object.insert (String.Lower.toString k) v o)
+          Object.empty $ Response.headers rep
+    }