generated from tpl/purs
feat: rework Request class to return high level types
This commit is contained in:
parent
87ac008ea6
commit
00ec9cf08c
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user