{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Database.Bolt.Connection.Type where
import Database.Bolt.Value.Type hiding (unpack)
import Control.DeepSeq (NFData(..), rwhnf)
import Control.Exception (Exception (..), SomeException, handle)
import Control.Monad.Trans (MonadTrans (..), MonadIO (..))
import Control.Monad.Reader (MonadReader (..), ReaderT)
import Control.Monad.Except (MonadError (..), ExceptT (..))
import Data.Default (Default (..))
import Data.Map.Strict (Map)
import Data.Monoid ()
import Data.Text (Text, unpack)
import Data.Word (Word16, Word32)
import GHC.Stack (HasCallStack, callStack, prettyCallStack)
import Network.Connection (Connection)
data ResponseError = KnownResponseFailure Text Text
| UnknownResponseFailure
deriving (ResponseError -> ResponseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseError -> ResponseError -> Bool
$c/= :: ResponseError -> ResponseError -> Bool
== :: ResponseError -> ResponseError -> Bool
$c== :: ResponseError -> ResponseError -> Bool
Eq, Eq ResponseError
ResponseError -> ResponseError -> Bool
ResponseError -> ResponseError -> Ordering
ResponseError -> ResponseError -> ResponseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResponseError -> ResponseError -> ResponseError
$cmin :: ResponseError -> ResponseError -> ResponseError
max :: ResponseError -> ResponseError -> ResponseError
$cmax :: ResponseError -> ResponseError -> ResponseError
>= :: ResponseError -> ResponseError -> Bool
$c>= :: ResponseError -> ResponseError -> Bool
> :: ResponseError -> ResponseError -> Bool
$c> :: ResponseError -> ResponseError -> Bool
<= :: ResponseError -> ResponseError -> Bool
$c<= :: ResponseError -> ResponseError -> Bool
< :: ResponseError -> ResponseError -> Bool
$c< :: ResponseError -> ResponseError -> Bool
compare :: ResponseError -> ResponseError -> Ordering
$ccompare :: ResponseError -> ResponseError -> Ordering
Ord)
instance Show ResponseError where
show :: ResponseError -> String
show (KnownResponseFailure Text
tpe Text
msg) = Text -> String
unpack Text
tpe forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
msg
show ResponseError
UnknownResponseFailure = String
"Unknown response error"
data BoltError = UnsupportedServerVersion
| AuthentificationFailed
| ResetFailed
| CannotReadChunk
| WrongMessageFormat UnpackError
| NoStructureInResponse
| ResponseError ResponseError
| RecordHasNoKey Text
| NonHasboltError SomeException
| HasCallStack => TimeOut
instance Show BoltError where
show :: BoltError -> String
show BoltError
UnsupportedServerVersion = String
"Cannot connect: unsupported server version"
show BoltError
AuthentificationFailed = String
"Cannot connect: authentification failed"
show BoltError
ResetFailed = String
"Cannot reset current pipe: recieved failure from server"
show BoltError
CannotReadChunk = String
"Cannot fetch: chunk read failed"
show (WrongMessageFormat UnpackError
msg) = String
"Cannot fetch: wrong message format (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show UnpackError
msg forall a. Semigroup a => a -> a -> a
<> String
")"
show BoltError
NoStructureInResponse = String
"Cannot fetch: no structure in response"
show (ResponseError ResponseError
re) = forall a. Show a => a -> String
show ResponseError
re
show (RecordHasNoKey Text
key) = String
"Cannot unpack record: key '" forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
key forall a. Semigroup a => a -> a -> a
<> String
"' is not presented"
show (NonHasboltError SomeException
msg) = String
"User error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SomeException
msg
show BoltError
TimeOut = String
"Operation timeout\n" forall a. Semigroup a => a -> a -> a
<> CallStack -> String
prettyCallStack HasCallStack => CallStack
callStack
instance Exception BoltError
newtype BoltActionT m a = BoltActionT { forall (m :: * -> *) a.
BoltActionT m a -> ReaderT Pipe (ExceptT BoltError m) a
runBoltActionT :: ReaderT Pipe (ExceptT BoltError m) a }
deriving (forall a b. a -> BoltActionT m b -> BoltActionT m a
forall a b. (a -> b) -> BoltActionT m a -> BoltActionT m b
forall (m :: * -> *) a b.
Functor m =>
a -> BoltActionT m b -> BoltActionT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BoltActionT m a -> BoltActionT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BoltActionT m b -> BoltActionT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> BoltActionT m b -> BoltActionT m a
fmap :: forall a b. (a -> b) -> BoltActionT m a -> BoltActionT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> BoltActionT m a -> BoltActionT m b
Functor, forall a. a -> BoltActionT m a
forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m a
forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m b
forall a b.
BoltActionT m (a -> b) -> BoltActionT m a -> BoltActionT m b
forall a b c.
(a -> b -> c)
-> BoltActionT m a -> BoltActionT m b -> BoltActionT m c
forall {m :: * -> *}. Monad m => Functor (BoltActionT m)
forall (m :: * -> *) a. Monad m => a -> BoltActionT m a
forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m a
forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m b
forall (m :: * -> *) a b.
Monad m =>
BoltActionT m (a -> b) -> BoltActionT m a -> BoltActionT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BoltActionT m a -> BoltActionT m b -> BoltActionT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m a
*> :: forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> BoltActionT m a -> BoltActionT m b -> BoltActionT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> BoltActionT m a -> BoltActionT m b -> BoltActionT m c
<*> :: forall a b.
BoltActionT m (a -> b) -> BoltActionT m a -> BoltActionT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
BoltActionT m (a -> b) -> BoltActionT m a -> BoltActionT m b
pure :: forall a. a -> BoltActionT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> BoltActionT m a
Applicative, forall a. a -> BoltActionT m a
forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m b
forall a b.
BoltActionT m a -> (a -> BoltActionT m b) -> BoltActionT m b
forall (m :: * -> *). Monad m => Applicative (BoltActionT m)
forall (m :: * -> *) a. Monad m => a -> BoltActionT m a
forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m b
forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> (a -> BoltActionT m b) -> BoltActionT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BoltActionT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BoltActionT m a
>> :: forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> BoltActionT m b -> BoltActionT m b
>>= :: forall a b.
BoltActionT m a -> (a -> BoltActionT m b) -> BoltActionT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
BoltActionT m a -> (a -> BoltActionT m b) -> BoltActionT m b
Monad, MonadError BoltError, MonadReader Pipe)
instance MonadTrans BoltActionT where
lift :: forall (m :: * -> *) a. Monad m => m a -> BoltActionT m a
lift = forall (m :: * -> *) a.
ReaderT Pipe (ExceptT BoltError m) a -> BoltActionT m a
BoltActionT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadIO m => MonadIO (BoltActionT m) where
liftIO :: forall a. IO a -> BoltActionT m a
liftIO = forall (m :: * -> *) a.
ReaderT Pipe (ExceptT BoltError m) a -> BoltActionT m a
BoltActionT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> BoltError
NonHasboltError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right
liftE :: Monad m => ExceptT BoltError m a -> BoltActionT m a
liftE :: forall (m :: * -> *) a.
Monad m =>
ExceptT BoltError m a -> BoltActionT m a
liftE = forall (m :: * -> *) a.
ReaderT Pipe (ExceptT BoltError m) a -> BoltActionT m a
BoltActionT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
data BoltCfg = BoltCfg { BoltCfg -> Word32
magic :: Word32
, BoltCfg -> Word32
version :: Word32
, BoltCfg -> Text
userAgent :: Text
, BoltCfg -> Word16
maxChunkSize :: Word16
, BoltCfg -> Int
socketTimeout :: Int
, BoltCfg -> String
host :: String
, BoltCfg -> Int
port :: Int
, BoltCfg -> Text
authType :: Text
, BoltCfg -> Text
user :: Text
, BoltCfg -> Text
password :: Text
, BoltCfg -> Bool
secure :: Bool
}
deriving (BoltCfg -> BoltCfg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoltCfg -> BoltCfg -> Bool
$c/= :: BoltCfg -> BoltCfg -> Bool
== :: BoltCfg -> BoltCfg -> Bool
$c== :: BoltCfg -> BoltCfg -> Bool
Eq, Int -> BoltCfg -> ShowS
[BoltCfg] -> ShowS
BoltCfg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoltCfg] -> ShowS
$cshowList :: [BoltCfg] -> ShowS
show :: BoltCfg -> String
$cshow :: BoltCfg -> String
showsPrec :: Int -> BoltCfg -> ShowS
$cshowsPrec :: Int -> BoltCfg -> ShowS
Show, ReadPrec [BoltCfg]
ReadPrec BoltCfg
Int -> ReadS BoltCfg
ReadS [BoltCfg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BoltCfg]
$creadListPrec :: ReadPrec [BoltCfg]
readPrec :: ReadPrec BoltCfg
$creadPrec :: ReadPrec BoltCfg
readList :: ReadS [BoltCfg]
$creadList :: ReadS [BoltCfg]
readsPrec :: Int -> ReadS BoltCfg
$creadsPrec :: Int -> ReadS BoltCfg
Read)
instance Default BoltCfg where
def :: BoltCfg
def = BoltCfg { magic :: Word32
magic = Word32
1616949271
, version :: Word32
version = Word32
3
, userAgent :: Text
userAgent = Text
"hasbolt/1.5"
, maxChunkSize :: Word16
maxChunkSize = Word16
65535
, socketTimeout :: Int
socketTimeout = Int
5
, host :: String
host = String
"127.0.0.1"
, port :: Int
port = Int
7687
, authType :: Text
authType = Text
"basic"
, user :: Text
user = Text
""
, password :: Text
password = Text
""
, secure :: Bool
secure = Bool
False
}
data ConnectionWithTimeout
= ConnectionWithTimeout
{ ConnectionWithTimeout -> Connection
cwtConnection :: !Connection
, ConnectionWithTimeout -> Int
cwtTimeoutUsec :: !Int
}
data Pipe = Pipe { Pipe -> ConnectionWithTimeout
connection :: ConnectionWithTimeout
, Pipe -> Word16
mcs :: Word16
, Pipe -> Word32
pipe_version :: Word32
}
instance NFData Pipe where
rnf :: Pipe -> ()
rnf = forall a. a -> ()
rwhnf
data AuthToken = AuthToken { AuthToken -> Text
scheme :: Text
, AuthToken -> Text
principal :: Text
, AuthToken -> Text
credentials :: Text
}
deriving (AuthToken -> AuthToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthToken -> AuthToken -> Bool
$c/= :: AuthToken -> AuthToken -> Bool
== :: AuthToken -> AuthToken -> Bool
$c== :: AuthToken -> AuthToken -> Bool
Eq, Int -> AuthToken -> ShowS
[AuthToken] -> ShowS
AuthToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthToken] -> ShowS
$cshowList :: [AuthToken] -> ShowS
show :: AuthToken -> String
$cshow :: AuthToken -> String
showsPrec :: Int -> AuthToken -> ShowS
$cshowsPrec :: Int -> AuthToken -> ShowS
Show)
data Response = ResponseSuccess { Response -> Map Text Value
succMap :: Map Text Value }
| ResponseRecord { Response -> [Value]
recsList :: [Value] }
| ResponseIgnored { Response -> Map Text Value
ignoreMap :: Map Text Value }
| ResponseFailure { Response -> Map Text Value
failMap :: Map Text Value }
deriving (Response -> Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)
data Request = RequestInit { Request -> Text
agent :: Text
, Request -> AuthToken
token :: AuthToken
, Request -> Bool
isHello :: Bool
}
| RequestRun { Request -> Text
statement :: Text
, Request -> Map Text Value
parameters :: Map Text Value
}
| RequestRunV3 { statement :: Text
, parameters :: Map Text Value
, :: Map Text Value
}
| RequestAckFailure
| RequestReset
| RequestDiscardAll
| RequestPullAll
| RequestGoodbye
deriving (Request -> Request -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)