{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards  #-}

module Database.Cayley.Client (

      Quad (..)

    -- * Connection
    , defaultCayleyConfig
    , connectCayley

    -- * Operations
    , query
    , Shape
    , queryShape
    , write
    , writeQuad
    , writeQuads
    , writeNQuadFile
    , delete
    , deleteQuad
    , deleteQuads

    -- * Utils
    , createQuad
    , isValid
    , results

    ) where

import           Control.Applicative                   ((<|>))
import           Control.Lens.Fold                     ((^?))
import           Control.Monad.Catch
import           Control.Monad.Reader
import qualified Data.Aeson                            as A
import qualified Data.Aeson.Lens                       as L
import qualified Data.Attoparsec.Text                  as APT
import qualified Data.Text                             as T
import           Data.Text.Encoding                    (encodeUtf8)
import           Network.HTTP.Client
import           Network.HTTP.Client.MultipartFormData

import           Database.Cayley.Client.Internal
import           Database.Cayley.Types

-- | Get a connection to Cayley with the given configuration.
--
-- >λ> conn <- connectCayley defaultCayleyConfig
--
connectCayley :: CayleyConfig -> IO CayleyConnection
connectCayley :: CayleyConfig -> IO CayleyConnection
connectCayley CayleyConfig
c =
  ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
    IO Manager
-> (Manager -> IO CayleyConnection) -> IO CayleyConnection
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Manager
m -> CayleyConnection -> IO CayleyConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CayleyConnection -> IO CayleyConnection)
-> CayleyConnection -> IO CayleyConnection
forall a b. (a -> b) -> a -> b
$ CayleyConnection { cayleyConfig :: CayleyConfig
cayleyConfig = CayleyConfig
c, manager :: Manager
manager = Manager
m }

-- | Perform a query, in Gremlin graph query language per default (or in MQL).
--
-- >λ> query conn "graph.Vertex('Humphrey Bogart').In('name').All()"
-- >Right (Array (fromList [Object (fromList [("id",String "/en/humphrey_bogart")])]))
--
query :: CayleyConnection
      -> Query
      -> IO (Either String A.Value)
query :: CayleyConnection -> Text -> IO (Either String Value)
query CayleyConnection{Manager
CayleyConfig
cayleyConfig :: CayleyConnection -> CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConfig
manager :: Manager
..} =
  Manager -> CayleyConfig -> Text -> IO (Either String Value)
doQuery Manager
manager CayleyConfig
cayleyConfig
  where
    doQuery :: Manager -> CayleyConfig -> Text -> IO (Either String Value)
doQuery Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
serverPort :: Int
serverName :: String
apiVersion :: APIVersion
queryLang :: QueryLang
serverPort :: CayleyConfig -> Int
serverName :: CayleyConfig -> String
apiVersion :: CayleyConfig -> APIVersion
queryLang :: CayleyConfig -> QueryLang
..} Text
q = do
      Maybe Value
r <- Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
             Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion
               String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/query/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QueryLang -> String
forall a. Show a => a -> String
show QueryLang
queryLang)
             Int
serverPort (ByteString -> RequestBody
RequestBodyBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
q)
      Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$
        case Maybe Value
r of
          Just Value
a  ->
            case Value
a Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
L.key Key
"result" of
              Just Value
v  -> Value -> Either String Value
forall a b. b -> Either a b
Right Value
v
              Maybe Value
Nothing ->
                case Value
a Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
L.key Key
"error" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
L._String of
                  Just Text
e  -> String -> Either String Value
forall a b. a -> Either a b
Left (Text -> String
forall a. Show a => a -> String
show Text
e)
                  Maybe Text
Nothing -> String -> Either String Value
forall a b. a -> Either a b
Left String
"No JSON response from Cayley server"
          Maybe Value
Nothing -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Can't get any response from Cayley server"

-- | Return the description of the given executed query.
queryShape :: CayleyConnection
           -> Query
           -> IO (Either String Shape)
queryShape :: CayleyConnection -> Text -> IO (Either String Shape)
queryShape CayleyConnection{Manager
CayleyConfig
cayleyConfig :: CayleyConnection -> CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConfig
manager :: Manager
..} =
  Manager -> CayleyConfig -> Text -> IO (Either String Shape)
forall {b}.
FromJSON b =>
Manager -> CayleyConfig -> Text -> IO (Either String b)
doShape Manager
manager CayleyConfig
cayleyConfig
  where
    doShape :: Manager -> CayleyConfig -> Text -> IO (Either String b)
doShape Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
serverPort :: CayleyConfig -> Int
serverName :: CayleyConfig -> String
apiVersion :: CayleyConfig -> APIVersion
queryLang :: CayleyConfig -> QueryLang
serverPort :: Int
serverName :: String
apiVersion :: APIVersion
queryLang :: QueryLang
..} Text
q = do
      Maybe Value
r <- Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
             Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/shape/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ QueryLang -> String
forall a. Show a => a -> String
show QueryLang
queryLang)
             Int
