{-# LANGUAGE OverloadedStrings #-} module Database.Cayley.Client.Internal where import Control.Monad.Catch import Control.Monad.IO.Class import qualified Data.Aeson as A import qualified Data.Text as T (pack) import Data.Vector (fromList) import Network.HTTP.Client import Database.Cayley.Types apiRequest :: Manager -> String -> Int -> RequestBody -> IO (Maybe A.Value) apiRequest :: Manager -> String -> Int -> RequestBody -> IO (Maybe Value) apiRequest Manager m String u Int p RequestBody b = do Request r <- String -> IO Request forall (m :: * -> *). MonadThrow m => String -> m Request parseRequest String u IO Request -> (Request -> IO Request) -> IO Request forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Request c -> Request -> IO Request forall (m :: * -> *) a. Monad m => a -> m a return Request c { method :: Method method = Method "POST", port :: Int port = Int p, requestBody :: RequestBody requestBody = RequestBody b } Either SomeException (Response ByteString) t <- IO (Either SomeException (Response ByteString)) -> IO (Either SomeException (Response ByteString)) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Response ByteString) -> IO (Either SomeException (Response ByteString)) forall (m :: * -> *) e a. (MonadCatch m, Exception e) => m a -> m (Either e a) try (IO (Response ByteString) -> IO (Either SomeException (Response ByteString))) -> IO (Response ByteString) -> IO (Either SomeException (Response ByteString)) forall a b. (a -> b) -> a -> b $ Request -> Manager -> IO (Response ByteString) httpLbs Request r Manager m) case Either SomeException (Response ByteString) t of Right Response ByteString r' -> Maybe Value -> IO (Maybe Value) forall (m :: * -> *) a. Monad m => a -> m a return (ByteString -> Maybe Value forall a. FromJSON a => ByteString -> Maybe a A.decode (ByteString -> Maybe Value) -> ByteString -> Maybe Value forall a b. (a -> b) -> a -> b $ Response ByteString -> ByteString forall body. Response body -> body responseBody Response ByteString r') Left SomeException e -> Maybe Value -> IO (Maybe Value) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Value -> IO (Maybe Value)) -> Maybe Value -> IO (Maybe Value) forall a b. (a -> b) -> a -> b $ Value -> Maybe Value forall a. a -> Maybe a Just (Value -> Maybe Value) -> Value -> Maybe Value forall a b. (a -> b) -> a -> b $ [Pair] -> Value A.object [Text "error" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv A..= String -> Text T.pack (SomeException -> String forall a. Show a => a -> String show (SomeException e :: SomeException))] toRequestBody :: [Quad] -> RequestBody toRequestBody :: [Quad] -> RequestBody toRequestBody = ByteString -> RequestBody RequestBodyLBS (ByteString -> RequestBody) -> ([Quad] -> ByteString) -> [Quad] -> RequestBody forall b c a. (b -> c) -> (a -> b) -> a -> c . Vector Value -> ByteString forall a. ToJSON a => a -> ByteString A.encode (Vector Value -> ByteString) -> ([Quad] -> Vector Value) -> [Quad] -> ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . [Value] -> Vector Value forall a. [a] -> Vector a fromList ([Value] -> Vector Value) -> ([Quad] -> [Value]) -> [Quad] -> Vector Value forall b c a. (b -> c) -> (a -> b) -> a -> c . (Quad -> Value) -> [Quad] -> [Value] forall a b. (a -> b) -> [a] -> [b] map Quad -> Value forall a. ToJSON a => a -> Value A.toJSON urlBase :: String -> APIVersion -> String urlBase :: String -> APIVersion -> String urlBase String s APIVersion a = String "http://" String -> String -> String forall a. [a] -> [a] -> [a] ++ String s String -> String -> String forall a. [a] -> [a] -> [a] ++ String "/api/v" String -> String -> String forall a. [a] -> [a] -> [a] ++ APIVersion -> String forall a. Show a => a -> String show APIVersion a