hasbolt 0.1.2.1 → 0.1.3.0

raw patch · 8 files changed

+74/−190 lines, 8 filesdep +connectiondep −QuickCheckdep −hasboltdep −hspecdep ~containersdep ~networkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: connection

Dependencies removed: QuickCheck, hasbolt, hspec

Dependency ranges changed: containers, network

API changes (from Hackage documentation)

Files

• hasbolt.cabal +5/−19
• src/Database/Bolt.hs +1/−1
• src/Database/Bolt/Connection/Connection.hs +37/−0
• src/Database/Bolt/Connection/Pipe.hs +25/−26
• src/Database/Bolt/Connection/Socket.hs +0/−46
• src/Database/Bolt/Connection/Type.hs +5/−4
• src/Database/Bolt/Lazy.hs +1/−1
• test/Spec.hs +0/−93

@@ -1,10 +1,10 @@ name: hasbolt-version: 0.1.2.1+version: 0.1.3.0 cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE-copyright: Copyright: (c) 2016 Pavel Yakovlev+copyright: (c) 2016 Pavel Yakovlev maintainer: pavel@yakovlev.me homepage: https://github.com/zmactep/hasbolt#readme synopsis: Haskell driver for Neo4j 3+ (BOLT protocol)@@ -42,6 +42,7 @@         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@@ -51,26 +52,11 @@         Database.Bolt.Value.Helpers         Database.Bolt.Value.Instances         Database.Bolt.Value.Structure-        Database.Bolt.Connection.Socket+        Database.Bolt.Connection.Connection         Database.Bolt.Connection.Type         Database.Bolt.Connection.Instances         Database.Bolt.Connection.Pipe         Database.Bolt.Connection         Database.Bolt.Record-    ghc-options: -Wall -O2+    ghc-options: -Wall -test-suite hasbolt-test-    type: exitcode-stdio-1.0-    main-is: Spec.hs-    build-depends:-        base >=4.8 && <5,-        hasbolt >=0.1.2.1 && <0.2,-        hspec >=2.4.1 && <2.5,-        QuickCheck >=2.9 && <2.11,-        hex >=0.1.2 && <0.2,-        text >=1.2.2.1 && <1.3,-        containers >=0.5.7.1 && <0.6,-        bytestring >=0.10.8.1 && <0.11-    default-language: Haskell2010-    hs-source-dirs: test-    ghc-options: -threaded -rtsopts -with-rtsopts=-N

@@ -4,7 +4,7 @@     , run, queryP, query, queryP_, query_     , Pipe     , BoltCfg (..)-    , BoltValue (..), Value (..), Record, RecordValue (..), at+    , BoltValue (..), Value (..), Structure (..), Record, RecordValue (..), at     , Node (..), Relationship (..), URelationship (..), Path (..)     ) where 

@@ -0,0 +1,37 @@+module Database.Bolt.Connection.Connection where++import           Control.Monad          (when, forM_)+import           Control.Monad.IO.Class (MonadIO (..))+import           Data.ByteString        (ByteString, null)+import           Data.Default           (Default (..))+import           Network.Socket         (PortNumber)+import           Network.Connection     (Connection, ConnectionParams (..), connectTo, connectionSetSecure,+                                         initConnectionContext, connectionClose, connectionGetExact, connectionPut)+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+                              pure conn++close :: MonadIO m => Connection -> m ()+close = liftIO . connectionClose++recv :: MonadIO m => Connection -> Int -> m (Maybe ByteString)+recv conn = liftIO . (filterMaybe (not . null) <$>) . connectionGetExact conn+  where+    filterMaybe :: (a -> Bool) -> a -> Maybe a+    filterMaybe p x | p x       = Just x+                    | otherwise = Nothing++send :: MonadIO m => Connection -> ByteString -> m ()+send conn = liftIO . connectionPut conn++sendMany :: MonadIO m => Connection -> [ByteString] -> m ()+sendMany conn chunks = forM_ chunks $ send conn

