{-# 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 :: forall (m :: * -> *). MonadFail m => String -> m URI
parseURI String
url = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Endpoint: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show String
url forall a. Semigroup a => a -> a -> a
<> String
"!")) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *). MonadThrow m => Text -> m URI
mkURI (String -> Text
T.pack String
url))
requestSingle :: ResponseStream a -> IO (Either (FetchError a) a)
requestSingle :: forall a. ResponseStream a -> IO (Either (FetchError a) a)
requestSingle ResponseStream {Headers
URI
Request a
_headers :: forall a. ResponseStream a -> Headers
_uri :: forall a. ResponseStream a -> URI
_req :: forall a. ResponseStream a -> Request a
_headers :: Headers
_uri :: URI
_req :: Request a
..}
| forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = forall (m :: * -> *) a.
(MonadFail m, MonadIO m, MonadUnliftIO m) =>
URI -> Headers -> (Connection -> m a) -> m a
useWS URI
_uri Headers
_headers forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
wsApp
| Bool
otherwise = forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
_uri Request a
_req Headers
_headers
where
wsApp :: Connection -> m (GQLClientResult a)
wsApp Connection
conn = do
let sid :: Text
sid = Text
"0243134"
forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
forall a (m :: * -> *).
(RequestType a, ToJSON (RequestArgs a), MonadIO m) =>
Connection -> Text -> Request a -> m ()
sendRequest Connection
conn Text
sid Request a
_req
GQLClientResult a
x <- forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
receiveResponse Connection
conn
forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid
forall (f :: * -> *) a. Applicative f => a -> f a
pure GQLClientResult a
x
requestMany :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany GQLClientResult a -> m ()
f ResponseStream {Headers
URI
Request a
_headers :: Headers
_uri :: URI
_req :: Request a
_headers :: forall a. ResponseStream a -> Headers
_uri :: forall a. ResponseStream a -> URI
_req :: forall a. ResponseStream a -> Request a
..}
| forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = forall (m :: * -> *) a.
(MonadFail m, MonadIO m, MonadUnliftIO m) =>
URI -> Headers -> (Connection -> m a) -> m a
useWS URI
_uri Headers
_headers Connection -> m ()
appWS
| Bool
otherwise = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
_uri Request a
_req Headers
_headers) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLClientResult a -> m ()
f
where
appWS :: Connection -> m ()
appWS Connection
conn = do
let sid :: Text
sid = Text
"0243134"
forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
forall a (m :: * -> *).
(RequestType a, ToJSON (RequestArgs a), MonadIO m) =>
Connection -> Text -> Request a -> m ()
sendRequest Connection
conn Text
sid Request a
_req
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLClientResult a -> m ()
f) (forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Connection -> [m (GQLClientResult a)]
responseStream Connection
conn)
forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid
data ResponseStream a = ClientTypeConstraint a =>
ResponseStream
{ forall a. ResponseStream a -> Request a
_req :: Request a,
forall a. ResponseStream a -> URI
_uri :: URI,
:: Headers
}
request :: (ClientTypeConstraint a, MonadFail m) => GQLClient -> Args a -> m (ResponseStream a)
request :: forall a (m :: * -> *).
(ClientTypeConstraint a, MonadFail m) =>
GQLClient -> Args a -> m (ResponseStream a)
request GQLClient {String
clientURI :: GQLClient -> String
clientURI :: String
clientURI, Headers
clientHeaders :: GQLClient -> Headers
clientHeaders :: Headers
clientHeaders} Args a
requestArgs = do
URI
_uri <- forall (m :: * -> *). MonadFail m => String -> m URI
parseURI String
clientURI
let _req :: Request a
_req = Request {Args a
requestArgs :: RequestArgs a
requestArgs :: Args a
requestArgs}
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseStream {Request a
_req :: Request a
_req :: Request a
_req, URI
_uri :: URI
_uri :: URI
_uri, _headers :: Headers
_headers = Headers
clientHeaders}
single :: MonadIO m => ResponseStream a -> m (GQLClientResult a)
single :: forall (m :: * -> *) a.
MonadIO m =>
ResponseStream a -> m (GQLClientResult a)
single = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ResponseStream a -> IO (Either (FetchError a) a)
requestSingle
forEach :: (MonadIO m, MonadUnliftIO m, MonadFail m) => (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach = forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany