{-# 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 = m URI -> (URI -> m URI) -> Maybe URI -> m URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m URI
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Endpoint: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall b a. (Show a, IsString b) => a -> b
show String
url String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"!")) URI -> m URI
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe URI
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
_req :: Request a
_uri :: URI
_headers :: Headers
_req :: forall a. ResponseStream a -> Request a
_uri :: forall a. ResponseStream a -> URI
_headers :: forall a. ResponseStream a -> Headers
..}
  | Request a -> Bool
forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = URI
-> Headers
-> (Connection -> IO (Either (FetchError a) a))
-> IO (Either (FetchError a) a)
forall (m :: * -> *) a.
(MonadFail m, MonadIO m, MonadUnliftIO m) =>
URI -> Headers -> (Connection -> m a) -> m a
useWS URI
_uri Headers
_headers Connection -> IO (Either (FetchError a) a)
forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
wsApp
  | Bool
otherwise = URI -> Request a -> Headers -> IO (Either (FetchError a) a)
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"
      Connection -> m ()
forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
      Connection -> Text -> Request a -> m ()
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 <- Connection -> m (GQLClientResult a)
forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
Connection -> m (GQLClientResult a)
receiveResponse Connection
conn
      Connection -> Text -> m ()
forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid
      GQLClientResult a -> m (GQLClientResult a)
forall a. a -> m a
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
_req :: forall a. ResponseStream a -> Request a
_uri :: forall a. ResponseStream a -> URI
_headers :: forall a. ResponseStream a -> Headers
_req :: Request a
_uri :: URI
_headers :: Headers
..}
  | Request a -> Bool
forall a. RequestType a => Request a -> Bool
isSubscription Request a
_req = URI -> Headers -> (Connection -> m ()) -> m ()
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 = IO (GQLClientResult a) -> m (GQLClientResult a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (URI -> Request a -> Headers -> IO (GQLClientResult a)
forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
_uri Request a
_req Headers
_headers) m (GQLClientResult a) -> (GQLClientResult a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
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"
      Connection -> m ()
forall (m :: * -> *). MonadIO m => Connection -> m ()
sendInitialRequest Connection
conn
      Connection -> Text -> Request a -> m ()
forall a (m :: * -> *).
(RequestType a, ToJSON (RequestArgs a), MonadIO m) =>
Connection -> Text -> Request a -> m ()
sendRequest Connection
conn Text
sid Request a
_req
      (m (GQLClientResult a) -> m ()) -> [m (GQLClientResult a)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (m (GQLClientResult a) -> (GQLClientResult a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GQLClientResult a -> m ()
f) (Connection -> [m (GQLClientResult a)]
forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Connection -> [m (GQLClientResult a)]
responseStream Connection
conn)
      Connection -> Text -> m ()
forall (m :: * -> *). MonadIO m => Connection -> Text -> m ()
endSession Connection
conn Text
sid

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

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 :: String
clientURI :: GQLClient -> String
clientURI, Headers
clientHeaders :: Headers
clientHeaders :: GQLClient -> Headers
clientHeaders} Args a
requestArgs = do
  URI
_uri <- String -> m URI
forall (m :: * -> *). MonadFail m => String -> m URI
parseURI String
clientURI
  let _req :: Request a
_req = Request {RequestArgs a
Args a
requestArgs :: Args a
requestArgs :: RequestArgs a
requestArgs}
  ResponseStream a -> m (ResponseStream a)
forall a. a -> m a
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}

-- | returns first response from the server
single :: MonadIO m => ResponseStream a -> m (GQLClientResult a)
single :: forall (m :: * -> *) a.
MonadIO m =>
ResponseStream a -> m (GQLClientResult a)
single = IO (GQLClientResult a) -> m (GQLClientResult a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GQLClientResult a) -> m (GQLClientResult a))
-> (ResponseStream a -> IO (GQLClientResult a))
-> ResponseStream a
-> m (GQLClientResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseStream a -> IO (GQLClientResult a)
forall a. ResponseStream a -> IO (Either (FetchError a) a)
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 :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forEach = (GQLClientResult a -> m ()) -> ResponseStream a -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadFail m) =>
(GQLClientResult a -> m ()) -> ResponseStream a -> m ()
requestMany