-----------------------------------------------------------------------------
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Fetch
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Module for interacting with the Fetch API <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
-- manually.
--
-- Refer to the miso README if you want to automatically interact with a Servant
-- API.
--
----------------------------------------------------------------------------
module Miso.Fetch
  ( -- ** JSON
    getJSON
  , postJSON
  , putJSON
  -- ** Text
  , getText
  , postText
  , putText
  -- ** Blob
  , getBlob
  , postBlob
  , putBlob
  -- ** FormData
  , getFormData
  , postFormData
  , putFormData
  -- ** Uint8Array
  , getUint8Array
  , postUint8Array
  , putUint8Array
  -- ** Image
  , postImage
  , putImage
  -- ** ArrayBuffer
  , getArrayBuffer
  , postArrayBuffer
  , putArrayBuffer
    -- ** Header helpers
  , accept
  , contentType
  , applicationJSON
  , textPlain
  , formData
    -- ** Types
  , Body
  , Response (..)
  , CONTENT_TYPE (..)
    -- ** Internal
  , fetch
  ) where
----------------------------------------------------------------------------
import           Data.Aeson
import qualified Data.Map.Strict as M
import           Language.Javascript.JSaddle (toJSVal, FromJSVal(..), JSVal)
----------------------------------------------------------------------------
import qualified Miso.FFI.Internal as FFI
import           Miso.Effect (Effect, withSink)
import           Miso.String (MisoString, ms)
import           Miso.Util ((=:))
import           Miso.FFI.Internal (Response(..), Blob, FormData, ArrayBuffer, Uint8Array, Image, fetch, CONTENT_TYPE(..))
----------------------------------------------------------------------------
-- | See <https://developer.mozilla.org/en-US/docs/Web/API/Fetch_API>
--
-- @
--
-- data Action
--  = FetchGitHub
--  | SetGitHub GitHub
--  | ErrorHandler MisoString
--  deriving (Show, Eq)
--
-- updateModel :: Action -> Effect Model Action
-- updateModel = \case
--   FetchGitHub -> getJSON "https://api.github.com" [] SetGitHub ErrorHandler
--   SetGitHub apiInfo -> info ?= apiInfo
--   ErrorHandler msg -> io_ (consoleError msg)
--
-- @
--
getJSON
  :: (FromJSON body, FromJSVal error)
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers
  -> (Response body -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getJSON :: forall body error action parent model.
(FromJSON body, FromJSVal error) =>
MisoString
-> [(MisoString, MisoString)]
-> (Response body -> action)
-> (Response error -> action)
-> Effect parent model action
getJSON MisoString
url [(MisoString, MisoString)]
headers_ Response body -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response JSVal -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
jsonHeaders
      (Sink action -> Response JSVal -> JSM ()
forall {b}. (action -> JSM b) -> Response JSVal -> JSM b
handleJSON Sink action
sink)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
JSON -- dmj: expected return type
  where
    jsonHeaders :: [(MisoString, MisoString)]
jsonHeaders = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON]
    handleJSON :: (action -> JSM b) -> Response JSVal -> JSM b
handleJSON action -> JSM b
sink resp :: Response JSVal
resp@Response {Maybe Int
Maybe MisoString
Map MisoString MisoString
JSVal
status :: Maybe Int
headers :: Map MisoString MisoString
errorMessage :: Maybe MisoString
body :: JSVal
body :: forall body. Response body -> body
errorMessage :: forall body. Response body -> Maybe MisoString
headers :: forall body. Response body -> Map MisoString MisoString
status :: forall body. Response body -> Maybe Int
..} =
      (Value -> Result body) -> Maybe Value -> Maybe (Result body)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Result body
forall a. FromJSON a => Value -> Result a
fromJSON (Maybe Value -> Maybe (Result body))
-> JSM (Maybe Value) -> JSM (Maybe (Result body))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> JSM (Maybe Value)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal JSVal
body JSM (Maybe (Result body))
-> (Maybe (Result body) -> JSM b) -> JSM b
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Result body)
Nothing -> do
          err <- JSVal -> JSM error
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked JSVal
body
          sink $ errorful $ Response
            { body = err
            , errorMessage = Just "Not a valid JSON object"
            , ..
            }
        Just (Success body
result) -> 
          action -> JSM b
