hasbolt 0.1.4.5 → 0.1.5.0

raw patch · 6 files changed

+76/−37 lines, 6 filesdep ~hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• hasbolt.cabal +7/−3
• src/Database/Bolt/Connection.hs +15/−12
• src/Database/Bolt/Connection/Instances.hs +14/−7
• src/Database/Bolt/Connection/Pipe.hs +12/−2
• src/Database/Bolt/Connection/Type.hs +21/−12
• src/Database/Bolt/Value/Helpers.hs +7/−1

@@ -1,6 +1,6 @@ cabal-version: >=1.10 name:          hasbolt-version:       0.1.4.5+version:       0.1.5.0 license:       BSD3 license-file:  LICENSE copyright:     (c) 2018 Pavel Yakovlev@@ -19,11 +19,15 @@     .     -Cypher queries and responses     .+    -Transactions and error handling+    .     -Authentification     .     -TLS/SSL connection     .-    The code was tested with neo4j versions 3.0 — 3.4 and GrapheneDB service+    -Bolt protocol version 3 initial support+    .+    The code was tested with neo4j versions 3.0 — 3.5 and GrapheneDB service  category:      Database build-type:    Simple@@ -82,7 +86,7 @@     build-depends:         base >=4.8 && <5,         hasbolt -any,-        hspec >=2.4.1 && <2.8,+        hspec >=2.4.1 && <2.9,         QuickCheck >=2.9 && <2.15,         text >=1.2.4.1 && <1.3,         containers >=0.6.2.1 && <0.7,

@@ -15,6 +15,7 @@ import           Database.Bolt.Connection.Pipe import           Database.Bolt.Connection.Instances import           Database.Bolt.Connection.Type+import           Database.Bolt.Value.Helpers import           Database.Bolt.Value.Type import           Database.Bolt.Record @@ -58,7 +59,7 @@  -- |Runs Cypher query with parameters and ignores response queryP_ :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m ()-queryP_ cypher params = do void $ sendRequest cypher params+queryP_ cypher params = do void $ sendRequest cypher params empty                            ask >>= liftE . discardAll  -- |Runs Cypher query and ignores response@@ -68,14 +69,14 @@ -- Helper functions  querySL :: MonadIO m => HasCallStack => Bool -> Text -> Map Text Value -> BoltActionT m [Record]-querySL strict cypher params = do keys <- pullKeys cypher params+querySL strict cypher params = do keys <- pullKeys cypher params empty                                   pullRecords strict keys -pullKeys :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m [Text]-pullKeys cypher params = do pipe <- ask-                            status <- sendRequest cypher params-                            liftE $ flush pipe RequestPullAll-                            mkKeys status+pullKeys :: MonadIO m => HasCallStack => Text -> Map Text Value -> Map Text Value -> BoltActionT m [Text]+pullKeys cypher params ext = do pipe <- ask+                                status <- sendRequest cypher params ext+                                liftE $ flush pipe RequestPullAll+                                mkKeys status   where     mkKeys :: MonadIO m => Response -> BoltActionT m [Text]     mkKeys (ResponseSuccess response) = response `at` "fields" `catchError` \(RecordHasNoKey _) -> pure []@@ -88,7 +89,7 @@   where     cases :: MonadIO m => Response -> BoltActionT m [Record]     cases resp | isSuccess resp = pure []-               | isFailure resp = do ask >>= ackFailure+               | isFailure resp = do ask >>= processError                                      throwError $ ResponseError (mkFailure resp)                | otherwise      = parseRecord resp @@ -102,13 +103,15 @@         pure (record:rest)  -- |Sends request to database and makes an action-sendRequest :: MonadIO m => HasCallStack => Text -> Map Text Value -> BoltActionT m Response-sendRequest cypher params =+sendRequest :: MonadIO m => HasCallStack => Text -> Map Text Value -> Map Text Value -> BoltActionT m Response+sendRequest cypher params ext =   do pipe <- ask      liftE $ do-         flush pipe $ RequestRun cypher params+         if isNewVersion (pipe_version pipe)+            then flush pipe $ RequestRunV3 cypher params ext+            else flush pipe $ RequestRun cypher params          status <- fetch pipe          if isSuccess status            then pure status-           else do ackFailure pipe+           else do processError pipe                    throwError $ ResponseError (mkFailure status)