@@ -4,28 +4,27 @@ import           Database.Bolt.Connection.Type import           Database.Bolt.Value.Instances import           Database.Bolt.Value.Type--import           Database.Bolt.Connection.Socket    (Socket, closeSock,-                                                     connectSock, recv, send,-                                                     sendMany)+import qualified Database.Bolt.Connection.Connection as C (close, connect, recv,+                                                           send, sendMany) -import           Control.Monad                      (forM_, unless, void, when)-import           Control.Monad.IO.Class             (MonadIO (..))-import           Data.ByteString                    (ByteString)-import qualified Data.ByteString                    as B (concat, length, null,-                                                          splitAt)-import           Data.Word                          (Word16)+import           Control.Monad                       (forM_, unless, void, when)+import           Control.Monad.IO.Class              (MonadIO (..))+import           Data.ByteString                     (ByteString)+import qualified Data.ByteString                     as B (concat, length, null,+                                                           splitAt)+import           Data.Word                           (Word16)+import           Network.Connection                  (Connection)  -- |Creates new 'Pipe' instance to use all requests through connect :: MonadIO m => BoltCfg -> m Pipe-connect bcfg = do (sock, _) <- connectSock (host bcfg) (show $ port bcfg)-                  let pipe = Pipe sock (maxChunkSize bcfg)+connect bcfg = do conn <- C.connect (secure bcfg) (host bcfg) (fromIntegral $ port bcfg)+                  let pipe = Pipe conn (maxChunkSize bcfg)                   handshake pipe bcfg                   pure pipe  -- |Closes 'Pipe' close :: MonadIO m => Pipe -> m ()-close = closeSock . connectionSocket+close = C.close . connection  -- |Resets current sessions reset :: MonadIO m => Pipe -> m ()@@ -42,13 +41,13 @@ discardAll pipe = flush pipe RequestDiscardAll >> void (fetch pipe)  flush :: MonadIO m => Pipe -> Request -> m ()-flush pipe request = do forM_ chunks $ sendMany sock . mkChunk-                        send sock terminal+flush pipe request = do forM_ chunks $ C.sendMany conn . mkChunk+                        C.send conn terminal   where bs        = pack $ toStructure request         chunkSize = chunkSizeFor (mcs pipe) bs         chunks    = split chunkSize bs         terminal  = encodeStrict (0 :: Word16)-        sock      = connectionSocket pipe+        conn      = connection pipe          mkChunk :: ByteString -> [ByteString]         mkChunk chunk = let size = fromIntegral (B.length chunk) :: Word16@@ -57,11 +56,11 @@ fetch :: MonadIO m => Pipe -> m Response fetch pipe = do bs <- B.concat <$> chunks                 unpack bs >>= fromStructure-  where sock = connectionSocket pipe+  where conn = connection pipe          chunks :: MonadIO m => m [ByteString]-        chunks = do size <- decodeStrict <$> recvChunk sock 2-                    chunk <- recvChunk sock size+        chunks = do size <- decodeStrict <$> recvChunk conn 2+                    chunk <- recvChunk conn size                     if B.null chunk                       then pure []                       else do rest <- chunks@@ -70,10 +69,10 @@ -- Helper functions  handshake :: MonadIO m => Pipe -> BoltCfg -> m ()-handshake pipe bcfg = do let sock = connectionSocket pipe-                         send sock (encodeStrict $ magic bcfg)-                         send sock (boltVersionProposal bcfg)-                         serverVersion <- decodeStrict <$> recvChunk sock 4+handshake pipe bcfg = do let conn = connection pipe+                         C.send conn (encodeStrict $ magic bcfg)+                         C.send conn (boltVersionProposal bcfg)+                         serverVersion <- decodeStrict <$> recvChunk conn 4                          when (serverVersion /= version bcfg) $                            fail "Unsupported server version"                          flush pipe (createInit bcfg)@@ -85,11 +84,11 @@ boltVersionProposal :: BoltCfg -> ByteString boltVersionProposal bcfg = B.concat $ encodeStrict <$> [version bcfg, 0, 0, 0] -recvChunk :: MonadIO m => Socket -> Word16 -> m ByteString-recvChunk sock size = B.concat <$> helper (fromIntegral size)+recvChunk :: MonadIO m => Connection -> Word16 -> m ByteString+recvChunk conn size = B.concat <$> helper (fromIntegral size)   where helper :: MonadIO m => Int -> m [ByteString]         helper 0  = pure []-        helper sz = do mbChunk <- recv sock sz+        helper sz = do mbChunk <- C.recv conn sz                        case mbChunk of                          Just chunk -> (chunk:) <$> helper (sz - B.length chunk)                          Nothing    -> fail "Cannot read chunk from sock"

