Initial commit

Author: natefaubion

.gitignore

@@ -0,0 +1,9 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2020 Awake Security
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1 @@
+# purescript-web-fetch

bower.json

@@ -0,0 +1,28 @@
+{
+  "name": "purescript-web-fetch",
+  "homepage": "https://github.com/purescript-web/purescript-web-fetch",
+  "license": "MIT",
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/purescript-web/purescript-web-fetch.git"
+  },
+  "ignore": [
+    "**/.*",
+    "bower_components",
+    "node_modules",
+    "output",
+    "bower.json",
+    "package.json"
+  ],
+  "dependencies": {
+    "purescript-prelude": "^4.0.0",
+    "purescript-effect": "^2.0.0",
+    "purescript-http-methods": "^4.0.0",
+    "purescript-typelevel-prelude": "^5.0.0",
+    "purescript-web-file": "^2.3.0",
+    "purescript-record": "^2.0.0",
+    "purescript-foreign-object": "^2.0.0",
+    "purescript-web-promise": "https://github.com/purescript-web/purescript-web-promise.git#^1.0.0",
+    "purescript-web-streams": "https://github.com/purescript-web/purescript-web-streams.git#^1.0.0"
+  }
+}

src/Web/Fetch.js

@@ -0,0 +1 @@
+exports._fetch = fetch;

src/Web/Fetch.purs

@@ -0,0 +1,26 @@
+module Web.Fetch
+  ( FetchOptions
+  , fetch
+  , fetchWithOptions
+  ) where
+
+import Effect (Effect)
+import Effect.Uncurried (EffectFn2, runEffectFn2)
+import Prim.Row as Row
+import Web.Fetch.AbortController (AbortSignal)
+import Web.Fetch.Request (Request)
+import Web.Fetch.Response (Response)
+import Web.Promise (Promise)
+
+type FetchOptions =
+  ( keepalive :: Boolean
+  , signal :: AbortSignal
+  )
+
+foreign import _fetch :: forall r. EffectFn2 Request { | r } (Promise Response)
+
+fetch :: Request -> Effect (Promise Response)
+fetch req = runEffectFn2 _fetch req {}
+
+fetchWithOptions :: forall r rx. Row.Union r rx FetchOptions => Request -> { | r } -> Effect (Promise Response)
+fetchWithOptions = runEffectFn2 _fetch

src/Web/Fetch/AbortController.js

@@ -0,0 +1,13 @@
+exports.new = function() {
+  return new AbortController();
+};
+
+exports.abort = function(controller) {
+  return function() {
+    return controller.abort();
+  };
+};
+
+exports.signal = function(controller) {
+  return controller.signal;
+};

src/Web/Fetch/AbortController.purs

@@ -0,0 +1,14 @@
+module Web.Fetch.AbortController where
+
+import Effect (Effect)
+import Prelude (Unit)
+
+foreign import data AbortController :: Type
+
+foreign import data AbortSignal :: Type
+
+foreign import new :: Effect AbortController
+
+foreign import abort :: AbortController -> Effect Unit
+
+foreign import signal :: AbortController -> AbortSignal

src/Web/Fetch/Headers.js

@@ -0,0 +1,23 @@
+exports.unsafeNew = function() {
+  return new Headers();
+};
+
+exports.unsafeAppend = function(key, value, headers) {
+  return headers.append(key, value);
+};
+
+exports.unsafeFromRecord = function(r) {
+  return new Headers(r);
+};
+
+exports._toArray = function(tuple, headers) {
+  var arr = [];
+  for (var pair of headers.entries()) {
+    arr.push(tuple(pair[0])(pair[1]));
+  }
+  return arr;
+}
+
+exports.fromObject = function(obj) {
+  return new Headers(obj);
+};

src/Web/Fetch/Headers.purs

