bolt 0.3.1.0 → 0.3.2.0

raw patch · 34 files changed

+1228/−1189 lines, 34 filesdep ~bifunctorsdep ~bytestringdep ~containerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bifunctors, bytestring, containers, hashable, network, transformers, vector

API changes (from Hackage documentation)

Files

• Changelog.md +5/−0
• LICENSE +30/−30
• README.md +15/−15
• Setup.hs +2/−2
• bolt.cabal +87/−75
• lib/Data/PackStream.hs +300/−0
• lib/Database/Bolt/Exception.hs +41/−0
• lib/Database/Bolt/Protocol/Ver1.hs +37/−0
• lib/Database/Bolt/Protocol/Ver1/Graph.hs +98/−0
• lib/Database/Bolt/Protocol/Ver1/Message.hs +87/−0
• lib/Database/Bolt/Protocol/Ver1/Pretty.hs +30/−0
• lib/Database/Bolt/Protocol/Ver1/Request.hs +77/−0
• lib/Database/Bolt/Protocol/Ver1/Transaction.hs +43/−0
• lib/Database/Bolt/Protocol/Ver1/Types.hs +46/−0
• lib/Database/Bolt/Transport.hs +68/−0
• lib/Database/Bolt/Transport/Chunked.hs +77/−0
• lib/Database/Bolt/Transport/Message.hs +26/−0
• lib/Database/Bolt/Transport/Socket.hs +81/−0
• lib/Database/Bolt/Types.hs +14/−0
• src/Data/PackStream.hs +0/−311
• src/Database/Bolt/Exception.hs +0/−40
• src/Database/Bolt/Protocol/Ver1.hs +0/−37
• src/Database/Bolt/Protocol/Ver1/Graph.hs +0/−82
• src/Database/Bolt/Protocol/Ver1/Message.hs +0/−81
• src/Database/Bolt/Protocol/Ver1/Pretty.hs +0/−30
• src/Database/Bolt/Protocol/Ver1/Request.hs +0/−76
• src/Database/Bolt/Protocol/Ver1/Transaction.hs +0/−43
• src/Database/Bolt/Protocol/Ver1/Types.hs +0/−46
• src/Database/Bolt/Transport.hs +0/−68
• src/Database/Bolt/Transport/Chunked.hs +0/−73
• src/Database/Bolt/Transport/Message.hs +0/−26
• src/Database/Bolt/Transport/Socket.hs +0/−79
• src/Database/Bolt/Types.hs +0/−14
• test/Spec.hs +64/−61

@@ -0,0 +1,5 @@+2025-07-18++- Update upper bounds for all dependencies.+- Tested with GHC 9.10.2.+- Use nix flake for development.