@@ -10,16 +10,19 @@ import           Database.Bolt.Value.Type  import           Control.Monad.Except           (MonadError (..))-import           Data.Map.Strict                (Map, fromList, empty, (!))+import           Data.Map.Strict                (Map, insert, fromList, empty, (!)) import           Data.Text                      (Text)  instance ToStructure Request where-  toStructure RequestInit{..} = Structure sigInit [T agent, M $ tokenMap token]-  toStructure RequestRun{..}  = Structure sigRun [T statement, M parameters]+  toStructure RequestInit{..}           = Structure sigInit $ if isHello then [M $ helloMap agent token]+                                                                         else [T agent, M $ tokenMap token]+  toStructure RequestRun{..}            = Structure sigRun [T statement, M parameters]+  toStructure RequestRunV3{..}          = Structure sigRun [T statement, M parameters, M extra]   toStructure RequestReset              = Structure sigReset []   toStructure RequestAckFailure         = Structure sigAFail []   toStructure RequestPullAll            = Structure sigPAll []   toStructure RequestDiscardAll         = Structure sigDAll []+  toStructure RequestGoodbye            = Structure sigGBye []  instance FromStructure Response where   fromStructure Structure{..}@@ -54,19 +57,23 @@  createInit :: BoltCfg -> Request createInit BoltCfg{..} = RequestInit userAgent-                                     AuthToken { scheme      = "basic"+                                     AuthToken { scheme      = authType                                                , principal   = user                                                , credentials = password                                                }+                                     (isNewVersion version)  createRun :: Text -> Request createRun stmt = RequestRun stmt empty  +helloMap :: Text -> AuthToken  -> Map Text Value +helloMap a = insert "user_agent" (T a) . tokenMap+ tokenMap :: AuthToken -> Map Text Value-tokenMap at = fromList [ ("scheme",      T $ scheme at)-                       , ("principal",   T $ principal at)-                       , ("credentials", T $ credentials at)+tokenMap at = fromList [ "scheme"     =: scheme at+                       , "principal"   =: principal at+                       , "credentials" =: credentials at                        ]  extractMap :: MonadError UnpackError m => Value -> m (Map Text Value)

@@ -1,9 +1,11 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-} module Database.Bolt.Connection.Pipe where  import           Database.Bolt.Connection.Instances import           Database.Bolt.Connection.Type+import           Database.Bolt.Value.Helpers import           Database.Bolt.Value.Instances import           Database.Bolt.Value.Type import qualified Database.Bolt.Connection.Connection as C (close, connect, recv,@@ -27,13 +29,15 @@   where     connect' :: MonadPipe m => BoltCfg -> m Pipe     connect' bcfg = do conn <- C.connect (secure bcfg) (host bcfg) (fromIntegral $ port bcfg) (socketTimeout bcfg)-                       let pipe = Pipe conn (maxChunkSize bcfg)+                       let pipe = Pipe conn (maxChunkSize bcfg) (version bcfg)                        handshake pipe bcfg                        pure pipe  -- |Closes 'Pipe' close :: MonadIO m => HasCallStack => Pipe -> m ()-close = C.close . connection+close pipe = do liftIO $ print "Closed"+                when (isNewVersion $ pipe_version pipe) $ makeIO (`flush` RequestGoodbye) pipe+                C.close $ connection pipe  -- |Resets current sessions reset :: MonadIO m => HasCallStack => Pipe -> m ()@@ -53,6 +57,12 @@                          Left  e -> liftIO $ throwIO e  -- = Internal interfaces++-- |Processes error via ackFailure or reset+processError :: MonadIO m => HasCallStack => Pipe -> m ()+processError pipe@Pipe{..} = if isNewVersion pipe_version+                               then reset pipe+                               else makeIO ackFailure pipe  ackFailure :: MonadPipe m => HasCallStack => Pipe -> m () ackFailure pipe = flush pipe RequestAckFailure >> void (fetch pipe)

@@ -14,7 +14,7 @@  import           Data.Default                    (Default (..)) import           Data.Map.Strict                 (Map)-import           Data.Monoid                     ((<>))+import           Data.Monoid                     () import           Data.Text                       (Text, unpack) import           Data.Word                       (Word16, Word32) import           GHC.Stack                       (HasCallStack, callStack, prettyCallStack)@@ -71,12 +71,13 @@  -- |Configuration of driver connection data BoltCfg = BoltCfg { magic         :: Word32  -- ^'6060B017' value-                       , version       :: Word32  -- ^'00000001' value+                       , version       :: Word32  -- ^Major version number (e.g. '00000104' for 4.1)                        , userAgent     :: Text    -- ^Driver user agent                        , maxChunkSize  :: Word16  -- ^Maximum chunk size of request                        , socketTimeout :: Int     -- ^Driver socket timeout in seconds                        , host          :: String  -- ^Neo4j server hostname                        , port          :: Int     -- ^Neo4j server port+                       , authType      :: Text    -- ^Neo4j auth schema                        , user          :: Text    -- ^Neo4j user                        , password      :: Text    -- ^Neo4j password                        , secure        :: Bool    -- ^Use TLS or not@@ -85,12 +86,13 @@  instance Default BoltCfg where   def = BoltCfg { magic         = 1616949271-                , version       = 1-                , userAgent     = "hasbolt/1.4"+                , version       = 3+                , userAgent     = "hasbolt/1.5"                 , maxChunkSize  = 65535                 , socketTimeout = 5                 , host          = "127.0.0.1"                 , port          = 7687+                , authType      = "basic"                 , user          = ""                 , password      = ""                 , secure        = False@@ -103,8 +105,9 @@         -- ^ Timeout in microseconds       } -data Pipe = Pipe { connection :: ConnectionWithTimeout -- ^Driver connection socket-                 , mcs        :: Word16                -- ^Driver maximum chunk size of request+data Pipe = Pipe { connection   :: ConnectionWithTimeout -- ^Driver connection socket+                 , mcs          :: Word16                -- ^Driver maximum chunk size of request+                 , pipe_version :: Word32                -- ^Connection version 0000mnMJ                  }  data AuthToken = AuthToken { scheme      :: Text@@ -119,14 +122,20 @@               | ResponseFailure { failMap   :: Map Text Value }   deriving (Eq, Show) -data Request = RequestInit { agent :: Text-                           , token :: AuthToken-                           }-             | RequestRun  { statement  :: Text-                           , parameters :: Map Text Value-                           }+data Request = RequestInit  { agent   :: Text+                            , token   :: AuthToken+                            , isHello :: Bool+                            }+             | RequestRun   { statement  :: Text+                            , parameters :: Map Text Value+                            }+             | RequestRunV3 { statement  :: Text+                            , parameters :: Map Text Value+                            , extra      :: Map Text Value+                            }              | RequestAckFailure              | RequestReset              | RequestDiscardAll              | RequestPullAll+             | RequestGoodbye   deriving (Eq, Show)

@@ -2,7 +2,7 @@  import           Control.Applicative (liftA2, liftA3, pure) import           Data.Bits           ((.&.))-import           Data.Word           (Word8)+import           Data.Word           (Word8, Word32)  -- = Checkers @@ -57,6 +57,9 @@ isStruct :: Word8 -> Bool isStruct = liftA3 (\x y z -> x || y || z) (== struct8Code) (== struct16Code) isTinyStruct +isNewVersion :: Word32 -> Bool+isNewVersion v = (v .&. 255) >= 3+ -- = Constants  -- == Null@@ -175,6 +178,9 @@  sigPAll :: Word8 sigPAll = 63++sigGBye :: Word8 +sigGBye = 2  -- == BOLT responses signatures