sink (action -> JSM b) -> action -> JSM b
forall a b. (a -> b) -> a -> b
$ Response body -> action
successful Response JSVal
resp { body = result }
        Just (Error String
msg) -> do 
          err <- JSVal -> JSM error
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked JSVal
body
          sink $ errorful $ Response
            { body = err
            , errorMessage = Just (ms msg)
            , ..
            }
----------------------------------------------------------------------------
postJSON
  :: (FromJSVal error, ToJSON body)
  => MisoString
  -- ^ url
  -> body
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postJSON :: forall error body action parent model.
(FromJSVal error, ToJSON body) =>
MisoString
-> body
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postJSON MisoString
url body
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- body -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify body
body_
    FFI.fetch url "POST" (Just bodyVal) jsonHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    jsonHeaders_ :: [(MisoString, MisoString)]
jsonHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON]
----------------------------------------------------------------------------
putJSON
  :: (FromJSVal error, ToJSON body)
  => MisoString
  -- ^ url
  -> body
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putJSON :: forall error body action parent model.
(FromJSVal error, ToJSON body) =>
MisoString
-> body
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putJSON MisoString
url body
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- body -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify body
body_
    FFI.fetch url "PUT" (Just bodyVal) jsonHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    jsonHeaders_ :: [(MisoString, MisoString)]
jsonHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
applicationJSON]
----------------------------------------------------------------------------
getText
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response MisoString -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getText :: forall error action parent model.
FromJSVal error =>
MisoString
-> [(MisoString, MisoString)]
-> (Response MisoString -> action)
-> (Response error -> action)
-> Effect parent model action
getText MisoString
url [(MisoString, MisoString)]
headers_ Response MisoString -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response MisoString -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
textHeaders_
      (Sink action
sink Sink action
-> (Response MisoString -> action) -> Response MisoString -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response MisoString -> action
successful)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
TEXT -- dmj: expected return type
  where
    textHeaders_ :: [(MisoString, MisoString)]
textHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
textPlain]
----------------------------------------------------------------------------
postText
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> MisoString
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postText :: forall error action parent model.
FromJSVal error =>
MisoString
-> MisoString
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postText MisoString
url MisoString
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- MisoString -> JSM JSVal
forall json. ToJSON json => json -> JSM JSVal
FFI.jsonStringify MisoString
body_
    FFI.fetch url "POST" (Just bodyVal) textHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    textHeaders_ :: [(MisoString, MisoString)]
textHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
textPlain]
----------------------------------------------------------------------------
putText
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> MisoString
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putText :: forall error action parent model.
FromJSVal error =>
MisoString
-> MisoString
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putText MisoString
url MisoString
imageBody [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- MisoString -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal MisoString
imageBody
    FFI.fetch url "PUT" (Just body_) textHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    textHeaders_ :: [(MisoString, MisoString)]
textHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
textPlain]
----------------------------------------------------------------------------
getBlob
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response Blob -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getBlob :: forall error action parent model.
FromJSVal error =>
MisoString
-> [(MisoString, MisoString)]
-> (Response Blob -> action)
-> (Response error -> action)
-> Effect parent model action
getBlob MisoString
url [(MisoString, MisoString)]
headers_ Response Blob -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response Blob -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
blobHeaders_
      (Sink action
sink Sink action -> (Response Blob -> action) -> Response Blob -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response Blob -> action
successful)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
BLOB -- dmj: expected return type
  where
    blobHeaders_ :: [(MisoString, MisoString)]
blobHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postBlob
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Blob
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postBlob :: forall error action parent model.
FromJSVal error =>
MisoString
-> Blob
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postBlob MisoString
url Blob
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- Blob -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Blob
body_
    FFI.fetch url "POST" (Just bodyVal) blobHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    blobHeaders_ :: [(MisoString, MisoString)]
blobHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
putBlob
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Blob
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putBlob :: forall error action parent model.
FromJSVal error =>
MisoString
-> Blob
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putBlob MisoString
url Blob
imageBody [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- Blob -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Blob
imageBody
    FFI.fetch url "PUT" (Just body_) blobHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    blobHeaders_ :: [(MisoString, MisoString)]
blobHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
getFormData
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response FormData -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getFormData :: forall error action parent model.
FromJSVal error =>
MisoString
-> [(MisoString, MisoString)]
-> (Response FormData -> action)
-> (Response error -> action)
-> Effect parent model action
getFormData MisoString
url [(MisoString, MisoString)]
headers_ Response FormData -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response FormData -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
formDataHeaders_
      (Sink action
sink Sink action
-> (Response FormData -> action) -> Response FormData -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response FormData -> action
successful)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
FORM_DATA -- dmj: expected return type
  where
    formDataHeaders_ :: [(MisoString, MisoString)]
formDataHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
formData]
----------------------------------------------------------------------------
postFormData
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> FormData
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postFormData :: forall error action parent model.
FromJSVal error =>
MisoString
-> FormData
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postFormData MisoString
url FormData
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- FormData -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal FormData
body_
    FFI.fetch url "POST" (Just bodyVal) formDataHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    formDataHeaders_ :: [(MisoString, MisoString)]
formDataHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
formData]
----------------------------------------------------------------------------
putFormData
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> FormData
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error  -> action)
  -- ^ errorful callback
  -> Effect parent model action
putFormData :: forall error action parent model.
FromJSVal error =>
MisoString
-> FormData
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putFormData MisoString
url FormData
imageBody [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- FormData -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal FormData
imageBody
    FFI.fetch url "PUT" (Just body_) formDataHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    formDataHeaders_ :: [(MisoString, MisoString)]
formDataHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
formData]
----------------------------------------------------------------------------
getArrayBuffer
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response ArrayBuffer -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getArrayBuffer :: forall error action parent model.
FromJSVal error =>
MisoString
-> [(MisoString, MisoString)]
-> (Response ArrayBuffer -> action)
-> (Response error -> action)
-> Effect parent model action
getArrayBuffer MisoString
url [(MisoString, MisoString)]
headers_ Response ArrayBuffer -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response ArrayBuffer -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
arrayBufferHeaders_
      (Sink action
sink Sink action
-> (Response ArrayBuffer -> action)
-> Response ArrayBuffer
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ArrayBuffer -> action
successful)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
ARRAY_BUFFER -- dmj: expected return type
  where
    arrayBufferHeaders_ :: [(MisoString, MisoString)]
arrayBufferHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postArrayBuffer
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> ArrayBuffer
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postArrayBuffer :: forall error action parent model.
FromJSVal error =>
MisoString
-> ArrayBuffer
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postArrayBuffer MisoString
url ArrayBuffer
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- ArrayBuffer -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ArrayBuffer
body_
    FFI.fetch url "POST" (Just bodyVal) arrayBufferHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    arrayBufferHeaders_ :: [(MisoString, MisoString)]
arrayBufferHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
putArrayBuffer
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> ArrayBuffer
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putArrayBuffer :: forall error action parent model.
FromJSVal error =>
MisoString
-> ArrayBuffer
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putArrayBuffer MisoString
url ArrayBuffer
arrayBuffer_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- ArrayBuffer -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ArrayBuffer
arrayBuffer_
    FFI.fetch url "PUT" (Just body_) arrayBufferHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    arrayBufferHeaders_ :: [(MisoString, MisoString)]
arrayBufferHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
getUint8Array
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response Uint8Array -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
getUint8Array :: forall error action parent model.
FromJSVal error =>
MisoString
-> [(MisoString, MisoString)]
-> (Response Uint8Array -> action)
-> (Response error -> action)
-> Effect parent model action
getUint8Array MisoString
url [(MisoString, MisoString)]
headers_ Response Uint8Array -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response Uint8Array -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
forall success error.
(FromJSVal success, FromJSVal error) =>
MisoString
-> MisoString
-> Maybe JSVal
-> [(MisoString, MisoString)]
-> (Response success -> JSM ())
-> (Response error -> JSM ())
-> CONTENT_TYPE
-> JSM ()
FFI.fetch MisoString
url MisoString
"GET" Maybe JSVal
forall a. Maybe a
Nothing [(MisoString, MisoString)]
uint8ArrayHeaders_
      (Sink action
sink Sink action
-> (Response Uint8Array -> action) -> Response Uint8Array -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response Uint8Array -> action
successful)
      (Sink action
sink Sink action
-> (Response error -> action) -> Response error -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response error -> action
errorful)
      CONTENT_TYPE
