second commit

.tool-versions

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

jsconfig.json

@@ -14,10 +14,6 @@
   },
   "include": [
     "./scripts/*.js",
-    "ui-serve/**/*.js",
-    "api/**/*.js",
-    "ui/**/*.js",
-    "aws/**/*.js",
-    "logging/**/*.js"
+    "src/**/*.js"
   ]
 }

rename.js

@@ -0,0 +1,14 @@
+import File from 'fs/promises'
+import Path from 'path'
+
+const contents = new Map()
+
+const files = (await File.readdir('./src', {recursive: true})).map(a => Path.resolve('./src', a)).filter(a => a.endsWith('.purs') || a.endsWith('.js'))
+for (const f of files) {
+  const fc = await File.readFile(f, 'utf8')
+  const fc_ = fc.replaceAll(/\bTower\b/g, 'Axon')
+  await File.writeFile(f, fc_)
+  const f_ = f.replace(/\bTower\b/, 'Axon')
+  await File.rename(f, f_)
+  console.log(`${f} -> ${f_}`)
+}

spago.yaml

@@ -1,9 +1,22 @@
 package:
   name: tower
   dependencies:
+    - aff
+    - argonaut-codecs
+    - argonaut-core
     - console
     - effect
+    - ezfetch
+    - maybe
+    - node-net
+    - node-streams
+    - nullable
     - prelude
+    - strings
+    - transformers
+    - tuples
+    - url-immutable
+    - web-streams
   test:
     main: Test.Main
     dependencies: []

src/Data.String.Lower.purs

@@ -0,0 +1,21 @@
+module Data.String.Lower where
+
+import Prelude
+
+import Data.Generic.Rep (class Generic)
+import Data.String as String
+
+newtype StringLower = StringLower String
+
+derive instance Generic StringLower _
+derive newtype instance Show StringLower
+derive newtype instance Eq StringLower
+derive newtype instance Ord StringLower
+derive newtype instance Monoid StringLower
+derive newtype instance Semigroup StringLower
+
+fromString :: String -> StringLower
+fromString = StringLower <<< String.toLower
+
+toString :: StringLower -> String
+toString (StringLower a) = a

src/Tower.Request.Method.purs

@@ -0,0 +1,38 @@
+module Tower.Request.Method where
+
+import Prelude
+
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..))
+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
+
+methodToString :: Method -> String
+methodToString GET = "GET"
+methodToString POST = "POST"
+methodToString PUT = "PUT"
+methodToString PATCH = "PATCH"
+methodToString DELETE = "DELETE"
+methodToString OPTIONS = "OPTIONS"
+methodToString TRACE = "TRACE"
+methodToString CONNECT = "CONNECT"
+
+methodFromString :: String -> Maybe Method
+methodFromString =
+  let
+    go "GET" = Just GET
+    go "POST" = Just POST
+    go "PUT" = Just PUT
+    go "PATCH" = Just PATCH
+    go "DELETE" = Just DELETE
+    go "OPTIONS" = Just OPTIONS
+    go "TRACE" = Just TRACE
+    go "CONNECT" = Just CONNECT
+    go _ = Nothing
+  in
+    go <<< String.toUpper

src/Tower.Request.Parts.Body.purs

@@ -0,0 +1,18 @@
+module Tower.Request.Parts.Body where
+
+import Prelude
+
+import Data.Generic.Rep (class Generic)
+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)
+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 _

src/Tower.Request.Parts.Class.purs

