hasbolt 0.1.3.0 → 0.1.3.1

raw patch · 6 files changed

+184/−53 lines, 6 filesdep +QuickCheckdep +hasboltdep +hspecdep ~bytestringdep ~containersdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, hasbolt, hspec

Dependency ranges changed: bytestring, containers, text

API changes (from Hackage documentation)

Files

• hasbolt.cabal +35/−19
• src/Database/Bolt/Connection.hs +30/−20
• src/Database/Bolt/Connection/Connection.hs +9/−8
• src/Database/Bolt/Connection/Pipe.hs +13/−4
• src/Database/Bolt/Connection/Type.hs +4/−2
• test/Spec.hs +93/−0

@@ -1,11 +1,11 @@-name: hasbolt-version: 0.1.3.0 cabal-version: >=1.10-build-type: Simple+name: hasbolt+version: 0.1.3.1 license: BSD3 license-file: LICENSE-copyright: (c) 2016 Pavel Yakovlev+copyright: (c) 2018 Pavel Yakovlev maintainer: pavel@yakovlev.me+author: Pavel Yakovlev, Martin Heuschober homepage: https://github.com/zmactep/hasbolt#readme synopsis: Haskell driver for Neo4j 3+ (BOLT protocol) description:@@ -21,9 +21,11 @@     .     -Authentification     .-    The code was tested with neo4j versions 3.0 and 3.1+    -TLS/SSL connection+    .+    The code was tested with neo4j versions 3.0 — 3.4 and GrapheneDB service category: Database-author: Pavel Yakovlev, Martin Heuschober+build-type: Simple  source-repository head     type: git@@ -33,19 +35,6 @@     exposed-modules:         Database.Bolt         Database.Bolt.Lazy-    build-depends:-        base >=4.7 && <5,-        bytestring >=0.10.8.1 && <0.11,-        text >=1.2.2.1 && <1.3,-        containers >=0.5.7.1 && <0.6,-        binary >=0.8.3.0 && <1.0,-        data-binary-ieee754 >=0.4.4 && <0.5,-        transformers >=0.5.2.0 && <0.6,-        network >=2.6.3.1 && <2.7,-        connection >=0.2.8 && <0.3,-        data-default >=0.7.1.1 && <0.8,-        hex >=0.1.2 && <0.2-    default-language: Haskell2010     hs-source-dirs: src     other-modules:         Database.Bolt.Value.Type@@ -58,5 +47,32 @@         Database.Bolt.Connection.Pipe         Database.Bolt.Connection         Database.Bolt.Record+    default-language: Haskell2010     ghc-options: -Wall+    build-depends:+        base >=4.7 && <5,+        bytestring >=0.10.8.1 && <0.11,+        text >=1.2.2.1 && <1.3,+        containers >=0.5.7.1 && <0.7,+        binary >=0.8.3.0 && <1.0,+        data-binary-ieee754 >=0.4.4 && <0.5,+        transformers >=0.5.2.0 && <0.6,+        network >=2.6.3.1 && <2.9,+        connection >=0.2.8 && <0.3,+        data-default >=0.7.1.1 && <0.8 +test-suite hasbolt-test+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs: test+    default-language: Haskell2010+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4.8 && <5,+        hasbolt -any,+        hspec >=2.4.1 && <2.6,+        QuickCheck >=2.9 && <2.13,+        hex >=0.1.2 && <0.2,+        text >=1.2.3.1 && <1.3,+        containers >=0.5.11.0 && <0.6,+        bytestring >=0.10.8.2 && <0.11

