diff --git a/.tool-versions b/.tool-versions
index 5329811..9ba56c1 100644
--- a/.tool-versions
+++ b/.tool-versions
@@ -1,2 +1,2 @@
purescript 0.15.16-4
-bun 1.1.38
+bun 1.2.4
diff --git a/README.md b/README.md
index 9fa53f8..eff472c 100644
--- a/README.md
+++ b/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`).
`RequestParts`
+
- - `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`
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.
`ToResponse`
+
- **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`
-
+
diff --git a/bun.lockb b/bun.lockb
index 357bea9..221ba54 100755
Binary files a/bun.lockb and b/bun.lockb differ
diff --git a/package.json b/package.json
index 905d818..fbaaaef 100644
--- a/package.json
+++ b/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"
},
diff --git a/spago.lock b/spago.lock
index d934490..33060db 100644
--- a/spago.lock
+++ b/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",
diff --git a/spago.yaml b/spago.yaml
index 79774b7..8600363 100644
--- a/spago.yaml
+++ b/spago.yaml
@@ -1,6 +1,7 @@
package:
name: axon
dependencies:
+ - aff-promise
- b64
- parsing
- aff: '>=8.0.0 <9.0.0'
diff --git a/src/Axon.Request.Method.purs b/src/Axon.Request.Method.purs
index 93506dd..73b2650 100644
--- a/src/Axon.Request.Method.purs
+++ b/src/Axon.Request.Method.purs
@@ -47,4 +47,4 @@ fromString =
go "CONNECT" = Just CONNECT
go _ = Nothing
in
- go
+ go <<< String.toUpper
diff --git a/src/Axon.Runtime.Bun.js b/src/Axon.Runtime.Bun.js
new file mode 100644
index 0000000..95487e4
--- /dev/null
+++ b/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}} 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} */
+export const stop = s => () => s.stop()
+
+/** @type {(_: {left: (a: A) => Either, right: (b: B) => Either}) => (req: Request) => (s: Bun.Server) => () => Either} */
+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)
+ }
diff --git a/src/Axon.Runtime.Bun.purs b/src/Axon.Runtime.Bun.purs
new file mode 100644
index 0000000..ac3d9bb
--- /dev/null
+++ b/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
+ }
diff --git a/src/Axon.Runtime.purs b/src/Axon.Runtime.purs
new file mode 100644
index 0000000..4c1909b
--- /dev/null
+++ b/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)
diff --git a/src/Axon.Web.Headers.purs b/src/Axon.Web.Headers.purs
index ceff049..d4d9cc8 100644
--- a/src/Axon.Web.Headers.purs
+++ b/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
diff --git a/src/Axon.Web.Request.purs b/src/Axon.Web.Request.purs
index 6af906d..66424f9 100644
--- a/src/Axon.Web.Request.purs
+++ b/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'
diff --git a/src/Axon.Web.Response.js b/src/Axon.Web.Response.js
new file mode 100644
index 0000000..dbb4f95
--- /dev/null
+++ b/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}) => () => Response} */
+export const make =
+ ({ body, status, headers }) =>
+ () =>
+ new Response(body, { status, headers })
+
+/** @type {Body} */
+export const bodyEmpty = null
diff --git a/src/Axon.Web.Response.purs b/src/Axon.Web.Response.purs
index b486cb4..4cf0128 100644
--- a/src/Axon.Web.Response.purs
+++ b/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
+ }