@@ -0,0 +1,53 @@
+module Web.Fetch.Headers
+  ( Headers
+  , fromFoldable
+  , fromRecord
+  , fromObject
+  , toArray
+  , toUnfoldable
+  , empty
+  ) where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Foldable (class Foldable, foldM)
+import Data.Function.Uncurried (Fn2, runFn2)
+import Data.Tuple (Tuple(..))
+import Data.Unfoldable (class Unfoldable)
+import Effect (Effect)
+import Effect.Uncurried (EffectFn3, runEffectFn3)
+import Effect.Unsafe (unsafePerformEffect)
+import Foreign.Object (Object)
+import Type.Row.Homogeneous (class Homogeneous)
+
+foreign import data Headers :: Type
+
+foreign import unsafeNew :: Effect Headers
+
+foreign import unsafeAppend :: EffectFn3 String String Headers Unit
+
+foreign import unsafeFromRecord :: forall r. { | r } -> Headers
+
+foreign import _toArray :: Fn2 (forall a b. a -> b -> Tuple a b) Headers (Array (Tuple String String))
+
+foreign import fromObject :: Object String -> Headers
+
+fromFoldable :: forall f. Foldable f => f (Tuple String String) -> Headers
+fromFoldable f = unsafePerformEffect do
+  init <- unsafeNew
+  foldM (\headers (Tuple key value) -> do
+    runEffectFn3 unsafeAppend key value headers
+    pure headers) init f
+
+fromRecord :: forall r. Homogeneous r String => { | r } -> Headers
+fromRecord = unsafeFromRecord
+
+toArray :: Headers -> Array (Tuple String String)
+toArray = runFn2 _toArray Tuple
+
+toUnfoldable :: forall f. Unfoldable f => Headers -> f (Tuple String String)
+toUnfoldable = Array.toUnfoldable <<< toArray
+
+empty :: Headers
+empty = fromFoldable []

src/Web/Fetch/Integrity.purs

@@ -0,0 +1,10 @@
+module Web.Fetch.Integrity where
+
+import Data.Newtype (class Newtype)
+import Prelude (class Eq, class Ord)
+
+newtype Integrity = Integrity String
+
+derive instance newtypeIntegrity :: Newtype Integrity _
+derive newtype instance eqIntegrity :: Eq Integrity
+derive newtype instance ordIntegrity :: Ord Integrity

src/Web/Fetch/Referrer.purs

@@ -0,0 +1,18 @@
+module Web.Fetch.Referrer where
+
+data Referrer
+  = ReferrerNone
+  | ReferrerClient
+  | ReferrerUrl String
+
+toString :: Referrer -> String
+toString = case _ of
+  ReferrerNone -> "none"
+  ReferrerClient -> "client"
+  ReferrerUrl url ->  url
+
+fromString :: String -> Referrer
+fromString = case _ of
+  "none" -> ReferrerNone
+  "client" -> ReferrerClient
+  url -> ReferrerUrl url

src/Web/Fetch/ReferrerPolicy.purs

@@ -0,0 +1,36 @@
+module Web.Fetch.ReferrerPolicy where
+
+import Data.Maybe (Maybe(..))
+
+data ReferrerPolicy
+  = Default
+  | NoReferrer
+  | NoReferrerWhenDowngrade
+  | SameOrigin
+  | StrictOrigin
+  | OriginWhenCrossOrigin
+  | StrictOriginWhenCrossOrigin
+  | UnsafeUrl
+
+toString :: ReferrerPolicy -> String
+toString = case _ of
+  Default -> ""
+  NoReferrer -> "no-referrer"
+  NoReferrerWhenDowngrade -> "no-referrer-when-downgrade"
+  SameOrigin -> "same-origin"
+  StrictOrigin -> "strict-origin"
+  OriginWhenCrossOrigin -> "origin-when-cross-origin"
+  StrictOriginWhenCrossOrigin -> "strict-origin-when-cross-origin"
+  UnsafeUrl -> "unsafe-url"
+
+fromString :: String -> Maybe ReferrerPolicy
+fromString = case _ of
+  "" -> Just Default
+  "no-referrer" -> Just NoReferrer
+  "no-referrer-when-downgrade" -> Just NoReferrerWhenDowngrade
+  "same-origin" -> Just SameOrigin
+  "strict-origin" -> Just StrictOrigin
+  "origin-when-cross-origin" -> Just OriginWhenCrossOrigin
+  "strict-origin-when-cross-origin" -> Just StrictOriginWhenCrossOrigin
+  "unsafe-url" -> Just UnsafeUrl
+  _ -> Nothing

src/Web/Fetch/Request.js

@@ -0,0 +1,8 @@
+exports._unsafeNew = function(url, options) {
+  try {
+    return new Request(url, options);
+  } catch (e) {
+    console.error(e);
+    throw e;
+  }
+};