@@ -12,6 +12,7 @@ import           Database.Bolt.Value.Type import           Database.Bolt.Record +import           Control.Monad                 (void) import           Control.Monad.IO.Class        (MonadIO (..), liftIO) import           Control.Monad.Trans.Reader    (ReaderT (..), ask, runReaderT) import           Data.Text                     (Text)@@ -44,9 +45,10 @@  -- |Runs Cypher query with parameters and ignores response queryP_ :: MonadIO m => Text -> Map Text Value -> BoltActionT m ()-queryP_ cypher params =-  do pipe <- ask-     liftIO $ sendRequest pipe cypher params $ \_ -> discardAll pipe+queryP_ cypher params = do pipe <- ask+                           liftIO $ do+                             void $ sendRequest pipe cypher params+                             discardAll pipe       -- |Runs Cypher query and ignores response query_ :: MonadIO m => Text -> BoltActionT m ()@@ -56,29 +58,37 @@  querySL :: MonadIO m => Bool -> Text -> Map Text Value -> BoltActionT m [Record] querySL strict cypher params = do pipe <- ask-                                  keys <- liftIO $ pullKeys pipe cypher params-                                  liftIO $ pullRecords pipe keys strict+                                  liftIO $ do+                                    keys <- pullKeys pipe cypher params+                                    pullRecords strict pipe keys  pullKeys :: Pipe -> Text -> Map Text Value -> IO [Text]-pullKeys pipe cypher params = sendRequest pipe cypher params $ \status -> do-  flush pipe RequestPullAll-  mkKeys status+pullKeys pipe cypher params = do status <- sendRequest pipe cypher params+                                 flush pipe RequestPullAll+                                 mkKeys status -pullRecords :: Pipe -> [Text] -> Bool -> IO [Record]-pullRecords pipe keys strict = do resp <- fetch pipe-                                  if isSuccess resp-                                    then pure []-                                    else do let record = mkRecord keys resp-                                            let pull = pullRecords pipe keys strict-                                            rest <- if strict then pull-                                                              else unsafeInterleaveIO pull-                                            pure (record:rest)+pullRecords :: Bool -> Pipe -> [Text] -> IO [Record]+pullRecords strict pipe keys = fetch pipe >>= cases+  where+    cases :: Response -> IO [Record]+    cases resp | isSuccess resp = pure []+               | isFailure resp = ackFailure pipe >> mkFailure resp+               | otherwise      = parseRecord resp +    parseRecord :: Response -> IO [Record]+    parseRecord resp = do+        let record = mkRecord keys resp+        let pull = pullRecords strict pipe keys+        rest <- if strict then pull+                          else unsafeInterleaveIO pull+        pure (record:rest)+ -- |Sends request to database and makes an action-sendRequest :: Pipe -> Text -> Map Text Value -> (Response -> IO a) -> IO a-sendRequest pipe cypher params f =+sendRequest :: Pipe -> Text -> Map Text Value -> IO Response+sendRequest pipe cypher params =   do flush pipe $ RequestRun cypher params      status <- fetch pipe-     if isSuccess status then f status+     if isSuccess status+       then pure status        else do ackFailure pipe                mkFailure status

@@ -1,5 +1,6 @@ module Database.Bolt.Connection.Connection where +import           Control.Applicative    (pure, (<$>)) import           Control.Monad          (when, forM_) import           Control.Monad.IO.Class (MonadIO (..)) import           Data.ByteString        (ByteString, null)@@ -10,14 +11,14 @@ import           Prelude                hiding (null)  connect :: MonadIO m => Bool -> String -> PortNumber -> m Connection-connect secure host port = do ctx <- liftIO $ initConnectionContext-                              conn <- liftIO $ connectTo ctx $ ConnectionParams { connectionHostname  = host-                                                                                , connectionPort      = port-                                                                                , connectionUseSecure = Nothing-                                                                                , connectionUseSocks  = Nothing-                                                                                }-                              when secure $-                                liftIO $ connectionSetSecure ctx conn def+connect secure host port = liftIO $ do+                              ctx  <- initConnectionContext+                              conn <- connectTo ctx ConnectionParams { connectionHostname  = host+                                                                     , connectionPort      = port+                                                                     , connectionUseSecure = Nothing+                                                                     , connectionUseSocks  = Nothing+                                                                     }+                              when secure $ connectionSetSecure ctx conn def                               pure conn  close :: MonadIO m => Connection -> m ()

@@ -32,7 +32,6 @@                 response <- fetch pipe                 when (isFailure response) $                   fail "Reset failed"-                pure ()  ackFailure :: MonadIO m => Pipe -> m () ackFailure pipe = flush pipe RequestAckFailure >> void (fetch pipe)@@ -41,7 +40,12 @@ discardAll pipe = flush pipe RequestDiscardAll >> void (fetch pipe)  flush :: MonadIO m => Pipe -> Request -> m ()-flush pipe request = do forM_ chunks $ C.sendMany conn . mkChunk+flush pipe request = do -- USELESS LOGGING+                        liftIO $ do+                          putStr "[->]: "+                          print request+                        -- USELESS LOGGING+                        forM_ chunks $ C.sendMany conn . mkChunk                         C.send conn terminal   where bs        = pack $ toStructure request         chunkSize = chunkSizeFor (mcs pipe) bs@@ -55,7 +59,13 @@  fetch :: MonadIO m => Pipe -> m Response fetch pipe = do bs <- B.concat <$> chunks-                unpack bs >>= fromStructure+                result <- unpack bs >>= fromStructure+                -- USELESS LOGGING+                liftIO $ do +                  putStr "[<-]: "+                  print result+                -- USELESS LOGGING+                pure result   where conn = connection pipe          chunks :: MonadIO m => m [ByteString]@@ -79,7 +89,6 @@                          response <- fetch pipe                          unless (isSuccess response) $                            fail "Authentification failed"-                         pure ()  boltVersionProposal :: BoltCfg -> ByteString boltVersionProposal bcfg = B.concat $ encodeStrict <$> [version bcfg, 0, 0, 0]

@@ -26,7 +26,7 @@ instance Default BoltCfg where   def = BoltCfg { magic         = 1616949271                 , version       = 1-                , userAgent     = "hasbolt/1.0"+                , userAgent     = "hasbolt/1.3"                 , maxChunkSize  = 65535                 , socketTimeout = 5                 , host          = "127.0.0.1"@@ -44,7 +44,8 @@                            , principal   :: Text                            , credentials :: Text                            }-+  deriving (Eq, Show)+   data Response = ResponseSuccess { succMap   :: Map Text Value }               | ResponseRecord  { recsList  :: [Value] }               | ResponseIgnored { ignoreMap :: Map Text Value }@@ -61,3 +62,4 @@              | RequestReset              | RequestDiscardAll              | RequestPullAll+  deriving (Eq, Show)

