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 -> [Char] -> Int -> RequestBody -> IO (Maybe Value)
apiRequest Manager
m [Char]
u Int
p RequestBody
b = do
  Request
r <- [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest [Char]
u IO Request -> (Request -> IO Request) -> IO Request
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
c ->
         Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
c { method = "POST", port = p, requestBody = b }
  Either SomeException (Response ByteString)
t <- IO (Either SomeException (Response ByteString))
-> IO (Either SomeException (Response ByteString))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) e a.
(HasCallStack, 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 a. a -> IO a
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 a. a -> IO a
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 [Key
"error" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Char] -> Text
T.pack (SomeException -> [Char]
forall a. Show a => a -> [Char]
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 :: [Char] -> APIVersion -> [Char]
urlBase [Char]
s APIVersion
a = [Char]
"http://" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/api/v" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ APIVersion -> [Char]
forall a. Show a => a -> [Char]
show APIVersion
a