feat: rework Request class to return high level types

This commit is contained in:
orion 2023-11-28 11:26:26 -06:00
parent 87ac008ea6
commit 00ec9cf08c
Signed by: orion
GPG Key ID: 6D4165AE4C928719
2 changed files with 32 additions and 28 deletions

View File

@ -11,7 +11,9 @@ import Effect (Effect)
import Effect.Aff.Class (class MonadAff, liftAff)
import Foreign.Object (Object)
import Foreign.Object as Object
import HTTP.Header (Headers(..))
import HTTP.Header (headers) as X
import HTTP.Request (bodyToRaw)
import HTTP.Request (class Request, Method(..)) as X
import HTTP.Request as Req
import HTTP.Response (Response)
@ -23,7 +25,8 @@ fetch req = do
url <- Req.requestUrl req
method <- Req.requestMethod req
body <- Req.requestBody req
headers <- Req.requestHeaders req
bodyRaw <- bodyToRaw body
Headers headers <- Req.requestHeaders req
let
methodStr = case method of
@ -34,4 +37,4 @@ fetch req = do
Req.DELETE -> "DELETE"
headers' = Object.fromFoldableWithIndex headers
liftAff $ Promise.toAffE $ fetchImpl url methodStr headers' $ Nullable.toNullable body
liftAff $ Promise.toAffE $ fetchImpl url methodStr headers' $ Nullable.toNullable bodyRaw

View File

@ -1,8 +1,9 @@
module HTTP.Request
( class Request
, Body
, Body(..)
, RawRequestBody
, Method(..)
, bodyToRaw
, json
, form
, blob
@ -96,13 +97,13 @@ bodyHeaders (BodyBuffer _ ct) = liftEffect $ Header.headers ct
bodyHeaders (BodyArrayBuffer _ ct) = liftEffect $ Header.headers ct
bodyHeaders (BodyBlob b) = liftEffect $ Header.headers <<< map (ContentType <<< MIME.fromString <<< unwrap) $ Blob.type_ b
bodyToRaw :: forall m. MonadAff m => Body -> m RawRequestBody
bodyToRaw :: forall m. MonadAff m => Body -> m (Maybe RawRequestBody)
bodyToRaw (BodyString body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyBuffer ct) $ Buffer.fromString body UTF8
bodyToRaw (BodyBuffer body ct) = flip bind bodyToRaw $ liftEffect $ map (flip BodyArrayBuffer ct) $ Buffer.toArrayBuffer body
bodyToRaw (BodyArrayBuffer body _) = pure $ unsafeArrayBufferToRawRequestBody body
bodyToRaw (BodyForm form') = map unsafeFormDataToRawRequestBody $ Form.toRawFormData form'
bodyToRaw (BodyBlob body) = unsafeBlobToRawRequestBody body
bodyToRaw BodyEmpty = pure $ unsafeEmptyRawRequestBody
bodyToRaw (BodyArrayBuffer body _) = pure $ Just $ unsafeArrayBufferToRawRequestBody body
bodyToRaw (BodyForm form') = map Just $ map unsafeFormDataToRawRequestBody $ Form.toRawFormData form'
bodyToRaw (BodyBlob body) = map Just $ unsafeBlobToRawRequestBody body
bodyToRaw BodyEmpty = pure Nothing
data Method
= GET
@ -122,53 +123,53 @@ class Request :: Type -> Constraint
class Request a where
requestUrl :: forall m. MonadAff m => a -> m URL
requestMethod :: forall m. MonadAff m => a -> m Method
requestBody :: forall m. MonadAff m => a -> m (Maybe RawRequestBody)
requestHeaders :: forall m. MonadAff m => a -> m (Map String String)
requestBody :: forall m. MonadAff m => a -> m Body
requestHeaders :: forall m. MonadAff m => a -> m Headers
instance Request (Method /\ URL /\ Body /\ Effect Headers) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract
requestBody = pure <<< extract
requestHeaders req = do
(Headers hs) <- liftEffect $ extract req
(Headers bodyHs) <- bodyHeaders $ extract req
pure $ Map.union hs bodyHs
hs <- liftEffect $ extract req
bodyHs <- bodyHeaders $ extract req
pure $ hs <> bodyHs
instance Request (Method /\ URL /\ Body /\ Headers) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract
requestBody = pure <<< extract
requestHeaders req = do
let (Headers hs) = extract req
(Headers bodyHs) <- bodyHeaders $ extract req
pure $ Map.union hs bodyHs
let hs = extract req
bodyHs <- bodyHeaders $ extract req
pure $ hs <> bodyHs
instance Request (Method /\ URL /\ Body) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody = map Just <<< bodyToRaw <<< extract
requestHeaders _ = pure Map.empty
requestBody = pure <<< extract
requestHeaders _ = pure mempty
instance Request (Method /\ URL /\ Headers) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty
requestHeaders = (\(Headers h) -> pure h) <<< extract
requestBody _ = pure BodyEmpty
requestHeaders = pure <<< extract
instance Request (Method /\ URL /\ Effect Headers) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty
requestHeaders = liftEffect <<< map (\(Headers h) -> h) <<< extract @(Effect Headers)
requestBody _ = pure BodyEmpty
requestHeaders = liftEffect <<< extract @(Effect Headers)
instance Request (Method /\ URL) where
requestUrl = pure <<< extract
requestMethod = pure <<< extract
requestBody _ = Just <$> bodyToRaw BodyEmpty
requestHeaders _ = pure Map.empty
requestBody _ = pure BodyEmpty
requestHeaders _ = pure mempty
instance Request URL where
requestUrl = pure
requestMethod _ = pure GET
requestBody _ = Just <$> bodyToRaw BodyEmpty
requestHeaders _ = pure Map.empty
requestBody _ = pure BodyEmpty
requestHeaders _ = pure mempty