hasbolt 0.1.5.0 → 0.1.6.0
raw patch · 7 files changed
+223/−182 lines, 7 filesdep +base64-bytestringdep +criteriondep +deepseqdep ~basedep ~binarydep ~bytestringPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: base64-bytestring, criterion, deepseq, deepseq-generics
Dependency ranges changed: base, binary, bytestring, hspec
API changes (from Hackage documentation)
+ Database.Bolt: BinaryError :: Text -> UnpackError
+ Database.Bolt.Lazy: BinaryError :: Text -> UnpackError
+ Database.Bolt.Serialization: BinaryError :: Text -> UnpackError
- Database.Bolt.Serialization: pack :: BoltValue a => a -> ByteString
+ Database.Bolt.Serialization: pack :: BoltValue a => a -> Put
- Database.Bolt.Serialization: unpackAction :: Monad m => UnpackT m a -> ByteString -> m (Either UnpackError a)
+ Database.Bolt.Serialization: unpackAction :: Get a -> ByteString -> Either UnpackError a
- Database.Bolt.Serialization: unpackT :: (BoltValue a, Monad m) => UnpackT m a
+ Database.Bolt.Serialization: unpackT :: BoltValue a => Get a
Files
- bench/Main.hs +37/−0
- hasbolt.cabal +21/−2
- src/Database/Bolt/Connection/Pipe.hs +35/−27
- src/Database/Bolt/Connection/Type.hs +4/−0
- src/Database/Bolt/Value/Instances.hs +75/−121
- src/Database/Bolt/Value/Type.hs +30/−15
- test/Spec.hs +21/−17
+ bench/Main.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Main where++import Criterion.Main+import Data.Binary.Put (runPut)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Lazy as BSL+import Data.Default++import Database.Bolt (BoltCfg (..), Structure, connect, query, run)+import Database.Bolt.Serialization (pack, unpackAction, unpackT)++main :: IO ()+main = defaultMain+ [ bgroup "unpackAction"+ [ bench "unpack big node" $ nf+ (either (error "wat") id . unpackAction @Structure unpackT) (BSL.fromStrict input)+ ]+ , bgroup "pack"+ [ bench "pack big node" $ nf+ (BSL.toStrict . runPut . pack) decodedInput+ ]+ , env (connect $ def { user = "neo4j", password = "test" })+ $ \pipe -> bgroup "Network tests"+ [ bench "fetch big node" $ nfIO $ run pipe $ query "MATCH (b:BigNode) RETURN b"+ ]+ ]++decodedInput :: Structure+decodedInput = either (error "wat") id $ unpackAction @Structure unpackT $ BSL.fromStrict input++input :: ByteString+input = either (error "wat") id $ B64.decode+ "sXGRs07JAf2Rh0JpZ05vZGWngWEqgWLJE4iBZACBZcFABb8Jlar3kINmb2/LAAAA6PJypSGBeMFACSH7TRLYSoR0ZXh00RhSTG9yZW0gaXBzdW0gZG9sb3Igc2l0IGFtZXQsIGNvbnNlY3RldHVyIGFkaXBpc2NpbmcgZWxpdC4gUGhhc2VsbHVzIGVnZXN0YXMgdGVtcHVzIHByZXRpdW0uIEluIGlkIHRyaXN0aXF1ZSBlcmF0LCBpZCBpbnRlcmR1bSBhdWd1ZS4gU2VkIG1hbGVzdWFkYSBtYXhpbXVzIGFyY3UsIHZlbCB1bHRyaWNpZXMgbGlndWxhIHRlbXBvciBmZXVnaWF0LiBVdCBlZ2V0IHRlbXB1cyB0dXJwaXMuIE1hdXJpcyBvcm5hcmUgdXQgbmliaCBhYyBzb2RhbGVzLiBPcmNpIHZhcml1cyBuYXRvcXVlIHBlbmF0aWJ1cyBldCBtYWduaXMgZGlzIHBhcnR1cmllbnQgbW9udGVzLCBuYXNjZXR1ciByaWRpY3VsdXMgbXVzLiBJbiBwb3J0dGl0b3IgZHVpIG1hc3NhLCB1dCBjb25kaW1lbnR1bSBlcm9zIGNvbmd1ZSBlZ2V0LiBQZWxsZW50ZXNxdWUgaGVuZHJlcml0IG5lcXVlIGxhY3VzLCBzZWQgdGVtcG9yIGVuaW0gbWF4aW11cyB2aXRhZS4gSW4gZmVsaXMgcXVhbSwgZmFjaWxpc2lzIGV1IG5pc2kgc2l0IGFtZXQsIGNvbW1vZG8gc2NlbGVyaXNxdWUgZG9sb3IuIENyYXMgYmliZW5kdW0gZXN0IGRvbG9yLCBzaXQgYW1ldCBhbGlxdWV0IGVyYXQgZWxlaWZlbmQgbm9uLiBOdWxsYW0gYWxpcXVhbSB0cmlzdGlxdWUgZG9sb3IgbmVjIHRpbmNpZHVudC4gU2VkIGF1Z3VlIHRlbGx1cywgZXVpc21vZCBzZWQgdGVtcG9yIGV1LCBwdWx2aW5hciBhdCBtYWduYS4gU2VkIGluIGF1Y3RvciBkdWkuIE51bGxhbSB2ZWwgdGVsbHVzIHBoYXJldHJhIG51bGxhIGZyaW5naWxsYSBpYWN1bGlzLiBQZWxsZW50ZXNxdWUgdmVsIGRvbG9yIG51bGxhLiBGdXNjZSBhY2N1bXNhbiBwbGFjZXJhdCBjb25ndWUuIE1vcmJpIG9ybmFyZSBmZWxpcyBleCwgdmVsIGNvbW1vZG8gbmVxdWUgcHVsdmluYXIgY29tbW9kby4gUHJhZXNlbnQgcXVpcyBsaWJlcm8gcXVpcyBmZWxpcyBjb25kaW1lbnR1bSBjb21tb2RvIGV1IG5vbiBkb2xvci4gUGVsbGVudGVzcXVlIHRlbXBvciB0ZWxsdXMgc2VkIGFsaXF1ZXQgaW1wZXJkaWV0LiBDbGFzcyBhcHRlbnQgdGFjaXRpIHNvY2lvc3F1IGFkIGxpdG9yYSB0b3JxdWVudCBwZXIgY29udWJpYSBub3N0cmEsIHBlciBpbmNlcHRvcyBoaW1lbmFlb3MuIERvbmVjIGFjIGNvbmRpbWVudHVtIHJpc3VzLiBEdWlzIHBvcnRhIGFudGUgaGVuZHJlcml0IGxvcmVtIGVnZXN0YXMsIHV0IHNjZWxlcmlzcXVlIG1pIGltcGVyZGlldC4gRnVzY2UgcG9ydGEgbWkgc2VkIGVyYXQgZGlnbmlzc2ltLCBjb25zZXF1YXQgZmF1Y2lidXMgbWV0dXMgdGluY2lkdW50LiBJbiBwb3J0dGl0b3IgbG9yZW0gbmVjIHRyaXN0aXF1ZSB0aW5jaWR1bnQuIE1hZWNlbmFzIGFsaXF1YW0gZG9sb3IgYXQgcGVsbGVudGVzcXVlIGltcGVyZGlldC4gQ3JhcyBibGFuZGl0IGVyb3MgcXVpcyBwbGFjZXJhdCBsYW9yZWV0LiBDdXJhYml0dXIgbm9uIGlhY3VsaXMgZWxpdC4gTWFlY2VuYXMgaWFjdWxpcyB0aW5jaWR1bnQgZGlhbSwgc2l0IGFtZXQgaW50ZXJkdW0gYW50ZSBjb25zZWN0ZXR1ciBuZWMuIE1vcmJpIGxvcmVtIG51bGxhLCBwb3J0YSBuZWMgaW1wZXJkaWV0IGEsIGxhb3JlZXQgaWQgbG9yZW0uIERvbmVjIGNvbmRpbWVudHVtIGFyY3UgYSBsYWNpbmlhIGNvbnNlY3RldHVyLiBDdXJhYml0dXIgdml0YWUgdml2ZXJyYSBsb3JlbSwgbm9uIGRhcGlidXMgbGliZXJvLiBBbGlxdWFtIHRpbmNpZHVudCBlbGVtZW50dW0gdGVsbHVzIHV0IGFjY3Vtc2FuLiBEb25lYyBzZWQgYWxpcXVhbSBqdXN0bywgZXQgcHVsdmluYXIgbGVjdHVzLiBWaXZhbXVzIGFjY3Vtc2FuIG5pc2wgYSBuZXF1ZSBhdWN0b3IsIGV1IHByZXRpdW0gbGFjdXMgZGlnbmlzc2ltLiBEb25lYyBlbGl0IGVzdCwgbWFsZXN1YWRhIHZpdGFlIHNhcGllbiBuZWMsIGRpY3R1bSB0cmlzdGlxdWUgdmVsaXQuIFN1c3BlbmRpc3NlIHRlbXB1cyBsb3JlbSBvZGlvLiBWZXN0aWJ1bHVtIHVsbGFtY29ycGVyIGxhY3VzIGV0IG1vbGVzdGllIGJpYmVuZHVtLiBTdXNwZW5kaXNzZSBwb3RlbnRpLiBTdXNwZW5kaXNzZSBzb2RhbGVzIG1hc3NhIGlkIHNlbSBldWlzbW9kIGxvYm9ydGlzIG5vbiBzaXQgYW1ldCBhdWd1ZS4gU3VzcGVuZGlzc2UgZXN0IGVzdCwgZGFwaWJ1cyB1bGxhbWNvcnBlciBuZXF1ZSBpbiwgbWFsZXN1YWRhIHZ1bHB1dGF0ZSBtYXVyaXMuIEZ1c2NlIGNvbnZhbGxpcyBwb3J0YSBkaWFtIG5vbiBibGFuZGl0LiBJbiBhdCB2dWxwdXRhdGUgZG9sb3IuIFNlZCBpbXBlcmRpZXQgZGljdHVtIHF1YW0gdml0YWUgY3Vyc3VzLiBNYWVjZW5hcyBmZWxpcyBhbnRlLCBwbGFjZXJhdCB2aXRhZSBpbnRlcmR1bSBwaGFyZXRyYSwgbWF0dGlzIG5vbiBzYXBpZW4uIE51bGxhbSBhYyB2ZWxpdCB0aW5jaWR1bnQsIGJsYW5kaXQgdGVsbHVzIHNpdCBhbWV0LCBzb2xsaWNpdHVkaW4gbGlndWxhLiBOdW5jIHZpdGFlIGVnZXN0YXMgbmlzbC4gSW50ZWdlciBmZXJtZW50dW0gdmVsIGVsaXQgaWQgcG9ydGEuIE51bmMgZXUgcG9ydGEgZXJhdC4gTWFlY2VuYXMgYWMgc2NlbGVyaXNxdWUgYXJjdS4gUHJhZXNlbnQgcHJldGl1bSBpbnRlcmR1bSBvcmNpIHZlbCBhY2N1bXNhbi4gU3VzcGVuZGlzc2UgZWdldCBudWxsYSBldSByaXN1cyBjb21tb2RvIGZldWdpYXQuIFByYWVzZW50IGZyaW5naWxsYSBlc3QgdmVsIGFudGUgbGFvcmVldCwgbmVjIGN1cnN1cyBtZXR1cyBzdXNjaXBpdC4gTWF1cmlzIGxhb3JlZXQgZXN0IGlkIHVybmEgZmVybWVudHVtIHBsYWNlcmF0LiBDcmFzIHZlc3RpYnVsdW0gbGVvIHNlZCBlbGl0IHVsbGFtY29ycGVyIGFjY3Vtc2FuIHZlbmVuYXRpcyBldSBtYXVyaXMuIE5hbSBkaWN0dW0gcHVsdmluYXIgZXN0LiBBZW5lYW4gdXQgZXJvcyBuZWMgZGlhbSBhbGlxdWFtIGNvbnZhbGxpcy4gUHJvaW4gZWxlaWZlbmQgbGlndWxhIHF1aXMgcGhhcmV0cmEgY29udmFsbGlzLiBDcmFzIGN1cnN1cywgYXVndWUgbm9uIHBvcnRhIG1vbGVzdGllLCBleCBtYXVyaXMgcG9zdWVyZSBsZWN0dXMsIHVsdHJpY2llcyBmYXVjaWJ1cyBvcmNpIHB1cnVzIGFjIGVuaW0uIE51bmMgYXQgbmVxdWUgdHJpc3RpcXVlLCBwZWxsZW50ZXNxdWUgYW50ZSBldCwgbW9sZXN0aWUgbmlzaS4gVXQgdWx0cmljZXMgYmliZW5kdW0gdm9sdXRwYXQuIEV0aWFtIGluIHVybmEgaW4gYXVndWUgaGVuZHJlcml0IGltcGVyZGlldCBzZWQgdXQgYXJjdS4gU2VkIGdyYXZpZGEgbmlzaSBzaXQgYW1ldCBmaW5pYnVzIHN1c2NpcGl0LiBOdW5jIG5lYyB0b3J0b3IgcXVpcyBvcmNpIGV1aXNtb2QgaW50ZXJkdW0uIE1hdXJpcyB2ZXN0aWJ1bHVtIGZlbGlzIGFjIG1hbGVzdWFkYSBldWlzbW9kLiBQcmFlc2VudCBhbGlxdWV0IG5lcXVlIHV0IGxpYmVybyBoZW5kcmVyaXQgc3VzY2lwaXQgbmVjIGV1IGxpYmVyby4gU2VkIHV0IGFudGUgc2VkIHVybmEgcG9ydHRpdG9yIGZhY2lsaXNpcy4gU3VzcGVuZGlzc2UgZGljdHVtIGF1Y3RvciB1bGxhbWNvcnBlci4gRG9uZWMgZWdldCBleCBhdCBuaWJoIGVnZXN0YXMgZWxlbWVudHVtLiBGdXNjZSBldSBqdXN0byBldWlzbW9kLCBzb2RhbGVzIG5pYmggZXQsIHRlbXB1cyBlbGl0LiBDcmFzIGluIGVuaW0gc2VtLiBVdCBwdWx2aW5hciBhdWd1ZSBldCBsaWd1bGEgaW50ZXJkdW0sIHNlZCB0ZW1wdXMgcmlzdXMgdmVzdGlidWx1bS4gTmFtIGN1cnN1cyBzZWQgYXVndWUgZXQgcG9ydHRpdG9yLiBTZWQgcmhvbmN1cyBpZCBmZWxpcyBuZWMgcGhhcmV0cmEuIFNlZCBmZXVnaWF0IHRpbmNpZHVudCBkdWksIGV1IHVsdHJpY2llcyBvcmNpIGltcGVyZGlldCBhYy4gVXQgYWMgYmxhbmRpdCB0b3J0b3IuIEZ1c2NlIGVmZmljaXR1ciwgZW5pbSBuZWMgZmF1Y2lidXMgdGVtcG9yLCB0dXJwaXMgbGVjdHVzIGRpZ25pc3NpbSBsZWN0dXMsIGEgY29uc2VxdWF0IG5pc2kgdmVsaXQgdml0YWUgZW5pbS4gUGhhc2VsbHVzIHRpbmNpZHVudCB1bHRyaWNpZXMgZGlhbSwgZXUgYXVjdG9yIGRvbG9yIHZhcml1cyBlZ2V0LiBTZWQgc2VkIGxpYmVybyB2dWxwdXRhdGUsIGRhcGlidXMgZG9sb3IgdXQsIHZ1bHB1dGF0ZSBqdXN0by4gVXQgZnJpbmdpbGxhIGVsaXQgYW50ZSwgc2VkIHNjZWxlcmlzcXVlIHR1cnBpcyBibGFuZGl0IHNpdCBhbWV0LiBQZWxsZW50ZXNxdWUgYXQgbmlzaSB2ZWxpdC4gRG9uZWMgY29uZGltZW50dW0gdmVsaXQgcXVpcyBkdWkgbW9sZXN0aWUgdWx0cmljZXMuIE5hbSB1dCBudW5jIHR1cnBpcy4gRHVpcyBsb2JvcnRpcyBuaWJoIGluIG1ldHVzIHZhcml1cyBkaWN0dW0uIEFsaXF1YW0gc2l0IGFtZXQgZW5pbSBldCBpcHN1bSBmcmluZ2lsbGEgY29tbW9kby4gUHJvaW4gcmhvbmN1cyBuZXF1ZSBzYXBpZW4sIGFjIGltcGVyZGlldCBhbnRlIHVsdHJpY2VzIHV0LiBVdCBuZWMgbmlzbCBwbGFjZXJhdCwgcHVsdmluYXIgbnVuYyB1dCwgb3JuYXJlIG5lcXVlLiBTZWQgZnJpbmdpbGxhIHZpdmVycmEgbWkgdmVsIGNvbW1vZG8uIEV0aWFtIGVmZmljaXR1ciBzaXQgYW1ldCBtaSBldCB0aW5jaWR1bnQuIFNlZCBtYXhpbXVzIGF1Z3VlIHNpdCBhbWV0IGxpZ3VsYSBzb2xsaWNpdHVkaW4gY29uc2VjdGV0dXIuIEludGVnZXIgZWxlbWVudHVtIHNhcGllbiBzaXQgYW1ldCBlbmltIHB1bHZpbmFyIHZlaGljdWxhLiBJbnRlZ2VyIGlkIGFudGUgc2VkIHNhcGllbiBwZWxsZW50ZXNxdWUgbG9ib3J0aXMuIFByYWVzZW50IHZpdGFlIGZhY2lsaXNpcyBmZWxpcywgcXVpcyB0aW5jaWR1bnQgbnVuYy4gRG9uZWMgaWQgcnV0cnVtIG9kaW8uIE51bGxhIHZpdGFlIHB1cnVzIGV1IGVuaW0gZGFwaWJ1cyBsb2JvcnRpcyBhIGlkIGRvbG9yLiBOdWxsYW0gdGluY2lkdW50IGV1IGFudGUgYSBhbGlxdWV0LiBQaGFzZWxsdXMgdm9sdXRwYXQgdXJuYSBuZWMgdmVsaXQgYmxhbmRpdCwgaW4gc29sbGljaXR1ZGluIGxpYmVybyB2b2x1dHBhdC4gTWFlY2VuYXMgc2NlbGVyaXNxdWUgYWxpcXVhbSBlcmF0IGVnZXQgbWF4aW11cy4gRnVzY2UgY3Vyc3VzIHBoYXJldHJhIGRpZ25pc3NpbS4gVXQgYWxpcXVhbSwgcHVydXMgYSBhdWN0b3IgcG9ydHRpdG9yLCBlcm9zIHRlbGx1cyBtYWxlc3VhZGEgZXN0LCBxdWlzIGhlbmRyZXJpdCBkaWFtIHR1cnBpcyB1dCBleC4gQ2xhc3MgYXB0ZW50IHRhY2l0aSBzb2Npb3NxdSBhZCBsaXRvcmEgdG9ycXVlbnQgcGVyIGNvbnViaWEgbm9zdHJhLCBwZXIgaW5jZXB0b3MgaGltZW5hZW9zLiBRdWlzcXVlIGZhdWNpYnVzLCB0b3J0b3IgYSBwaGFyZXRyYSBzdXNjaXBpdCwgaXBzdW0gYXVndWUgaGVuZHJlcml0IG5lcXVlLCBldCBhdWN0b3IgbmlzbCBmZWxpcyBxdWlzIGR1aS4gUXVpc3F1ZSByaG9uY3VzIGR1aSBhdCBwbGFjZXJhdCBzb2xsaWNpdHVkaW4uIE1hdXJpcyBydXRydW0gbHVjdHVzIHR1cnBpcy4gUXVpc3F1ZSBzY2VsZXJpc3F1ZSBsYWN1cyBtYXVyaXMsIHF1aXMgbWF4aW11cyBwdXJ1cyBzY2VsZXJpc3F1ZSBub24uIFV0IGV0IGVzdCBzaXQgYW1ldCBxdWFtIGxhb3JlZXQgcHJldGl1bSBpbiBhdCB0b3J0b3IuIE51bGxhbSBhcmN1IGRpYW0sIGF1Y3RvciBiaWJlbmR1bSBsZWN0dXMgZXQsIGJsYW5kaXQgbGFjaW5pYSBxdWFtLiBBbGlxdWFtIGFsaXF1YW0gcG9zdWVyZSBuaXNsIGF0IGFjY3Vtc2FuLiBQaGFzZWxsdXMgYSBwb3N1ZXJlIGRpYW0sIG5lYyBiaWJlbmR1bSBzZW0uIFN1c3BlbmRpc3NlIGludGVyZHVtIG1hc3NhIGVsaXQsIHF1aXMgZmV1Z2lhdCBuaXNpIHZlaGljdWxhIHZpdGFlLiBTZWQgZHVpIG1hdXJpcywgZWxlbWVudHVtIGV0IGFudGUgcXVpcywgdnVscHV0YXRlIGVmZmljaXR1ciBsaWJlcm8uIE5hbSBhbGlxdWV0IGVsaXQgYWMgbGliZXJvIGFsaXF1ZXQsIGVnZXQgZmluaWJ1cyBuaXNpIHRpbmNpZHVudC4gU3VzcGVuZGlzc2UgdmVsIG5pc2wgaW4gdGVsbHVzIHBoYXJldHJhIGdyYXZpZGEgZXQgdml0YWUgbWF1cmlzLiBDdXJhYml0dXIgcG9zdWVyZSBjb252YWxsaXMgYWxpcXVldC4gTnVsbGFtIHNlZCBlc3QgYXQgbmlzbCBhdWN0b3IgbGFjaW5pYSBpZCBzaXQgYW1ldCBtYWduYS4gTnVsbGEgZXQgdG9ydG9yIHR1cnBpcy4gU3VzcGVuZGlzc2Ugc2FwaWVuIGVyb3MsIGZlcm1lbnR1bSBxdWlzIHBlbGxlbnRlc3F1ZSB2ZWwsIGRpZ25pc3NpbSB2ZWwgdXJuYS4gQWxpcXVhbSBuaXNpIG1hdXJpcywgc2NlbGVyaXNxdWUgZWdldCBuaWJoIHF1aXMsIGNvbnNlY3RldHVyIGZlcm1lbnR1bSBqdXN0by4gUHJhZXNlbnQgZWdldCBlbGVtZW50dW0gaXBzdW0uIFNlZCBuaWJoIG1pLCB0aW5jaWR1bnQgcXVpcyBuaWJoIHV0LCB1bHRyaWNpZXMgZmFjaWxpc2lzIG5lcXVlLg=="
hasbolt.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: hasbolt-version: 0.1.5.0+version: 0.1.6.0 license: BSD3 license-file: LICENSE copyright: (c) 2018 Pavel Yakovlev@@ -68,7 +68,9 @@ mtl >=2.2.0 && <2.3, network >=2.6.3.1 && <3.2, connection >=0.2.8 && <0.4,- data-default >=0.7.1.1 && <0.8+ data-default >=0.7.1.1 && <0.8,+ deepseq >=1.4.4.0 && <1.5,+ deepseq-generics >=0.2.0.0 && <0.3 if impl(ghc <8.6) build-depends: contravariant >=1.4.1 && <1.6@@ -90,4 +92,21 @@ QuickCheck >=2.9 && <2.15, text >=1.2.4.1 && <1.3, containers >=0.6.2.1 && <0.7,+ binary >=0.8.8.0 && <0.9, bytestring >=0.10.12.0 && <0.11++benchmark hasbolt-bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -eventlog+ build-depends:+ base >=4.14.1.0 && <4.15,+ base64-bytestring >=1.1.0.0 && <1.2,+ binary >=0.8.8.0 && <0.9,+ bytestring >=0.10.12.0 && <0.11,+ criterion >=1.5.9.0 && <1.6,+ data-default >=0.7.1.1 && <0.8,+ hasbolt -any,+ hspec >=2.7.8 && <2.8
src/Database/Bolt/Connection/Pipe.hs view
@@ -3,21 +3,26 @@ {-# LANGUAGE RecordWildCards #-} module Database.Bolt.Connection.Pipe where +import qualified Database.Bolt.Connection.Connection as C (close, connect, recv, send, sendMany) import Database.Bolt.Connection.Instances import Database.Bolt.Connection.Type import Database.Bolt.Value.Helpers import Database.Bolt.Value.Instances-import Database.Bolt.Value.Type-import qualified Database.Bolt.Connection.Connection as C (close, connect, recv,- send, sendMany)+import Database.Bolt.Value.Type (BoltValue (pack, unpackT),+ FromStructure (fromStructure),+ ToStructure (toStructure), unpackAction) import Control.Exception (throwIO) import Control.Monad (forM_, unless, void, when)-import Control.Monad.Except (MonadError (..), ExceptT, runExceptT)+import Control.Monad.Except (ExceptT, MonadError (..), runExceptT) import Control.Monad.Trans (MonadIO (..))+import Data.Binary (decode)+import Data.Binary.Put (runPut) import Data.ByteString (ByteString)-import qualified Data.ByteString as B (concat, length, null,- splitAt)+import qualified Data.ByteString as B (concat, length)+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Internal as BSL+import Data.Int (Int64) import Data.Word (Word16) import GHC.Stack (HasCallStack) @@ -73,7 +78,7 @@ flush :: MonadPipe m => HasCallStack => Pipe -> Request -> m () flush pipe request = do forM_ chunks $ C.sendMany conn . mkChunk C.send conn terminal- where bs = pack $ toStructure request+ where bs = runPut $ pack $ toStructure request chunkSize = chunkSizeFor (mcs pipe) bs chunks = split chunkSize bs terminal = encodeStrict (0 :: Word16)@@ -84,18 +89,21 @@ in [encodeStrict size, chunk] fetch :: MonadPipe m => HasCallStack => Pipe -> m Response-fetch pipe = do bs <- B.concat <$> chunks- response <- flip unpackAction bs $ unpackT >>= fromStructure- either (throwError . WrongMessageFormat) pure response+fetch pipe = do bs <- chunks+ let response = unpackAction unpackT bs >>= fromStructure+ case response of+ Left ue -> throwError $ WrongMessageFormat ue+ Right a -> pure a+ where conn = connection pipe - chunks :: MonadPipe m => m [ByteString]- chunks = do size <- decodeStrict <$> recvChunk conn 2+ chunks :: MonadPipe m => m BSL.ByteString+ chunks = do size <- decode <$> recvChunk conn 2 chunk <- recvChunk conn size- if B.null chunk- then pure []+ if BSL.null chunk+ then pure BSL.empty else do rest <- chunks- pure (chunk:rest)+ pure $! chunk <> rest -- Helper functions @@ -103,7 +111,7 @@ handshake pipe bcfg = do let conn = connection pipe C.send conn (encodeStrict $ magic bcfg) C.send conn (boltVersionProposal bcfg)- serverVersion <- decodeStrict <$> recvChunk conn 4+ serverVersion <- decode <$> recvChunk conn 4 when (serverVersion /= version bcfg) $ throwError UnsupportedServerVersion flush pipe (createInit bcfg)@@ -114,21 +122,21 @@ boltVersionProposal :: BoltCfg -> ByteString boltVersionProposal bcfg = B.concat $ encodeStrict <$> [version bcfg, 0, 0, 0] -recvChunk :: MonadPipe m => HasCallStack => ConnectionWithTimeout -> Word16 -> m ByteString-recvChunk conn size = B.concat <$> helper (fromIntegral size)- where helper :: MonadPipe m => Int -> m [ByteString]- helper 0 = pure []+recvChunk :: MonadPipe m => HasCallStack => ConnectionWithTimeout -> Word16 -> m BSL.ByteString+recvChunk conn size = helper (fromIntegral size)+ where helper :: MonadPipe m => Int -> m BSL.ByteString+ helper 0 = pure BSL.empty helper sz = do mbChunk <- C.recv conn sz case mbChunk of- Just chunk -> (chunk:) <$> helper (sz - B.length chunk)+ Just chunk -> BSL.chunk chunk <$> helper (sz - B.length chunk) Nothing -> throwError CannotReadChunk -chunkSizeFor :: Word16 -> ByteString -> Int+chunkSizeFor :: Word16 -> BSL.ByteString -> Int64 chunkSizeFor maxSize bs = 1 + div len noc- where len = B.length bs+ where len = BSL.length bs noc = 1 + div len (fromIntegral maxSize) -split :: Int -> ByteString -> [ByteString]-split size bs | B.null bs = []- | otherwise = let (chunk, rest) = B.splitAt size bs- in chunk : split size rest+split :: Int64 -> BSL.ByteString -> [ByteString]+split size bs | BSL.null bs = []+ | otherwise = let (chunk, rest) = BSL.splitAt size bs+ in BSL.toStrict chunk : split size rest
src/Database/Bolt/Connection/Type.hs view
@@ -7,6 +7,7 @@ import Database.Bolt.Value.Type hiding (unpack) +import Control.DeepSeq (NFData(..), rwhnf) import Control.Exception (Exception (..), SomeException, handle) import Control.Monad.Trans (MonadTrans (..), MonadIO (..)) import Control.Monad.Reader (MonadReader (..), ReaderT)@@ -109,6 +110,9 @@ , mcs :: Word16 -- ^Driver maximum chunk size of request , pipe_version :: Word32 -- ^Connection version 0000mnMJ }++instance NFData Pipe where+ rnf = rwhnf data AuthToken = AuthToken { scheme :: Text , principal :: Text
src/Database/Bolt/Value/Instances.hs view
@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Database.Bolt.Value.Instances where@@ -10,12 +11,13 @@ import Control.Applicative (pure) import Control.Monad (forM, replicateM)-import Control.Monad.State (gets, modify) import Control.Monad.Except (MonadError (..))-import Data.Binary (Binary (..), decode, encode)+import Data.Binary (Binary (..), Put, decode, encode)+import Data.Binary.Get import Data.Binary.IEEE754 (doubleToWord, wordToDouble)-import Data.ByteString (ByteString, append, cons,- singleton)+import Data.Binary.Put (putByteString, putWord16be, putWord32be, putWord64be,+ putWord8)+import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Int@@ -26,101 +28,101 @@ import Data.Word instance BoltValue () where- pack () = singleton nullCode+ pack () = putWord8 nullCode - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | m == nullCode = pure ()- | otherwise = throwError NotNull+ | otherwise = fail "expected null" instance BoltValue Bool where- pack True = singleton trueCode- pack False = singleton falseCode+ pack True = putWord8 trueCode+ pack False = putWord8 falseCode - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | m == trueCode = pure True | m == falseCode = pure False- | otherwise = throwError NotBool+ | otherwise = fail "expected bool" instance BoltValue Int where- pack int | isTinyInt int = encodeStrict (fromIntegral int :: Word8)- | isIntX 8 int = cons int8Code $ encodeStrict (fromIntegral int :: Word8)- | isIntX 16 int = cons int16Code $ encodeStrict (fromIntegral int :: Word16)- | isIntX 32 int = cons int32Code $ encodeStrict (fromIntegral int :: Word32)- | isIntX 62 int = cons int64Code $ encodeStrict (fromIntegral int :: Word64)+ pack int | isTinyInt int = putWord8 $ fromIntegral int+ | isIntX 8 int = putWord8 int8Code >> putWord8 (fromIntegral int)+ | isIntX 16 int = putWord8 int16Code >> putWord16be (fromIntegral int :: Word16)+ | isIntX 32 int = putWord8 int32Code >> putWord32be (fromIntegral int :: Word32)+ | isIntX 62 int = putWord8 int64Code >> putWord64be (fromIntegral int :: Word64) | otherwise = error "Cannot pack so large integer" - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | isTinyWord m = pure . toInt $ (fromIntegral m :: Int8)- | m == int8Code = toInt <$> unpackI8- | m == int16Code = toInt <$> unpackI16- | m == int32Code = toInt <$> unpackI32- | m == int64Code = toInt <$> unpackI64- | otherwise = throwError NotInt+ | m == int8Code = toInt <$> getInt8+ | m == int16Code = toInt <$> getInt16be+ | m == int32Code = toInt <$> getInt32be+ | m == int64Code = toInt <$> getInt64be+ | otherwise = fail "expected int" instance BoltValue Double where- pack dbl = cons doubleCode $ encodeStrict (doubleToWord dbl)+ pack dbl = putWord8 doubleCode >> putWord64be (doubleToWord dbl) - unpackT = unpackW8 >>= unpackByMarker- where unpackByMarker m | m == doubleCode = wordToDouble <$> unpackW64- | otherwise = throwError NotFloat+ unpackT = getWord8 >>= unpackByMarker+ where unpackByMarker m | m == doubleCode = wordToDouble <$> getWord64be+ | otherwise = fail "expected double" instance BoltValue Text where- pack txt = mkPackedCollection (B.length pbs) pbs (textConst, text8Code, text16Code, text32Code)- where pbs = encodeUtf8 txt+ pack txt = mkPackedCollection (B.length bs) pbs (textConst, text8Code, text16Code, text32Code)+ where bs = encodeUtf8 txt+ pbs = putByteString bs - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | isTinyText m = unpackTextBySize (getSize m)- | m == text8Code = toInt <$> unpackW8 >>= unpackTextBySize- | m == text16Code = toInt <$> unpackW16 >>= unpackTextBySize- | m == text32Code = toInt <$> unpackW32 >>= unpackTextBySize- | otherwise = throwError NotString- unpackTextBySize size = do str <- gets (B.take size)- modify (B.drop size)- pure $ decodeUtf8 str+ | m == text8Code = toInt <$> getInt8 >>= unpackTextBySize+ | m == text16Code = toInt <$> getInt16be >>= unpackTextBySize+ | m == text32Code = toInt <$> getInt32be >>= unpackTextBySize+ | otherwise = fail "expected text"+ unpackTextBySize size = do str <- getByteString size+ pure $! decodeUtf8 str instance BoltValue a => BoltValue [a] where pack lst = mkPackedCollection (length lst) pbs (listConst, list8Code, list16Code, list32Code)- where pbs = B.concat $ map pack lst+ where pbs = mapM_ pack lst - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | isTinyList m = unpackListBySize (getSize m)- | m == list8Code = toInt <$> unpackW8 >>= unpackListBySize- | m == list16Code = toInt <$> unpackW16 >>= unpackListBySize- | m == list32Code = toInt <$> unpackW32 >>= unpackListBySize- | otherwise = throwError NotList+ | m == list8Code = toInt <$> getInt8 >>= unpackListBySize+ | m == list16Code = toInt <$> getInt16be >>= unpackListBySize+ | m == list32Code = toInt <$> getInt32be >>= unpackListBySize+ | otherwise = fail "expected list" unpackListBySize size = forM [1..size] $ const unpackT instance BoltValue a => BoltValue (Map Text a) where pack dict = mkPackedCollection (M.size dict) pbs (dictConst, dict8Code, dict16Code, dict32Code)- where pbs = B.concat $ map mkPairPack $ M.assocs dict- mkPairPack (key, val) = pack key `append` pack val+ where pbs = mapM_ mkPairPack $ M.assocs dict+ mkPairPack (key, val) = pack key >> pack val - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | isTinyDict m = unpackDictBySize (getSize m)- | m == dict8Code = toInt <$> unpackW8 >>= unpackDictBySize- | m == dict16Code = toInt <$> unpackW16 >>= unpackDictBySize- | m == dict32Code = toInt <$> unpackW32 >>= unpackDictBySize- | otherwise = throwError NotDict + | m == dict8Code = toInt <$> getInt16be >>= unpackDictBySize+ | m == dict16Code = toInt <$> getInt16be >>= unpackDictBySize+ | m == dict32Code = toInt <$> getInt32be >>= unpackDictBySize+ | otherwise = fail "expected dict" unpackDictBySize = (M.fromList <$>) . unpackPairsBySize unpackPairsBySize size = forM [1..size] $ const $ do- key <- unpackT- value <- unpackT+ !key <- unpackT+ !value <- unpackT pure (key, value) instance BoltValue Structure where- pack (Structure sig lst) | size < size4 = (structConst + fromIntegral size) `cons` pData- | size < size8 = struct8Code `cons` fromIntegral size `cons` pData- | size < size16 = struct16Code `cons` encodeStrict size `append` pData+ pack (Structure sig lst) | size < size4 = putWord8 (structConst + fromIntegral size) >> pData+ | size < size8 = putWord8 struct8Code >> putWord8 (fromIntegral size) >> pData+ | size < size16 = putWord8 struct16Code >> putWord16be size >> pData | otherwise = error "Cannot pack so large structure" where size = fromIntegral $ length lst :: Word16- pData = sig `cons` B.concat (map pack lst)+ pData = putWord8 sig >> mapM_ pack lst - unpackT = unpackW8 >>= unpackByMarker+ unpackT = getWord8 >>= unpackByMarker where unpackByMarker m | isTinyStruct m = unpackStructureBySize (getSize m)- | m == struct8Code = toInt <$> unpackW8 >>= unpackStructureBySize- | m == struct16Code = toInt <$> unpackW16 >>= unpackStructureBySize- | otherwise = throwError NotStructure- unpackStructureBySize size = Structure <$> unpackW8 <*> replicateM size unpackT+ | m == struct8Code = toInt <$> getInt8 >>= unpackStructureBySize+ | m == struct16Code = toInt <$> getInt16be >>= unpackStructureBySize+ | otherwise = fail "expected structure"+ unpackStructureBySize size = Structure <$> getWord8 <*> replicateM size unpackT instance BoltValue Value where pack (N n) = pack n@@ -132,7 +134,7 @@ pack (M m) = pack m pack (S s) = pack s - unpackT = observeW8 >>= unpackByMarker+ unpackT = lookAhead getWord8 >>= unpackByMarker where unpackByMarker m | isNull m = N <$> unpackT | isBool m = B <$> unpackT | isInt m = I <$> unpackT@@ -141,7 +143,7 @@ | isList m = L <$> unpackT | isDict m = M <$> unpackT | isStruct m = S <$> unpackT- | otherwise = throwError NotValue + | otherwise = fail "not value" -- = Structure instances for Neo4j structures @@ -153,7 +155,7 @@ where cnvT [] = pure [] cnvT (T x:xs) = (x:) <$> cnvT xs- cnvT _ = throwError NotString + cnvT _ = throwError NotString instance FromStructure Relationship where fromStructure struct =@@ -168,7 +170,7 @@ _ -> throwError $ Not "URelationship" instance FromStructure Path where- fromStructure struct = + fromStructure struct = case struct of (Structure sig [L vnp, L vrp, L vip]) | sig == sigPath -> Path <$> cnvN vnp <*> cnvR vrp <*> cnvI vip _ -> throwError $ Not "Path"@@ -176,77 +178,29 @@ cnvN [] = pure [] cnvN (S x:xs) = (:) <$> fromStructure x <*> cnvN xs cnvN _ = throwError $ Not "Node"- + cnvR [] = pure [] cnvR (S x:xs) = (:) <$> fromStructure x <*> cnvR xs- cnvR _ = throwError NotStructure - + cnvR _ = throwError NotStructure+ cnvI [] = pure [] cnvI (I x:xs) = (x:) <$> cnvI xs cnvI _ = throwError NotInt --- = Integer values unpackers--observeW8 :: Monad m => UnpackT m Word8-observeW8 = observeNum 1--unpackW8 :: Monad m => UnpackT m Word8-unpackW8 = unpackNum 1--unpackW16 :: Monad m => UnpackT m Word16-unpackW16 = unpackNum 2--unpackW32 :: Monad m => UnpackT m Word32-unpackW32 = unpackNum 4--unpackW64 :: Monad m => UnpackT m Word64-unpackW64 = unpackNum 8--unpackI8 :: Monad m => UnpackT m Int8-unpackI8 = unpackNum 1--unpackI16 :: Monad m => UnpackT m Int16-unpackI16 = unpackNum 2--unpackI32 :: Monad m => UnpackT m Int32-unpackI32 = unpackNum 4--unpackI64 :: Monad m => UnpackT m Int64-unpackI64 = unpackNum 8---- = Other helpers---- |Unpacks n bytes as a numeric type-observeNum :: (Monad m, Binary a) => Int -> UnpackT m a-observeNum = (decodeStrict <$>) . topBS--unpackNum :: (Monad m, Binary a) => Int -> UnpackT m a-unpackNum = (decodeStrict <$>) . popBS- decodeStrict :: Binary a => ByteString -> a decodeStrict = decode . fromStrict encodeStrict :: Binary a => a -> ByteString encodeStrict = toStrict . encode --- |Obtain first n bytes of 'ByteString'-topBS :: Monad m => Int -> UnpackT m ByteString-topBS size = gets (B.take size)---- |Obtain first n bytes of 'ByteString' and move offset by n-popBS :: Monad m => Int -> UnpackT m ByteString-popBS size = do top <- topBS size- modify (B.drop size)- pure top- -- |Pack collection using it's size and set of BOLT constants-mkPackedCollection :: Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString+mkPackedCollection :: Int -> Put -> (Word8, Word8, Word8, Word8) -> Put mkPackedCollection size bst (wt, w8, w16, w32)- | size < size4 = cons (wt + fromIntegral size) bst- | size < size8 = cons w8 $ cons (fromIntegral size) bst- | size < size16 = cons w16 $ encodeStrict (fromIntegral size :: Word16) `append` bst- | size < size32 = cons w32 $ encodeStrict (fromIntegral size :: Word32) `append` bst+ | size < size4 = putWord8 (wt + fromIntegral size) >> bst+ | size < size8 = putWord8 w8 >> putWord8 (fromIntegral size) >> bst+ | size < size16 = putWord8 w16 >> putWord16be (fromIntegral size :: Word16) >> bst+ | size < size32 = putWord8 w32 >> putWord32be (fromIntegral size :: Word32) >> bst | otherwise = error "Cannot pack so large collection" size4,size8, size16,size32 :: Integral a => a
src/Database/Bolt/Value/Type.hs view
@@ -1,19 +1,28 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DerivingStrategies #-} module Database.Bolt.Value.Type where +import Control.DeepSeq (NFData)+import Control.Monad.Except (ExceptT, MonadError (..)) import Control.Monad.Fail as Fail (MonadFail (..))-import Control.Monad.State (MonadState (..), StateT (..), evalStateT)-import Control.Monad.Except (MonadError (..), ExceptT, runExceptT)+import Control.Monad.State (MonadState (..), StateT (..))+import Data.Binary.Get+import Data.Binary.Put import Data.ByteString (ByteString)+import Data.ByteString.Lazy (fromStrict)+import qualified Data.ByteString.Lazy as BSL import Data.Map.Strict (Map, fromList) import Data.Monoid ((<>)) import Data.Text (Text)-import qualified Data.Text as T (unpack, pack)+import qualified Data.Text as T (pack, unpack) import Data.Word (Word8)+import GHC.Generics (Generic) -- |Error during unpack process data UnpackError = NotNull@@ -25,6 +34,7 @@ | NotDict | NotStructure | NotValue+ | BinaryError Text | Not Text deriving (Eq, Ord) @@ -38,17 +48,19 @@ show NotDict = "Not a Dict value" show NotStructure = "Not a Structure value" show NotValue = "Not a Value value"+ show (BinaryError what) = "Error while decoding binary format: " <> T.unpack what show (Not what) = "Not a " <> T.unpack what <> " (Structure) value" -- |The 'UnpackT' transformer helps to unpack a set of values from one 'ByteString' newtype UnpackT m a = UnpackT { runUnpackT :: ExceptT UnpackError (StateT ByteString m) a }- deriving (Functor, Applicative, Monad, MonadError UnpackError, MonadState ByteString)+ deriving newtype (Functor, Applicative, Monad, MonadError UnpackError, MonadState ByteString) -- |The 'Structure' datatype describes Neo4j structure for BOLT protocol data Structure = Structure { signature :: Word8 , fields :: [Value] }- deriving (Show, Eq)+ deriving stock (Show, Eq, Generic)+ deriving anyclass (NFData) -- |Generalizes all datatypes that can be deserialized from 'Structure's. class FromStructure a where@@ -61,24 +73,26 @@ -- |The 'BoltValue' class describes values, that can be packed and unpacked for BOLT protocol. class BoltValue a where -- |Packs a value to 'ByteString'- pack :: a -> ByteString+ pack :: a -> Put -- |Unpacks in a State monad to get values from single 'ByteString'- unpackT :: Monad m => UnpackT m a+ unpackT :: Get a -- |Unpacks a 'ByteString' to selected value unpack :: (Monad m, BoltValue a) => ByteString -> m (Either UnpackError a)-unpack = unpackAction unpackT+unpack = pure . unpackAction unpackT . fromStrict -- |Old-style unpack that runs 'fail' on error unpackF :: (MonadFail m, BoltValue a) => ByteString -> m a-unpackF bs = do result <- unpack bs+unpackF bs = do let result = unpackAction unpackT $ fromStrict bs case result of Right x -> pure x Left e -> Fail.fail $ show e -- |Unpacks a 'ByteString' to selected value by some custom action-unpackAction :: Monad m => UnpackT m a -> ByteString -> m (Either UnpackError a)-unpackAction action = evalStateT (runExceptT $ runUnpackT action) +unpackAction :: Get a -> BSL.ByteString -> Either UnpackError a+unpackAction action bs = case runGetOrFail action bs of+ Left (_, _, err) -> Left $ BinaryError $ T.pack err+ Right (_, _, a) -> Right a -- |The 'Value' datatype generalizes all primitive 'BoltValue's data Value = N ()@@ -89,7 +103,8 @@ | L [Value] | M (Map Text Value) | S Structure- deriving (Show, Eq)+ deriving stock (Show, Eq, Generic)+ deriving anyclass (NFData) -- |Every datatype that can be represented as BOLT protocol value class IsValue a where
test/Spec.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} import Control.Applicative ((<$>))+import Data.Binary.Put (runPut) import Data.ByteString (ByteString) import Data.ByteString.Lazy (fromStrict, toStrict) import Hex@@ -22,6 +23,9 @@ packStreamTests unpackStreamTests +pack' :: BoltValue a => a -> ByteString+pack' = toStrict . runPut . pack+ unpackStreamTests :: Spec unpackStreamTests = describe "Unpack" $ do@@ -69,29 +73,29 @@ 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"+ 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"+ 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"+ 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"+ 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"+ 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"+ 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"+ hex (pack' ()) `shouldBe` "C0" prepareData :: MonadFail m => ByteString -> m ByteString prepareData = (toStrict <$>) . unhex . fromStrict