@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++import           Control.Applicative      ((<$>))+import           Data.ByteString          (ByteString)+import           Data.ByteString.Lazy     (fromStrict, toStrict)+import           Data.Hex+import           Data.Map                 (Map (..))+import qualified Data.Map                 as M (empty, fromList)+import           Data.Text                (Text)+import qualified Data.Text                as T (pack)+import           Test.Hspec+import           Test.QuickCheck++import Database.Bolt++main :: IO ()+main = hspec $ do+         packStreamTests+         unpackStreamTests++unpackStreamTests :: Spec+unpackStreamTests =+  describe "Unpack" $ do+    it "unpacks integers correct" $ do+      u1 <- prepareData "01" >>= unpack :: IO Int+      u1 `shouldBe` 1+      u42 <- prepareData "2A" >>= unpack :: IO Int+      u42 `shouldBe` 42+      u1234 <- prepareData "C904D2" >>= unpack :: IO Int+      u1234 `shouldBe` 1234+    it "unpacks doubles correct" $ do+      u6d <- prepareData "C1401921FB54442D18" >>= unpack :: IO Double+      u6d `shouldBe` 6.283185307179586+      um1d <- prepareData "C1BFF199999999999A" >>= unpack :: IO Double+      um1d `shouldBe` (-1.1)+    it "unpacks booleans correct" $ do+      uF <- prepareData "C2" >>= unpack :: IO Bool+      uF `shouldBe` False+      uT <- prepareData "C3" >>= unpack :: IO Bool+      uT `shouldBe` True+    it "unpacks strings correct" $ do+      usE <- prepareData "80" >>= unpack :: IO Text+      usE `shouldBe` T.pack ""+      usA <- prepareData "8141" >>= unpack :: IO Text+      usA `shouldBe` T.pack "A"+      usU <- prepareData "D0124772C3B6C39F656E6D61C39F7374C3A46265" >>= unpack :: IO Text+      usU `shouldBe` T.pack "Größenmaßstäbe"+    it "unpacks lists correct" $ do+      ulE <- prepareData "90" >>= unpack :: IO [Int]+      ulE `shouldBe` []+      ulI <- prepareData "93010203" >>= unpack :: IO [Int]+      ulI `shouldBe` [1,2,3]+      ulL <- prepareData "D4280102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F202122232425262728" >>= unpack :: IO [Int]+      ulL `shouldBe` [1..40]+    it "unpacks dicts correct" $ do+      udE <- prepareData "A0" >>= unpack :: IO (Map Text ())+      udE `shouldBe` M.fromList []+      udS <- prepareData "A1836F6E658465696E73" >>= unpack :: IO (Map Text Text)+      udS `shouldBe` M.fromList [(T.pack "one", T.pack "eins")]+    it "unpacks () correct" $ do+      uN <- prepareData "C0" >>= unpack :: IO ()+      uN `shouldBe` ()++packStreamTests :: Spec+packStreamTests =+  describe "Pack" $ do+    it "packs integers correct" $ do+      hex (pack (1::Int)) `shouldBe` "01"+      hex (pack (42::Int)) `shouldBe` "2A"+      hex (pack (1234::Int)) `shouldBe` "C904D2"+    it "packs doubles correct" $ do+      hex (pack (6.283185307179586::Double)) `shouldBe` "C1401921FB54442D18"+      hex (pack (-1.1::Double)) `shouldBe` "C1BFF199999999999A"+    it "packs booleans correct" $ do+      hex (pack False) `shouldBe` "C2"+      hex (pack True) `shouldBe` "C3"+    it "packs strings correct" $ do+      hex (pack $ T.pack "") `shouldBe` "80"+      hex (pack $ T.pack "A") `shouldBe` "8141"+      hex (pack $ T.pack "Größenmaßstäbe") `shouldBe` "D0124772C3B6C39F656E6D61C39F7374C3A46265"+      hex (pack $ T.pack "ABCDEFGHIJKLMNOPQRSTUVWXYZ") `shouldBe` "D01A4142434445464748494A4B4C4D4E4F505152535455565758595A"+    it "packs lists correct" $ do+      hex (pack ([]::[Int])) `shouldBe` "90"+      hex (pack ([1,2,3]::[Int])) `shouldBe` "93010203"+      hex (pack ([1..40]::[Int])) `shouldBe` "D4280102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F202122232425262728"+    it "packs dicts correct" $ do+      hex (pack (M.empty :: Map Text ())) `shouldBe` "A0"+      hex (pack (M.fromList [(T.pack "one", T.pack "eins")])) `shouldBe` "A1836F6E658465696E73"+    it "packs () correct" $+      hex (pack ()) `shouldBe` "C0"++prepareData :: Monad m => ByteString -> m ByteString+prepareData = (toStrict <$>) . unhex . fromStrict