@@ -0,0 +1,149 @@
+module Tower.Request.Parts.Class (class RequestParts, extractRequestParts, module Parts.Method, module Parts.Body, module Path.Parts) where
+
+import Prelude
+
+import Control.Alternative (guard)
+import Control.Monad.Except (ExceptT(..), runExceptT)
+import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
+import Control.Monad.Trans.Class (lift)
+import Data.Argonaut.Decode (class DecodeJson, decodeJson)
+import Data.Array as Array
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype, wrap)
+import Data.Tuple.Nested (type (/\), (/\))
+import Data.URL as URL
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Node.Buffer (Buffer)
+import Tower.Request (Request)
+import Tower.Request as Request
+import Tower.Request.Method (Method)
+import Tower.Request.Method as Method
+import Tower.Request.Parts.Body (Json(..), Stream(..))
+import Tower.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body
+import Tower.Request.Parts.Method (Connect, Delete, Get, Options, Patch, Post, Put, Trace)
+import Tower.Request.Parts.Method (Get(..), Post(..), Put(..), Patch(..), Delete(..), Trace(..), Options(..), Connect(..)) as Parts.Method
+import Tower.Request.Parts.Path (Path(..)) as Path.Parts
+import Tower.Request.Parts.Path (class PathParts, Path(..), extractPathParts)
+import Tower.Response (Response)
+import Tower.Response as Response
+
+extractMethod :: forall @t a. RequestParts a => Newtype t a => Method -> Request -> Aff (Either Response (Maybe t))
+extractMethod method r =
+  if Request.method r == method then
+    extractRequestParts @a r
+      # ExceptT
+      # MaybeT
+      <#> wrap
+      # runMaybeT
+      # runExceptT
+  else
+    pure $ Right Nothing
+
+class RequestParts a where
+  extractRequestParts :: Request -> Aff (Either Response (Maybe a))
+
+instance RequestParts Unit where
+  extractRequestParts _ = pure unit # runMaybeT # runExceptT
+
+instance RequestParts Request where
+  extractRequestParts r = pure r # runMaybeT # runExceptT
+
+instance RequestParts String where
+  extractRequestParts r =
+    Request.bodyString r
+    <#> lmap (const $ Response.fromStatus 500)
+    # ExceptT
+    # lift
+    # runMaybeT
+    # runExceptT
+
+instance PathParts a b => RequestParts (Path a b) where
+  extractRequestParts r =
+    let
+      segments = Request.url r # URL.path # case _ of
+        URL.PathAbsolute a -> a
+        URL.PathRelative a -> a
+        _ -> []
+      extract = extractPathParts @a @b (Request.url r)
+      ensureConsumed (leftover /\ x) = guard (Array.null leftover) $> x
+    in
+      segments
+        # extract
+        # Right
+        # MaybeT
+        >>= ensureConsumed
+        <#> Path
+        # runMaybeT
+        # pure
+
+instance (DecodeJson a) => RequestParts (Json a) where
+  extractRequestParts r =
+    let
+      jsonBody =
+        Request.bodyJSON r
+          <#> lmap (const $ Response.fromStatus 500)
+          # ExceptT
+          # lift
+      decode j =
+        decodeJson j
+          # lmap (const $ Response.fromStatus 400)
+          # pure
+          # ExceptT
+          # lift
+    in
+      jsonBody >>= decode <#> Json # runMaybeT # runExceptT
+
+instance RequestParts Buffer where
+  extractRequestParts r =
+    let
+      bufBody =
+        Request.bodyBuffer r
+          <#> lmap (const $ Response.fromStatus 500)
+          # ExceptT
+          # lift
+    in
+      bufBody # runMaybeT # runExceptT
+
+instance RequestParts Stream where
+  extractRequestParts r =
+    let
+      streamBody =
+        Request.bodyReadable r
+          <#> lmap (const $ Response.fromStatus 500)
+          # ExceptT
+          # lift
+    in
+      streamBody <#> Stream # runMaybeT # runExceptT # liftEffect
+
+instance (RequestParts a) => RequestParts (Get a) where
+  extractRequestParts = extractMethod @(Get a) Method.GET
+
+instance (RequestParts a) => RequestParts (Post a) where
+  extractRequestParts = extractMethod @(Post a) Method.POST
+
+instance (RequestParts a) => RequestParts (Put a) where
+  extractRequestParts = extractMethod @(Put a) Method.PUT
+
+instance (RequestParts a) => RequestParts (Patch a) where
+  extractRequestParts = extractMethod @(Patch a) Method.PATCH
+
+instance (RequestParts a) => RequestParts (Delete a) where
+  extractRequestParts = extractMethod @(Delete a) Method.DELETE
+
+instance (RequestParts a) => RequestParts (Options a) where
+  extractRequestParts = extractMethod @(Options a) Method.OPTIONS
+
+instance (RequestParts a) => RequestParts (Connect a) where
+  extractRequestParts = extractMethod @(Connect a) Method.CONNECT
+
+instance (RequestParts a) => RequestParts (Trace a) where
+  extractRequestParts = extractMethod @(Trace a) Method.TRACE
+
+instance (RequestParts a, RequestParts b) => RequestParts (a /\ b) where
+  extractRequestParts r = runExceptT $ runMaybeT do
+    a <- extractRequestParts @a r # ExceptT # MaybeT
+    b <- extractRequestParts @b r # ExceptT # MaybeT
+    pure $ a /\ b