BYTES -- expected return type
  where
    uint8ArrayHeaders_ :: [(MisoString, MisoString)]
uint8ArrayHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
accept MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postUint8Array
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Uint8Array
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postUint8Array :: forall error action parent model.
FromJSVal error =>
MisoString
-> Uint8Array
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postUint8Array MisoString
url Uint8Array
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- Uint8Array -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Uint8Array
body_
    FFI.fetch url "POST" (Just bodyVal) uint8ArrayHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    uint8ArrayHeaders_ :: [(MisoString, MisoString)]
uint8ArrayHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
putUint8Array
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Uint8Array
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putUint8Array :: forall error action parent model.
FromJSVal error =>
MisoString
-> Uint8Array
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putUint8Array MisoString
url Uint8Array
uint8Array_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- Uint8Array -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Uint8Array
uint8Array_
    FFI.fetch url "PUT" (Just body_) uint8ArrayHeaders_
      (sink . successful)
      (sink . errorful)
      NONE
  where
    uint8ArrayHeaders_ :: [(MisoString, MisoString)]
uint8ArrayHeaders_ = [(MisoString, MisoString)]
-> [(MisoString, MisoString)] -> [(MisoString, MisoString)]
forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(MisoString, MisoString)]
headers_ [MisoString
contentType MisoString -> MisoString -> (MisoString, MisoString)
forall k v. k -> v -> (k, v)
=: MisoString
octetStream]
----------------------------------------------------------------------------
postImage
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Image
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
postImage :: forall error action parent model.
FromJSVal error =>
MisoString
-> Image
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
postImage MisoString
url Image
body_ [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    bodyVal <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
body_
    FFI.fetch url "POST" (Just bodyVal) headers_
      (sink . successful)
      (sink . errorful)
      NONE
----------------------------------------------------------------------------
putImage
  :: FromJSVal error
  => MisoString
  -- ^ url
  -> Image
  -- ^ Body
  -> [(MisoString, MisoString)]
  -- ^ headers_
  -> (Response () -> action)
  -- ^ successful callback
  -> (Response error -> action)
  -- ^ errorful callback
  -> Effect parent model action
putImage :: forall error action parent model.
FromJSVal error =>
MisoString
-> Image
-> [(MisoString, MisoString)]
-> (Response () -> action)
-> (Response error -> action)
-> Effect parent model action
putImage MisoString
url Image
imageBody [(MisoString, MisoString)]
headers_ Response () -> action
successful Response error -> action
errorful =
  (Sink action -> JSM ()) -> Effect parent model action
forall action parent model.
(Sink action -> JSM ()) -> Effect parent model action
withSink ((Sink action -> JSM ()) -> Effect parent model action)
-> (Sink action -> JSM ()) -> Effect parent model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    body_ <- Image -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Image
imageBody
    FFI.fetch url "PUT" (Just body_) headers_
      (sink . successful)
      (sink . errorful)
      NONE
----------------------------------------------------------------------------
type Body = JSVal
----------------------------------------------------------------------------
accept :: MisoString
accept :: MisoString
accept = MisoString
"Accept"
----------------------------------------------------------------------------
contentType :: MisoString
contentType :: MisoString
contentType = MisoString
"Content-Type"
----------------------------------------------------------------------------
applicationJSON :: MisoString
applicationJSON :: MisoString
applicationJSON = MisoString
"application/json"
----------------------------------------------------------------------------
textPlain :: MisoString
textPlain :: MisoString
textPlain = MisoString
"text/plain"
----------------------------------------------------------------------------
octetStream :: MisoString
octetStream :: MisoString
octetStream = MisoString
"application/octect-stream"
----------------------------------------------------------------------------
formData :: MisoString
formData :: MisoString
formData = MisoString
"multipart/form-data"
----------------------------------------------------------------------------
biasHeaders :: Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders :: forall k a. Ord k => [(k, a)] -> [(k, a)] -> [(k, a)]
biasHeaders [(k, a)]
userDefined [(k, a)]
contentSpecific
  = Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList
  (Map k a -> [(k, a)]) -> Map k a -> [(k, a)]
forall a b. (a -> b) -> a -> b
$ [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, a)]
userDefined Map k a -> Map k a -> Map k a
forall a. Semigroup a => a -> a -> a
<> [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, a)]
contentSpecific
----------------------------------------------------------------------------