diff --git a/spago.lock b/spago.lock index 33060db..d9f7215 100644 --- a/spago.lock +++ b/spago.lock @@ -86,6 +86,7 @@ { "typelevel-prelude": ">=7.0.0 <8.0.0" }, + "unlift", { "url-immutable": ">=1.0.0 <2.0.0" }, @@ -102,6 +103,7 @@ "arrays", "b64", "bifunctors", + "catenable-lists", "console", "const", "contravariant", @@ -118,6 +120,8 @@ "foldable-traversable", "foreign", "foreign-object", + "free", + "freet", "functions", "functors", "gen", @@ -129,6 +133,7 @@ "lazy", "lists", "maybe", + "monad-control", "newtype", "node-buffer", "node-event-emitter", @@ -162,6 +167,7 @@ "typelevel-prelude", "unfoldable", "unicode", + "unlift", "unsafe-coerce", "url-immutable", "variant", @@ -1177,6 +1183,23 @@ "unsafe-coerce" ] }, + "freet": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-zkL6wU4ZPq8xz1kGFxoliWqyhBksepMJTyA68VEBaJo=", + "dependencies": [ + "aff", + "bifunctors", + "effect", + "either", + "exists", + "free", + "prelude", + "tailrec", + "transformers", + "tuples" + ] + }, "functions": { "type": "registry", "version": "6.0.0", @@ -1329,6 +1352,17 @@ "transformers" ] }, + "monad-control": { + "type": "registry", + "version": "5.0.0", + "integrity": "sha256-bgfDW30wbIm70NR1Tvvh9P+VFQMDh1wK2sSJXCj/dZc=", + "dependencies": [ + "aff", + "freet", + "identity", + "lists" + ] + }, "newtype": { "type": "registry", "version": "5.0.0", @@ -1920,6 +1954,25 @@ "strings" ] }, + "unlift": { + "type": "registry", + "version": "1.0.1", + "integrity": "sha256-nbBCVV0fZz/3UHKoW11dcTwBYmQOIgK31ht2BN47RPw=", + "dependencies": [ + "aff", + "effect", + "either", + "freet", + "identity", + "lists", + "maybe", + "monad-control", + "prelude", + "st", + "transformers", + "tuples" + ] + }, "unsafe-coerce": { "type": "registry", "version": "6.0.0", diff --git a/spago.yaml b/spago.yaml index 8600363..6609421 100644 --- a/spago.yaml +++ b/spago.yaml @@ -4,6 +4,7 @@ package: - aff-promise - b64 - parsing + - unlift - aff: '>=8.0.0 <9.0.0' - argonaut-codecs: '>=9.1.0 <10.0.0' - argonaut-core: '>=7.0.0 <8.0.0' diff --git a/src/Axon.Request.purs b/src/Axon.Request.purs index 7f6b3e6..f9878ef 100644 --- a/src/Axon.Request.purs +++ b/src/Axon.Request.purs @@ -39,6 +39,7 @@ import Data.MIME as MIME import Data.Map (Map) import Data.Map as Map import Data.Maybe (Maybe) +import Data.Net.SocketAddress (SocketAddress) import Data.Show.Generic (genericShow) import Data.String.Lower (StringLower) import Data.String.Lower as String.Lower @@ -54,7 +55,6 @@ 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 @@ -110,7 +110,7 @@ data Body data Request = Request { headers :: Map StringLower String - , address :: Either (SocketAddress IPv4) (SocketAddress IPv6) + , address :: SocketAddress , url :: URL , method :: Method , bodyRef :: Effect.Ref Body @@ -118,7 +118,7 @@ data Request = make :: { headers :: Map String String - , address :: Either (SocketAddress IPv4) (SocketAddress IPv6) + , address :: SocketAddress , url :: URL , method :: Method , body :: Body @@ -155,7 +155,7 @@ contentLength = lookupHeader "content-length" >=> Int.fromString method :: Request -> Method method (Request a) = a.method -address :: Request -> Either (SocketAddress IPv4) (SocketAddress IPv6) +address :: Request -> SocketAddress address (Request a) = a.address url :: Request -> URL diff --git a/src/Axon.Runtime.Bun.js b/src/Axon.Runtime.Bun.js index 95487e4..6e7b93d 100644 --- a/src/Axon.Runtime.Bun.js +++ b/src/Axon.Runtime.Bun.js @@ -23,9 +23,7 @@ foreign import requestAddr :: /** @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 + * @typedef {(addr: string) => (port: number) => unknown} FFISocketAddress */ /** @type {(s: ServeOptions) => () => Bun.Server} */ @@ -47,13 +45,13 @@ 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} */ +/** @type {(_: {ipv4: FFISocketAddress, ipv6: FFISocketAddress}) => (req: Request) => (s: Bun.Server) => () => unknown} */ export const requestAddr = - ({ left, right }) => + ({ ipv4, ipv6 }) => req => s => () => { const ip = s.requestIP(req) if (!ip) throw new Error('Request closed') - return ip.family === 'IPv4' ? left(ip) : right(ip) + return (ip.family === 'IPv4' ? ipv4 : ipv6)(ip.address)(ip.port) } diff --git a/src/Axon.Runtime.Bun.purs b/src/Axon.Runtime.Bun.purs index ac3d9bb..d9338ac 100644 --- a/src/Axon.Runtime.Bun.purs +++ b/src/Axon.Runtime.Bun.purs @@ -1,6 +1,6 @@ module Axon.Runtime.Bun where -import Prelude +import Prelude hiding (join) import Axon.Request (Request) import Axon.Response (Response) @@ -10,18 +10,22 @@ 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.Monad.Fork.Class (fork, join, never) import Control.Promise (Promise) import Control.Promise as Promise import Data.Either (Either(..)) +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 Effect (Effect) import Effect.Aff (Aff) import Effect.Aff as Aff +import Effect.Aff.Class (liftAff) +import Effect.Aff.Unlift (class MonadUnliftAff, UnliftAff(..), askUnliftAff) import Effect.Class (liftEffect) import Effect.Exception (error) -import Node.Net.Types (IPv4, IPv6, SocketAddress) foreign import data Bun :: Type @@ -37,31 +41,49 @@ 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 } -> + { ipv4 :: String -> Int -> SocketAddress + , ipv6 :: String -> Int -> SocketAddress + } -> WebRequest -> Bun -> - Effect (Either (SocketAddress IPv4) (SocketAddress IPv6)) + Effect SocketAddress 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) + forall m. + MonadUnliftAff m => + (Request -> m Response) -> + m + ( WebRequest -> + Bun -> + Effect (Promise WebResponse) + ) +fetchImpl f = do + UnliftAff toAff <- askUnliftAff + pure \req bun -> + Promise.fromAff do + addr <- liftEffect $ requestAddr + { ipv4: SocketAddress.IPv4, ipv6: SocketAddress.IPv6 } + req + bun + req' <- liftEffect $ WebRequest.toRequest addr req + toAff $ 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 + -- `stopSignal` will never resolve, but it can be killed. + stopSignal <- liftAff $ Aff.forkAff Aff.never + + -- blocks on `stopSignal`, resolving when it's killed. + stopFiber <- fork $ liftAff $ void $ try $ Aff.joinFiber stopSignal + + fetch <- fetchImpl o.fetch let o' = { port: Null.toNullable o.port , hostname: Null.toNullable o.hostname , idleTimeout: Null.toNullable $ unwrap <$> o.idleTimeout - , fetch: fetchImpl o.fetch + , fetch } bun <- liftEffect $ serve o' @@ -70,7 +92,7 @@ instance Runtime Bun where pure { server: bun , join: stopFiber - , stop: do + , stop: liftAff do Promise.toAff $ stop bun Aff.killFiber (error "") stopSignal } diff --git a/src/Axon.Runtime.purs b/src/Axon.Runtime.purs index 4c1909b..b6a969e 100644 --- a/src/Axon.Runtime.purs +++ b/src/Axon.Runtime.purs @@ -4,24 +4,27 @@ import Prelude import Axon.Request (Request) import Axon.Response (Response) +import Control.Monad.Fork.Class (class MonadFork) import Data.Maybe (Maybe) import Data.Time.Duration (Seconds) -import Effect (Effect) import Effect.Aff (Aff, Fiber) +import Effect.Aff.Class (class MonadAff) +import Effect.Aff.Unlift (class MonadUnliftAff) -type Init = - { fetch :: Request -> Aff Response +type Init m = + { fetch :: Request -> m Response , port :: Maybe Int , hostname :: Maybe String , idleTimeout :: Maybe Seconds } -type Handle a = +type Handle m f a = { server :: a - , join :: Fiber Unit - , stop :: Aff Unit + , join :: f Unit + , stop :: m Unit } class Runtime :: Type -> Constraint class Runtime a where - serve :: Init -> Aff (Handle a) + serve :: + forall m f. MonadFork f m => MonadUnliftAff m => Init m -> m (Handle m f a) diff --git a/src/Axon.Web.Request.purs b/src/Axon.Web.Request.purs index 66424f9..165c885 100644 --- a/src/Axon.Web.Request.purs +++ b/src/Axon.Web.Request.purs @@ -13,12 +13,12 @@ import Control.Monad.Trans.Class (lift) import Data.ArrayBuffer.Types (Uint8Array) import Data.Either (Either) import Data.Maybe (fromMaybe) +import Data.Net.SocketAddress (SocketAddress) 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) @@ -37,7 +37,7 @@ foreign import readableFromWeb :: ReadableStream Uint8Array -> Effect (Stream.Readable ()) toRequest :: - Either (SocketAddress IPv4) (SocketAddress IPv6) -> + SocketAddress -> WebRequest -> Effect Request toRequest address req = diff --git a/src/Axon.purs b/src/Axon.purs index 32b8438..421e6e6 100644 --- a/src/Axon.purs +++ b/src/Axon.purs @@ -1,2 +1,142 @@ module Axon where +import Prelude + +import Axon.Request (Request) +import Axon.Request.Handler (Handler(..)) +import Axon.Request.Handler.Default as Handler.Default +import Axon.Request.Parts.Class (ExtractError(..)) +import Axon.Response (Response) +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) +import Effect.Console as Console +import Effect.Exception (Error) +import Effect.Exception as Error +import Prim.Row (class Nub, class Union) +import Record as Record + +type Serve m = + ( port :: Int + , hostname :: String + , idleTimeout :: Milliseconds + , handleError :: Request -> Error -> m Response + , handleBadRequest :: Request -> String -> m Response + , handleUnmatched :: Handler m Response + ) + +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 + } + +serveToRuntime :: + forall m. + MonadUnliftAff m => + Handler m Response -> + Record (Serve m) -> + Runtime.Init m +serveToRuntime h o = + let + fetch :: Boolean -> Handler m Response -> Request -> m Response + fetch recursed (Handler f) req = + f req + >>= case _ of + Left (ExtractError m) -> o.handleError req (Error.error m) + Left (ExtractBadRequest m) -> o.handleBadRequest req m + Left ExtractNext + | recursed -> liftAff $ throwError $ Error.error + "Fatal: `serve.handleUnmatched` didn't match request." + | otherwise -> fetch true o.handleUnmatched req + Right rep -> pure rep + in + { fetch: fetch false h + , port: Just o.port + , hostname: Just o.hostname + , idleTimeout: Just $ 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`. +-- | Omitted fields are set using `serveDefaults`. +-- | +-- | Second argument is your application's `Handler` entrypoint. +serve :: + forall @runtime f m opts optsMissing optsMerged. + MonadUnliftAff m => + MonadFork f m => + Runtime runtime => + Union opts optsMissing (Serve m) => + Union opts (Serve m) optsMerged => + Nub optsMerged (Serve m) => + Record opts -> + Handler m Response -> + m (Runtime.Handle m f runtime) +serve opts' handle = + let + -- Add visible type application to Record.merge + -- so we can explicitly set intermediate row type + merge' :: + forall @r1 @r2 @r3 @r4. + Union r1 r2 r3 => + Nub r3 r4 => + Record r1 -> + Record r2 -> + Record r4 + merge' = Record.merge + + -- Merge input options with defaults + opts :: Record (Serve m) + opts = merge' @_ @_ @optsMerged @_ opts' serveDefaults + in + Runtime.serve $ serveToRuntime handle opts diff --git a/src/Data.Net.SocketAddress.js b/src/Data.Net.SocketAddress.js new file mode 100644 index 0000000..6d1c4c0 --- /dev/null +++ b/src/Data.Net.SocketAddress.js @@ -0,0 +1,5 @@ +/** @type {(s: import('node:net').SocketAddress) => string} */ +export const nodeAddr = s => s.address + +/** @type {(s: import('node:net').SocketAddress) => number} */ +export const nodePort = s => s.port diff --git a/src/Data.Net.SocketAddress.purs b/src/Data.Net.SocketAddress.purs new file mode 100644 index 0000000..04b0bbd --- /dev/null +++ b/src/Data.Net.SocketAddress.purs @@ -0,0 +1,19 @@ +module Data.Net.SocketAddress where + +import Data.Either (Either(..)) +import Node.Net.Types as Node.Net + +data SocketAddress = IPv4 String Int | IPv6 String Int + +foreign import nodeAddr :: + forall (f :: Node.Net.IpFamily). Node.Net.SocketAddress f -> String + +foreign import nodePort :: + forall (f :: Node.Net.IpFamily). Node.Net.SocketAddress f -> Int + +fromNode :: + Either (Node.Net.SocketAddress Node.Net.IPv4) + (Node.Net.SocketAddress Node.Net.IPv6) -> + SocketAddress +fromNode (Left a) = IPv4 (nodeAddr a) (nodePort a) +fromNode (Right a) = IPv6 (nodeAddr a) (nodePort a) diff --git a/test/Test/Axon.Request.Handler.purs b/test/Test/Axon.Request.Handler.purs index 2f9cee3..69c95d2 100644 --- a/test/Test/Axon.Request.Handler.purs +++ b/test/Test/Axon.Request.Handler.purs @@ -1,6 +1,6 @@ module Test.Axon.Request.Handler where -import Axon.Request.Parts.Class +import Axon.Request.Parts.Class (Get, Path(..)) import Prelude import Axon.Request (Body) @@ -11,30 +11,27 @@ import Axon.Request.Method (Method(..)) import Axon.Request.Parts.Path (type (/)) import Axon.Response (Response) import Axon.Response as Response -import Axon.Response.Body as Response.Body import Axon.Response.Construct (toResponse) import Axon.Response.Construct as Response.Construct import Axon.Response.Status as Status import Control.Monad.Error.Class (liftEither) import Data.Bifunctor (lmap) -import Data.Either (Either(..)) import Data.Map (Map) import Data.Map as Map import Data.Maybe (fromJust) +import Data.Net.SocketAddress (SocketAddress) +import Data.Net.SocketAddress (SocketAddress(..)) as SocketAddress import Data.URL (URL) import Data.URL as URL import Effect.Aff (Aff, error) import Effect.Class (liftEffect) -import Effect.Unsafe (unsafePerformEffect) -import Node.Net.SocketAddress as SocketAddress -import Node.Net.Types (IPv4, IPv6, SocketAddress) import Partial.Unsafe (unsafePartial) import Test.Spec (Spec, describe, it) import Test.Spec.Assertions (shouldEqual) defaultRequest :: { headers :: Map String String - , address :: Either (SocketAddress IPv4) (SocketAddress IPv6) + , address :: SocketAddress , url :: URL , method :: Method , body :: Body @@ -43,8 +40,7 @@ defaultRequest = { body: Request.BodyEmpty , url: URL.fromString "http://localhost:80/" # unsafePartial fromJust , headers: Map.singleton "content-type" "application/json" - , address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 - { address: "127.0.0.1", port: 81 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } diff --git a/test/Test/Axon.Request.Parts.purs b/test/Test/Axon.Request.Parts.purs index 0eb422a..787baee 100644 --- a/test/Test/Axon.Request.Parts.purs +++ b/test/Test/Axon.Request.Parts.purs @@ -23,6 +23,7 @@ import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Map as Map import Data.Maybe (fromJust) +import Data.Net.SocketAddress as SocketAddress import Data.Tuple.Nested (type (/\), (/\)) import Data.URL as URL import Effect.Aff (Aff) @@ -45,8 +46,7 @@ spec = describe "Parts" do { body: Request.BodyEmpty , url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust , headers: Map.singleton "content-type" "application/json" - , address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 - { address: "127.0.0.1", port: 81 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } _ :: Request <- invokeHandler (pure @Aff) req <#> lmap (error <<< show) >>= @@ -62,8 +62,7 @@ spec = describe "Parts" do , url: URL.fromString "http://localhost:80/users/12" # unsafePartial fromJust , headers: Map.singleton "content-type" "application/json" - , address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 - { address: "127.0.0.1", port: 81 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: PATCH } @@ -91,8 +90,7 @@ spec = describe "Parts" do { 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path "foo" _) req <#> lmap (error <<< show) @@ -105,8 +103,7 @@ spec = describe "Parts" do , 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path ("foo" / "bar" / "baz") _) req @@ -120,8 +117,7 @@ spec = describe "Parts" do , 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path ("foo" / "bar") _) req @@ -133,8 +129,7 @@ spec = describe "Parts" do , 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path ("foo" / "bar" / IgnoreRest) _) req @@ -148,8 +143,7 @@ spec = describe "Parts" do , 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path ("foo" / Int / "bar") _) req @@ -163,8 +157,7 @@ spec = describe "Parts" do , 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Path ("foo" / Int / "bar" / String) _) req @@ -178,8 +171,7 @@ spec = describe "Parts" do { 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Try Request.BodyStringError String) req @@ -194,8 +186,7 @@ spec = describe "Parts" do { 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Try Request.BodyStringError String) req @@ -213,8 +204,7 @@ spec = describe "Parts" do { 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: GET } a <- extractRequestParts @(Try Request.BodyStringError String) req @@ -234,8 +224,7 @@ spec = describe "Parts" do { 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 } + , address: SocketAddress.IPv4 "127.0.0.1" 81 , method: POST } a <- extractRequestParts @(Post /\ Json { foo :: Int, bar :: String }) req