src/Tower.Request.Parts.Method.purs

@@ -0,0 +1,62 @@
+module Tower.Request.Parts.Method where
+
+import Prelude
+
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+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)
+derive newtype instance (Ord a) => Ord (Connect a)
+derive newtype instance (Show a) => Show (Connect a)

src/Tower.Request.Parts.Path.purs

@@ -0,0 +1,50 @@
+module Tower.Request.Parts.Path where
+
+import Prelude
+
+import Control.Alternative (guard)
+import Data.Array as Array
+import Data.Int as Int
+import Data.Maybe (Maybe(..), fromMaybe)
+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 Sep :: Type -> Type -> Type
+data Sep a b
+
+data IgnoreRest :: Type
+data IgnoreRest
+
+infixl 9 type Sep as /
+infixl 9 type IgnoreRest as ...
+
+class PathParts :: forall a. a -> Type -> Constraint
+class PathParts a b | a -> b where
+  extractPathParts :: URL -> Array String -> Maybe (Array String /\ b)
+
+instance (PathParts aa ab, PathParts ba bb) => PathParts (aa / ba) (ab /\ bb) where
+  extractPathParts u segments = do
+    segments' /\ ab <- extractPathParts @aa u segments
+    segments'' /\ bb <- extractPathParts @ba u segments'
+    pure $ segments'' /\ ab /\ bb
+else instance PathParts (...) Unit where
+  extractPathParts _ _ = Just $ [] /\ unit
+else instance PathParts String String where
+  extractPathParts _ segments = do
+    head <- Array.head segments
+    pure $ (fromMaybe [] (Array.tail segments) /\ head)
+else instance PathParts Int Int where
+  extractPathParts _ segments = do
+    head <- Array.head segments
+    a <- Int.fromString head
+    pure $ (fromMaybe [] (Array.tail segments) /\ a)
+else instance (IsSymbol k) => PathParts k Unit where
+  extractPathParts _ segments = do
+    head <- Array.head segments
+    guard $ head == reflectSymbol (Proxy @k)
+    pure $ (fromMaybe [] (Array.tail segments) /\ unit)

src/Tower.Request.purs

@@ -0,0 +1,200 @@
+module Tower.Request (Request, BodyReadableError(..), BodyStringError(..), BodyJSONError(..), BodyBufferError(..), bodyReadable, bodyString, bodyJSON, bodyBuffer, headers, method, address, url, contentType, accept, contentLength, lookupHeader) where
+
+import Prelude
+
+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.Bifunctor (lmap)
+import Data.Either (Either, note)
+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.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.Class (liftAff)
+import Effect.Class (liftEffect)
+import Effect.Exception (Error)
+import Effect.Exception as Error
+import Effect.Ref (Ref) as Effect
+import Effect.Ref as Ref
+import Node.Buffer (Buffer)
+import Node.Buffer as Buffer
+import Node.Encoding (Encoding(..))
+import Node.Net.Types (IPv4, IPv6, SocketAddress)
+import Node.Stream as Stream
+import Node.Stream.Aff as Stream.Aff
+import Tower.Request.Method (Method)
+
+data BodyReadableError
+  = BodyReadableErrorHasBeenConsumed
+  | BodyReadableErrorEmpty
+
+derive instance Generic BodyReadableError _
+derive instance Eq BodyReadableError
+instance Show BodyReadableError where
+  show = genericShow
+
+data BodyBufferError
+  = BodyBufferErrorReadable BodyReadableError
+  | BodyBufferErrorReading Error
+
+derive instance Generic BodyBufferError _
+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
+
+data BodyStringError
+  = BodyStringErrorBuffer BodyBufferError
+  | BodyStringErrorNotUTF8
+
+derive instance Generic BodyStringError _
+derive instance Eq BodyStringError
+instance Show BodyStringError where
+  show = genericShow
+
+data BodyJSONError
+  = BodyJSONErrorString BodyStringError
+  | BodyJSONErrorParsing String
+
+derive instance Generic BodyJSONError _
+derive instance Eq BodyJSONError
+instance Show BodyJSONError where
+  show = genericShow
+
+data Body
+  = BodyEmpty
+  | BodyReadable (Stream.Readable ())
+  | BodyReadableConsumed
+  | BodyCached Buffer
+  | BodyCachedString String
+  | BodyCachedJSON Json
+
+data Request =
+  Request
+    { headers :: Map StringLower String
+    , address :: Either (SocketAddress IPv4) (SocketAddress IPv6)
+    , url :: URL
+    , method :: Method
+    , bodyRef :: Effect.Ref Body
+    }
+
+headers :: Request -> Map StringLower String
+headers (Request a) = a.headers
+
+lookupHeader :: String -> Request -> Maybe String
+lookupHeader k (Request a) = Map.lookup (String.Lower.fromString k) a.headers
+
+contentType :: Request -> Maybe MIME
+contentType = lookupHeader "content-type" >>> map MIME.fromString
+
+accept :: Request -> Maybe MIME
+accept = lookupHeader "accept" >>> map MIME.fromString
+
+contentLength :: Request -> Maybe Int
+contentLength = lookupHeader "content-length" >=> Int.fromString
+
+method :: Request -> Method
+method (Request a) = a.method
+
+address :: Request -> Either (SocketAddress IPv4) (SocketAddress IPv6)
+address (Request a) = a.address
+
+url :: Request -> URL
+url (Request a) = a.url
+
+bodyReadable :: Request -> Effect (Either BodyReadableError (Stream.Readable ()))
+bodyReadable (Request {bodyRef}) = runExceptT do
+  body <- liftEffect $ Ref.read bodyRef
+  case body of
+    BodyEmpty -> throwError BodyReadableErrorEmpty
+    BodyReadableConsumed -> throwError BodyReadableErrorHasBeenConsumed
+    BodyReadable r ->
+      Ref.write BodyReadableConsumed bodyRef $> r # lift
+    BodyCached buf -> Stream.readableFromBuffer buf # lift
+    BodyCachedString str -> Stream.readableFromString str UTF8 # lift
+    BodyCachedJSON json -> json # JSON.stringify # flip Buffer.fromString UTF8 >>= Stream.readableFromBuffer # lift
+
+bodyBuffer :: Request -> Aff (Either BodyBufferError Buffer)
+bodyBuffer r@(Request {bodyRef}) =
+  let
+    stream =
+        bodyReadable r
+          # liftEffect
+          <#> lmap BodyBufferErrorReadable
+          # ExceptT
+    readAll s =
+      Stream.Aff.readAll s
+      # 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
+  
+bodyString :: Request -> Aff (Either BodyStringError String)
+bodyString r@(Request {bodyRef}) =
+  let
+    buf =
+        bodyBuffer r
+          <#> lmap BodyStringErrorBuffer
+          # ExceptT
+    bufString b =
+      Buffer.toString UTF8 b
+        # liftEffect
+        # try
+        <#> 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
+
+bodyJSON :: Request -> Aff (Either BodyJSONError Json)
+bodyJSON r@(Request {bodyRef}) =
+  let
+    str =
+        bodyString r
+          <#> lmap BodyJSONErrorString
+          # ExceptT
+    parse s =
+      JSON.jsonParser s
+      # 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

src/Tower.Response.Body.purs

