This commit is contained in:
Orion Kindel 2024-12-01 17:11:10 -06:00
parent e2018dbbef
commit 3c4f732f2c
Signed by untrusted user who does not match committer: orion
GPG Key ID: 6D4165AE4C928719
24 changed files with 820 additions and 121 deletions

8
.prettierrc.cjs Normal file
View File

@ -0,0 +1,8 @@
module.exports = {
tabWidth: 2,
trailingComma: 'all',
singleQuote: true,
semi: false,
arrowParens: 'avoid',
plugins: [],
}

121
.spec-results Normal file
View File

@ -0,0 +1,121 @@
[
[
"Axon Request Parts Body extracts a JSON body",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Body extracts a string body from a buffer",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Body extracts a string body from a cached string",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Body extracts a string body from a readable stream",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path ... but does if ends in IgnoreRest",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path does not partially match a route ...",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path extracts an int",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path extracts an int and a string",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path matches a route matching literal",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts Path matches a route matching multiple literals",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts extracts a string body",
{
"timestamp": "1733092879598.0",
"success": true
}
],
[
"Axon Request Parts extracts a string body from a buffer",
{
"timestamp": "1733093315868.0",
"success": true
}
],
[
"Axon Request Parts extracts a string body from a cached string",
{
"timestamp": "1733093315868.0",
"success": true
}
],
[
"Axon Request Parts extracts a string body from a readable stream",
{
"timestamp": "1733093315868.0",
"success": true
}
],
[
"Axon Request Parts extracts method, path, JSON body",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Axon Request Parts extracts the whole request",
{
"timestamp": "1733094319834.0",
"success": true
}
],
[
"Parts extracts the whole request",
{
"timestamp": "1733092816548.0",
"success": true
}
]
]

1
README.md Normal file
View File

@ -0,0 +1 @@
# axon

View File

@ -12,8 +12,5 @@
"noEmit": true,
"strict": true
},
"include": [
"./scripts/*.js",
"src/**/*.js"
]
"include": ["./scripts/*.js", "src/**/*.js"]
}

20
scripts/common.js Normal file
View File

@ -0,0 +1,20 @@
import Fs from 'fs/promises'
import Path from 'path'
export const rootDir = Path.resolve(__dirname, '..')
export const packageDirs = async () => ['./src']
export const packageSources = async () => {
const packages = await packageDirs()
const sources = []
for (const p of packages) {
const files = await Fs.readdir(p, { recursive: true, withFileTypes: true })
sources.push(
...files.flatMap(e =>
e.isFile() ? [Path.resolve(rootDir, e.path, e.name)] : [],
),
)
}
return sources
}

38
scripts/fmt.js Normal file
View File

@ -0,0 +1,38 @@
import { $ } from 'bun'
import { packageSources } from './common.js'
const check = process.argv.includes('--check')
const sources = await packageSources()
const purs = sources.filter(f => f.endsWith('.purs'))
const js = sources
.filter(f => f.endsWith('.js'))
.concat(['./scripts/**/*.js', '.prettierrc.cjs'])
const json = ['package.json', 'jsconfig.json']
const yml = sources.filter(f => f.endsWith('.yaml')).concat(['spago.yaml'])
/** @type {(parser: string, ps: string[]) => import("bun").ShellPromise} */
const prettier = (parser, ps) =>
$`bun x prettier ${check ? '--check' : '--write'} '--parser' ${parser} ${ps}`
const procs = [
() => prettier('babel', js),
() => prettier('json', json),
() => prettier('yaml', yml),
() =>
prettier(
'markdown',
sources.filter(f => f.endsWith('.md')).concat(['README.md']),
),
() => $`bun x purs-tidy ${check ? 'check' : 'format-in-place'} ${purs}`,
]
.map(go => async () => {
const p = await go().nothrow().quiet()
if (p.exitCode === 0) return
process.stdout.write(p.stdout)
process.stderr.write(p.stderr)
process.exit(1)
})
.reduce((acc, go) => acc.then(() => go()), Promise.resolve())
await procs

View File

