From 00ec9cf08ccb0482d04e21e8e055428e6c9efceb Mon Sep 17 00:00:00 2001
From: Orion Kindel <orionkindel@gmail.com>
Date: Tue, 28 Nov 2023 11:26:26 -0600
Subject: [PATCH] feat: rework Request class to return high level types

---
 src/HTTP.purs         |  7 ++++--
 src/HTTP/Request.purs | 53 ++++++++++++++++++++++---------------------
 2 files changed, 32 insertions(+), 28 deletions(-)

diff --git a/src/HTTP.purs b/src/HTTP.purs
index de50ed7..e2bbe5c 100644
--- a/src/HTTP.purs
+++ b/src/HTTP.purs
@@ -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
diff --git a/src/HTTP/Request.purs b/src/HTTP/Request.purs
index d42ad76..1c8b17f 100644
--- a/src/HTTP/Request.purs
+++ b/src/HTTP/Request.purs
@@ -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