From c36c4cf37737ba972482a34c8df2b61a541e7f0a Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Wed, 19 Feb 2025 17:05:11 +0100 Subject: add `acms query` --- backend/lib/ACMS/API/Fetch.hs | 63 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 backend/lib/ACMS/API/Fetch.hs (limited to 'backend/lib/ACMS/API/Fetch.hs') diff --git a/backend/lib/ACMS/API/Fetch.hs b/backend/lib/ACMS/API/Fetch.hs new file mode 100644 index 0000000..84330b1 --- /dev/null +++ b/backend/lib/ACMS/API/Fetch.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ACMS.API.Fetch + ( APIMonad(fetch), +#ifndef ghcjs_HOST_OS + Network.HTTP.Simple.Request, + Network.HTTP.Simple.setRequestMethod, + Network.HTTP.Simple.setRequestBodyLBS, +#else + JavaScript.Web.XMLHttpRequest.Request, + setRequestMethod, + setRequestBodyLBS, +#endif + ) +where + +#ifndef ghcjs_HOST_OS +import Network.HTTP.Simple +#else +import Data.ByteString.Lazy.UTF8 qualified as LB +import Data.Maybe +import Data.String +import JavaScript.Web.XMLHttpRequest +import Miso.String qualified as J +import Data.ByteString qualified as B +#endif +import Control.Monad.Catch (MonadThrow) +import Data.ByteString.Lazy.Char8 qualified as LB +import Miso (JSM) + +class (MonadThrow m) => APIMonad m where + fetch :: Request -> m LB.ByteString + +instance APIMonad JSM where + fetch req = LB.fromStrict . getResponseBody <$> httpBS req + +#ifdef ghcjs_HOST_OS +httpBS :: Request -> JSM (Response B.ByteString) +httpBS req = xhrByteString req + +instance IsString Request where + fromString uri = + Request + { reqMethod = GET, + reqURI = J.pack uri, + reqLogin = Nothing, + reqHeaders = [], + reqWithCredentials = False, + reqData = NoData + } + +setRequestMethod :: B.ByteString -> Request -> Request +setRequestMethod "POST" req = req {reqMethod = POST} + +setRequestBodyLBS :: LB.ByteString -> Request -> Request +setRequestBodyLBS body req = req {reqData = StringData (J.pack (LB.toString body))} + +getResponseBody :: Response B.ByteString -> B.ByteString +getResponseBody = fromMaybe "" . contents +#else +instance APIMonad IO where + fetch req = LB.fromStrict . getResponseBody <$> httpBS req +#endif -- cgit v1.2.3