@@ -1,30 +1,30 @@-Copyright Shaun Sharples (c) 2016
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Author name here nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright Shaun Sharples (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,15 +1,15 @@-# Bolt driver for Haskell
-
-I have started writing a basic Bolt driver to access Neo4j databases by
-implementing the [Bolt Protocol, Version 1](http://boltprotocol.org/v1/).
-
-## Join In!
-
-I am happy to receive bug reports, fixes, documentation enhancements, and
-other improvements.
-
-Please report bugs via the [github issue tracker](https://github.com/bflyblue/bolt/issues).
-
-## Authors
-
-This library is written and maintained by Shaun Sharples, <shaun.sharples@gmail.com>.
+# Bolt driver for Haskell++I have started writing a basic Bolt driver to access Neo4j databases by+implementing the [Bolt Protocol, Version 1](http://boltprotocol.org/v1/).++## Join In!++I am happy to receive bug reports, fixes, documentation enhancements, and+other improvements.++Please report bugs via the [github issue tracker](https://github.com/bflyblue/bolt/issues).++## Authors++This library is written and maintained by Shaun Sharples, <shaun.sharples@gmail.com>.

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,75 +1,87 @@-name:                bolt
-version:             0.3.1.0
-synopsis:            Bolt driver for Neo4j
-description:
-    A Bolt driver to access Neo4j databases using
-    the Bolt Protocol, Version 1. <http://boltprotocol.org/v1/>
-homepage:            https://github.com/bflyblue/bolt#readme
-license:             BSD3
-license-file:        LICENSE
-author:              Shaun Sharples
-maintainer:          shaun.sharples@gmail.com
-stability:           experimental
-copyright:           (c) 2016 Shaun Sharples
-category:            Database
-build-type:          Simple
-extra-source-files:  README.md
-cabal-version:       >=1.10
-
-library
-  hs-source-dirs:      src
-  other-extensions:    DeriveAnyClass
-                     , DeriveGeneric
-                     , MultiWayIf
-                     , OverloadedStrings
-                     , RecordWildCards
-                     , ScopedTypeVariables
-  exposed-modules:     Data.PackStream
-                     , Database.Bolt.Exception
-                     , Database.Bolt.Protocol.Ver1
-                     , Database.Bolt.Protocol.Ver1.Graph
-                     , Database.Bolt.Protocol.Ver1.Message
-                     , Database.Bolt.Protocol.Ver1.Pretty
-                     , Database.Bolt.Protocol.Ver1.Request
-                     , Database.Bolt.Protocol.Ver1.Transaction
-                     , Database.Bolt.Protocol.Ver1.Types
-                     , Database.Bolt.Transport
-                     , Database.Bolt.Transport.Chunked
-                     , Database.Bolt.Transport.Message
-                     , Database.Bolt.Transport.Socket
-                     , Database.Bolt.Types
-  build-depends:       base                 >= 4.8    && < 5
-                     , bifunctors           >= 5.2    && < 5.5
-                     , bytestring           >= 0.10.6 && < 0.11
-                     , cereal               >= 0.5.4  && < 0.6
-                     , containers           >= 0.5.6  && < 0.6
-                     , hashable             >= 1.2.4  && < 1.3
-                     , network              >= 2.6.2  && < 2.7
-                     , network-uri          >= 2.6.1  && < 2.7
-                     , scientific           >= 0.3.0  && < 0.4
-                     , text                 >= 1.2.2  && < 1.3
-                     , transformers         >= 0.5.0  && < 0.6
-                     , unordered-containers >= 0.2.7  && < 0.3
-                     , vector               >= 0.11.0 && < 0.12
-  ghc-options:         -Wall
-  default-language:    Haskell2010
-
-test-suite tests
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      test
-  main-is:             Spec.hs
-  build-depends:       base
-                     , bolt
-                     , bytestring           >= 0.10.6 && < 0.11
-                     , cereal               >= 0.5.4  && < 0.6
-                     , text                 >= 1.2.2  && < 1.3
-                     , unordered-containers >= 0.2.7  && < 0.3
-                     , vector               >= 0.11.0 && < 0.12
-                     , tasty
-                     , tasty-quickcheck
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
-  default-language:    Haskell2010
-
-source-repository head
-  type:     git
-  location: https://github.com/bflyblue/bolt
+cabal-version: 3.8+name: bolt+version: 0.3.2.0+synopsis: Bolt driver for Neo4j+description: A Bolt driver to access Neo4j databases using the Bolt Protocol. <https://boltprotocol.org/>+homepage: https://github.com/bflyblue/bolt#readme+license: BSD-3-Clause+license-file: LICENSE+author: Shaun Sharples+maintainer: shaun.sharples@gmail.com+stability: experimental+copyright: (c) 2025 Shaun Sharples+category: Database+build-type: Simple+extra-source-files: README.md+extra-doc-files: Changelog.md++common common+  ghc-options: -Wall+  default-language: GHC2021++library+  import: common+  hs-source-dirs: lib+  other-extensions:+    DeriveAnyClass+    DeriveGeneric+    MultiWayIf+    OverloadedStrings+    RecordWildCards++  -- cabal-gild: discover lib/+  exposed-modules:+    Data.PackStream+    Database.Bolt.Exception+    Database.Bolt.Protocol.Ver1+    Database.Bolt.Protocol.Ver1.Graph+    Database.Bolt.Protocol.Ver1.Message+    Database.Bolt.Protocol.Ver1.Pretty+    Database.Bolt.Protocol.Ver1.Request+    Database.Bolt.Protocol.Ver1.Transaction+    Database.Bolt.Protocol.Ver1.Types+    Database.Bolt.Transport+    Database.Bolt.Transport.Chunked+    Database.Bolt.Transport.Message+    Database.Bolt.Transport.Socket+    Database.Bolt.Types++  build-depends:+    base >=4.8 && <5,+    bifunctors >=5.2 && <5.7,+    bytestring >=0.10.6 && <0.13,+    cereal >=0.5.4 && <0.6,+    containers >=0.5.6 && <0.8,+    hashable >=1.2.4 && <1.5,+    network >=2.6.2 && <3.3,+    network-uri >=2.6.1 && <2.7,+    scientific >=0.3.0 && <0.4,+    text >=1.2.2 && <1.3,+    transformers >=0.5.0 && <0.7,+    unordered-containers >=0.2.7 && <0.3,+    vector >=0.11.0 && <0.14,++test-suite test-bolt+  import: common+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Spec.hs+  build-depends:+    base,+    bolt,+    bytestring >=0.10.6 && <0.13,+    cereal >=0.5.4 && <0.6,+    tasty,+    tasty-quickcheck,+    text >=1.2.2 && <1.3,+    unordered-containers >=0.2.7 && <0.3,+    vector >=0.11.0 && <0.14,++  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N++source-repository head+  type: git+  location: https://github.com/bflyblue/bolt

@@ -0,0 +1,300 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.PackStream (+  PackStream (..),+  ToPackStream (..),+  FromPackStream (..),+  Parser,+  parse,+  parsefail,+  parseEither,+  parseMaybe,+  pack,+  unpack,+  pretty,+  prettyStruct,+  genericStructName,+  (.=),+  (.:),+  (.:?),+  (.!=),+)+where++import Control.Monad+import Data.Bifunctor+import Data.Bits+import Data.ByteString qualified as BS+import Data.HashMap.Strict qualified as HM+import Data.Hashable+import Data.Int+import Data.Map.Strict qualified as M+import Data.Monoid+import Data.Scientific+import Data.Serialize.Get+import Data.Serialize.IEEE754+import Data.Serialize.Put+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Vector qualified as V+import Data.Word+import GHC.Generics (Generic)+import Text.Printf++-- Orphan instance should go away once vector-instances 0.4 is available+instance (Hashable a) => Hashable (V.Vector a) where+  hashWithSalt salt = hashWithSalt salt . V.toList+  {-# INLINE hashWithSalt #-}++data PackStream+  = Null+  | Bool !Bool+  | Int !Int64+  | Float !Double+  | String !Text+  | List !(V.Vector PackStream)+  | Map !(HM.HashMap PackStream PackStream)+  | Struct !Word8 ![PackStream]+  deriving (Show, Eq, Generic, Hashable)++type Parser = Either String++parse :: (a -> Parser b) -> a -> Parser b+parse = parseEither++parseEither :: (a -> Parser b) -> a -> Either String b+parseEither f = f++parseMaybe :: (a -> Parser b) -> a -> Maybe b+parseMaybe f = either (const Nothing) Just . parseEither f++parsefail :: a -> Either a b+parsefail = Left++class FromPackStream a where+  parsePackStream :: PackStream -> Parser a++instance FromPackStream PackStream where+  parsePackStream = return++instance FromPackStream Bool where+  parsePackStream (Bool b) = return b+  parsePackStream _ = parsefail "Expecting Bool"++instance FromPackStream Int64 where+  parsePackStream (Int i) = return i+  parsePackStream _ = parsefail "Expecting Int"++instance FromPackStream Double where+  parsePackStream (Float d) = return d+  parsePackStream _ = parsefail "Expecting Float"++instance FromPackStream Text where+  parsePackStream (String t) = return t+  parsePackStream _ = parsefail "Expecting String"++instance (FromPackStream a) => FromPackStream [a] where+  parsePackStream (List l) = mapM parsePackStream (V.toList l)+  parsePackStream _ = parsefail "Expecting List"++instance (FromPackStream a) => FromPackStream (V.Vector a) where+  parsePackStream (List l) = mapM parsePackStream l+  parsePackStream _ = parsefail "Expecting List"++instance (Eq a, Hashable a, FromPackStream a, FromPackStream b) => FromPackStream (HM.HashMap a b) where+  parsePackStream (Map m) = do+    kvs <- mapM parseAssoc (HM.toList m)+    return $ HM.fromList kvs+   where+    parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v+  parsePackStream _ = parsefail "Expecting Map"++instance (Ord a, FromPackStream a, FromPackStream b) => FromPackStream (M.Map a b) where+  parsePackStream (Map m) = do+    kvs <- mapM parseAssoc (HM.toList m)+    return $ M.fromList kvs+   where+    parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v+  parsePackStream _ = parsefail "Expecting Map"++instance FromPackStream Scientific where+  parsePackStream (Int i) = return $ fromIntegral i+  parsePackStream (Float f) = return $ fromFloatDigits f+  parsePackStream _ = parsefail "Expecting Int or Float"++class ToPackStream a where+  toPackStream :: a -> PackStream++instance ToPackStream PackStream where+  toPackStream = id++instance ToPackStream Bool where+  toPackStream = Bool++instance ToPackStream Int64 where+  toPackStream = Int++instance ToPackStream Double where+  toPackStream = Float++instance ToPackStream Text where+  toPackStream = String++instance (ToPackStream a) => ToPackStream [a] where+  toPackStream = List . V.fromList . fmap toPackStream++instance (ToPackStream a) => ToPackStream (V.Vector a) where+  toPackStream = List . fmap toPackStream++instance (ToPackStream a, ToPackStream b) => ToPackStream (M.Map a b) where+  toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . M.toList++instance (ToPackStream a, ToPackStream b) => ToPackStream (HM.HashMap a b) where+  toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . HM.toList++instance ToPackStream Scientific where+  toPackStream s =+    case Data.Scientific.floatingOrInteger s of+      Left rf -> Float rf+      Right i -> Int i++pack :: (ToPackStream a) => Putter a+pack = putPackStream . toPackStream++unpack :: (FromPackStream a) => Get (Parser a)+unpack = parsePackStream <$> getPackStream++getPackStream :: Get PackStream+getPackStream = do+  marker <- getWord8+  if+    | marker == 0xc0 -> return Null+    | marker == 0xc1 -> Float <$> getFloat64be+    | marker == 0xc2 -> return $ Bool False+    | marker == 0xc3 -> return $ Bool True+    | marker < 0x80 -> return $ Int (fromIntegral marker)+    | marker >= 0xf0 -> return $ Int (fromIntegral marker - 0x100)+    | marker == 0xc8 -> Int . fromIntegral <$> getInt8+    | marker == 0xc9 -> Int . fromIntegral <$> getInt16be+    | marker == 0xca -> Int . fromIntegral <$> getInt32be+    | marker == 0xcb -> Int . fromIntegral <$> getInt64be+    | 0x80 <= marker && marker < 0x90 ->+        getString (fromIntegral marker .&. 0x0f)+    | marker == 0xd0 -> fromIntegral <$> getWord8 >>= getString+    | marker == 0xd1 -> fromIntegral <$> getWord16be >>= getString+    | marker == 0xd2 -> fromIntegral <$> getWord32be >>= getString+    | 0x90 <= marker && marker < 0xa0 ->+        getList (fromIntegral marker .&. 0x0f)+    | marker == 0xd4 -> fromIntegral <$> getWord8 >>= getList+    | marker == 0xd5 -> fromIntegral <$> getWord16be >>= getList+    | marker == 0xd6 -> fromIntegral <$> getWord32be >>= getList+    | 0xa0 <= marker && marker < 0xb0 ->+        getMap (fromIntegral marker .&. 0x0f)+    | marker == 0xd8 -> fromIntegral <$> getWord8 >>= getMap+    | marker == 0xd9 -> fromIntegral <$> getWord16be >>= getMap+    | marker == 0xda -> fromIntegral <$> getWord32be >>= getMap+    | 0xb0 <= marker && marker < 0xc0 ->+        getStruct (fromIntegral marker .&. 0x0f)+    | marker == 0xdc -> fromIntegral <$> getWord8 >>= getStruct+    | marker == 0xdd -> fromIntegral <$> getWord16be >>= getStruct+    | otherwise -> fail $ "Unknown marker " ++ printf "0x%02x" marker++getString :: Int -> Get PackStream+getString n = String . T.decodeUtf8 <$> getByteString n++getList :: Int -> Get PackStream+getList n = List . V.fromList <$> replicateM n getPackStream++getMap :: Int -> Get PackStream+getMap n = Map . HM.fromList <$> replicateM n getPair+ where+  getPair = (,) <$> getPackStream <*> getPackStream++getStruct :: Int -> Get PackStream+getStruct n = Struct <$> getWord8 <*> replicateM n getPackStream++putPackStream :: Putter PackStream+putPackStream Null = putWord8 0xc0+putPackStream (Float d) = putWord8 0xc1 >> putFloat64be d+putPackStream (Bool False) = putWord8 0xc2+putPackStream (Bool True) = putWord8 0xc3+putPackStream (Int i)+  | -0x10 <= i && i < 0x80 = putInt8 (fromIntegral i)+  | -0x80 <= i && i < 0x80 = putWord8 0xc8 >> putInt8 (fromIntegral i)+  | -0x8000 <= i && i < 0x8000 = putWord8 0xc9 >> putInt16be (fromIntegral i)+  | -0x80000000 <= i && i < 0x80000000 = putWord8 0xca >> putInt32be (fromIntegral i)+  | otherwise = putWord8 0xcb >> putInt64be (fromIntegral i)+putPackStream (String t) = do+  let bstr = T.encodeUtf8 t+      size = BS.length bstr+  if+    | size < 0x10 -> putWord8 (0x80 + fromIntegral size)+    | size < 0x100 -> putWord8 0xd0 >> putWord8 (fromIntegral size)+    | size < 0x10000 -> putWord8 0xd1 >> putWord16be (fromIntegral size)+    | size < 0x100000000 -> putWord8 0xd2 >> putWord16be (fromIntegral size)+    | otherwise -> error "String too long"+  putByteString $ T.encodeUtf8 t+putPackStream (List xs) = do+  let size = V.length xs+  if+    | size < 0x10 -> putWord8 (0x90 + fromIntegral size)+    | size < 0x100 -> putWord8 0xd4 >> putWord8 (fromIntegral size)+    | size < 0x10000 -> putWord8 0xd5 >> putWord16be (fromIntegral size)+    | size < 0x100000000 -> putWord8 0xd6 >> putWord16be (fromIntegral size)+    | otherwise -> error "List too long"+  mapM_ putPackStream xs+putPackStream (Map m) = do+  let size = HM.size m+  if+    | size < 0x10 -> putWord8 (0xa0 + fromIntegral size)+    | size < 0x100 -> putWord8 0xd8 >> putWord8 (fromIntegral size)+    | size < 0x10000 -> putWord8 0xd9 >> putWord16be (fromIntegral size)+    | size < 0x100000000 -> putWord8 0xda >> putWord16be (fromIntegral size)+    | otherwise -> error "Map too large"+  mapM_ (uncurry putPair) (HM.toList m)+ where+  putPair k v = putPackStream k >> putPackStream v+putPackStream (Struct sig fs) = do+  let size = length fs+  if+    | size < 0x10 -> putWord8 (0xb0 + fromIntegral size)+    | size < 0x100 -> putWord8 0xdc >> putWord8 (fromIntegral size)+    | size < 0x10000 -> putWord8 0xdd >> putWord16be (fromIntegral size)+    | otherwise -> error "Structure too big"+  putWord8 sig+  mapM_ putPackStream fs++pretty :: PackStream -> Text+pretty = prettyStruct genericStructName++prettyStruct :: (Word8 -> Text) -> PackStream -> Text+prettyStruct _ Null = "null"+prettyStruct _ (Bool True) = "true"+prettyStruct _ (Bool False) = "false"+prettyStruct _ (Int i) = T.pack (show i)+prettyStruct _ (Float d) = T.pack (show d)+prettyStruct _ (String t) = "\"" <> t <> "\""+prettyStruct _ (List xs) = "[" <> T.intercalate ", " (pretty <$> V.toList xs) <> "]"+prettyStruct _ (Map ps) = "{" <> T.intercalate ", " (fmap (\(k, v) -> pretty k <> ": " <> pretty v) (HM.toList ps)) <> "}"+prettyStruct sn (Struct s fs) = sn s <> "{" <> T.intercalate ", " (pretty <$> fs) <> "}"++genericStructName :: Word8 -> Text+genericStructName n = "Struct(signature=" <> T.pack (printf "0x%02x" n) <> ")"++(.=) :: (ToPackStream a) => Text -> a -> (PackStream, PackStream)+k .= v = (String k, toPackStream v)++(.:) :: (FromPackStream a) => HM.HashMap PackStream PackStream -> Text -> Parser a+m .: k = maybe (parsefail "Expected Key missing in map") parsePackStream (HM.lookup (String k) m)++(.:?) :: (FromPackStream a) => HM.HashMap PackStream PackStream -> Text -> Parser (Maybe a)+m .:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup (String k) m)++(.!=) :: Parser (Maybe a) -> a -> Parser a+p .!= d = do+  ma <- p+  maybe (return d) return ma

@@ -0,0 +1,41 @@+module Database.Bolt.Exception (+  internalErr,+  transportErr,+  protocolErr,+  authFail,+  reqFail,+  reqIgnore,+) where++import Control.Exception+import Data.Text (Text)+import Database.Bolt.Types++data BoltException+  = AuthenticationFailure Text+  | RequestFailure Object Text+  | RequestIgnored Object Text+  | InternalError Text+  | TransportError Text+  | ProtocolError Text+  deriving (Show)++instance Exception BoltException++authFail :: Text -> IO a+authFail = throwIO . AuthenticationFailure++reqFail :: Object -> Text -> IO a+reqFail meta = throwIO . RequestFailure meta++reqIgnore :: Object -> Text -> IO a+reqIgnore meta = throwIO . RequestIgnored meta++internalErr :: Text -> IO a+internalErr = throwIO . InternalError++transportErr :: Text -> IO a+transportErr = throwIO . TransportError++protocolErr :: Text -> IO a+protocolErr = throwIO . ProtocolError

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Protocol.Ver1 (+  init,+  exec,+  AuthToken (..),+  open,+  Transaction,+  runTransaction,+  cypher,+  object,+  (#=),+  (#:),+  (#:?),+) where++import Control.Monad+import Prelude hiding (init)++import Database.Bolt.Exception+import Database.Bolt.Protocol.Ver1.Message (AuthToken (..))+import Database.Bolt.Protocol.Ver1.Request (exec, init)+import Database.Bolt.Protocol.Ver1.Transaction (Transaction, cypher, runTransaction)+import Database.Bolt.Protocol.Ver1.Types+import Database.Bolt.Transport++useragent :: UserAgent+useragent = "haskell-bolt/0.0"++open :: (Transport t) => (a -> IO t) -> a -> AuthToken -> IO t+open c a auth = do+  conn <- c a+  agreed <- handshake conn (OfferProtocols 1 noProto noProto noProto)+  unless (agreed == 1) $+    protocolErr "Can't negotiate protocol version"+  init conn useragent auth+  return conn

@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Protocol.Ver1.Graph (+  Node (..),+  Relationship (..),+  Path (..),+  UnboundedRelationship (..),+)+where++import Data.Int+import Data.PackStream++import Database.Bolt.Protocol.Ver1.Types++data Node = Node+  { nodeIdentity :: Identity+  , nodeLabels :: [Label]+  , nodeProperties :: Properties+  }+  deriving (Show, Eq)++data Relationship = Relationship+  { relIdentity :: Identity+  , startNodeIdentity :: Identity+  , endNodeIdentity :: Identity+  , relType :: Type+  , relProperties :: Properties+  }+  deriving (Show, Eq)++data Path = Path+  { pathNodes :: [Node]+  , pathRelationships :: [UnboundedRelationship]+  , pathSequence :: [Int64]+  }+  deriving (Show, Eq)++data UnboundedRelationship = UnboundedRelationship+  { urelIdentity :: Identity+  , urelType :: Type+  , urelProperties :: Properties+  }+  deriving (Show, Eq)++instance ToPackStream Node where+  toPackStream (Node nodeid labels props) = Struct 0x4e [toPackStream nodeid, toPackStream labels, toPackStream props]++instance FromPackStream Node where+  parsePackStream s = do+    struct <- parsePackStream s+    case struct of+      (Struct 0x4e [nodeid, labels, props]) -> Node <$> parsePackStream nodeid <*> parsePackStream labels <*> parsePackStream props+      _ -> error "Invalid Node"++instance ToPackStream Relationship where+  toPackStream (Relationship relid start end ty props) =+    Struct+      0x52+      [ toPackStream relid+      , toPackStream start+      , toPackStream end+      , toPackStream ty+      , toPackStream props+      ]++instance FromPackStream Relationship where+  parsePackStream s = do+    struct <- parsePackStream s+    case struct of+      (Struct 0x52 [relid, start, end, ty, props]) ->+        Relationship+          <$> parsePackStream relid+          <*> parsePackStream start+          <*> parsePackStream end+          <*> parsePackStream ty+          <*> parsePackStream props+      _ -> error "Invalid Relationship"++instance ToPackStream Path where+  toPackStream (Path nodes rels seqn) = Struct 0x50 [toPackStream nodes, toPackStream rels, toPackStream seqn]++instance FromPackStream Path where+  parsePackStream s = do+    struct <- parsePackStream s+    case struct of+      (Struct 0x50 [nodes, rels, seqn]) -> Path <$> parsePackStream nodes <*> parsePackStream rels <*> parsePackStream seqn+      _ -> error "Invalid Path"++instance ToPackStream UnboundedRelationship where+  toPackStream (UnboundedRelationship relid ty props) = Struct 0x72 [toPackStream relid, toPackStream ty, toPackStream props]++instance FromPackStream UnboundedRelationship where+  parsePackStream s = do+    struct <- parsePackStream s+    case struct of+      (Struct 0x72 [relid, ty, props]) -> UnboundedRelationship <$> parsePackStream relid <*> parsePackStream ty <*> parsePackStream props+      _ -> error "Invalid UnboundedRelationship"

@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Protocol.Ver1.Message (+  Message (..),+  AuthToken (..),+)+where++import Data.HashMap.Strict qualified as HM+import Data.PackStream+import Data.Text (Text)+import Data.Text qualified as T++import Database.Bolt.Protocol.Ver1.Types++data Message+  = Init UserAgent AuthToken+  | AckFailure+  | Reset+  | Run Statement Parameters+  | DiscardAll+  | PullAll+  | Success Metadata+  | Ignored Metadata+  | Failure Metadata+  | Record Record+  deriving (Show)++instance ToPackStream Message where+  toPackStream (Init useragent authtoken) = Struct 0x01 [toPackStream useragent, toPackStream authtoken]+  toPackStream AckFailure = Struct 0x0e []+  toPackStream Reset = Struct 0x0f []+  toPackStream (Run stmt params) = Struct 0x10 [toPackStream stmt, toPackStream params]+  toPackStream DiscardAll = Struct 0x2f []+  toPackStream PullAll = Struct 0x3f []+  toPackStream (Success metadata) = Struct 0x70 [toPackStream metadata]+  toPackStream (Ignored metadata) = Struct 0x71 [toPackStream metadata]+  toPackStream (Failure metadata) = Struct 0x7e [toPackStream metadata]+  toPackStream (Record record) = Struct 0x7f [toPackStream record]++instance FromPackStream Message where+  parsePackStream s = do+    struct <- parsePackStream s+    case struct of+      (Struct 0x01 [useragent, authtoken]) -> Init <$> parsePackStream useragent <*> parsePackStream authtoken+      (Struct 0x0e []) -> return AckFailure+      (Struct 0x0f []) -> return Reset+      (Struct 0x10 [stmt, params]) -> Run <$> parsePackStream stmt <*> parsePackStream params+      (Struct 0x2f []) -> return DiscardAll+      (Struct 0x3f []) -> return PullAll+      (Struct 0x70 [metadata]) -> Success <$> parsePackStream metadata+      (Struct 0x71 [record]) -> Record <$> parsePackStream record+      (Struct 0x7e [metadata]) -> Ignored <$> parsePackStream metadata+      (Struct 0x7e []) -> return $ Ignored mempty+      (Struct 0x7f [metadata]) -> Failure <$> parsePackStream metadata+      (Struct 0x7f []) -> return $ Failure mempty+      (Struct sn xs) -> error $ "Invalid Message: " ++ T.unpack (pretty (Struct sn xs))+      _ -> error "Invalid Message (not a struct)"++data AuthToken+  = NoAuth+  | Basic Principal Credentials+  deriving (Show)++instance ToPackStream AuthToken where+  toPackStream NoAuth = Map $ HM.fromList ["scheme" .= ("none" :: Text)]+  toPackStream (Basic user pass) =+    Map $+      HM.fromList+        [ "scheme" .= ("basic" :: Text)+        , "principal" .= user+        , "credentials" .= pass+        ]++instance FromPackStream AuthToken where+  parsePackStream (Map m) = do+    scheme <- m .:? "scheme" .!= "none"+    parseScheme scheme+   where+    parseScheme :: Text -> Parser AuthToken+    parseScheme "none" = return NoAuth+    parseScheme "basic" =+      Basic+        <$> m .: "principal"+        <*> m .: "credentials"+    parseScheme _ = error "Unknown authentication scheme"+  parsePackStream _ = error "AuthToken should be a map"

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Protocol.Ver1.Pretty (+  pretty,+  structName,+) where++import Data.PackStream (PackStream, genericStructName, prettyStruct)+import Data.Text+import Data.Word++pretty :: PackStream -> Text+pretty = prettyStruct structName++structName :: Word8 -> Text+structName 0x01 = "InitMessage"+structName 0x0e = "AckFailureMessage"+structName 0x0f = "ResetMessage"+structName 0x10 = "RunMessage"+structName 0x2f = "DiscardAllMessage"+structName 0x3f = "PullAllMessage"+structName 0x4e = "Node"+structName 0x50 = "Path"+structName 0x52 = "Relationship"+structName 0x70 = "SuccessMessage"+structName 0x71 = "RecordMessage"+structName 0x72 = "UnboundedRelationship"+structName 0x7e = "IgnoredMessage"+structName 0x7f = "FailureMessage"+structName n = genericStructName n

@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Protocol.Ver1.Request (+  init,+  reset,+  discardAll,+  pullAll,+  run,+  exec,+) where++import Prelude hiding (init)++import Database.Bolt.Exception+import Database.Bolt.Protocol.Ver1.Message (AuthToken, Message)+import Database.Bolt.Protocol.Ver1.Message qualified as Msg+import Database.Bolt.Protocol.Ver1.Types+import Database.Bolt.Transport+import Database.Bolt.Transport.Message++data Response+  = Success Metadata [Record]+  | Failed Metadata+  | Ignored Metadata++request :: (Transport t) => t -> Message -> IO Response+request conn msg = do+  -- print ("send", msg)+  sendmsg conn msg+  gather []+ where+  gather vals = do+    reply <- recvmsg conn+    -- print ("recv", reply)+    case reply of+      Msg.Success meta -> return $ Success meta (reverse vals)+      Msg.Failure meta -> return $ Failed meta+      Msg.Ignored meta -> return $ Ignored meta+      Msg.Record val -> gather (val : vals)+      _ -> protocolErr "Unexpected message in response"++simple :: (Transport t) => t -> Message -> IO ()+simple conn msg = do+  resp <- request conn msg+  case resp of+    Success _ [] -> return ()+    Success meta _ -> reqFail meta "Request not expecting records"+    Failed meta -> reqFail meta "Request failed"+    Ignored meta -> reqIgnore meta "Request ignored"++detail :: (Transport t) => t -> Message -> IO [Record]+detail conn msg = do+  resp <- request conn msg+  case resp of+    Success _ rs -> return rs+    Failed meta -> reqFail meta "Request failed"+    Ignored meta -> reqIgnore meta "Request ignored"++init :: (Transport t) => t -> UserAgent -> AuthToken -> IO ()+init conn agent auth = simple conn $ Msg.Init agent auth++reset :: (Transport t) => t -> IO ()+reset conn = simple conn Msg.Reset++discardAll :: (Transport t) => t -> IO ()+discardAll conn = simple conn Msg.DiscardAll++pullAll :: (Transport t) => t -> IO [Record]+pullAll conn = detail conn Msg.PullAll++run :: (Transport t) => t -> Statement -> Parameters -> IO ()+run conn stmt params = simple conn $ Msg.Run stmt params++exec :: (Transport t) => t -> Statement -> Parameters -> IO [Record]+exec conn stmt params = do+  run conn stmt params+  pullAll conn

@@ -0,0 +1,43 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}++module Database.Bolt.Protocol.Ver1.Transaction (+  Transaction,+  Tran (..),+  runTransaction,+  cypher,+) where++import Control.Exception+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Data.HashMap.Strict qualified as HM+import Database.Bolt.Protocol.Ver1.Request+import Database.Bolt.Protocol.Ver1.Types+import Database.Bolt.Transport++newtype Tran t a = Tran {unTran :: ReaderT t IO a}+  deriving (Functor, Applicative, Monad, MonadIO)++type Transaction a = forall t. (Transport t) => Tran t a++runTransaction :: (Transport t) => t -> Transaction a -> IO a+runTransaction conn t = do+  _ <- exec conn "BEGIN" HM.empty+  r <- try $ runReaderT (unTran t) conn+  case r of+    Left (SomeException ex) -> do+      reset conn+      throwIO ex+    Right a -> do+      _ <- exec conn "COMMIT" HM.empty+      return a++getConn :: Tran t t+getConn = Tran ask++cypher :: Statement -> Parameters -> Transaction [Record]+cypher stmt params = do+  conn <- getConn+  liftIO $ exec conn stmt params

@@ -0,0 +1,46 @@+module Database.Bolt.Protocol.Ver1.Types (+  Object,+  object,+  UserAgent,+  Principal,+  Credentials,+  Statement,+  Label,+  Type,+  Identity,+  Parameters,+  Properties,+  Metadata,+  Record,+  (#=),+  (#:),+  (#:?),+) where++import Data.HashMap.Strict qualified as HM+import Data.Int+import Data.PackStream+import Data.Text (Text)+import Database.Bolt.Types (Object, object)++type UserAgent = Text+type Principal = Text+type Credentials = Text+type Statement = Text+type Label = Text+type Type = Text+type Identity = Int64++type Parameters = Object+type Properties = Object+type Metadata = Object+type Record = [PackStream]++(#=) :: (ToPackStream a) => Text -> a -> (Text, PackStream)+k #= v = (k, toPackStream v)++(#:) :: (FromPackStream a) => Object -> Text -> Parser a+m #: k = maybe (parsefail "Expected Key missing in object") parsePackStream (HM.lookup k m)++(#:?) :: (FromPackStream a) => Object -> Text -> Parser (Maybe a)+m #:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup k m)

@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Transport (+  Transport (..),+  put,+  get,+  getE,+  handshake,+  BoltProtocol,+  OfferProtocols (..),+  noProto,+) where++import Data.ByteString qualified as BS+import Data.Monoid+import Data.Serialize.Get+import Data.Serialize.Put+import Data.Text as T+import Data.Word++import Database.Bolt.Exception++-- Transport++class Transport t where+  send :: t -> BS.ByteString -> IO ()+  recv :: t -> Int -> IO BS.ByteString+  close :: t -> IO ()++  sendMany :: t -> [BS.ByteString] -> IO ()+  sendMany conn = mapM_ (send conn)++put :: (Transport t) => t -> Put -> IO ()+put conn = send conn . runPut++get :: (Transport t) => t -> Int -> Get a -> IO a+get conn n g = getE conn n g >>= either bad return+ where+  bad e = transportErr $ "Bad data received: " <> T.pack e++getE :: (Transport t) => t -> Int -> Get a -> IO (Either String a)+getE conn n g = runGet g <$> recv conn n++-- Protocol negotiation++type BoltProtocol = Word32++noProto :: BoltProtocol+noProto = 0++data OfferProtocols = OfferProtocols BoltProtocol BoltProtocol BoltProtocol BoltProtocol+  deriving (Show, Eq, Ord)++handshake :: (Transport t) => t -> OfferProtocols -> IO BoltProtocol+handshake conn offer = do+  put conn (gogobolt >> offerProtocols offer)+  get conn 4 agreedProtocol++gogobolt :: Put+gogobolt = mapM_ putWord8 [0x60, 0x60, 0xb0, 0x17]++offerProtocols :: Putter OfferProtocols+offerProtocols (OfferProtocols p1 p2 p3 p4) = mapM_ offerProtocol [p1, p2, p3, p4]+ where+  offerProtocol = putWord32be++agreedProtocol :: Get BoltProtocol+agreedProtocol = getWord32be

@@ -0,0 +1,77 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Transport.Chunked (+  send,+  recv,+  put,+  get,+) where++import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.Monoid+import Data.Serialize.Get+import Data.Serialize.Put+import Data.Text qualified as T++import Database.Bolt.Exception+import Database.Bolt.Transport (Transport)+import Database.Bolt.Transport qualified as Trans++-------- Chunked I/O --------++send :: (Transport t) => t -> LBS.ByteString -> IO ()+send conn lbs = Trans.put conn $ mapM_ putChunks (LBS.toChunks lbs) >> done+ where+  maxChunk = 0xffff++  done = putWord16be 0++  putChunks bs = do+    let sz = BS.length bs+    if+      | sz == 0 -> return ()+      | sz > maxChunk -> split bs+      | otherwise -> sendChunk bs++  split bs = do+    let (bs1, bs2) = BS.splitAt maxChunk bs+    sendChunk bs1+    putChunks bs2++  sendChunk bs = do+    putWord16be $ fromIntegral $ BS.length bs+    putByteString bs++recv :: (Transport t) => t -> IO LBS.ByteString+recv conn = LBS.fromChunks <$> getChunks+ where+  getChunks = do+    size <- Trans.get conn 2 getWord16be+    case size of+      0 -> return []+      csz -> do+        bs <- getChunk csz+        bs' <- getChunks+        return (bs ++ bs')++  getChunk n = do+    bs <- Trans.recv conn (fromIntegral n)+    let sz = fromIntegral $ BS.length bs+    if+      | sz == 0 -> transportErr "Unexpected end of stream"+      | sz < n -> do+          bs' <- getChunk (n - sz)+          return (bs : bs')+      | otherwise -> return [bs]++put :: (Transport t) => t -> Put -> IO ()+put conn = send conn . runPutLazy++get :: (Transport t) => t -> Get a -> IO a+get conn g = do+  lbs <- recv conn+  case runGetLazy g lbs of+    Left err -> transportErr $ "Unexpected data received: " <> T.pack err+    Right a -> return a

@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Bolt.Transport.Message (+  sendmsg,+  recvmsg,+) where++import Data.Monoid+import Data.PackStream+import Data.Text qualified as T++import Database.Bolt.Exception+import Database.Bolt.Transport (Transport)+import Database.Bolt.Transport.Chunked qualified as Chunked++-------- Message I/O --------++sendmsg :: (Transport t, ToPackStream a) => t -> a -> IO ()+sendmsg conn = Chunked.put conn . pack++recvmsg :: (Transport t, FromPackStream a) => t -> IO a+recvmsg conn = do+  ma <- Chunked.get conn unpack+  case ma of+    Left e -> transportErr $ "Couldn't unpack received data: " <> T.pack e+    Right a -> return a

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Database.Bolt.Transport.Socket (+  ConnInfo,+  hostserv,+  uri,+  Connection,+  connect,+  close,+  send,+  sendMany,+  recv,+  put,+  get,+) where++import Control.Exception+import Control.Monad+import Data.Monoid+import Data.Text qualified as T+import Network.Socket qualified as Net+import Network.Socket.ByteString qualified as NetBS+import Network.URI++import Database.Bolt.Exception+import Database.Bolt.Transport++-------- Socket --------++newtype Connection = Connection {connSocket :: Net.Socket}++instance Transport Connection where+  send = NetBS.sendAll . connSocket+  sendMany = NetBS.sendMany . connSocket+  recv = NetBS.recv . connSocket+  close = Net.close . connSocket++data ConnInfo = ConnInfo+  { connHost :: Net.HostName+  , connService :: Net.ServiceName+  }+  deriving (Show, Read, Eq, Ord)++-------- Connections --------++-- Create ConnInfo from a host and service name+hostserv :: String -> String -> ConnInfo+hostserv = ConnInfo++-- Create ConnInfo from a bolt URI+uri :: String -> Maybe ConnInfo+uri uristr = do+  uri' <- parseAbsoluteURI uristr+  guard $ uriScheme uri' == "bolt"+  auth <- uriAuthority uri'+  guard $ uriUserInfo auth == ""+  guard $ uriPath uri' == ""+  guard $ uriQuery uri' == ""+  guard $ uriFragment uri' == ""+  return+    ConnInfo+      { connHost = uriRegName auth+      , connService = uriPort auth+      }++-- Connect using ConnInfo and return a handle+connect :: ConnInfo -> IO Connection+connect ConnInfo{..} = do+  let hints = Net.defaultHints{Net.addrSocketType = Net.Stream}+  addrs <- Net.getAddrInfo (Just hints) (Just connHost) (Just connService)+  connectAny addrs+ where+  connectAny [] = transportErr $ "Unable to connect to " <> T.pack connHost <> ":" <> T.pack connService+  connectAny (addr : addrs) = doConnect addr `catch` (\(_ :: IOException) -> connectAny addrs)++  doConnect addr = do+    sock <- Net.socket (Net.addrFamily addr) (Net.addrSocketType addr) (Net.addrProtocol addr)+    Net.connect sock (Net.addrAddress addr) `onException` Net.close sock+    return $ Connection sock

@@ -0,0 +1,14 @@+module Database.Bolt.Types (+  Object,+  object,+) where++import Data.HashMap.Strict qualified as HM+import Data.Hashable+import Data.PackStream+import Data.Text (Text)++type Object = HM.HashMap Text PackStream++object :: (Eq k, Hashable k) => [(k, v)] -> HM.HashMap k v+object = HM.fromList

@@ -1,311 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE MultiWayIf        #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Data.PackStream
-  ( PackStream(..)
-  , ToPackStream(..)
-  , FromPackStream(..)
-  , Parser
-  , parse
-  , parsefail
-  , parseEither
-  , parseMaybe
-  , pack
-  , unpack
-  , pretty
-  , prettyStruct
-  , genericStructName
-  , (.=)
-  , (.:)
-  , (.:?)
-  , (.!=)
-  )
-where
-
-import           Control.Monad
-import           Data.Bifunctor
-import           Data.Bits
-import qualified Data.ByteString        as BS
-import           Data.Hashable
-import qualified Data.HashMap.Strict    as HM
-import           Data.Int
-import qualified Data.Map.Strict        as M
-import           Data.Monoid
-import           Data.Scientific
-import           Data.Serialize.Get
-import           Data.Serialize.IEEE754
-import           Data.Serialize.Put
-import           Data.Text              (Text)
-import qualified Data.Text              as T
-import qualified Data.Text.Encoding     as T
-import qualified Data.Vector            as V
-import           Data.Word
-import           GHC.Generics           (Generic)
-import           Text.Printf
-
--- Orphan instance should go away once vector-instances 0.4 is available
-instance (Hashable a) => Hashable (V.Vector a) where
-    hashWithSalt salt = hashWithSalt salt . V.toList
-    {-# INLINE hashWithSalt #-}
-
-data PackStream = Null
-                | Bool   !Bool
-                | Int    !Int64
-                | Float  !Double
-                | String !Text
-                | List   !(V.Vector PackStream)
-                | Map    !(HM.HashMap PackStream PackStream)
-                | Struct !Word8 ![PackStream]
-    deriving (Show, Eq, Generic, Hashable)
-
-type Parser = Either String
-
-parse :: (a -> Parser b) -> a -> Parser b
-parse = parseEither
-
-parseEither :: (a -> Parser b) -> a -> Either String b
-parseEither f = f
-
-parseMaybe :: (a -> Parser b) -> a -> Maybe b
-parseMaybe f = either (const Nothing) Just . parseEither f
-
-parsefail :: a -> Either a b
-parsefail = Left
-
-class FromPackStream a where
-    parsePackStream :: PackStream -> Parser a
-
-instance FromPackStream PackStream where
-    parsePackStream = return
-
-instance FromPackStream Bool where
-    parsePackStream (Bool b) = return b
-    parsePackStream _        = parsefail "Expecting Bool"
-
-instance FromPackStream Int64 where
-    parsePackStream (Int i) = return i
-    parsePackStream _       = parsefail "Expecting Int"
-
-instance FromPackStream Double where
-    parsePackStream (Float d) = return d
-    parsePackStream _         = parsefail "Expecting Float"
-
-instance FromPackStream Text where
-    parsePackStream (String t) = return t
-    parsePackStream _          = parsefail "Expecting String"
-
-instance FromPackStream a => FromPackStream [a] where
-    parsePackStream (List l) = mapM parsePackStream (V.toList l)
-    parsePackStream _        = parsefail "Expecting List"
-
-instance FromPackStream a => FromPackStream (V.Vector a) where
-    parsePackStream (List l) = mapM parsePackStream l
-    parsePackStream _        = parsefail "Expecting List"
-
-instance (Eq a, Hashable a, FromPackStream a, FromPackStream b) => FromPackStream (HM.HashMap a b) where
-    parsePackStream (Map m) = do
-        kvs <- mapM parseAssoc (HM.toList m)
-        return $ HM.fromList kvs
-      where
-        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v
-
-    parsePackStream _ = parsefail "Expecting Map"
-
-instance (Ord a, FromPackStream a, FromPackStream b) => FromPackStream (M.Map a b) where
-    parsePackStream (Map m) = do
-        kvs <- mapM parseAssoc (HM.toList m)
-        return $ M.fromList kvs
-      where
-        parseAssoc (k, v) = (,) <$> parsePackStream k <*> parsePackStream v
-
-    parsePackStream _ = parsefail "Expecting Map"
-
-instance FromPackStream Scientific where
-    parsePackStream (Int i)   = return $ fromIntegral i
-    parsePackStream (Float f) = return $ fromFloatDigits f
-    parsePackStream _         = parsefail "Expecting Int or Float"
-
-class ToPackStream a where
-    toPackStream :: a -> PackStream
-
-instance ToPackStream PackStream where
-    toPackStream = id
-
-instance ToPackStream Bool where
-    toPackStream = Bool
-
-instance ToPackStream Int64 where
-    toPackStream = Int
-
-instance ToPackStream Double where
-    toPackStream = Float
-
-instance ToPackStream Text where
-    toPackStream = String
-
-instance ToPackStream a => ToPackStream [a] where
-    toPackStream = List . V.fromList . fmap toPackStream
-
-instance ToPackStream a => ToPackStream (V.Vector a) where
-    toPackStream = List . fmap toPackStream
-
-instance (ToPackStream a, ToPackStream b) => ToPackStream (M.Map a b) where
-    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . M.toList
-
-instance (ToPackStream a, ToPackStream b) => ToPackStream (HM.HashMap a b) where
-    toPackStream = Map . HM.fromList . fmap (bimap toPackStream toPackStream) . HM.toList
-
-instance ToPackStream Scientific where
-    toPackStream s =
-        case Data.Scientific.floatingOrInteger s of
-            Left rf -> Float rf
-            Right i -> Int i
-
-pack :: ToPackStream a => Putter a
-pack = putPackStream . toPackStream
-
-unpack :: FromPackStream a => Get (Parser a)
-unpack = parsePackStream <$> getPackStream
-
-getPackStream :: Get PackStream
-getPackStream = do
-    marker <- getWord8
-    if | marker == 0xc0   -> return Null
-
-       | marker == 0xc1   -> Float <$> getFloat64be
-
-       | marker == 0xc2   -> return $ Bool False
-       | marker == 0xc3   -> return $ Bool True
-
-       | marker <  0x80   -> return $ Int (fromIntegral marker)
-       | marker >= 0xf0   -> return $ Int (fromIntegral marker - 0x100)
-       | marker == 0xc8   -> Int . fromIntegral <$> getInt8
-       | marker == 0xc9   -> Int . fromIntegral <$> getInt16be
-       | marker == 0xca   -> Int . fromIntegral <$> getInt32be
-       | marker == 0xcb   -> Int . fromIntegral <$> getInt64be
-
-       | 0x80 <= marker && marker < 0x90
-                          -> getString (fromIntegral marker .&. 0x0f)
-       | marker == 0xd0   -> fromIntegral <$> getWord8    >>= getString
-       | marker == 0xd1   -> fromIntegral <$> getWord16be >>= getString
-       | marker == 0xd2   -> fromIntegral <$> getWord32be >>= getString
-
-       | 0x90 <= marker && marker < 0xa0
-                          -> getList (fromIntegral marker .&. 0x0f)
-       | marker == 0xd4   -> fromIntegral <$> getWord8    >>= getList
-       | marker == 0xd5   -> fromIntegral <$> getWord16be >>= getList
-       | marker == 0xd6   -> fromIntegral <$> getWord32be >>= getList
-
-       | 0xa0 <= marker && marker < 0xb0
-                          -> getMap (fromIntegral marker .&. 0x0f)
-       | marker == 0xd8   -> fromIntegral <$> getWord8    >>= getMap
-       | marker == 0xd9   -> fromIntegral <$> getWord16be >>= getMap
-       | marker == 0xda   -> fromIntegral <$> getWord32be >>= getMap
-
-       | 0xb0 <= marker && marker < 0xc0
-                          -> getStruct (fromIntegral marker .&. 0x0f)
-       | marker == 0xdc   -> fromIntegral <$> getWord8    >>= getStruct
-       | marker == 0xdd   -> fromIntegral <$> getWord16be >>= getStruct
-       | otherwise        -> fail $ "Unknown marker " ++ printf "0x%02x" marker
-
-getString :: Int -> Get PackStream
-getString n = String . T.decodeUtf8 <$> getByteString n
-
-getList :: Int -> Get PackStream
-getList n = List . V.fromList <$> replicateM n getPackStream
-
-getMap :: Int -> Get PackStream
-getMap n = Map . HM.fromList <$> replicateM n getPair
-  where
-    getPair = (,) <$> getPackStream <*> getPackStream
-
-getStruct :: Int -> Get PackStream
-getStruct n = Struct <$> getWord8 <*> replicateM n getPackStream
-
-putPackStream :: Putter PackStream
-
-putPackStream Null          = putWord8 0xc0
-
-putPackStream (Float d)     = putWord8 0xc1 >> putFloat64be d
-
-putPackStream (Bool False)  = putWord8 0xc2
-putPackStream (Bool True)   = putWord8 0xc3
-
-putPackStream (Int i)
-    |               -0x10 <= i && i < 0x80               =                  putInt8    (fromIntegral i)
-    |               -0x80 <= i && i < 0x80               = putWord8 0xc8 >> putInt8    (fromIntegral i)
-    |             -0x8000 <= i && i < 0x8000             = putWord8 0xc9 >> putInt16be (fromIntegral i)
-    |         -0x80000000 <= i && i < 0x80000000         = putWord8 0xca >> putInt32be (fromIntegral i)
-    | otherwise                                          = putWord8 0xcb >> putInt64be (fromIntegral i)
-
-putPackStream (String t) = do
-    let bstr = T.encodeUtf8 t
-        size = BS.length bstr
-    if | size < 0x10         -> putWord8 (0x80 + fromIntegral size)
-       | size < 0x100        -> putWord8 0xd0 >> putWord8    (fromIntegral size)
-       | size < 0x10000      -> putWord8 0xd1 >> putWord16be (fromIntegral size)
-       | size < 0x100000000  -> putWord8 0xd2 >> putWord16be (fromIntegral size)
-       | otherwise           -> fail "String too long"
-    putByteString $ T.encodeUtf8 t
-
-putPackStream (List xs) = do
-    let size = V.length xs
-    if | size < 0x10         -> putWord8 (0x90 + fromIntegral size)
-       | size < 0x100        -> putWord8 0xd4 >> putWord8    (fromIntegral size)
-       | size < 0x10000      -> putWord8 0xd5 >> putWord16be (fromIntegral size)
-       | size < 0x100000000  -> putWord8 0xd6 >> putWord16be (fromIntegral size)
-       | otherwise           -> fail "List too long"
-    mapM_ putPackStream xs
-
-putPackStream (Map m) = do
-    let size = HM.size m
-    if | size < 0x10         -> putWord8 (0xa0 + fromIntegral size)
-       | size < 0x100        -> putWord8 0xd8 >> putWord8    (fromIntegral size)
-       | size < 0x10000      -> putWord8 0xd9 >> putWord16be (fromIntegral size)
-       | size < 0x100000000  -> putWord8 0xda >> putWord16be (fromIntegral size)
-       | otherwise           -> fail "Map too large"
-    mapM_ (uncurry putPair) (HM.toList m)
-  where
-    putPair k v = putPackStream k >> putPackStream v
-
-putPackStream (Struct sig fs) = do
-    let size = length fs
-    if | size < 0x10         -> putWord8 (0xb0 + fromIntegral size)
-       | size < 0x100        -> putWord8 0xdc >> putWord8    (fromIntegral size)
-       | size < 0x10000      -> putWord8 0xdd >> putWord16be (fromIntegral size)
-       | otherwise           -> fail "Structure too big"
-    putWord8 sig
-    mapM_ putPackStream fs
-
-pretty :: PackStream -> Text
-pretty = prettyStruct genericStructName
-
-prettyStruct :: (Word8 -> Text) -> PackStream -> Text
-prettyStruct _  Null           = "null"
-prettyStruct _  (Bool True)    = "true"
-prettyStruct _  (Bool False)   = "false"
-prettyStruct _  (Int i)        = T.pack (show i)
-prettyStruct _  (Float d)      = T.pack (show d)
-prettyStruct _  (String t)     = "\"" <> t <> "\""
-prettyStruct _  (List xs)      = "[" <> T.intercalate ", " (pretty <$> V.toList xs) <> "]"
-prettyStruct _  (Map ps)       = "{" <> T.intercalate ", " (fmap (\(k, v) -> pretty k <> ": " <> pretty v) (HM.toList ps)) <> "}"
-prettyStruct sn (Struct s fs)  = sn s <> "{" <> T.intercalate ", " (pretty <$> fs) <> "}"
-
-genericStructName :: Word8 -> Text
-genericStructName n = "Struct(signature=" <> T.pack (printf "0x%02x" n) <> ")"
-
-(.=) :: ToPackStream a => Text -> a -> (PackStream, PackStream)
-k .= v = (String k, toPackStream v)
-
-(.:) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser a
-m .: k = maybe (parsefail "Expected Key missing in map") parsePackStream (HM.lookup (String k) m)
-
-(.:?) :: FromPackStream a => HM.HashMap PackStream PackStream -> Text -> Parser (Maybe a)
-m .:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup (String k) m)
-
-(.!=) :: Parser (Maybe a) -> a -> Parser a
-p .!= d = do
-    ma <- p
-    maybe (return d) return ma

@@ -1,40 +0,0 @@-module Database.Bolt.Exception
-    ( internalErr
-    , transportErr
-    , protocolErr
-    , authFail
-    , reqFail
-    , reqIgnore
-    ) where
-
-import           Control.Exception
-import           Data.Text           (Text)
-import           Database.Bolt.Types
-
-data BoltException = AuthenticationFailure Text
-                   | RequestFailure Object Text
-                   | RequestIgnored Object Text
-                   | InternalError Text
-                   | TransportError Text
-                   | ProtocolError Text
-    deriving (Show)
-
-instance Exception BoltException
-
-authFail :: Text -> IO a
-authFail = throwIO . AuthenticationFailure
-
-reqFail :: Object -> Text -> IO a
-reqFail meta = throwIO . RequestFailure meta
-
-reqIgnore :: Object -> Text -> IO a
-reqIgnore meta = throwIO . RequestIgnored meta
-
-internalErr :: Text -> IO a
-internalErr = throwIO . InternalError
-
-transportErr :: Text -> IO a
-transportErr = throwIO . TransportError
-
-protocolErr :: Text -> IO a
-protocolErr = throwIO . ProtocolError

@@ -1,37 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Protocol.Ver1
- ( init
- , exec
- , AuthToken(..)
- , open
- , Transaction
- , runTransaction
- , cypher
- , object
- , (#=)
- , (#:)
- , (#:?)
- ) where
-
-import           Control.Monad
-import           Prelude                                 hiding (init)
-
-import           Database.Bolt.Exception
-import           Database.Bolt.Protocol.Ver1.Message     (AuthToken (..))
-import           Database.Bolt.Protocol.Ver1.Request     (exec, init)
-import           Database.Bolt.Protocol.Ver1.Transaction (Transaction, cypher, runTransaction)
-import           Database.Bolt.Protocol.Ver1.Types
-import           Database.Bolt.Transport
-
-useragent :: UserAgent
-useragent = "haskell-bolt/0.0"
-
-open :: Transport t => (a -> IO t) -> a -> AuthToken -> IO t
-open c a auth = do
-    conn <- c a
-    agreed <- handshake conn (OfferProtocols 1 noProto noProto noProto)
-    unless (agreed == 1) $
-        protocolErr "Can't negotiate protocol version"
-    init conn useragent auth
-    return conn

@@ -1,82 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Protocol.Ver1.Graph
- ( Node(..)
- , Relationship(..)
- , Path(..)
- , UnboundedRelationship(..)
- )
-where
-
-import           Data.Int
-import           Data.PackStream
-
-import           Database.Bolt.Protocol.Ver1.Types
-
-data Node = Node
-    { nodeIdentity      :: Identity
-    , nodeLabels        :: [Label]
-    , nodeProperties    :: Properties
-    } deriving (Show, Eq)
-
-data Relationship = Relationship
-    { relIdentity       :: Identity
-    , startNodeIdentity :: Identity
-    , endNodeIdentity   :: Identity
-    , relType           :: Type
-    , relProperties     :: Properties
-    } deriving (Show, Eq)
-
-data Path = Path
-    { pathNodes         :: [Node]
-    , pathRelationships :: [UnboundedRelationship]
-    , pathSequence      :: [Int64]
-    } deriving (Show, Eq)
-
-data UnboundedRelationship = UnboundedRelationship
-    { urelIdentity      :: Identity
-    , urelType          :: Type
-    , urelProperties    :: Properties
-    } deriving (Show, Eq)
-
-instance ToPackStream Node where
-    toPackStream (Node nodeid labels props) = Struct 0x4e [toPackStream nodeid, toPackStream labels, toPackStream props]
-
-instance FromPackStream Node where
-    parsePackStream s = do
-        struct <- parsePackStream s
-        case struct of
-            (Struct 0x4e [nodeid, labels, props]) -> Node <$> parsePackStream nodeid <*> parsePackStream labels <*> parsePackStream props
-            _                                     -> error "Invalid Node"
-
-instance ToPackStream Relationship where
-    toPackStream (Relationship relid start end ty props) = Struct 0x52 [ toPackStream relid, toPackStream start, toPackStream end
-                                                                       , toPackStream ty, toPackStream props ]
-
-instance FromPackStream Relationship where
-    parsePackStream s = do
-        struct <- parsePackStream s
-        case struct of
-            (Struct 0x52 [relid, start, end, ty, props]) -> Relationship <$> parsePackStream relid <*> parsePackStream start <*> parsePackStream end
-                                                                         <*> parsePackStream ty <*> parsePackStream props
-            _                                            -> error "Invalid Relationship"
-
-instance ToPackStream Path where
-    toPackStream (Path nodes rels seqn) = Struct 0x50 [ toPackStream nodes, toPackStream rels, toPackStream seqn]
-
-instance FromPackStream Path where
-    parsePackStream s = do
-        struct <- parsePackStream s
-        case struct of
-            (Struct 0x50 [nodes, rels, seqn]) -> Path <$> parsePackStream nodes <*> parsePackStream rels <*> parsePackStream seqn
-            _                                 -> error "Invalid Path"
-
-instance ToPackStream UnboundedRelationship where
-    toPackStream (UnboundedRelationship relid ty props) = Struct 0x72 [toPackStream relid, toPackStream ty, toPackStream props]
-
-instance FromPackStream UnboundedRelationship where
-    parsePackStream s = do
-        struct <- parsePackStream s
-        case struct of
-            (Struct 0x72 [relid, ty, props]) -> UnboundedRelationship <$> parsePackStream relid <*> parsePackStream ty <*> parsePackStream props
-            _                                -> error "Invalid UnboundedRelationship"

@@ -1,81 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Protocol.Ver1.Message
- ( Message(..)
- , AuthToken(..)
- )
-where
-
-import qualified Data.HashMap.Strict               as HM
-import           Data.PackStream
-import           Data.Text                         (Text)
-import qualified Data.Text                         as T
-
-import           Database.Bolt.Protocol.Ver1.Types
-
-data Message = Init UserAgent AuthToken
-             | AckFailure
-             | Reset
-             | Run Statement Parameters
-             | DiscardAll
-             | PullAll
-             | Success Metadata
-             | Ignored Metadata
-             | Failure Metadata
-             | Record Record
-    deriving (Show)
-
-instance ToPackStream Message where
-    toPackStream (Init useragent authtoken) = Struct 0x01 [toPackStream useragent, toPackStream authtoken]
-    toPackStream AckFailure                 = Struct 0x0e []
-    toPackStream Reset                      = Struct 0x0f []
-    toPackStream (Run stmt params)          = Struct 0x10 [toPackStream stmt, toPackStream params]
-    toPackStream DiscardAll                 = Struct 0x2f []
-    toPackStream PullAll                    = Struct 0x3f []
-    toPackStream (Success metadata)         = Struct 0x70 [toPackStream metadata]
-    toPackStream (Ignored metadata)         = Struct 0x71 [toPackStream metadata]
-    toPackStream (Failure metadata)         = Struct 0x7e [toPackStream metadata]
-    toPackStream (Record  record)           = Struct 0x7f [toPackStream record]
-
-instance FromPackStream Message where
-    parsePackStream s = do
-        struct <- parsePackStream s
-        case struct of
-            (Struct 0x01 [useragent, authtoken]) -> Init <$> parsePackStream useragent <*> parsePackStream authtoken
-            (Struct 0x0e [])                     -> return AckFailure
-            (Struct 0x0f [])                     -> return Reset
-            (Struct 0x10 [stmt, params])         -> Run <$> parsePackStream stmt <*> parsePackStream params
-            (Struct 0x2f [])                     -> return DiscardAll
-            (Struct 0x3f [])                     -> return PullAll
-            (Struct 0x70 [metadata])             -> Success <$> parsePackStream metadata
-            (Struct 0x71 [record])               -> Record <$> parsePackStream record
-            (Struct 0x7e [metadata])             -> Ignored <$> parsePackStream metadata
-            (Struct 0x7e [])                     -> return $ Ignored mempty
-            (Struct 0x7f [metadata])             -> Failure <$> parsePackStream metadata
-            (Struct 0x7f [])                     -> return $ Failure mempty
-            (Struct sn xs)                       -> error $ "Invalid Message: " ++ T.unpack (pretty (Struct sn xs))
-            _                                    -> error "Invalid Message (not a struct)"
-
-data AuthToken = NoAuth
-               | Basic Principal Credentials
-    deriving (Show)
-
-instance ToPackStream AuthToken where
-    toPackStream NoAuth            = Map $ HM.fromList [ "scheme"      .= ("none"  :: Text) ]
-    toPackStream (Basic user pass) = Map $ HM.fromList [ "scheme"      .= ("basic" :: Text)
-                                                       , "principal"   .= user
-                                                       , "credentials" .= pass
-                                                       ]
-
-instance FromPackStream AuthToken where
-    parsePackStream (Map m) = do
-        scheme <- m .:? "scheme" .!= "none"
-        parseScheme scheme
-      where
-        parseScheme :: Text -> Parser AuthToken
-        parseScheme "none"  = return NoAuth
-        parseScheme "basic" = Basic <$> m .: "principal"
-                                    <*> m .: "credentials"
-        parseScheme _       = error "Unknown authentication scheme"
-
-    parsePackStream _ = error "AuthToken should be a map"

@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Protocol.Ver1.Pretty
- ( pretty
- , structName
- ) where
-
-import           Data.PackStream (PackStream, genericStructName, prettyStruct)
-import           Data.Text
-import           Data.Word
-
-pretty :: PackStream -> Text
-pretty = prettyStruct structName
-
-structName :: Word8 -> Text
-structName 0x01 = "InitMessage"
-structName 0x0e = "AckFailureMessage"
-structName 0x0f = "ResetMessage"
-structName 0x10 = "RunMessage"
-structName 0x2f = "DiscardAllMessage"
-structName 0x3f = "PullAllMessage"
-structName 0x4e = "Node"
-structName 0x50 = "Path"
-structName 0x52 = "Relationship"
-structName 0x70 = "SuccessMessage"
-structName 0x71 = "RecordMessage"
-structName 0x72 = "UnboundedRelationship"
-structName 0x7e = "IgnoredMessage"
-structName 0x7f = "FailureMessage"
-structName n    = genericStructName n

@@ -1,76 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Protocol.Ver1.Request
- ( init
- , reset
- , discardAll
- , pullAll
- , run
- , exec
- ) where
-
-import           Prelude                             hiding (init)
-
-import           Database.Bolt.Exception
-import           Database.Bolt.Protocol.Ver1.Message (AuthToken, Message)
-import qualified Database.Bolt.Protocol.Ver1.Message as Msg
-import           Database.Bolt.Protocol.Ver1.Types
-import           Database.Bolt.Transport
-import           Database.Bolt.Transport.Message
-
-data Response = Success Metadata [Record]
-              | Failed Metadata
-              | Ignored Metadata
-
-request :: Transport t => t -> Message -> IO Response
-request conn msg = do
-    -- print ("send", msg)
-    sendmsg conn msg
-    gather []
-  where
-    gather vals = do
-        reply <- recvmsg conn
-        -- print ("recv", reply)
-        case reply of
-            Msg.Success meta -> return $ Success meta (reverse vals)
-            Msg.Failure meta -> return $ Failed meta
-            Msg.Ignored meta -> return $ Ignored meta
-            Msg.Record  val   -> gather (val : vals)
-            _                 -> protocolErr "Unexpected message in response"
-
-simple :: Transport t => t -> Message -> IO ()
-simple conn msg = do
-    resp <- request conn msg
-    case resp of
-        Success _    [] -> return ()
-        Success meta _  -> reqFail meta "Request not expecting records"
-        Failed  meta    -> reqFail meta "Request failed"
-        Ignored meta    -> reqIgnore meta "Request ignored"
-
-detail :: Transport t => t -> Message -> IO [Record]
-detail conn msg = do
-    resp <- request conn msg
-    case resp of
-        Success _    rs -> return rs
-        Failed  meta    -> reqFail   meta "Request failed"
-        Ignored meta    -> reqIgnore meta "Request ignored"
-
-init :: Transport t => t -> UserAgent -> AuthToken -> IO ()
-init conn agent auth = simple conn $ Msg.Init agent auth
-
-reset :: Transport t => t -> IO ()
-reset conn = simple conn Msg.Reset
-
-discardAll :: Transport t => t -> IO ()
-discardAll conn = simple conn Msg.DiscardAll
-
-pullAll :: Transport t => t -> IO [Record]
-pullAll conn = detail conn Msg.PullAll
-
-run :: Transport t => t -> Statement -> Parameters -> IO ()
-run conn stmt params = simple conn $ Msg.Run stmt params
-
-exec :: Transport t => t -> Statement -> Parameters -> IO [Record]
-exec conn stmt params = do
-    run conn stmt params
-    pullAll conn

@@ -1,43 +0,0 @@-{-# LANGUAGE Rank2Types                 #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-
-module Database.Bolt.Protocol.Ver1.Transaction
- ( Transaction
- , Tran(..)
- , runTransaction
- , cypher
- ) where
-
-import           Control.Exception
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Reader
-import qualified Data.HashMap.Strict                 as HM
-import           Database.Bolt.Protocol.Ver1.Request
-import           Database.Bolt.Protocol.Ver1.Types
-import           Database.Bolt.Transport
-
-newtype Tran t a = Tran { unTran :: ReaderT t IO a }
-    deriving (Functor, Applicative, Monad, MonadIO)
-
-type Transaction a = forall t. Transport t => Tran t a
-
-runTransaction :: Transport t => t -> Transaction a -> IO a
-runTransaction conn t = do
-    _ <- exec conn "BEGIN" HM.empty
-    r <- try $ runReaderT (unTran t) conn
-    case r of
-        Left (SomeException ex) -> do
-            reset conn
-            throwIO ex
-        Right a -> do
-            _ <- exec conn "COMMIT" HM.empty
-            return a
-
-getConn :: Tran t t
-getConn = Tran ask
-
-cypher :: Statement -> Parameters -> Transaction [Record]
-cypher stmt params = do
-    conn <- getConn
-    liftIO $ exec conn stmt params

@@ -1,46 +0,0 @@-module Database.Bolt.Protocol.Ver1.Types
-    ( Object
-    , object
-    , UserAgent
-    , Principal
-    , Credentials
-    , Statement
-    , Label
-    , Type
-    , Identity
-    , Parameters
-    , Properties
-    , Metadata
-    , Record
-    , (#=)
-    , (#:)
-    , (#:?)
-    ) where
-
-import qualified Data.HashMap.Strict as HM
-import           Data.Int
-import           Data.PackStream
-import           Data.Text           (Text)
-import           Database.Bolt.Types (Object, object)
-
-type UserAgent   = Text
-type Principal   = Text
-type Credentials = Text
-type Statement   = Text
-type Label       = Text
-type Type        = Text
-type Identity    = Int64
-
-type Parameters  = Object
-type Properties  = Object
-type Metadata    = Object
-type Record      = [PackStream]
-
-(#=) :: ToPackStream a => Text -> a -> (Text, PackStream)
-k #= v = (k, toPackStream v)
-
-(#:) :: FromPackStream a => Object -> Text -> Parser a
-m #: k = maybe (parsefail "Expected Key missing in object") parsePackStream (HM.lookup k m)
-
-(#:?) :: FromPackStream a => Object -> Text -> Parser (Maybe a)
-m #:? k = maybe (return Nothing) (fmap Just . parsePackStream) (HM.lookup k m)

@@ -1,68 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Transport
-    ( Transport(..)
-    , put
-    , get
-    , getE
-    , handshake
-    , BoltProtocol
-    , OfferProtocols(..)
-    , noProto
-    ) where
-
-import qualified Data.ByteString         as BS
-import           Data.Monoid
-import           Data.Serialize.Get
-import           Data.Serialize.Put
-import           Data.Text               as T
-import           Data.Word
-
-import           Database.Bolt.Exception
-
--- Transport
-
-class Transport t where
-    send :: t -> BS.ByteString -> IO ()
-    recv :: t -> Int -> IO BS.ByteString
-    close :: t -> IO ()
-
-    sendMany :: t -> [BS.ByteString] -> IO ()
-    sendMany conn = mapM_ (send conn)
-
-put :: Transport t => t -> Put -> IO ()
-put conn = send conn . runPut
-
-get :: Transport t => t -> Int -> Get a -> IO a
-get conn n g = getE conn n g >>= either bad return
-  where
-    bad e = transportErr $ "Bad data received: " <> T.pack e
-
-getE :: Transport t => t -> Int -> Get a -> IO (Either String a)
-getE conn n g = runGet g <$> recv conn n
-
--- Protocol negotiation
-
-type BoltProtocol = Word32
-
-noProto :: BoltProtocol
-noProto = 0
-
-data OfferProtocols = OfferProtocols BoltProtocol BoltProtocol BoltProtocol BoltProtocol
-    deriving (Show, Eq, Ord)
-
-handshake :: Transport t => t -> OfferProtocols -> IO BoltProtocol
-handshake conn offer = do
-    put conn (gogobolt >> offerProtocols offer)
-    get conn 4 agreedProtocol
-
-gogobolt :: Put
-gogobolt = mapM_ putWord8 [0x60, 0x60, 0xb0, 0x17]
-
-offerProtocols :: Putter OfferProtocols
-offerProtocols (OfferProtocols p1 p2 p3 p4) = mapM_ offerProtocol [p1, p2, p3, p4]
-  where
-    offerProtocol = putWord32be
-
-agreedProtocol :: Get BoltProtocol
-agreedProtocol = getWord32be

@@ -1,73 +0,0 @@-{-# LANGUAGE MultiWayIf        #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Transport.Chunked
-    ( send
-    , recv
-    , put
-    , get
-    ) where
-
-import qualified Data.ByteString         as BS
-import qualified Data.ByteString.Lazy    as LBS
-import           Data.Monoid
-import           Data.Serialize.Get
-import           Data.Serialize.Put
-import qualified Data.Text               as T
-
-import           Database.Bolt.Exception
-import           Database.Bolt.Transport (Transport)
-import qualified Database.Bolt.Transport as Trans
-
--------- Chunked I/O --------
-
-send :: Transport t => t -> LBS.ByteString -> IO ()
-send conn lbs = Trans.put conn $ mapM_ putChunks (LBS.toChunks lbs) >> done
-  where
-    maxChunk = 0xffff
-
-    done = putWord16be 0
-
-    putChunks bs = do
-        let sz = BS.length bs
-        if | sz == 0       -> return ()
-           | sz > maxChunk -> split bs
-           | otherwise     -> sendChunk bs
-
-    split bs = do
-        let (bs1, bs2) = BS.splitAt maxChunk bs
-        sendChunk bs1
-        putChunks bs2
-
-    sendChunk bs = do
-        putWord16be $ fromIntegral $ BS.length bs
-        putByteString bs
-
-recv :: Transport t => t -> IO LBS.ByteString
-recv conn = LBS.fromChunks <$> getChunks
-  where
-    getChunks = do
-        size <- Trans.get conn 2 getWord16be
-        case size of
-            0   -> return []
-            csz -> do bs  <- getChunk csz
-                      bs' <- getChunks
-                      return (bs ++ bs')
-
-    getChunk n = do
-        bs <- Trans.recv conn (fromIntegral n)
-        let sz = fromIntegral $ BS.length bs
-        if | sz == 0   -> transportErr "Unexpected end of stream"
-           | sz < n    -> do bs' <- getChunk (n - sz)
-                             return (bs : bs')
-           | otherwise -> return [bs]
-
-put :: Transport t => t -> Put -> IO ()
-put conn = send conn . runPutLazy
-
-get :: Transport t => t -> Get a -> IO a
-get conn g = do
-    lbs <- recv conn
-    case runGetLazy g lbs of
-        Left err -> transportErr $ "Unexpected data received: " <> T.pack err
-        Right a  -> return a

@@ -1,26 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}
-
-module Database.Bolt.Transport.Message
-    ( sendmsg
-    , recvmsg
-    ) where
-
-import           Data.Monoid
-import           Data.PackStream
-import qualified Data.Text                       as T
-
-import           Database.Bolt.Exception
-import           Database.Bolt.Transport         (Transport)
-import qualified Database.Bolt.Transport.Chunked as Chunked
-
--------- Message I/O --------
-
-sendmsg :: (Transport t, ToPackStream a) => t -> a -> IO ()
-sendmsg conn = Chunked.put conn . pack
-
-recvmsg :: (Transport t, FromPackStream a) => t -> IO a
-recvmsg conn = do
-    ma <- Chunked.get conn unpack
-    case ma of
-        Left e  -> transportErr $ "Couldn't unpack received data: " <> T.pack e
-        Right a -> return a

@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Database.Bolt.Transport.Socket
-    ( ConnInfo
-    , hostserv
-    , uri
-
-    , Connection
-    , connect
-    , close
-
-    , send
-    , sendMany
-    , recv
-    , put
-    , get
-    ) where
-
-import           Control.Exception
-import           Control.Monad
-import           Data.Monoid
-import qualified Data.Text                 as T
-import qualified Network.Socket            as Net
-import qualified Network.Socket.ByteString as NetBS
-import           Network.URI
-
-import           Database.Bolt.Exception
-import           Database.Bolt.Transport
-
--------- Socket --------
-
-newtype Connection = Connection { connSocket :: Net.Socket }
-
-instance Transport Connection where
-    send     = NetBS.sendAll  . connSocket
-    sendMany = NetBS.sendMany . connSocket
-    recv     = NetBS.recv     . connSocket
-    close    = Net.close      . connSocket
-
-data ConnInfo = ConnInfo
-    { connHost    :: Net.HostName
-    , connService :: Net.ServiceName
-    } deriving (Show, Read, Eq, Ord)
-
--------- Connections --------
-
--- Create ConnInfo from a host and service name
-hostserv :: String -> String -> ConnInfo
-hostserv = ConnInfo
-
--- Create ConnInfo from a bolt URI
-uri :: String -> Maybe ConnInfo
-uri uristr = do
-    uri' <- parseAbsoluteURI uristr
-    guard $ uriScheme    uri' == "bolt"
-    auth <- uriAuthority uri'
-    guard $ uriUserInfo  auth == ""
-    guard $ uriPath      uri' == ""
-    guard $ uriQuery     uri' == ""
-    guard $ uriFragment  uri' == ""
-    return ConnInfo { connHost = uriRegName auth
-                    , connService = uriPort auth }
-
--- Connect using ConnInfo and return a handle
-connect :: ConnInfo -> IO Connection
-connect ConnInfo{..} = do
-    let hints = Net.defaultHints { Net.addrSocketType = Net.Stream }
-    addrs <- Net.getAddrInfo (Just hints) (Just connHost) (Just connService)
-    connectAny addrs
-  where
-    connectAny []           = transportErr $ "Unable to connect to " <> T.pack connHost <> ":" <> T.pack connService
-    connectAny (addr:addrs) = doConnect addr `catch` (\ (_ :: IOException) -> connectAny addrs)
-
-    doConnect addr = do
-        sock <- Net.socket (Net.addrFamily addr) (Net.addrSocketType addr) (Net.addrProtocol addr)
-        Net.connect sock (Net.addrAddress addr) `onException` Net.close sock
-        return $ Connection sock

@@ -1,14 +0,0 @@-module Database.Bolt.Types
-    ( Object
-    , object
-    ) where
-
-import           Data.Hashable
-import qualified Data.HashMap.Strict as HM
-import           Data.PackStream
-import           Data.Text           (Text)
-
-type Object = HM.HashMap Text PackStream
-
-object :: (Eq k, Hashable k) => [(k, v)] -> HM.HashMap k v
-object = HM.fromList

@@ -1,61 +1,64 @@-module Main where
-
-import           Data.ByteString     (ByteString)
-import           Data.PackStream
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Text           as Text
-import qualified Data.Vector         as Vec
-import           Data.Serialize.Get
-import           Data.Serialize.Put
-
-import           Test.Tasty
-import           Test.Tasty.QuickCheck
-
-instance Arbitrary PackStream where
-    arbitrary =
-      oneof [ return Null
-            , Bool   <$> arbitrary
-            , Int    <$> arbitrary
-            , Float  <$> arbitrary
-            , String <$> (Text.pack    <$> arbitrary)
-            , List   <$> (Vec.fromList <$> scale' (listOf arbitrary))
-            , Map    <$> (HM.fromList  <$> scale' (listOf arbitrary))
-            , Struct <$> arbitrary     <*> scale' (listOf arbitrary)
-            ]
-      where
-         scale' = scale (`div` 2)
-
-    shrink Null          = []
-    shrink (Bool _)      = [Null]
-    shrink (Int _)       = [Null]
-    shrink (Float _)     = [Null]
-    shrink (String s)    = Null : ((String . Text.pack)  <$> shrink (Text.unpack s))
-    shrink (List xs)
-        | Vec.length xs == 0 = [Null]
-        | Vec.length xs == 1 = [Vec.head xs]
-        | otherwise          = Null : ((List . Vec.fromList) <$> shrink (Vec.toList xs))
-    shrink (Map xs)
-        | HM.size xs == 0 = [Null]
-        | HM.size xs == 1 = let [(k, v)] = HM.toList xs in [k, v]
-        | otherwise       = Null : ((Map . HM.fromList)   <$> shrink (HM.toList xs))
-    shrink (Struct s xs) = Null : List (Vec.fromList xs) : (Struct s <$> shrink xs)
-
-prop_decode_encode :: PackStream -> Property
-prop_decode_encode a = (decode . encode) a === a
-  where
-    encode :: PackStream -> ByteString
-    encode = runPut . pack
-    decode :: ByteString -> PackStream
-    decode x = case runGet unpack x of
-                 Left err -> error err
-                 Right (Left err) -> error err
-                 Right (Right ps) -> ps
-
-
-main :: IO ()
-main = defaultMain $
-  testGroup "Tests"
-    [ testGroup "(checked by QuickCheck)"
-        [ testProperty "id == decode . encode" prop_decode_encode
-        ]
-    ]
+module Main where++import Data.ByteString (ByteString)+import qualified Data.HashMap.Strict as HM+import Data.PackStream+import Data.Serialize.Get+import Data.Serialize.Put+import qualified Data.Text as Text+import qualified Data.Vector as Vec++import Test.Tasty+import Test.Tasty.QuickCheck++instance Arbitrary PackStream where+  arbitrary =+    oneof+      [ return Null+      , Bool <$> arbitrary+      , Int <$> arbitrary+      , Float <$> arbitrary+      , String <$> (Text.pack <$> arbitrary)+      , List <$> (Vec.fromList <$> scale' (listOf arbitrary))+      , Map <$> (HM.fromList <$> scale' (listOf arbitrary))+      , Struct <$> arbitrary <*> scale' (listOf arbitrary)+      ]+   where+    scale' = scale (`div` 2)++  shrink Null = []+  shrink (Bool _) = [Null]+  shrink (Int _) = [Null]+  shrink (Float _) = [Null]+  shrink (String s) = Null : ((String . Text.pack) <$> shrink (Text.unpack s))+  shrink (List xs)+    | Vec.length xs == 0 = [Null]+    | Vec.length xs == 1 = [Vec.head xs]+    | otherwise = Null : ((List . Vec.fromList) <$> shrink (Vec.toList xs))+  shrink (Map xs)+    | HM.size xs == 0 = [Null]+    | HM.size xs == 1 = let [(k, v)] = HM.toList xs in [k, v]+    | otherwise = Null : ((Map . HM.fromList) <$> shrink (HM.toList xs))+  shrink (Struct s xs) = Null : List (Vec.fromList xs) : (Struct s <$> shrink xs)++prop_decode_encode :: PackStream -> Property+prop_decode_encode a = (decode . encode) a === a+ where+  encode :: PackStream -> ByteString+  encode = runPut . pack+  decode :: ByteString -> PackStream+  decode x = case runGet unpack x of+    Left err -> error err+    Right (Left err) -> error err+    Right (Right ps) -> ps++main :: IO ()+main =+  defaultMain $+    testGroup+      "Tests"+      [ testGroup+          "(checked by QuickCheck)"+          [ testProperty "id == decode . encode" prop_decode_encode+          ]+      ]