@ -1,7 +1,7 @@
{
"workspace": {
"packages": {
"tower": {
"axon": {
"path": "./",
"core": {
"dependencies": [
@ -101,8 +101,84 @@
]
},
"test": {
"dependencies": [],
"build_plan": []
"dependencies": [
"spec",
"spec-node"
],
"build_plan": [
"aff",
"ansi",
"argonaut-codecs",
"argonaut-core",
"arraybuffer-types",
"arrays",
"avar",
"bifunctors",
"catenable-lists",
"console",
"const",
"contravariant",
"control",
"datetime",
"distributive",
"effect",
"either",
"enums",
"exceptions",
"exists",
"exitcodes",
"foldable-traversable",
"foreign",
"foreign-object",
"fork",
"free",
"functions",
"functors",
"gen",
"identity",
"integers",
"invariant",
"js-date",
"lazy",
"lists",
"maybe",
"mmorph",
"newtype",
"node-buffer",
"node-event-emitter",
"node-fs",
"node-path",
"node-process",
"node-streams",
"nonempty",
"now",
"nullable",
"numbers",
"open-memoize",
"optparse",
"ordered-collections",
"orders",
"parallel",
"partial",
"pipes",
"posix-types",
"prelude",
"profunctor",
"record",
"refs",
"safe-coerce",
"spec",
"spec-node",
"st",
"strings",
"tailrec",
"transformers",
"tuples",
"type-equality",
"typelevel-prelude",
"unfoldable",
"unsafe-coerce"
]
}
}
},
@ -658,6 +734,16 @@
"foreign"
]
},
"ansi": {
"type": "registry",
"version": "7.0.0",
"integrity": "sha256-ZMB6HD+q9CXvn9fRCmJ8dvuDrOVHcjombL3oNOerVnE=",
"dependencies": [
"foldable-traversable",
"lists",
"strings"
]
},
"argonaut-codecs": {
"type": "registry",
"version": "9.1.0",
@ -721,6 +807,19 @@
"unsafe-coerce"
]
},
"avar": {
"type": "registry",
"version": "5.0.0",
"integrity": "sha256-e7hf0x4hEpcygXP0LtvfvAQ49Bbj2aWtZT3gqM///0A=",
"dependencies": [
"aff",
"effect",
"either",
"exceptions",
"functions",
"maybe"
]
},
"b64": {
"type": "registry",
"version": "0.0.8",
@ -749,6 +848,20 @@
"tuples"
]
},
"catenable-lists": {
"type": "registry",
"version": "7.0.0",
"integrity": "sha256-76vYENhwF4BWTBsjeLuErCH2jqVT4M3R1HX+4RwSftA=",
"dependencies": [
"control",
"foldable-traversable",
"lists",
"maybe",
"prelude",
"tuples",
"unfoldable"
]
},
"console": {
"type": "registry",
"version": "6.1.0",
@ -892,6 +1005,14 @@
"unsafe-coerce"
]
},
"exitcodes": {
"type": "registry",
"version": "4.0.0",
"integrity": "sha256-4wxViTbyOoyKJ/WaRGI6+hZmgMKI5Miv16lSwefiLSM=",
"dependencies": [
"enums"
]
},
"ezfetch": {
"type": "registry",
"version": "1.1.0",
@ -994,6 +1115,35 @@
"unfoldable"
]
},
"fork": {
"type": "registry",
"version": "6.0.0",
"integrity": "sha256-X7u0SuCvFbLbzuNEKLBNuWjmcroqMqit4xEzpQwAP7E=",
"dependencies": [
"aff"
]
},
"free": {
"type": "registry",
"version": "7.1.0",
"integrity": "sha256-JAumgEsGSzJCNLD8AaFvuX7CpqS5yruCngi6yI7+V5k=",
"dependencies": [
"catenable-lists",
"control",
"distributive",
"either",
"exists",
"foldable-traversable",
"invariant",
"lazy",
"maybe",
"prelude",
"tailrec",
"transformers",
"tuples",
"unsafe-coerce"
]
},
"functions": {
"type": "registry",
"version": "6.0.0",
@ -1145,6 +1295,16 @@
"prelude"
]
},
"mmorph": {
"type": "registry",
"version": "7.0.0",
"integrity": "sha256-urZlZNNqGeQFe5D/ClHlR8QgGBNHTMFPtJ5S5IpflTQ=",
"dependencies": [
"free",
"functors",
"transformers"
]
},
"newtype": {
"type": "registry",
"version": "5.0.0",
@ -1232,6 +1392,22 @@
"effect"
]
},
"node-process": {
"type": "registry",
"version": "11.2.0",
"integrity": "sha256-+2MQDYChjGbVbapCyJtuWYwD41jk+BntF/kcOTKBMVs=",
"dependencies": [
"effect",
"foreign",
"foreign-object",
"maybe",
"node-event-emitter",
"node-streams",
"posix-types",
"prelude",
"unsafe-coerce"
]
},
"node-streams": {
"type": "registry",
"version": "9.0.0",
@ -1288,6 +1464,22 @@
"maybe"
]
},
"open-memoize": {
"type": "registry",
"version": "6.2.0",
"integrity": "sha256-p1m7wF3aHQ80yUvqMs20OTMl496WS6YpKlmI2Nkg9j0=",
"dependencies": [
"either",
"integers",
"lazy",
"lists",
"maybe",
"partial",
"prelude",
"strings",
"tuples"
]
},
"options": {
"type": "registry",
"version": "7.0.0",
@ -1300,6 +1492,43 @@
"tuples"
]
},
"optparse": {
"type": "registry",
"version": "5.0.1",
"integrity": "sha256-cEzEkNW4q0gZlXl4z0zn+H2vs6l2UAp7NPHCsois73k=",
"dependencies": [
"aff",
"arrays",
"bifunctors",
"console",
"control",
"effect",
"either",
"enums",
"exists",
"exitcodes",
"foldable-traversable",
"free",
"gen",
"integers",
"lazy",
"lists",
"maybe",
"newtype",
"node-buffer",
"node-process",
"node-streams",
"nonempty",
"numbers",
"open-memoize",
"partial",
"prelude",
"strings",
"tailrec",
"transformers",
"tuples"
]
},
"ordered-collections": {
"type": "registry",
"version": "3.2.0",
@ -1351,6 +1580,29 @@
"integrity": "sha256-fwXerld6Xw1VkReh8yeQsdtLVrjfGiVuC5bA1Wyo/J4=",
"dependencies": []
},
"pipes": {
"type": "registry",
"version": "8.0.0",
"integrity": "sha256-kvfqGM4cPA/wCcBHbp5psouFw5dZGvku2462x7ZBwSY=",
"dependencies": [
"aff",
"lists",
"mmorph",
"prelude",
"tailrec",
"transformers",
"tuples"
]
},
"posix-types": {
"type": "registry",
"version": "6.0.0",
"integrity": "sha256-ZfFz8RR1lee/o/Prccyeut3Q+9tYd08mlR72sIh6GzA=",
"dependencies": [
"maybe",
"prelude"
]
},
"prelude": {
"type": "registry",
"version": "6.0.1",
@ -1415,6 +1667,72 @@
"variant"
]
},
"spec": {
"type": "registry",
"version": "8.1.1",
"integrity": "sha256-EM7UfQIaSgiw13LJ4ZASkfYmmRDKIlec3nYbGKFqGhk=",
"dependencies": [
"aff",
"ansi",
"arrays",
"avar",
"bifunctors",
"control",
"datetime",
"effect",
"either",
"exceptions",
"foldable-traversable",
"fork",
"identity",
"integers",
"lists",
"maybe",
"newtype",
"now",
"ordered-collections",
"parallel",
"pipes",
"prelude",
"refs",
"strings",
"tailrec",
"transformers",
"tuples"
]
},
"spec-node": {
"type": "registry",
"version": "0.0.3",
"integrity": "sha256-Bjzg6l4uOfMN/FV0SKuT1Mm8eMP9sloLGVcY/0MeMnI=",
"dependencies": [
"aff",
"argonaut-codecs",
"argonaut-core",
"arrays",
"control",
"datetime",
"effect",
"either",
"foldable-traversable",
"identity",
"integers",
"maybe",
"newtype",
"node-buffer",
"node-fs",
"node-process",
"now",
"numbers",
"optparse",
"ordered-collections",
"partial",
"prelude",
"spec",
"strings",
"tuples"
]
},
"st": {
"type": "registry",
"version": "6.2.0",

View File

@ -19,7 +19,9 @@ package:
- web-streams
test:
main: Test.Main
dependencies: []
dependencies:
- spec
- spec-node
workspace:
packageSet:
registry: 61.2.0

View File

@ -8,9 +8,11 @@ import Data.Show.Generic (genericShow)
import Data.String as String
data Method = GET | POST | PUT | PATCH | DELETE | OPTIONS | TRACE | CONNECT
derive instance Generic Method _
derive instance Eq Method
instance Show Method where show = genericShow
instance Show Method where
show = genericShow
methodToString :: Method -> String
methodToString GET = "GET"

View File

@ -7,6 +7,7 @@ import Data.Newtype (class Newtype)
import Node.Stream as Stream
newtype Json a = Json a
derive instance Generic (Json a) _
derive instance Newtype (Json a) _
derive newtype instance (Eq a) => Eq (Json a)
@ -14,5 +15,6 @@ derive newtype instance (Ord a) => Ord (Json a)
derive newtype instance (Show a) => Show (Json a)
newtype Stream = Stream (Stream.Readable ())
derive instance Generic Stream _
derive instance Newtype Stream _

View File

@ -2,6 +2,18 @@ module Axon.Request.Parts.Class (class RequestParts, extractRequestParts, module
import Prelude
import Axon.Request (Request)
import Axon.Request as Request
import Axon.Request.Method (Method)
import Axon.Request.Method as Method
import Axon.Request.Parts.Body (Json(..), Stream(..))
import Axon.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body
import Axon.Request.Parts.Method (Connect, Delete, Get, Options, Patch, Post, Put, Trace)
import Axon.Request.Parts.Method (Get(..), Post(..), Put(..), Patch(..), Delete(..), Trace(..), Options(..), Connect(..)) as Parts.Method
import Axon.Request.Parts.Path (Path(..)) as Path.Parts
import Axon.Request.Parts.Path (class DiscardTupledUnits, class PathParts, Path(..), discardTupledUnits, extractPathParts)
import Axon.Response (Response)
import Axon.Response as Response
import Control.Alternative (guard)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
@ -17,18 +29,6 @@ import Data.URL as URL
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Node.Buffer (Buffer)
import Axon.Request (Request)
import Axon.Request as Request
import Axon.Request.Method (Method)
import Axon.Request.Method as Method
import Axon.Request.Parts.Body (Json(..), Stream(..))
import Axon.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body
import Axon.Request.Parts.Method (Connect, Delete, Get, Options, Patch, Post, Put, Trace)
import Axon.Request.Parts.Method (Get(..), Post(..), Put(..), Patch(..), Delete(..), Trace(..), Options(..), Connect(..)) as Parts.Method
import Axon.Request.Parts.Path (Path(..)) as Path.Parts
import Axon.Request.Parts.Path (class PathParts, Path(..), extractPathParts)
import Axon.Response (Response)
import Axon.Response as Response
extractMethod :: forall @t a. RequestParts a => Newtype t a => Method -> Request -> Aff (Either Response (Maybe t))
extractMethod method r =
@ -54,13 +54,19 @@ instance RequestParts Request where
instance RequestParts String where
extractRequestParts r =
Request.bodyString r
<#> lmap (const $ Response.fromStatus 500)
# ExceptT
# lift
# runMaybeT
# runExceptT
<#> lmap (const $ Response.fromStatus 500)
# ExceptT
# lift
# runMaybeT
# runExceptT
instance PathParts a b => RequestParts (Path a b) where
instance RequestParts (Either Request.BodyStringError String) where
extractRequestParts r =
Request.bodyString r
<#> Just
<#> Right
instance (PathParts a b, DiscardTupledUnits b c) => RequestParts (Path a c) where
extractRequestParts r =
let
segments = Request.url r # URL.path # case _ of
@ -75,6 +81,7 @@ instance PathParts a b => RequestParts (Path a b) where
# Right
# MaybeT
>>= ensureConsumed
<#> discardTupledUnits
<#> Path
# runMaybeT
# pure

View File

@ -6,6 +6,7 @@ import Data.Generic.Rep (class Generic)
import Data.Newtype (class Newtype)
newtype Get a = Get a
derive instance Generic (Get a) _
derive instance Newtype (Get a) _
derive newtype instance (Eq a) => Eq (Get a)
@ -13,6 +14,7 @@ derive newtype instance (Ord a) => Ord (Get a)
derive newtype instance (Show a) => Show (Get a)
newtype Post a = Post a
derive instance Generic (Post a) _
derive instance Newtype (Post a) _
derive newtype instance (Eq a) => Eq (Post a)
@ -20,6 +22,7 @@ derive newtype instance (Ord a) => Ord (Post a)
derive newtype instance (Show a) => Show (Post a)
newtype Put a = Put a
derive instance Generic (Put a) _
derive instance Newtype (Put a) _
derive newtype instance (Eq a) => Eq (Put a)
@ -27,6 +30,7 @@ derive newtype instance (Ord a) => Ord (Put a)
derive newtype instance (Show a) => Show (Put a)
newtype Patch a = Patch a
derive instance Generic (Patch a) _
derive instance Newtype (Patch a) _
derive newtype instance (Eq a) => Eq (Patch a)
@ -34,6 +38,7 @@ derive newtype instance (Ord a) => Ord (Patch a)
derive newtype instance (Show a) => Show (Patch a)
newtype Delete a = Delete a
derive instance Generic (Delete a) _
derive instance Newtype (Delete a) _
derive newtype instance (Eq a) => Eq (Delete a)
@ -41,6 +46,7 @@ derive newtype instance (Ord a) => Ord (Delete a)
derive newtype instance (Show a) => Show (Delete a)
newtype Options a = Options a
derive instance Generic (Options a) _
derive instance Newtype (Options a) _
derive newtype instance (Eq a) => Eq (Options a)
@ -48,6 +54,7 @@ derive newtype instance (Ord a) => Ord (Options a)
derive newtype instance (Show a) => Show (Options a)
newtype Trace a = Trace a
derive instance Generic (Trace a) _
derive instance Newtype (Trace a) _
derive newtype instance (Eq a) => Eq (Trace a)
@ -55,6 +62,7 @@ derive newtype instance (Ord a) => Ord (Trace a)
derive newtype instance (Show a) => Show (Trace a)
newtype Connect a = Connect a
derive instance Generic (Connect a) _
derive instance Newtype (Connect a) _
derive newtype instance (Eq a) => Eq (Connect a)

View File

@ -4,26 +4,46 @@ import Prelude
import Control.Alternative (guard)
import Data.Array as Array
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Show.Generic (genericShow)
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Tuple.Nested (type (/\), (/\))
import Data.URL (URL)
import Type.Prelude (Proxy(..))
newtype Path :: Type -> Type -> Type
newtype Path a b = Path b
data Path :: forall k. k -> Type -> Type
data Path a b = Path b
data Sep :: Type -> Type -> Type
derive instance Generic (Path a b) _
derive instance Eq b => Eq (Path a b)
instance Show b => Show (Path a b) where
show = genericShow
data Sep :: forall ka kb. ka -> kb -> Type
data Sep a b
data IgnoreRest :: Type
data IgnoreRest
infixl 9 type Sep as /
infixr 9 type Sep as /
infixl 9 type IgnoreRest as ...
class PathParts :: forall a. a -> Type -> Constraint
class DiscardTupledUnits :: Type -> Type -> Constraint
class DiscardTupledUnits a b | a -> b where
discardTupledUnits :: a -> b
instance (DiscardTupledUnits a b) => DiscardTupledUnits (Unit /\ a) b where
discardTupledUnits (_ /\ a) = discardTupledUnits a
else instance (DiscardTupledUnits a b) => DiscardTupledUnits (a /\ Unit) b where
discardTupledUnits (a /\ _) = discardTupledUnits a
else instance (DiscardTupledUnits aa ab, DiscardTupledUnits ba bb) => DiscardTupledUnits (aa /\ ba) (ab /\ bb) where
discardTupledUnits (a /\ b) = discardTupledUnits a /\ discardTupledUnits b
else instance DiscardTupledUnits a a where
discardTupledUnits = identity
class PathParts :: forall k. k -> Type -> Constraint
class PathParts a b | a -> b where
extractPathParts :: URL -> Array String -> Maybe (Array String /\ b)
@ -32,7 +52,7 @@ instance (PathParts aa ab, PathParts ba bb) => PathParts (aa / ba) (ab /\ bb) wh
segments' /\ ab <- extractPathParts @aa u segments
segments'' /\ bb <- extractPathParts @ba u segments'
pure $ segments'' /\ ab /\ bb
else instance PathParts (...) Unit where
else instance PathParts IgnoreRest Unit where
extractPathParts _ _ = Just $ [] /\ unit
else instance PathParts String String where
extractPathParts _ segments = do

View File

@ -1,7 +1,8 @@
module Axon.Request (Request, BodyReadableError(..), BodyStringError(..), BodyJSONError(..), BodyBufferError(..), bodyReadable, bodyString, bodyJSON, bodyBuffer, headers, method, address, url, contentType, accept, contentLength, lookupHeader) where
module Axon.Request (Request, Body(..), BodyReadableError(..), BodyStringError(..), BodyJSONError(..), BodyBufferError(..), bodyReadable, bodyString, bodyJSON, bodyBuffer, headers, method, address, url, contentType, accept, contentLength, lookupHeader, make) where
import Prelude
import Axon.Request.Method (Method)
import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.Class (lift)
@ -9,14 +10,15 @@ import Data.Argonaut.Core (Json)
import Data.Argonaut.Core (stringify) as JSON
import Data.Argonaut.Parser (jsonParser) as JSON
import Data.Bifunctor (lmap)
import Data.Either (Either, note)
import Data.Either (Either)
import Data.FoldableWithIndex (foldlWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Int as Int
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)
import Data.Show.Generic (genericShow)
import Data.String.Lower (StringLower)
import Data.String.Lower as String.Lower
@ -35,7 +37,6 @@ import Node.Encoding (Encoding(..))
import Node.Net.Types (IPv4, IPv6, SocketAddress)
import Node.Stream as Stream
import Node.Stream.Aff as Stream.Aff
import Axon.Request.Method (Method)
data BodyReadableError
= BodyReadableErrorHasBeenConsumed
@ -55,6 +56,7 @@ instance Eq BodyBufferError where
eq (BodyBufferErrorReadable a) (BodyBufferErrorReadable b) = a == b
eq (BodyBufferErrorReading a) (BodyBufferErrorReading b) = Error.message a == Error.message b
eq _ _ = false
instance Show BodyBufferError where
show = genericShow
@ -93,6 +95,18 @@ data Request =
, bodyRef :: Effect.Ref Body
}
make
:: { headers :: Map String String
, address :: Either (SocketAddress IPv4) (SocketAddress IPv6)
, url :: URL
, method :: Method
, body :: Body
}
-> Effect Request
make a = do
bodyRef <- Ref.new a.body
pure $ Request { bodyRef: bodyRef, headers: foldlWithIndex (\k m v -> Map.insert (String.Lower.fromString k) v m) Map.empty a.headers, address: a.address, url: a.url, method: a.method }
headers :: Request -> Map StringLower String
headers (Request a) = a.headers
@ -118,7 +132,7 @@ url :: Request -> URL
url (Request a) = a.url
bodyReadable :: Request -> Effect (Either BodyReadableError (Stream.Readable ()))
bodyReadable (Request {bodyRef}) = runExceptT do
bodyReadable (Request { bodyRef }) = runExceptT do
body <- liftEffect $ Ref.read bodyRef
case body of
BodyEmpty -> throwError BodyReadableErrorEmpty
@ -130,38 +144,38 @@ bodyReadable (Request {bodyRef}) = runExceptT do
BodyCachedJSON json -> json # JSON.stringify # flip Buffer.fromString UTF8 >>= Stream.readableFromBuffer # lift
bodyBuffer :: Request -> Aff (Either BodyBufferError Buffer)
bodyBuffer r@(Request {bodyRef}) =
bodyBuffer r@(Request { bodyRef }) =
let
stream =
bodyReadable r
# liftEffect
<#> lmap BodyBufferErrorReadable
# ExceptT
bodyReadable r
# liftEffect
<#> lmap BodyBufferErrorReadable
# ExceptT
readAll s =
Stream.Aff.readAll s
# liftAff
# try
<#> lmap BodyBufferErrorReading
# ExceptT
>>= (liftEffect <<< Buffer.concat)
# liftAff
# try
<#> lmap BodyBufferErrorReading
# ExceptT
>>= (liftEffect <<< Buffer.concat)
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCached buf -> pure buf
BodyCachedString str -> Buffer.fromString str UTF8 # liftEffect
BodyCachedJSON json -> Buffer.fromString (JSON.stringify json) UTF8 # liftEffect
_ -> do
buf <- stream >>= readAll
Ref.write (BodyCached buf) bodyRef $> buf # liftEffect
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCached buf -> pure buf
BodyCachedString str -> Buffer.fromString str UTF8 # liftEffect
BodyCachedJSON json -> Buffer.fromString (JSON.stringify json) UTF8 # liftEffect
_ -> do
buf <- stream >>= readAll
Ref.write (BodyCached buf) bodyRef $> buf # liftEffect
bodyString :: Request -> Aff (Either BodyStringError String)
bodyString r@(Request {bodyRef}) =
bodyString r@(Request { bodyRef }) =
let
buf =
bodyBuffer r
<#> lmap BodyStringErrorBuffer
# ExceptT
bodyBuffer r
<#> lmap BodyStringErrorBuffer
# ExceptT
bufString b =
Buffer.toString UTF8 b
# liftEffect
@ -169,32 +183,32 @@ bodyString r@(Request {bodyRef}) =
<#> lmap (const BodyStringErrorNotUTF8)
# ExceptT
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedString str -> pure str
BodyCachedJSON json -> JSON.stringify json # pure
_ -> do
str <- buf >>= bufString
Ref.write (BodyCachedString str) bodyRef $> str # liftEffect
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedString str -> pure str
BodyCachedJSON json -> JSON.stringify json # pure
_ -> do
str <- buf >>= bufString
Ref.write (BodyCachedString str) bodyRef $> str # liftEffect
bodyJSON :: Request -> Aff (Either BodyJSONError Json)
bodyJSON r@(Request {bodyRef}) =
bodyJSON r@(Request { bodyRef }) =
let
str =
bodyString r
<#> lmap BodyJSONErrorString
# ExceptT
bodyString r
<#> lmap BodyJSONErrorString
# ExceptT
parse s =
JSON.jsonParser s
# lmap BodyJSONErrorParsing
# pure
# ExceptT
# lmap BodyJSONErrorParsing
# pure
# ExceptT
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedJSON j -> pure j
_ -> do
j <- str >>= parse
Ref.write (BodyCachedJSON j) bodyRef $> j # liftEffect
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedJSON j -> pure j
_ -> do
j <- str >>= parse
Ref.write (BodyCachedJSON j) bodyRef $> j # liftEffect

View File

@ -16,6 +16,13 @@ data Body
| BodyFormData HTTP.RawFormData
| BodyReadable (Stream.Readable ())
instance Show Body where
show BodyEmpty = "BodyEmpty"
show (BodyString s) = "BodyString " <> show s
show (BodyBuffer _) = "BodyBuffer _"
show (BodyFormData _) = "BodyFormData _"
show (BodyReadable _) = "BodyReadable _"
formBody :: HTTP.Form -> Effect Body
formBody f = HTTP.Form.toRawFormData f <#> BodyFormData

View File

@ -1,19 +1,25 @@
module Axon.Response (Response, response, body, status, headers, withHeader, withBody, withStatus, fromStatus, ok, module Body) where
module Axon.Response (Response(..), response, body, status, headers, withHeader, withBody, withStatus, fromStatus, ok, module Body) where
import Prelude
import Data.FoldableWithIndex (foldlWithIndex)
import Data.Map (Map)
import Data.Map as Map
import Data.String.Lower (StringLower)
import Data.String.Lower as String.Lower
import Axon.Response.Body (Body(..))
import Axon.Response.Body (Body(..), formBody) as Body
import Data.FoldableWithIndex (foldlWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Map (Map)
import Data.Map as Map
import Data.Show.Generic (genericShow)
import Data.String.Lower (StringLower)
import Data.String.Lower as String.Lower
data Response = Response {body :: Body, headers :: Map StringLower String, status :: Int}
data Response = Response { body :: Body, headers :: Map StringLower String, status :: Int }
derive instance Generic Response _
instance Show Response where
show = genericShow
response :: Int -> Body -> Map String String -> Response
response s b h = Response {status: s, body: b, headers: h # foldlWithIndex (\k m v -> Map.insert (String.Lower.fromString k) v m) Map.empty}
response s b h = Response { status: s, body: b, headers: h # foldlWithIndex (\k m v -> Map.insert (String.Lower.fromString k) v m) Map.empty }
status :: Response -> Int
status (Response a) = a.status
@ -25,16 +31,16 @@ headers :: Response -> Map StringLower 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}
withHeader k v (Response a) = Response $ a { headers = Map.insert (String.Lower.fromString k) v a.headers }
withStatus :: Int -> Response -> Response
withStatus s (Response a) = Response $ a {status = s}
withStatus s (Response a) = Response $ a { status = s }
withBody :: Body -> Response -> Response
withBody b (Response a) = Response $ a {body = b}
withBody b (Response a) = Response $ a { body = b }
fromStatus :: Int -> Response
fromStatus s = Response {body: BodyEmpty, headers: Map.empty, status: s}
fromStatus s = Response { body: BodyEmpty, headers: Map.empty, status: s }
ok :: Response
ok = fromStatus 200

View File

@ -2,4 +2,8 @@
/// <reference lib="dom.iterable" />
/** @type {(_: {tuple: <A, B>(a: A) => (b: B) => unknown}) => (h: Headers) => () => Array<unknown>} */
export const headerEntries = ({tuple}) => hs => () => Array.from(hs.entries()).map(([a, b]) => tuple(a)(b))
export const headerEntries =
({ tuple }) =>
hs =>
() =>
Array.from(hs.entries()).map(([a, b]) => tuple(a)(b))

View File

@ -4,4 +4,4 @@ import Data.Tuple.Nested (type (/\))
import Effect (Effect)
foreign import data WebHeaders :: Type
foreign import headerEntries :: {tuple :: forall a b. a -> b -> a /\ b} -> WebHeaders -> Effect (Array (String /\ String))
foreign import headerEntries :: { tuple :: forall a b. a -> b -> a /\ b } -> WebHeaders -> Effect (Array (String /\ String))

View File

@ -20,15 +20,15 @@ export const headers = r => () => r.headers
/** @type {(r: ReadableStream<Uint8Array>) => () => Stream.Readable} */
export const readableFromWeb = r => () => {
const reader = r.getReader();
const reader = r.getReader()
return new Stream.Readable({
read: function() {
(async () => {
read: function () {
;(async () => {
/** @type {ReadableStreamReadResult<Uint8Array> | undefined} */
let res = undefined;
let res = undefined
try {
res = await reader.read()
} catch(e) {
} catch (e) {
if (typeof e === 'undefined' || e instanceof Error) {
this.destroy(e)
return
@ -37,8 +37,8 @@ export const readableFromWeb = r => () => {
}
}
if (res.value) this.push(res.value);
if (res.done) this.push(null);
if (res.value) this.push(res.value)
if (res.done) this.push(null)
})()
},
})

View File

@ -1,10 +1,10 @@
module Axon.Web.Request where
import Data.ArrayBuffer.Types (Uint8Array)
import Axon.Web.Headers (WebHeaders)
import Data.Nullable (Nullable)
import Effect (Effect)
import Node.Stream as Stream
import Axon.Request.Web (WebHeaders)
import Web.Streams.ReadableStream (ReadableStream)
foreign import data WebRequest :: Type

View File

@ -1,10 +0,0 @@
module Main where
import Prelude
import Effect (Effect)
import Effect.Console (log)
main :: Effect Unit
main = do
log "🍝"

View File

@ -0,0 +1,123 @@
module Test.Axon.Request.Parts where
import Prelude
import Axon.Request (Request)
import Axon.Request as Request
import Axon.Request.Method (Method(..))
import Axon.Request.Parts.Class (Json(..), Patch(..), Path(..), Post(..), extractRequestParts)
import Axon.Request.Parts.Path (type (...), type (/), IgnoreRest)
import Control.Monad.Error.Class (liftEither, liftMaybe)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Tuple.Nested (type (/\), (/\))
import Data.URL as URL
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Unsafe (unsafePerformEffect)
import Node.Buffer as Buffer
import Node.Encoding (Encoding(..))
import Node.Net.SocketAddress as SocketAddress
import Node.Stream as Stream
import Partial.Unsafe (unsafePartial)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
spec :: Spec Unit
spec = describe "Parts" do
it "extracts the whole request" do
req <- liftEffect $ Request.make {body: Request.BodyEmpty, url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
void $ extractRequestParts @Request req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
it "extracts method, path, JSON body" do
stream <- Buffer.fromString """{"firstName": "henry"}""" UTF8 >>= Stream.readableFromBuffer # liftEffect
req <- liftEffect $ Request.make {body: Request.BodyReadable stream, url: URL.fromString "http://localhost:80/users/12" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: PATCH}
a <- extractRequestParts @(Patch ((Path ("users" / Int) _) /\ Json {firstName :: String})) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` Patch (Path 12 /\ Json {firstName: "henry"})
describe "Path" do
it "matches a route matching literal" do
req <- liftEffect $ Request.make {body: Request.BodyCachedString "foo", url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
a <- extractRequestParts @(Path "foo" _) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Path unit)
it "matches a route matching multiple literals" do
req <- liftEffect $ Request.make {body: Request.BodyCachedString "foo", url: URL.fromString "http://localhost:80/foo/bar/baz" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
a <- extractRequestParts @(Path ("foo" / "bar" / "baz") _) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Path unit)
it "does not partially match a route ..." do
req <- liftEffect $ Request.make
{ body: Request.BodyCachedString "foo"
, url: URL.fromString "http://localhost:80/foo/bar/baz" # unsafePartial fromJust
, headers: Map.empty
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}
, method: GET
}
a <- extractRequestParts @(Path ("foo" / "bar") _) req <#> lmap (error <<< show) >>= liftEither
a `shouldEqual` Nothing
it "... but does if ends in IgnoreRest" do
req <- liftEffect $ Request.make
{ body: Request.BodyCachedString "foo"
, url: URL.fromString "http://localhost:80/foo/bar/baz" # unsafePartial fromJust
, headers: Map.empty
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}
, method: GET
}
a <- extractRequestParts @(Path ("foo" / "bar" / IgnoreRest) _) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Path unit)
it "extracts an int" do
req <- liftEffect $ Request.make
{ body: Request.BodyCachedString "foo"
, url: URL.fromString "http://localhost:80/foo/123/bar" # unsafePartial fromJust
, headers: Map.empty
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}
, method: GET
}
a <- extractRequestParts @(Path ("foo" / Int / "bar") _) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Path 123)
it "extracts an int and a string" do
req <- liftEffect $ Request.make
{ body: Request.BodyCachedString "foo"
, url: URL.fromString "http://localhost:80/foo/123/bar/baz" # unsafePartial fromJust
, headers: Map.empty
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}
, method: GET
}
a <- extractRequestParts @(Path ("foo" / Int / "bar" / String) _) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Path $ 123 /\ "baz")
describe "Body" do
it "extracts a string body from a cached string" do
req <- liftEffect $ Request.make {body: Request.BodyCachedString "foo", url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
a <- extractRequestParts @(Either Request.BodyStringError String) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Right "foo")
it "extracts a string body from a readable stream" do
stream <- Buffer.fromString "foo" UTF8 >>= Stream.readableFromBuffer # liftEffect
req <- liftEffect $ Request.make {body: Request.BodyReadable stream, url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
a <- extractRequestParts @(Either Request.BodyStringError String) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Right "foo")
a' <- extractRequestParts @String req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a' `shouldEqual` "foo"
it "extracts a string body from a buffer" do
buf <- Buffer.fromString "foo" UTF8 # liftEffect
req <- liftEffect $ Request.make {body: Request.BodyCached buf, url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: GET}
a <- extractRequestParts @(Either Request.BodyStringError String) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` (Right "foo")
a' <- extractRequestParts @String req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a' `shouldEqual` "foo"
it "extracts a JSON body" do
stream <- Buffer.fromString """{"foo": 123, "bar": "abc"}""" UTF8 >>= Stream.readableFromBuffer # liftEffect
req <- liftEffect $ Request.make {body: Request.BodyReadable stream, url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust, headers: Map.empty, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 {address: "127.0.0.1", port: 81}, method: POST}
a <- extractRequestParts @(Post (Json {foo :: Int, bar :: String})) req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe (error "was nothing")
a `shouldEqual` Post (Json {foo: 123, bar: "abc"})

View File

@ -0,0 +1,10 @@
module Test.Axon.Request where
import Prelude
import Test.Axon.Request.Parts as Parts
import Test.Spec (Spec, describe)
spec :: Spec Unit
spec = describe "Request" do
Parts.spec

View File

@ -3,10 +3,11 @@ module Test.Main where
import Prelude
import Effect (Effect)
import Effect.Class.Console (log)
import Test.Axon.Request as Test.Request
import Test.Spec (describe)
import Test.Spec.Reporter (specReporter)
import Test.Spec.Runner.Node (runSpecAndExitProcess)
main :: Effect Unit
main = do
log "🍕"
log "You should add some tests."
main = runSpecAndExitProcess [ specReporter ] $ describe "Axon" do
Test.Request.spec