@@ -1,46 +0,0 @@-module Database.Bolt.Connection.Socket-  ( Socket-  , connectSock, closeSock-  , recv, send, sendMany-  ) where--import           Control.Exception         (bracketOnError)-import           Control.Monad.IO.Class    (MonadIO (..))-import           Data.ByteString           (ByteString, null)-import           Network.Socket            (AddrInfoFlag (..), HostName,-                                            ServiceName, SockAddr, Socket,-                                            SocketType (..), addrAddress,-                                            addrFamily, addrFlags, addrProtocol,-                                            addrSocketType, defaultHints,-                                            getAddrInfo, socket, close, connect)-import qualified Network.Socket.ByteString as NSB (recv, sendAll, sendMany)-import           Prelude                   hiding (null)--connectSock :: MonadIO m => HostName -> ServiceName -> m (Socket, SockAddr)-connectSock host port = liftIO $ bracketOnError (createSock host port) (closeSock . fst) $-                          \(sock, addr) -> liftIO (connect sock addr) >> pure (sock, addr)--createSock :: MonadIO m => HostName -> ServiceName -> m (Socket, SockAddr)-createSock host port = liftIO $ do (addr:_) <- getAddrInfo (Just hints) (Just host) (Just port)-                                   let family'   = addrFamily addr-                                   let type'     = addrSocketType addr-                                   let protocol' = addrProtocol addr-                                   sock <- socket family' type' protocol'-                                   pure (sock, addrAddress addr)-  where hints = defaultHints { addrFlags = [AI_ADDRCONFIG]-                             , addrSocketType = Stream-                             }--closeSock :: MonadIO m => Socket -> m ()-closeSock = liftIO . close--recv :: MonadIO m => Socket -> Int -> m (Maybe ByteString)-recv sock nbytes = liftIO $ do bs <- NSB.recv sock nbytes-                               if null bs then pure Nothing-                                            else pure (Just bs)--send :: MonadIO m => Socket -> ByteString -> m ()-send sock = liftIO . NSB.sendAll sock--sendMany :: MonadIO m => Socket -> [ByteString] -> m ()-sendMany sock = liftIO . NSB.sendMany sock

@@ -4,12 +4,11 @@  import           Database.Bolt.Value.Type -import           Database.Bolt.Connection.Socket (Socket)- import           Data.Default                    (Default (..)) import           Data.Map.Strict                 (Map) import           Data.Text                       (Text) import           Data.Word                       (Word16, Word32)+import           Network.Connection              (Connection)  -- |Configuration of driver connection data BoltCfg = BoltCfg { magic         :: Word32  -- ^'6060B017' value@@ -21,6 +20,7 @@                        , port          :: Int     -- ^Neo4j server port                        , user          :: Text    -- ^Neo4j user                        , password      :: Text    -- ^Neo4j password+                       , secure        :: Bool    -- ^Use TLS or not                        }  instance Default BoltCfg where@@ -33,10 +33,11 @@                 , port          = 7687                 , user          = ""                 , password      = ""+                , secure        = False                 } -data Pipe = Pipe { connectionSocket :: Socket     -- ^Driver connection socket-                 , mcs              :: Word16     -- ^Driver maximum chunk size of request+data Pipe = Pipe { connection :: Connection -- ^Driver connection socket+                 , mcs        :: Word16     -- ^Driver maximum chunk size of request                  }  data AuthToken = AuthToken { scheme      :: Text

@@ -4,7 +4,7 @@     , run, queryP, query, queryP_, query_     , Pipe     , BoltCfg (..)-    , BoltValue (..), Value (..), Record, RecordValue (..), at+    , BoltValue (..), Value (..), Structure (..), Record, RecordValue (..), at     , Node (..), Relationship (..), URelationship (..), Path (..)     ) where 

@@ -1,93 +0,0 @@-{-# 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