ResponseStream.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Fetch.ResponseStream
  ( request,
    forEach,
    single,
    ResponseStream,
    GQLClient,
    withHeaders,
  )
where

import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Morpheus.Client.Fetch (Args)
import Data.Morpheus.Client.Fetch.GQLClient
import Data.Morpheus.Client.Fetch.Http (httpRequest)
import Data.Morpheus.Client.Fetch.RequestType
  ( ClientTypeConstraint,
    Request (..),
    isSubscription,
  )
import Data.Morpheus.Client.Fetch.Types
import Data.Morpheus.Client.Fetch.WebSockets
  ( endSession,
    receiveResponse,
    responseStream,
    sendInitialRequest,
    sendRequest,
    useWS,
  )
import qualified Data.Text as T
import Relude hiding (ByteString)
import Text.URI (URI, mkURI)

parseURI :: (MonadFail m) => String -> m URI
parseURI url = maybe (fail ("Invalid Endpoint: " <> show url <> "!")) pure (mkURI (T.pack url))

requestSingle :: ResponseStream a -> IO (Either (FetchError a) a)
requestSingle ResponseStream {..}
  | isSubscription _req = useWS _uri _headers wsApp
  | otherwise = httpRequest _uri _req _headers
  where
    wsApp conn = do
      let sid = "0243134"
      sendInitialRequest conn
      sendRequest conn sid _req
      x <- receiveResponse conn
      endSession conn sid
      pure x

requestMany :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany f ResponseStream {..}
  | isSubscription _req = useWS _uri _headers appWS
  | otherwise = liftIO (httpRequest _uri _req _headers) >>= f
  where
    appWS conn = do
      let sid = "0243134"
      sendInitialRequest conn
      sendRequest conn sid _req
      traverse_ (>>= f) (responseStream conn)
      endSession conn sid

-- PUBLIC API
data ResponseStream a
  = (ClientTypeConstraint a) =>
  ResponseStream
  { _req :: Request a,
    _uri :: URI,
    _headers :: Headers
    -- _wsConnection :: Connection
  }

request :: (ClientTypeConstraint a, MonadFail m) => GQLClient -> Args a -> m (ResponseStream a)
request GQLClient {clientURI, clientHeaders} requestArgs = do
  _uri <- parseURI clientURI
  let _req = Request {requestArgs}
  pure ResponseStream {_req, _uri, _headers = clientHeaders}

-- | returns first response from the server
single :: (MonadIO m) => ResponseStream a -> m (GQLClientResult a)
single = liftIO . requestSingle

-- | returns loop listening subscription events forever. if you want to run it in background use `forkIO`
forEach :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach = requestMany