diff --git a/spago.lock b/spago.lock index 319e704..a56400d 100644 --- a/spago.lock +++ b/spago.lock @@ -7,6 +7,7 @@ workspace: - aff-promise - arraybuffer - arraybuffer-types + - b64 - bifunctors - effect - either @@ -37,6 +38,7 @@ workspace: - arraybuffer - arraybuffer-types - arrays + - b64 - bifunctors - const - contravariant @@ -45,6 +47,7 @@ workspace: - distributive - effect - either + - encoding - enums - exceptions - exists @@ -5802,6 +5805,20 @@ packages: - tuples - unfoldable - unsafe-coerce + b64: + type: git + url: https://github.com/menelaos/purescript-b64.git + rev: 1d66c26733ed5924bcab8901204245daac0f2952 + dependencies: + - arraybuffer-types + - either + - encoding + - enums + - exceptions + - functions + - partial + - prelude + - strings bifunctors: type: git url: https://github.com/purescript/purescript-bifunctors.git @@ -5883,6 +5900,16 @@ packages: - invariant - maybe - prelude + encoding: + type: git + url: https://github.com/menelaos/purescript-encoding.git + rev: a9d1913de736821c133ecd7944a08b2ab07ad774 + dependencies: + - arraybuffer-types + - either + - exceptions + - functions + - prelude enums: type: git url: https://github.com/purescript/purescript-enums.git diff --git a/spago.yaml b/spago.yaml index 8a6a490..d5c378c 100644 --- a/spago.yaml +++ b/spago.yaml @@ -4,6 +4,7 @@ package: - aff-promise - arraybuffer - arraybuffer-types + - b64 - bifunctors - effect - either diff --git a/src/HTTP/Form.purs b/src/HTTP/Form.purs index e9365bc..487a6a4 100644 --- a/src/HTTP/Form.purs +++ b/src/HTTP/Form.purs @@ -2,14 +2,12 @@ module HTTP.Form where import Prelude -import Control.Monad.Error.Class (liftMaybe, try) +import Control.Monad.Error.Class (liftMaybe) import Control.Monad.Except (runExcept) import Control.Promise (Promise) import Control.Promise as Promise -import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Either (hush) -import Data.Foldable (foldl) import Data.FoldableWithIndex (foldlWithIndex) import Data.Generic.Rep (class Generic) import Data.Map (Map) @@ -20,19 +18,15 @@ import Data.Nullable (Nullable) import Data.Nullable as Nullable import Data.Show.Generic (genericShow) import Data.Traversable (for) -import Data.Tuple (Tuple(..)) import Effect (Effect) -import Effect.Aff (Aff) import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Class (class MonadEffect, liftEffect) import Effect.Exception (error) import Foreign (Foreign, unsafeReadTagged, unsafeToForeign) import Foreign.Object (Object) import Foreign.Object as Object -import HTTP.Header as Header import HTTP.MIME (MIME) import HTTP.MIME as MIME -import Node.Buffer.Immutable (ImmutableBuffer) import Simple.JSON (readImpl, unsafeStringify) import Unsafe.Coerce (unsafeCoerce) import Web.File.Blob (Blob) diff --git a/src/HTTP/Header.purs b/src/HTTP/Header.purs index e1a662a..e56276b 100644 --- a/src/HTTP/Header.purs +++ b/src/HTTP/Header.purs @@ -2,6 +2,7 @@ module HTTP.Header where import Prelude +import Control.Monad.Error.Class (liftEither) import Data.Eq.Generic (genericEq) import Data.Generic.Rep (class Generic) import Data.Map (Map) @@ -9,13 +10,12 @@ import Data.Map as Map import Data.Maybe (Maybe, maybe) import Data.Newtype (class Newtype, unwrap, wrap) import Data.Show.Generic (genericShow) +import Data.String.Base64 as String.Base64 import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Class (class MonadEffect, liftEffect) import HTTP.MIME (MIME) import HTTP.MIME as MIME -import Node.Buffer as Buffer -import Node.Encoding (Encoding(..)) newtype ContentType = ContentType MIME @@ -50,8 +50,7 @@ instance Eq Authorization where authorizationValue :: forall m. MonadEffect m => Authorization -> m String authorizationValue (AuthBasic { username, password }) = do - buf <- liftEffect $ Buffer.fromString (username <> ":" <> password) UTF8 - val <- liftEffect $ Buffer.toString Base64 buf + val <- liftEffect $ liftEither $ String.Base64.btoa $ username <> ":" <> password authorizationValue $ AuthCustom (wrap "Basic") val authorizationValue (AuthBearer val) = authorizationValue $ AuthCustom (wrap "Bearer") val authorizationValue (AuthCustom (AuthScheme scheme) val) = pure $ scheme <> " " <> val diff --git a/src/HTTP/Request.purs b/src/HTTP/Request.purs index 350348d..4f8486c 100644 --- a/src/HTTP/Request.purs +++ b/src/HTTP/Request.purs @@ -7,7 +7,6 @@ module HTTP.Request , json , form , blob - , buffer , arrayBuffer , requestBody , requestHeaders @@ -23,8 +22,6 @@ import Control.Promise as Promise import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Eq.Generic (genericEq) import Data.Generic.Rep (class Generic) -import Data.Map (Map) -import Data.Map as Map import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) import Data.Nullable as Nullable @@ -37,13 +34,10 @@ import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Class (class MonadEffect, liftEffect) import HTTP.Form (Form, RawFormData) import HTTP.Form as Form -import HTTP.Header (ContentType(..), Headers(..)) +import HTTP.Header (ContentType(..), Headers) import HTTP.Header as Header import HTTP.MIME (MIME) import HTTP.MIME as MIME -import Node.Buffer (Buffer) -import Node.Buffer as Buffer -import Node.Encoding (Encoding(..)) import Simple.JSON (class WriteForeign, writeJSON) import Unsafe.Coerce (unsafeCoerce) import Web.File.Blob (Blob) @@ -57,6 +51,9 @@ foreign import rawRequestBodySize :: RawRequestBody -> Effect Int unsafeEmptyRawRequestBody :: RawRequestBody unsafeEmptyRawRequestBody = unsafeCoerce Nullable.null +unsafeStringRawRequestBody :: String -> RawRequestBody +unsafeStringRawRequestBody = unsafeCoerce + unsafeFormDataToRawRequestBody :: RawFormData -> RawRequestBody unsafeFormDataToRawRequestBody = unsafeCoerce @@ -69,7 +66,6 @@ unsafeBlobToRawRequestBody = map unsafeArrayBufferToRawRequestBody <<< liftAff < data Body = BodyString String (Maybe ContentType) | BodyArrayBuffer ArrayBuffer (Maybe ContentType) - | BodyBuffer Buffer (Maybe ContentType) | BodyBlob Blob | BodyForm Form | BodyEmpty @@ -83,9 +79,6 @@ form = BodyForm blob :: Blob -> Body blob = BodyBlob -buffer :: MIME -> Buffer -> Body -buffer mime buf = BodyBuffer buf $ Just $ ContentType mime - arrayBuffer :: MIME -> ArrayBuffer -> Body arrayBuffer mime buf = BodyArrayBuffer buf $ Just $ ContentType mime @@ -93,13 +86,11 @@ bodyHeaders :: forall m. MonadEffect m => Body -> m Headers bodyHeaders (BodyForm _) = pure mempty bodyHeaders (BodyEmpty) = pure mempty bodyHeaders (BodyString _ ct) = liftEffect $ Header.headers ct -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 (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 (BodyString body _) = pure $ Just $ unsafeStringRawRequestBody body bodyToRaw (BodyArrayBuffer body _) = pure $ Just $ unsafeArrayBufferToRawRequestBody body bodyToRaw (BodyForm form') = map Just $ map unsafeFormDataToRawRequestBody $ Form.toRawFormData form' bodyToRaw (BodyBlob body) = map Just $ unsafeBlobToRawRequestBody body