@@ -0,0 +1,35 @@
+module Tower.Response.Body where
+
+import Prelude
+
+import Data.Argonaut.Core (Json, stringify)
+import Effect (Effect)
+import Effect.Aff.HTTP.Form (Form, RawFormData) as HTTP
+import Effect.Aff.HTTP.Form as HTTP.Form
+import Node.Buffer (Buffer)
+import Node.Stream as Stream
+
+data Body
+  = BodyEmpty
+  | BodyString String
+  | BodyBuffer Buffer
+  | BodyFormData HTTP.RawFormData
+  | BodyReadable (Stream.Readable ())
+
+formBody :: HTTP.Form -> Effect Body
+formBody f = HTTP.Form.toRawFormData f <#> BodyFormData
+
+stringBody :: String -> Body
+stringBody = BodyString
+
+bufferBody :: Buffer -> Body
+bufferBody = BodyBuffer
+
+streamBody :: Stream.Readable () -> Body
+streamBody = BodyReadable
+
+emptyBody :: Body
+emptyBody = BodyEmpty
+
+jsonBody :: Json -> Body
+jsonBody = stringify >>> BodyString

src/Tower.Response.purs

@@ -0,0 +1,40 @@
+module Tower.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 Tower.Response.Body (Body(..))
+import Tower.Response.Body (Body(..), formBody) as Body
+
+data Response = Response {body :: Body, headers :: Map StringLower String, status :: Int}
+
+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}
+
+status :: Response -> Int
+status (Response a) = a.status
+
+body :: Response -> Body
+body (Response a) = a.body
+
+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}
+
+withStatus :: Int -> Response -> Response
+withStatus s (Response a) = Response $ a {status = s}
+
+withBody :: Body -> Response -> Response
+withBody b (Response a) = Response $ a {body = b}
+
+fromStatus :: Int -> Response
+fromStatus s = Response {body: BodyEmpty, headers: Map.empty, status: s}
+
+ok :: Response
+ok = fromStatus 200

src/Tower.Service.Class.purs

@@ -0,0 +1,2 @@
+module Tower.Service.Class where
+

src/Tower.Web.Headers.js

@@ -0,0 +1,5 @@
+/// <reference lib="dom" />
+/// <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))

src/Tower.Web.Headers.purs

@@ -0,0 +1,7 @@
+module Tower.Web.Headers where
+
+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))

src/Tower.Web.Request.js

@@ -0,0 +1,45 @@
+/// <reference lib="dom" />
+/// <reference lib="dom.iterable" />
+
+import Stream from 'stream'
+
+/** @type {(r: Request) => () => ReadableStream<Uint8Array> | null} */
+export const body = r => () => r.body
+
+/** @type {(r: Request) => () => boolean} */
+export const bodyUsed = r => () => r.bodyUsed
+
+/** @type {(r: Request) => () => string} */
+export const method = r => () => r.method
+
+/** @type {(r: Request) => () => string} */
+export const url = r => () => r.url
+
+/** @type {(r: Request) => () => Headers} */
+export const headers = r => () => r.headers
+
+/** @type {(r: ReadableStream<Uint8Array>) => () => Stream.Readable} */
+export const readableFromWeb = r => () => {
+  const reader = r.getReader();
+  return new Stream.Readable({
+    read: function() {
+      (async () => {
+        /** @type {ReadableStreamReadResult<Uint8Array> | undefined} */
+        let res = undefined;
+        try {
+          res = await reader.read()
+        } catch(e) {
+          if (typeof e === 'undefined' || e instanceof Error) {
+            this.destroy(e)
+            return
+          } else {
+            throw e
+          }
+        }
+
+        if (res.value) this.push(res.value);
+        if (res.done) this.push(null);
+      })()
+    },
+  })
+}

src/Tower.Web.Request.purs

@@ -0,0 +1,19 @@
+module Tower.Web.Request where
+
+import Data.ArrayBuffer.Types (Uint8Array)
+import Data.Nullable (Nullable)
+import Effect (Effect)
+import Node.Stream as Stream
+import Tower.Request.Web (WebHeaders)
+import Web.Streams.ReadableStream (ReadableStream)
+
+foreign import data WebRequest :: Type
+
+foreign import body :: WebRequest -> Effect (Nullable (ReadableStream Uint8Array))
+foreign import bodyUsed :: WebRequest -> Effect Boolean
+foreign import method :: WebRequest -> Effect String
+foreign import url :: WebRequest -> Effect String
+
+foreign import headers :: WebRequest -> Effect WebHeaders
+
+foreign import readableFromWeb :: ReadableStream Uint8Array -> Effect (Stream.Readable ())

src/Tower.Web.Response.purs

@@ -0,0 +1 @@
+module Tower.Web.Response where