serverPort (ByteString -> RequestBody
RequestBodyBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
q)
      Either String b -> IO (Either String b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$
        case Maybe Value
r of
          Just Value
o  ->
            case Value -> Result b
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
o of
              A.Success b
s -> b -> Either String b
forall a b. b -> Either a b
Right b
s
              A.Error String
e   -> String -> Either String b
forall a b. a -> Either a b
Left (String
"Not a shape (\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\")")
          Maybe Value
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left String
"API request error"

-- | Write a 'Quad' with the given subject, predicate, object and optional
-- label. Throw result or extract amount of query 'results'
-- from it.
--
-- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love")
-- >Just (Object (fromList [("result",String "Successfully wrote 1 quads.")]))
--
writeQuad :: CayleyConnection
          -> Subject
          -> Predicate
          -> Object
          -> Maybe Label
          -> IO (Maybe A.Value)
writeQuad :: CayleyConnection
-> Text -> Text -> Text -> Maybe Text -> IO (Maybe Value)
writeQuad CayleyConnection
c Text
s Text
p Text
o Maybe Text
l =
  CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection
c [Quad { subject :: Text
subject = Text
s, predicate :: Text
predicate = Text
p, object :: Text
object = Text
o, label :: Maybe Text
label = Maybe Text
l }]

-- | Write the given 'Quad'.
write :: CayleyConnection
      -> Quad
      -> IO (Maybe A.Value)
write :: CayleyConnection -> Quad -> IO (Maybe Value)
write CayleyConnection
c Quad
q = CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection
c [Quad
q]

-- | Delete the 'Quad' defined by the given subject, predicate, object
-- and optional label.
deleteQuad :: CayleyConnection
           -> Subject
           -> Predicate
           -> Object
           -> Maybe Label
           -> IO (Maybe A.Value)
deleteQuad :: CayleyConnection
-> Text -> Text -> Text -> Maybe Text -> IO (Maybe Value)
deleteQuad CayleyConnection
c Text
s Text
p Text
o Maybe Text
l =
  CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection
c [Quad { subject :: Text
subject = Text
s, predicate :: Text
predicate = Text
p, object :: Text
object = Text
o, label :: Maybe Text
label = Maybe Text
l }]

-- | Delete the given 'Quad'.
delete :: CayleyConnection -> Quad -> IO (Maybe A.Value)
delete :: CayleyConnection -> Quad -> IO (Maybe Value)
delete CayleyConnection
c Quad
q = CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection
c [Quad
q]

-- | Write the given list of 'Quad'(s).
writeQuads :: CayleyConnection
           -> [Quad]
           -> IO (Maybe A.Value)
writeQuads :: CayleyConnection -> [Quad] -> IO (Maybe Value)
writeQuads CayleyConnection{Manager
CayleyConfig
cayleyConfig :: CayleyConnection -> CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConfig
manager :: Manager
..} =
  Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
writeQuads' Manager
manager CayleyConfig
cayleyConfig
  where
    writeQuads' :: Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
writeQuads' Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
serverPort :: CayleyConfig -> Int
serverName :: CayleyConfig -> String
apiVersion :: CayleyConfig -> APIVersion
queryLang :: CayleyConfig -> QueryLang
serverPort :: Int
serverName :: String
apiVersion :: APIVersion
queryLang :: QueryLang
..} [Quad]
qs =
      Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
        Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/write")
        Int
serverPort ([Quad] -> RequestBody
toRequestBody [Quad]
qs)

-- | Delete the given list of 'Quad'(s).
deleteQuads :: CayleyConnection
            -> [Quad]
            -> IO (Maybe A.Value)
deleteQuads :: CayleyConnection -> [Quad] -> IO (Maybe Value)
deleteQuads CayleyConnection{Manager
CayleyConfig
cayleyConfig :: CayleyConnection -> CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConfig
manager :: Manager
..} =
  Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
doDeletions Manager
manager CayleyConfig
cayleyConfig
  where
    doDeletions :: Manager -> CayleyConfig -> [Quad] -> IO (Maybe Value)
doDeletions Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
serverPort :: CayleyConfig -> Int
serverName :: CayleyConfig -> String
apiVersion :: CayleyConfig -> APIVersion
queryLang :: CayleyConfig -> QueryLang
serverPort :: Int
serverName :: String
apiVersion :: APIVersion
queryLang :: QueryLang
..} [Quad]
qs =
      Manager -> String -> Int -> RequestBody -> IO (Maybe Value)
apiRequest
        Manager
