add `acms query`

1 files changed, 63 insertions, 0 deletions

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