m (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/delete")
        Int
serverPort ([Quad] -> RequestBody
toRequestBody [Quad]
qs)

-- | Write a N-Quad file.
--
-- >λ> writeNQuadFile conn "testdata.nq"
-- >Just (Object (fromList [("result",String "Successfully wrote 11 quads.")]))
--
writeNQuadFile :: (MonadThrow m, MonadIO m)
               => CayleyConnection
               -> FilePath
               -> m (Maybe A.Value)
writeNQuadFile :: forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
CayleyConnection -> String -> m (Maybe Value)
writeNQuadFile CayleyConnection{Manager
CayleyConfig
cayleyConfig :: CayleyConnection -> CayleyConfig
manager :: CayleyConnection -> Manager
cayleyConfig :: CayleyConfig
manager :: Manager
..} =
  Manager -> CayleyConfig -> String -> m (Maybe Value)
forall {m :: * -> *}.
(MonadIO m, MonadThrow m) =>
Manager -> CayleyConfig -> String -> m (Maybe Value)
doWrite Manager
manager CayleyConfig
cayleyConfig
  where
    doWrite :: Manager -> CayleyConfig -> String -> m (Maybe Value)
doWrite Manager
m CayleyConfig{Int
String
QueryLang
APIVersion
serverPort :: CayleyConfig -> Int
serverName :: CayleyConfig -> String
apiVersion :: CayleyConfig -> APIVersion
queryLang :: CayleyConfig -> QueryLang
serverPort :: Int
serverName :: String
apiVersion :: APIVersion
queryLang :: QueryLang
..} String
fp = do
      Request
r <- String -> m Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> APIVersion -> String
urlBase String
serverName APIVersion
apiVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/write/file/nquad")
             m Request -> (Request -> m Request) -> m Request
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
r -> Request -> m Request
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
r { port = serverPort }
      Either SomeException (Response ByteString)
t <- IO (Either SomeException (Response ByteString))
-> m (Either SomeException (Response ByteString))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Response ByteString))
 -> m (Either SomeException (Response ByteString)))
-> IO (Either SomeException (Response ByteString))
-> m (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$
             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))
-> Manager -> Request -> IO (Response ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Request -> Manager -> IO (Response ByteString)
httpLbs Manager
m
                 (Request -> IO (Response ByteString))
-> IO Request -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Part] -> Request -> IO Request
forall (m :: * -> *). MonadIO m => [Part] -> Request -> m Request
formDataBody [Text -> String -> Part
partFileSource Text
"NQuadFile" String
fp] Request
r
      Maybe Value -> m (Maybe Value)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$
        case Either SomeException (Response ByteString)
t of
          Right Response ByteString
b -> ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
b)
          Left SomeException
e  -> 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..= String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException))]

-- | A valid 'Quad' has its subject, predicate and object not empty.
isValid :: Quad -> Bool
isValid :: Quad -> Bool
isValid Quad{Maybe Text
Text
subject :: Quad -> Text
predicate :: Quad -> Text
object :: Quad -> Text
label :: Quad -> Maybe Text
subject :: Text
predicate :: Text
object :: Text
label :: Maybe Text
..} = Text
T.empty Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
subject, Text
predicate, Text
object]

-- | Given a subject, a predicate, an object and an optional label,
-- create a valid 'Quad'.
createQuad :: Subject
           -> Predicate
           -> Object
           -> Maybe Label
           -> Maybe Quad
createQuad :: Text -> Text -> Text -> Maybe Text -> Maybe Quad
createQuad Text
s Text
p Text
o Maybe Text
l =
  if Text
T.empty Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
s,Text
p,Text
o]
    then Quad -> Maybe Quad
forall a. a -> Maybe a
Just Quad { subject :: Text
subject = Text
s, predicate :: Text
predicate = Text
p, object :: Text
object = Text
o, label :: Maybe Text
label = Maybe Text
l }
    else Maybe Quad
forall a. Maybe a
Nothing

-- | Get amount of results from a write/delete 'Quad'(s) operation,
-- or an explicite error message.
--
-- >λ> writeNQuadFile conn "testdata.nq" >>= results
-- >Right 11
--
results :: Maybe A.Value
        -> IO (Either String Int)
results :: Maybe Value -> IO (Either String Int)
results Maybe Value
m = Either String Int -> IO (Either String Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Int -> IO (Either String Int))
-> Either String Int -> IO (Either String Int)
forall a b. (a -> b) -> a -> b
$
  case Maybe Value
m of
    Just Value
v ->
      case Value
v Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
L.key Key
"result" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
L._String of
        Just Text
r  ->
          case Parser Int -> Text -> Result Int
forall a. Parser a -> Text -> Result a
APT.parse Parser Int
getAmount Text
r of
            APT.Done Text
"" Int
i -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
i
            Result Int
_             -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Can't get amount of results"
        Maybe Text
Nothing ->
          case Value
v Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
L.key Key
"error" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
L._String of
            Just Text
e  -> String -> Either String Int
forall a b. a -> Either a b
Left (Text -> String
forall a. Show a => a -> String
show Text
e)
            Maybe Text
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"No JSON response from Cayley server"
    Maybe Value
Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Can't get any response from Cayley server"
  where
  getAmount :: Parser Int
getAmount = do
      Text
_ <- Text -> Parser Text
APT.string Text
"Successfully "
      Text
_ <- Text -> Parser Text
APT.string Text
"deleted " Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
APT.string Text
"wrote "
      Int
a <- Parser Int
forall a. Integral a => Parser a
APT.decimal
      Text
_ <- Text -> Parser Text
APT.string Text
" quads."
      Int -> Parser Int
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
a