packages feed

packstream (empty) → 0.1.0.0

raw patch · 14 files changed

+1231/−0 lines, 14 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, containers, data-binary-ieee754, hspec, mtl, packstream, text

Files

+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Changelog for packstream++## [0.1.0.0]+- Initial support of PackStream protocol+- Test for all available data types+- Partial support of Structure types
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Pavel Yakovlev (c) 2021++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 Pavel Yakovlev 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.
+ README.md view
@@ -0,0 +1,35 @@+# packstream++[![Travis](https://img.shields.io/travis/zmactep/packstream.svg)](https://travis-ci.org/zmactep/packstream)+[![GitHub Build](https://github.com/zmactep/packstream/workflows/build/badge.svg)](https://github.com/zmactep/packstream/actions?query=workflow%3A%22build%22)+[![hackage](https://img.shields.io/hackage/v/packstream.svg)](https://hackage.haskell.org/package/packstream)+[![hackage-deps](https://img.shields.io/hackage-deps/v/packstream.svg)](https://hackage.haskell.org/package/packstream)++PackStream converter for Neo4j BOLT protocol++Documentation+-------------++To build Haddock documentation run:+```bash+$ stack haddock+```++Usage example+-------------++```haskell+ghci> :set -XOverloadedStrings+ghci> import Data.ByteString+ghci> import Data.PackStream+ghci> import Data.PackStream.Internal.Hex+ghci> hex (pack 100500)+"CA00018894"+ghci> hex (pack [True, False, True])+"93C3C2C3"+ghci> bs <- unhex "93C3C2C3" :: IO ByteString+ghci> unpack bs :: IO [Bool]+[True, False, True]+ghci> unpack bs :: IO [Value]+[B True, B False, B True]+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ packstream.cabal view
@@ -0,0 +1,72 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b8814ee71f844d4802d1ee000fc17039604d267030cc1a1fccb2b68c64a93bba++name:           packstream+version:        0.1.0.0+synopsis:       PackStream converter for Neo4j BOLT protocol+description:    Please see the README on GitHub at <https://github.com/zmactep/packstream#readme>+category:       Data+homepage:       https://github.com/zmactep/packstream#readme+bug-reports:    https://github.com/zmactep/packstream/issues+author:         Pavel Yakovlev+maintainer:     pavel@yakovlev.me+copyright:      (c) 2021, Pavel Yakovlev+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/zmactep/packstream++library+  exposed-modules:+      Data.PackStream+      Data.PackStream.Internal.Binary+      Data.PackStream.Internal.Code+      Data.PackStream.Internal.Hex+      Data.PackStream.Internal.Type+      Data.PackStream.Parser+      Data.PackStream.Serializer+      Data.PackStream.Structure+  other-modules:+      Paths_packstream+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , binary >=0.8.3.0 && <0.11+    , bytestring >=0.10.8.1 && <0.12+    , containers >=0.5.7.1 && <0.7+    , data-binary-ieee754 >=0.4.4 && <0.5+    , mtl >=2.2.0 && <2.3+    , text >=1.2.2.1 && <1.3+  default-language: Haskell2010++test-suite packstream-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_packstream+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , binary >=0.8.3.0 && <0.11+    , bytestring >=0.10.8.1 && <0.12+    , containers >=0.5.7.1 && <0.7+    , data-binary-ieee754 >=0.4.4 && <0.5+    , hspec >=2.4.1 && <2.9+    , mtl >=2.2.0 && <2.3+    , packstream+    , text >=1.2.2.1 && <1.3+  default-language: Haskell2010
+ src/Data/PackStream.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.PackStream+(+  PackStreamError (..), PackStream (..), PackStreamValue (..)+, unpackStream, unpackFail, unpackThrow+, Value (..), (=:)+, Structure (..)+) where++import Data.PackStream.Internal.Type+import qualified Data.PackStream.Parser as P+import qualified Data.PackStream.Serializer as S++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Map.Strict (Map)+import Control.Monad.Except (MonadError(..), liftEither)+++-- |The data types that can be interpreted or parsed to/from 'PackStream' 'ByteString'+class PackStreamValue a where+    -- |Pack a value into a 'PackStream' 'ByteString'+    pack :: a -> ByteString+    -- |Parse a value from a 'PackStream' 'ByteString'+    unpack :: PackStream a++instance PackStreamValue () where+    pack _ = S.null+    unpack = P.null++instance PackStreamValue Bool where+    pack = S.bool+    unpack = P.bool++instance PackStreamValue Int where+    pack = S.integer+    unpack = P.integer++instance PackStreamValue Integer where+    pack = S.integer . fromIntegral+    unpack = fromIntegral <$> P.integer++instance PackStreamValue Double where+    pack = S.float+    unpack = P.float++instance PackStreamValue ByteString where+    pack = S.bytes+    unpack = P.bytes++instance PackStreamValue Text where+    pack = S.string+    unpack = P.string++instance (ToValue a, PackStreamValue a) => PackStreamValue [a] where+    pack = S.list . fmap toValue+    unpack = P.list unpack++instance (ToValue a, PackStreamValue a) => PackStreamValue (Map Text a) where+    pack = S.dict . fmap toValue+    unpack = P.dict unpack++instance PackStreamValue Structure where+    pack = S.structure+    unpack = P.structure++instance PackStreamValue Value where+    pack = S.value+    unpack = P.value++-- |Unpack some value of the specific type from 'ByteString' or raise 'PackStreamError'+unpackThrow :: (MonadError PackStreamError m, PackStreamValue a) => ByteString -> m a+unpackThrow = liftEither . unpackStream unpack++-- |Unpack some value of the specific type from 'ByteString' or 'fail'+unpackFail :: (MonadFail m, PackStreamValue a) => ByteString -> m a+unpackFail bs = case unpackStream unpack bs of+                  Right x -> pure x+                  Left  e -> fail $ show e
+ src/Data/PackStream/Internal/Binary.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.PackStream.Internal.Binary where++import Data.PackStream.Internal.Type ( PackStream, PackStreamError(..) )++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (length)+import Data.ByteString.Lazy (fromStrict, toStrict)+import Data.Binary (Binary, encode, decode)+import Data.Binary.IEEE754 (wordToDouble, doubleToWord)+import Data.Text (Text)+import Data.Int (Int, Int8, Int16, Int32, Int64)+import Control.Applicative (liftA2)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Control.Monad.Except (throwError, MonadError)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+++-- |The data types that can be intepreted from 'ByteString'+class Interpret a where+    -- |Interpret a 'ByteString' as a specific type of raise 'PackStreamError'+    interpret :: MonadError PackStreamError m => ByteString -> m a++    default interpret :: (MonadError PackStreamError m, Binary a) => ByteString -> m a+    interpret = pure . decode . fromStrict++instance Interpret Int8+instance Interpret Int16+instance Interpret Int32+instance Interpret Int64++instance Interpret Word8+instance Interpret Word16+instance Interpret Word32+instance Interpret Word64++instance Interpret Word where+    interpret bs | BS.length bs == 1 = fromIntegral @Word8  <$> interpret bs+                 | BS.length bs == 2 = fromIntegral @Word16 <$> interpret bs+                 | BS.length bs == 4 = fromIntegral @Word32 <$> interpret bs+                 | BS.length bs == 8 = fromIntegral @Word64 <$> interpret bs+                 | otherwise         = throwError NotWord++instance Interpret Int where+    interpret bs | BS.length bs == 1 = fromIntegral @Int8  <$> interpret bs+                 | BS.length bs == 2 = fromIntegral @Int16 <$> interpret bs+                 | BS.length bs == 4 = fromIntegral @Int32 <$> interpret bs+                 | BS.length bs == 8 = fromIntegral @Int64 <$> interpret bs+                 | otherwise         = throwError NotInt++instance Interpret Integer where+    interpret = fmap fromIntegral . interpret @Int++instance Interpret Double where+    interpret = fmap wordToDouble . interpret++instance Interpret ByteString where+    interpret = pure++instance Interpret Text where+    interpret = pure . decodeUtf8++-- |The data types that can be serialized into 'ByteString'+class Serialize a where+    -- |Serialize a specific data type into a 'ByteString'+    serialize :: a -> ByteString++    default serialize :: Binary a => a -> ByteString+    serialize = toStrict . encode++instance Serialize Int8+instance Serialize Int16+instance Serialize Int32+instance Serialize Int64++instance Serialize Word8+instance Serialize Word16+instance Serialize Word32+instance Serialize Word64++instance Serialize Word where+    serialize i | i <= 0xFF               = serialize @Word8  $ fromIntegral i+                | i <= 0xFFFF             = serialize @Word16 $ fromIntegral i+                | i <= 0xFFFFFFFF         = serialize @Word32 $ fromIntegral i+                | i <= 0xFFFFFFFFFFFFFFFF = serialize @Word64 $ fromIntegral i+                | otherwise               = error "Not a 64-bit unsigned integer"++instance Serialize Int where+    serialize i | inDepth  8 i = serialize @Int8  $ fromIntegral i+                | inDepth 16 i = serialize @Int16 $ fromIntegral i+                | inDepth 32 i = serialize @Int32 $ fromIntegral i+                | inDepth 64 i = serialize @Int64 $ fromIntegral i+                | otherwise    = error "Not a 64-bit integer"++instance Serialize Integer where+    serialize i | inDepth 64 i = serialize @Int $ fromIntegral i+                | otherwise    = error "Not a 64-bit integer"++instance Serialize Double where+    serialize = serialize . doubleToWord++instance Serialize ByteString where+    serialize = id++instance Serialize Text where+    serialize = encodeUtf8++-- |Check that the 'Integral' value is in the n-bit bounds+inDepth :: Integral a => Int -> a -> Bool+inDepth bitDepth = let bound = 2 ^ (bitDepth - 1) :: Integer+                   in  liftA2 (&&) (>= -bound) (< bound) . fromIntegral
+ src/Data/PackStream/Internal/Code.hs view
@@ -0,0 +1,136 @@+module Data.PackStream.Internal.Code where++import Data.Binary (Word8)+import Control.Applicative (liftA2)+import Data.Bits ((.&.))++-- * Checkers+--+-- These functions check the marker bytes of 'ByteString's to+-- identify the represented datatype. There names are self-describing.++-- |Checks whether the represented data is '()'+isNull :: Word8 -> Bool+isNull = (== nullCode)++isFalse, isTrue :: Word8 -> Bool+isFalse = (== falseCode)+isTrue = (== trueCode)++-- |Checks whether the represented data is 'Bool'+isBool :: Word8 -> Bool+isBool = isSmth [isFalse, isTrue]++isTinyInt, isInt8, isInt16, isInt32, isInt64 :: Word8 -> Bool+isTinyInt = liftA2 (||) (>= 0xF0) (<= 0x7F)+isInt8 = (== int8Code)+isInt16 = (== int16Code)+isInt32 = (== int32Code)+isInt64 = (== int64Code)++-- |Checks whether the represented data is 'Int'+isInt :: Word8 -> Bool+isInt = isSmth [isTinyInt, isInt8, isInt16, isInt32, isInt64]++-- |Checks whether the represented data is 'Double'+isFloat :: Word8 -> Bool+isFloat = (== floatCode)++isBytes8, isBytes16, isBytes32 :: Word8 -> Bool+isBytes8  = (== bytes8Code)+isBytes16 = (== bytes16Code)+isBytes32 = (== bytes32Code)++-- |Checks whether the represented data is 'ByteString'+isBytes :: Word8 -> Bool+isBytes = isSmth [isBytes8, isBytes16, isBytes32]++isTinyString, isString8, isString16, isString32 :: Word8 -> Bool+isTinyString = liftA2 (&&) (>= stringTinyCode) (<= stringTinyCode + 0x0F)+isString8 = (== string8Code)+isString16 = (== string16Code)+isString32 = (== string32Code)++-- |Checks whether the represented data is 'Text'+isString :: Word8 -> Bool+isString = isSmth [isTinyString, isString8, isString16, isString32]++isTinyList, isList8, isList16, isList32 :: Word8 -> Bool+isTinyList = liftA2 (&&) (>= listTinyCode) (<= listTinyCode + 0x0F)+isList8 = (== list8Code)+isList16 = (== list16Code)+isList32 = (== list32Code)++-- |Checks whether the represented data is '[Value]'+isList :: Word8 -> Bool+isList = isSmth [isTinyList, isList8, isList16, isList32]++isTinyDict, isDict8, isDict16, isDict32 :: Word8 -> Bool+isTinyDict = liftA2 (&&) (>= dictTinyCode) (<= dictTinyCode + 0x0F)+isDict8 = (== dict8Code)+isDict16 = (== dict16Code)+isDict32 = (== dict32Code)++-- |Checks whether the represented data is 'Map Text Value'+isDict :: Word8 -> Bool+isDict = isSmth [isTinyDict, isDict8, isDict16, isDict32]++-- |Checks whether the represented data is 'Structure'+isStructure :: Word8 -> Bool+isStructure = liftA2 (&&) (>= structureCode) (<= structureCode + 0x0F)++-- * Helper functions++-- |Extracts the size of tiny collection ('Text', '[Value]' or 'Map Text Value')+tinySize :: Word8 -> Int+tinySize x = fromIntegral $ x .&. 0x0F++-- |Gets the collection of predicates and checks whether any is 'True' on some data+isSmth :: (Foldable t, Functor t) => t (b -> Bool) -> b -> Bool+isSmth preds = or . flip fmap preds . flip id++-- * Codes+--+-- These are the 'PackStream' constants that mark specific data types.++nullCode :: Word8+nullCode = 0xC0++falseCode, trueCode :: Word8+falseCode = 0xC2+trueCode = 0xC3++int8Code, int16Code, int32Code, int64Code :: Word8+int8Code = 0xC8+int16Code = 0xC9+int32Code = 0xCA+int64Code = 0xCB++floatCode :: Word8+floatCode = 0xC1++bytes8Code, bytes16Code, bytes32Code :: Word8+bytes8Code = 0xCC+bytes16Code = 0xCD+bytes32Code = 0xCE++stringTinyCode, string8Code, string16Code, string32Code :: Word8+stringTinyCode = 0x80+string8Code = 0xD0+string16Code = 0xD1+string32Code = 0xD2++listTinyCode, list8Code, list16Code, list32Code :: Word8+listTinyCode = 0x90+list8Code = 0xD4+list16Code = 0xD5+list32Code = 0xD6++dictTinyCode, dict8Code, dict16Code, dict32Code :: Word8+dictTinyCode = 0xA0+dict8Code = 0xD8+dict16Code = 0xD9+dict32Code = 0xDA++structureCode :: Word8+structureCode = 0xB0
+ src/Data/PackStream/Internal/Hex.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-+ This module is copied from @hex@ module (https://github.com/taruti/haskell-hex),+ because it is not supported and was removed from stackage.+-}+module Data.PackStream.Internal.Hex (Hex(..)) where++import qualified Data.ByteString.Char8      as B+import qualified Data.ByteString.Lazy.Char8 as L+#if !MIN_VERSION_base(4, 13, 0)+import           Control.Monad.Fail (MonadFail)+#endif++-- | Convert strings into hexadecimal and back.+class Hex t where+    -- | Convert string into hexadecimal.+    hex   :: t -> t+    -- | Convert from hexadecimal and fail on invalid input.+    unhex :: MonadFail m => t -> m t+++instance Hex String where+    hex = Prelude.concatMap w+        where w ch = let s = "0123456789ABCDEF"+                         x = fromEnum ch+                     in [s !! div x 16,s !! mod x 16]+    unhex []      = return []+    unhex (a:b:r) = do x <- c a+                       y <- c b+                       (toEnum ((x * 16) + y) :) <$> unhex r+    unhex [_]      = fail "Non-even length"+++c :: MonadFail m => Char -> m Int+c '0' = return 0+c '1' = return 1+c '2' = return 2+c '3' = return 3+c '4' = return 4+c '5' = return 5+c '6' = return 6+c '7' = return 7+c '8' = return 8+c '9' = return 9+c 'A' = return 10+c 'B' = return 11+c 'C' = return 12+c 'D' = return 13+c 'E' = return 14+c 'F' = return 15+c 'a' = return 10+c 'b' = return 11+c 'c' = return 12+c 'd' = return 13+c 'e' = return 14+c 'f' = return 15+c _   = fail "Invalid hex digit!"++instance Hex B.ByteString where+    hex = B.pack . hex . B.unpack+    unhex x = fmap B.pack $ unhex $ B.unpack x++instance Hex L.ByteString where+    hex = L.pack . hex . L.unpack+    unhex x = fmap L.pack $ unhex $ L.unpack x
+ src/Data/PackStream/Internal/Type.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeApplications #-}+module Data.PackStream.Internal.Type where++import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)+import Control.Monad.State (State, MonadState, evalState)+import Data.ByteString (ByteString)+import Data.Binary (Word8)+import Data.Map.Strict (Map)+import Data.Text (Text)++-- * PackStream basics++-- PackStream is a general purpose data serialisation format, originally inspired +-- by (but incompatible with) MessagePack. This module provides basic types+-- and typeclasses to help you to parse or to serialize.++-- |Basic 'PackStream' error type that is used to handle parsing errors.+data PackStreamError = NotNull             -- ^This 'ByteString' doesn't represent null object+                     | NotBool             -- ^This 'ByteString' doesn't represent any boolean+                     | NotWord             -- ^This 'ByteString' doesn't represent any unsigned integer+                     | NotInt              -- ^This 'ByteString' doesn't represent any integer+                     | NotFloat            -- ^This 'ByteString' doesn't represent any floating-point number+                     | NotString           -- ^This 'ByteString' doesn't represent any 'Text' string+                     | NotBytes            -- ^This 'ByteString' doesn't represent any 'ByteString' array+                     | NotList             -- ^This 'ByteString' doesn't represent any list of 'PackStream' values+                     | NotDict             -- ^This 'ByteString' doesn't represent any dictionary of 'PackStream' values+                     | NotStructure        -- ^This 'ByteString' doesn't represent any 'Structure'+                     | NotValue            -- ^This 'ByteString' doesn't represent any 'Value'+                     | WrongStructure Text -- ^This 'ByteString' doesn't represent specific 'Structure'+  deriving (Show, Eq, Ord)++-- |Basic parser type. It works like parser combinators for binary data that represents PackStream.+newtype PackStream a = PackStream { runUnpackS :: ExceptT PackStreamError (State ByteString) a }+  deriving (Functor, Applicative, Monad, MonadState ByteString, MonadError PackStreamError)++-- |Use specific parser combinator to parse the 'ByteString' that represents any 'PackStream' data.+unpackStream :: PackStream a -> ByteString -> Either PackStreamError a+unpackStream action = evalState (runExceptT $ runUnpackS action)++-- |PackStream offers a number of core data types, many supported by multiple binary representations, as well as a flexible extension mechanism.+data Value = N                   -- ^Missing or empty value+           | B Bool              -- ^True or False+           | I Int               -- ^Signed 64-bit integer+           | F Double            -- ^64-bit floating point number+           | U ByteString        -- ^Byte array+           | T Text              -- ^Unicode text, UTF-8+           | L [Value]           -- ^Ordered collection of 'Value's+           | D (Map Text Value)  -- ^Collection of key-value entries (no order guaranteed)+           | S Structure         -- ^Composite value with a type signature+  deriving (Show, Eq)++-- |A structure is a composite value, comprised of fields and a unique type code.+-- Structure encodings consist, beyond the marker, of a single byte, the tag byte, followed +-- by a sequence of up to 15 fields, each an individual value. The size of a structure is +-- measured as the number of fields and not the total byte size. This count does not include the tag.+data Structure = Structure { signature :: Word8   -- ^Type code+                           , fields    :: [Value] -- ^Structure fields+                           }+  deriving (Show, Eq)++-- |The data types that can be serialized as 'PackStream'+class ToValue a where+    -- |Convert data type to the generic 'Value'+    toValue :: a -> Value++instance ToValue () where+    toValue = const N++instance ToValue Bool where+    toValue = B++instance ToValue Int where+    toValue = I++instance ToValue Integer where+    toValue = toValue @Int . fromIntegral++instance ToValue Double where+    toValue = F++instance ToValue ByteString where+    toValue = U++instance ToValue Text where+    toValue = T++instance ToValue a => ToValue [a] where+    toValue = L . fmap toValue++instance ToValue a => ToValue (Map Text a) where+    toValue = D . fmap toValue++instance ToValue Structure where+    toValue = S++instance ToValue Value where+    toValue = id++-- |Represent a 'Text' key and some 'ToValue' data into the 'Map' pair.+-- Can be useful to work with 'PackStream' dictionaries.+--+-- > fromList ["hello" =: 1, "world" =: False]+(=:) :: ToValue a => Text -> a -> (Text, Value)+(=:) key val = (key, toValue val)++-- |The data types taht can be read from 'PackStream' representation+class FromValue a where+    -- |Converts generic 'Value' type to a specific one or raises 'PackStreamError'+    fromValue :: Value -> Either PackStreamError a++instance FromValue () where+    fromValue N = pure ()+    fromValue _ = throwError NotNull++instance FromValue Bool where+    fromValue (B x) = pure x+    fromValue _     = throwError NotBool++instance FromValue Int where+    fromValue (I x) = pure x+    fromValue _     = throwError NotInt++instance FromValue Integer where+    fromValue = fmap fromIntegral . fromValue @Int++instance FromValue Double where+    fromValue (F x) = pure x+    fromValue _     = throwError NotFloat++instance FromValue ByteString where+    fromValue (U x) = pure x+    fromValue _     = throwError NotBytes++instance FromValue Text where+    fromValue (T x) = pure x+    fromValue _     = throwError NotString++instance FromValue a => FromValue [a] where+    fromValue (L xs) = traverse fromValue xs+    fromValue _      = throwError NotList++instance FromValue a => FromValue (Map Text a) where+    fromValue (D mp) = traverse fromValue mp+    fromValue _      = throwError NotDict++instance FromValue Structure where+    fromValue (S x) = pure x+    fromValue _     = throwError NotStructure++instance FromValue Value where+    fromValue = pure
+ src/Data/PackStream/Parser.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Data.PackStream.Parser+(+  null, bool, integer, float,+  bytes, string, list, dict, structure,+  value+) where++import Data.PackStream.Internal.Type ( PackStream, PackStreamError(..), Structure(..), Value(..) )+import Data.PackStream.Internal.Code+import Data.PackStream.Internal.Binary ( Interpret(..) )++import Prelude hiding (null)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (head, tail, drop, take, singleton)+import Data.Text (Text)+import Data.Map.Strict (Map, fromList)+import Data.Binary (Word8)+import Control.Monad.State ( gets, modify )+import Control.Monad.Except (throwError)+import Control.Monad (replicateM, (>=>))+++-- |Parse '()'+null :: PackStream ()+null = bite1 >>= select NotNull [ (isNull, pure ()) ]++-- |Parse 'Bool'+bool :: PackStream Bool+bool = bite1 >>= select NotBool [ (isTrue, pure True)+                                , (isFalse, pure False)+                                ]++-- |Parse 'Int'+integer :: PackStream Int+integer = bite1 >>= \x -> select NotInt [ (isTinyInt, interpret $ BS.singleton x)+                                        , (isInt8,  bite 1 >>= interpret)+                                        , (isInt16, bite 2 >>= interpret)+                                        , (isInt32, bite 4 >>= interpret)+                                        , (isInt64, bite 8 >>= interpret)+                                        ] x++-- |Parse 'Double'+float :: PackStream Double+float = bite1 >>= select NotFloat [ (isFloat, bite 8 >>= interpret) ]++-- |Parse 'ByteString'+bytes :: PackStream ByteString+bytes = bite1 >>= select NotBytes [ (isBytes8,  bite'by'bytes 1)+                                  , (isBytes16, bite'by'bytes 2)+                                  , (isBytes32, bite'by'bytes 4)+                                  ]++-- |Parse 'Text'+string :: PackStream Text+string = bite1 >>= \x -> select NotBytes [ (isTinyString, bite (tinySize x) >>= interpret)+                                         , (isString8,    bite'by'bytes 1 >>= interpret)+                                         , (isString16,   bite'by'bytes 2 >>= interpret)+                                         , (isString32,   bite'by'bytes 4 >>= interpret)+                                         ] x++-- |Parse a list of specified 'Value's (e.g. `list integer` will parse some '[Int]')+list :: PackStream a -> PackStream [a]+list action = bite1 >>= \x -> select NotList [ (isTinyList, multiple action (tinySize x))+                                             , (isList8,    collectionSize 1 >>= multiple action)+                                             , (isList16,   collectionSize 2 >>= multiple action)+                                             , (isList32,   collectionSize 4 >>= multiple action)+                                             ] x++-- |Parse a dictionary of specified 'Value's (e.g. `dict integer` will parse some 'Map Text Int')+dict :: forall a.PackStream a -> PackStream (Map Text a)+dict action = bite1 >>= \x -> select NotDict [ (isTinyDict, makeDict (tinySize x))+                                             , (isDict8,    collectionSize 1 >>= makeDict)+                                             , (isDict16,   collectionSize 2 >>= makeDict)+                                             , (isDict32,   collectionSize 4 >>= makeDict)+                                             ] x+  where+    makeDict :: Int -> PackStream (Map Text a)+    makeDict = (fromList <$>) . multiple ((,) <$> string <*> action)++-- |Parse 'Structure'+structure :: PackStream Structure+structure = bite1 >>= \x -> select NotStructure [ (isStructure, makeStructure (tinySize x)) ] x+  where+    makeStructure :: Int -> PackStream Structure+    makeStructure n = Structure <$> bite1 <*> multiple value n++-- |Parse any valid 'Value'+value :: PackStream Value+value = look1 >>= byMarker+  where+    byMarker :: Word8 -> PackStream Value+    byMarker n | isNull n      = N <$ null+               | isBool n      = B <$> bool+               | isInt n       = I <$> integer+               | isFloat n     = F <$> float+               | isBytes n     = U <$> bytes+               | isString n    = T <$> string+               | isList n      = L <$> list value+               | isDict n      = D <$> dict value+               | isStructure n = S <$> structure+               | otherwise     = throwError NotValue++-- |Selects a parser to use by the marker byte predicate. Raises the 'PackStreamError' if nothing is suitable+select :: PackStreamError -> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a+select e []               _ = throwError e+select e ((p, action):xs) w | p w       = action+                            | otherwise = select e xs w++-- |Gets one byte from the 'ByteString'+bite1 :: PackStream Word8+bite1 = do b <- gets BS.head+           modify BS.tail+           pure b++-- |Gets the specified number of bytes from the 'ByteString'+bite :: Int -> PackStream ByteString+bite n = do bs <- gets $ BS.take n+            modify $ BS.drop n+            pure bs++-- |Looks at the first byte of the 'ByteString' without modifying it+look1 :: PackStream Word8+look1 = gets BS.head++-- |Gets the specified number of bytes from the 'ByteString', +-- interprets them as some unsigned int ('Word') and then get the specified number of+-- further bytes from the 'ByteString'+bite'by'bytes :: Int -> PackStream ByteString+bite'by'bytes n = collectionSize n >>= bite++-- |Performs some 'PackStream' parser combinator the specified number of times+multiple :: PackStream a -> Int -> PackStream [a]+multiple action n = replicateM n action++-- |Gets the specified number of bytes from the 'ByteString' and+-- interprets them as some unsigned int ('Word')+collectionSize :: Int -> PackStream Int+collectionSize n = bite n >>= fmap fromIntegral . interpret @Word
+ src/Data/PackStream/Serializer.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE TypeApplications #-}+module Data.PackStream.Serializer+(+  null, bool, integer, float,+  bytes, string, list, dict, structure,+  value+) where+++import Data.PackStream.Internal.Type (Structure (..), Value (..))+import Data.PackStream.Internal.Code+import Data.PackStream.Internal.Binary (Serialize(..), inDepth)++import Prelude hiding (null)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (singleton, cons, append, length, concat, empty)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Data.Map.Strict (Map, toList)+import Data.Word (Word8, Word)+++-- |Represent '()' as 'PackStream' 'ByteString'+null :: ByteString+null = BS.singleton nullCode++-- |Represent 'Bool' as 'PackStream' 'ByteString'+bool :: Bool -> ByteString+bool False = BS.singleton falseCode+bool True  = BS.singleton trueCode++-- |Represent 'Int' as 'PackStream' 'ByteString'+integer :: Int -> ByteString+integer n | n >= -16 && n < 128 = serialize n+          | inDepth 8  n        = int8Code  `BS.cons` serialize n+          | inDepth 16 n        = int16Code `BS.cons` serialize n+          | inDepth 32 n        = int32Code `BS.cons` serialize n+          | inDepth 64 n        = int64Code `BS.cons` serialize n+          | otherwise           = BS.empty++-- |Represent 'Double' as 'PackStream' 'ByteString'+float :: Double -> ByteString+float x = floatCode `BS.cons` serialize x++-- |Represent 'ByteString' as 'PackStream' 'ByteString'+bytes :: ByteString -> ByteString+bytes bs = constructCollection mstart bs+  where+    mstart :: Maybe ByteString+    mstart = (`BS.cons` serializeLen (BS.length bs)) <$> firstByte+  +    firstByte :: Maybe Word8+    firstByte | BS.length bs <= 0xFF       = pure bytes8Code+              | BS.length bs <= 0xFFFF     = pure bytes16Code+              | BS.length bs <= 0xFFFFFFFF = pure bytes32Code+              | otherwise                  = Nothing++-- |Represent 'Text' as 'PackStream' 'ByteString'+string :: Text -> ByteString+string s = constructCollection mstart (serialize s)+  where+    mstart :: Maybe ByteString+    mstart = firstBytes stringTinyCode string8Code string16Code string32Code (BS.length $ encodeUtf8 s)++-- |Represent '[Value]' as 'PackStream' 'ByteString'+list :: [Value] -> ByteString+list l = constructCollection mstart (BS.concat (value <$> l))+  where+    mstart :: Maybe ByteString+    mstart = firstBytes listTinyCode list8Code list16Code list32Code (length l)++-- |Represent 'Map Text Value' as 'PackStream' 'ByteString'+dict :: Map Text Value -> ByteString+dict d = constructCollection mstart (BS.concat (kvs <$> toList d))+  where+    mstart :: Maybe ByteString+    mstart = firstBytes dictTinyCode dict8Code dict16Code dict32Code (length d)++    kvs :: (Text, Value) -> ByteString+    kvs (k, v) = string k `BS.append` value v++-- |Represent 'Structure' as 'PackStream' 'ByteString'+structure :: Structure -> ByteString+structure s | len < 16  = structureCode + len `BS.cons` signature s `BS.cons` BS.concat (value <$> fields s)+            | otherwise = BS.empty+  where+    len = fromIntegral $ length $ fields s++-- |Represent 'Value' as 'PackStream' 'ByteString'+value :: Value -> ByteString+value N     = null+value (B b) = bool b+value (I i) = integer i+value (F f) = float f+value (U u) = bytes u+value (T t) = string t+value (L l) = list l+value (D d) = dict d+value (S s) = structure s++-- Helper functions++constructCollection :: Maybe ByteString -> ByteString -> ByteString+constructCollection mstart end = case mstart of+                                   Just start -> start `BS.append` end+                                   Nothing    -> BS.empty++firstBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Int -> Maybe ByteString+firstBytes bt b8 b16 b32 len | len <= 0xF        = pure $ BS.singleton $ bt  + fromIntegral len+                             | len <= 0xFF       = pure $ b8  `BS.cons` serializeLen len+                             | len <= 0xFFFF     = pure $ b16 `BS.cons` serializeLen len+                             | len <= 0xFFFFFFFF = pure $ b32 `BS.cons` serializeLen len+                             | otherwise         = Nothing++serializeLen :: Int -> ByteString+serializeLen = serialize @Word . fromIntegral
+ src/Data/PackStream/Structure.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.PackStream.Structure+( ToStructure (..), FromStructure (..)+, Node (..), Relationship (..), UnboundRelationship (..), Path (..)+, Date (..), Time (..), LocalTime (..), DateTime (..), DateTimeZoneId (..), LocalDateTime (..)+, Duration (..)+, Point2D (..), Point3D (..)+) where++import Data.Text (Text)+import Data.Map.Strict (Map)+import Control.Monad.Except (MonadError(..))+import Control.Monad ((>=>))++import Data.PackStream.Internal.Type+import Data.PackStream ( PackStreamValue(..) )++-- * Structure coverters+-- +-- 'PackStream' protocol provides several built-in 'Structure' types. They+-- are the objects with specific fields and one-byte structure signature.+-- The 'ToStructure' and 'FromStructure' typeclasses help to convert+-- Haskell representation of these objects into and from generic 'Structure'+-- type.++-- |The set of types, that can be presented as 'PackStream' 'Structure's+class ToStructure a where+    -- |Convert object to 'Structure'+    toStructure :: a -> Structure++-- |The set of types, that can be parsed from 'PackStream' 'Structure's+class FromStructure a where+    -- |Convert 'Structure' to the object of selected type+    fromStructure :: Structure -> Either PackStreamError a++-- * Built-in structure types++-- |Snapshot of a node within a graph database+data Node = Node { nodeId    :: Int            -- ^Node identifier+                 , labels    :: [Text]         -- ^List of node labels+                 , nodeProps :: Map Text Value -- ^Dict of node properties+                 }+  deriving (Show, Eq)++instance ToStructure Node where+    toStructure Node{..} = Structure 0x4E [ toValue nodeId+                                          , toValue labels+                                          , toValue nodeProps+                                          ]++instance FromStructure Node where+    fromStructure (Structure 0x4E [I nid, L lbls, D nps]) = Node nid <$> traverse fromValue lbls <*> pure nps+    fromStructure _                                       = throwError $ WrongStructure "Node"++-- |Snapshot of a relationship within a graph database+data Relationship = Relationship { relId       :: Int            -- ^Relationship identifier+                                 , startNodeId :: Int            -- ^Identifier of the start node+                                 , endNodeId   :: Int            -- ^Identifier of the end node+                                 , relType     :: Text           -- ^Relationship type+                                 , relProps    :: Map Text Value -- ^Dict of relationship properties+                                 }+  deriving (Show, Eq)++instance ToStructure Relationship where+    toStructure Relationship{..} = Structure 0x52 [ toValue relId+                                                  , toValue startNodeId+                                                  , toValue endNodeId+                                                  , toValue relType+                                                  , toValue relProps+                                                  ]++instance FromStructure Relationship where+    fromStructure (Structure 0x52 [I rid, I snid, I enid, T rt, D rps]) = pure $ Relationship rid snid enid rt rps+    fromStructure _                                                     = throwError $ WrongStructure "Relationship"++-- |Relationship detail without start or end node information+data UnboundRelationship = UnboundRelationship { urelId    :: Int            -- ^Relationship identifier+                                               , urelType  :: Text           -- ^Relationship type+                                               , urelProps :: Map Text Value -- ^Dict of relationship properties+                                               }+  deriving (Show, Eq)++instance ToStructure UnboundRelationship where+    toStructure UnboundRelationship{..} = Structure 0x72 [ toValue urelId+                                                         , toValue urelType+                                                         , toValue urelProps+                                                         ]++instance FromStructure UnboundRelationship where+    fromStructure (Structure 0x72 [I rid, T rt, D rps]) = pure $ UnboundRelationship rid rt rps+    fromStructure _                                     = throwError $ WrongStructure "UnboundRelationship"++-- |Alternating sequence of nodes and relationships+data Path = Path { nodes :: [Node]                -- ^Chain of 'Node's in path+                 , rels  :: [UnboundRelationship] -- ^Chain of 'UnboundRelationship's in path+                 , ids   :: [Int]                 -- ^The ids is a list of relationship id and node id to represent the path+                 }+  deriving (Show, Eq)++instance ToStructure Path where+    toStructure Path{..} = Structure 0x50 [ toValue $ fmap toStructure nodes+                                          , toValue $ fmap toStructure rels+                                          , toValue ids+                                          ]++instance FromStructure Path where+    fromStructure (Structure 0x50 [L nds, L rls, L is]) = Path <$> traverse (fromValue >=> fromStructure) nds +                                                               <*> traverse (fromValue >=> fromStructure) rls +                                                               <*> traverse fromValue is++-- |The days are days since the Unix epoch+newtype Date = Date { days :: Int -- ^The days are days since the Unix epoch+                    }+  deriving (Show, Eq)++instance ToStructure Date where+  toStructure Date{..} = Structure 0x44 [toValue days]++instance FromStructure Date where+  fromStructure (Structure 0x44 [I ds]) = pure $ Date ds+  fromStructure _                       = throwError $ WrongStructure "Date"++data Time+data LocalTime+data DateTime+data DateTimeZoneId+data LocalDateTime+data Duration+data Point2D+data Point3D
+ test/Spec.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec+import Data.Text (Text)+import qualified Data.Text as T (unpack)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B (pack, unpack, take, empty)+import Data.ByteString.Lazy (toStrict, fromStrict)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M (empty, fromList)++import Data.PackStream (PackStreamValue (..), Value(..), (=:), unpackFail)+import Data.PackStream.Internal.Hex (Hex(..))+++main :: IO ()+main = hspec $ do serializeSpec+                  parseSpec++serializeSpec :: Spec+serializeSpec =+    describe "Serializer" $ do+        it "packs ()" $+            hex (pack ()) `shouldBe` "C0"+        it "packs Bool" $ do+            hex (pack False) `shouldBe` "C2"+            hex (pack True) `shouldBe` "C3"+        it "packs Int" $ do+            hex (pack (1::Int)) `shouldBe` "01"+            hex (pack (42::Int)) `shouldBe` "2A"+            hex (pack (32767::Int)) `shouldBe` "C97FFF"+            hex (pack (-32768::Int)) `shouldBe` "C98000"+            hex (pack (9223372036854775807::Int)) `shouldBe` "CB7FFFFFFFFFFFFFFF"+            hex (pack (-9223372036854775808::Int)) `shouldBe` "CB8000000000000000"+        it "packs Integer" $ do+            hex (pack (1::Integer)) `shouldBe` "01"+            hex (pack (42::Integer)) `shouldBe` "2A"+            hex (pack (1234::Integer)) `shouldBe` "C904D2"+            hex (pack (32767::Integer)) `shouldBe` "C97FFF"+            hex (pack (-32768::Integer)) `shouldBe` "C98000"+            hex (pack (-9223372036854775808::Integer)) `shouldBe` "CB8000000000000000"+        it "packs Double" $ do+            hex (pack (6.283185307179586::Double)) `shouldBe` "C1401921FB54442D18"+            hex (pack (-1.1::Double)) `shouldBe` "C1BFF199999999999A"+        it "packs ByteString" $ do+            hex (pack B.empty) `shouldBe` "CC00"+            hex (pack (B.pack [1, 2, 3])) `shouldBe` "CC03010203"+            B.take 12 (hex (pack (B.pack [1 .. 255]))) `shouldBe` "CCFF01020304"+            B.take 14 (hex (pack (B.pack [0 .. 255]))) `shouldBe` "CD010000010203"+        it "packs Text" $ do+            hex (pack (""::Text)) `shouldBe` "80"+            hex (pack ("ABCDE"::Text)) `shouldBe` "854142434445"+            hex (pack ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"::Text)) `shouldBe` "D01A4142434445464748494A4B4C4D4E4F505152535455565758595A"+            hex (pack ("Größenmaßstäbe"::Text)) `shouldBe` "D0124772C3B6C39F656E6D61C39F7374C3A46265"+        it "packs []" $ do+            hex (pack ([]::[Int])) `shouldBe` "90"+            hex (pack [1::Int, 2, 3]) `shouldBe` "93010203"+            hex (pack [I 1, F (-1.1), T "", B False]) `shouldBe` "9401C1BFF199999999999A80C2"+            hex (pack [1::Int .. 32]) `shouldBe` "D4200102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F20"+            B.take 14 (hex (pack [0::Int .. 255])) `shouldBe` "D5010000010203"+        it "packs Map" $ do+            hex (pack (M.empty::Map Text Int)) `shouldBe` "A0"+            hex (pack (M.fromList ["A" =: True, "B" =: False])) `shouldBe` "A28141C38142C2"+            hex (pack (M.fromList ["A" =: (1::Int), "B" =: ("ABCDE"::Text)])) `shouldBe` "A28141018142854142434445"+            hex (pack bigMap) `shouldBe` bigMapBS++parseSpec :: Spec+parseSpec =+    describe "Parser" $ do+        it "parses ()" $ do+            v <- prepareData "C0" >>= unpackFail :: IO ()+            v `shouldBe` ()+        it "parses Bool" $ do+            t <- prepareData "C3" >>= unpackFail :: IO Bool+            t `shouldBe` True+            f <- prepareData "C2" >>= unpackFail :: IO Bool+            f `shouldBe` False+        it "parses Int" $ do+            u1 <- prepareData "01" >>= unpackFail :: IO Int+            u1 `shouldBe` 1+            u42 <- prepareData "2A" >>= unpackFail :: IO Int+            u42 `shouldBe` 42+            u32767 <- prepareData "C97FFF" >>= unpackFail :: IO Int+            u32767 `shouldBe` 32767+            umin <- prepareData "CB8000000000000000" >>= unpackFail :: IO Int+            umin `shouldBe` (-9223372036854775808)+        it "parses Integer" $ do+            u1 <- prepareData "01" >>= unpackFail :: IO Integer+            u1 `shouldBe` 1+            u42 <- prepareData "2A" >>= unpackFail :: IO Integer+            u42 `shouldBe` 42+            u1234 <- prepareData "C97FFF" >>= unpackFail :: IO Integer+            u1234 `shouldBe` 32767+            umin <- prepareData "CB8000000000000000" >>= unpackFail :: IO Integer+            umin `shouldBe` (-9223372036854775808)+        it "parses Double" $ do+            uf <- prepareData "C1BFF199999999999A" >>= unpackFail :: IO Double+            uf `shouldBe` (-1.1)+            us <- prepareData "C1401921FB54442D18" >>= unpackFail :: IO Double+            us `shouldBe` 6.283185307179586+        it "parses ByteString" $ do+            uemp <- prepareData "CC00" >>= unpackFail :: IO ByteString+            B.unpack uemp `shouldBe` []+            usmall <- prepareData "CC03010203" >>= unpackFail :: IO ByteString+            B.unpack usmall `shouldBe` [1, 2, 3]+            u255 <- unpackFail (B.pack $ [0xCC, 0xFF] ++ [1 .. 255]) :: IO ByteString+            B.unpack u255 `shouldBe` [1 .. 255]+            u256 <- unpackFail (B.pack $ [0xCD, 0x01, 0x00] ++ [0 .. 255]) :: IO ByteString+            B.unpack u256 `shouldBe` [0 .. 255]+        it "parses Text" $ do+            uemp <- prepareData "80" >>= unpackFail :: IO Text+            T.unpack uemp `shouldBe` ""+            usmall <- prepareData "854142434445" >>= unpackFail :: IO Text+            T.unpack usmall `shouldBe` "ABCDE"+            ubig <- prepareData "D01A4142434445464748494A4B4C4D4E4F505152535455565758595A" >>= unpackFail :: IO Text+            T.unpack ubig `shouldBe` "ABCDEFGHIJKLMNOPQRSTUVWXYZ"+            uutf <- prepareData "D0124772C3B6C39F656E6D61C39F7374C3A46265" >>= unpackFail :: IO Text+            uutf `shouldBe` "Größenmaßstäbe"+        it "parses []" $ do+            uemp <- prepareData "90" >>= unpackFail :: IO [Bool]+            uemp `shouldBe` []+            usmall <- prepareData "9401C1BFF199999999999A80C2" >>= unpackFail :: IO [Value]+            usmall `shouldBe` [I 1, F (-1.1), T "", B False]+            ubig <- prepareData "D4200102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F20" >>= unpackFail :: IO [Int]+            ubig `shouldBe` [1 .. 32]+        it "parses Map" $ do+            uemp <- prepareData "A0" >>= unpackFail :: IO (Map Text Int)+            uemp `shouldBe` M.empty+            usmall <- prepareData "A28141018142854142434445" >>= unpackFail :: IO (Map Text Value)+            usmall `shouldBe` M.fromList ["A" =: (1::Int), "B" =: ("ABCDE"::Text)]+            ubig <- prepareData bigMapBS >>= unpackFail :: IO (Map Text Int)+            ubig `shouldBe` bigMap++-- Helper++prepareData :: MonadFail m => ByteString -> m ByteString+prepareData = (toStrict <$>) . unhex . fromStrict++bigMap :: Map Text Int+bigMap = M.fromList [ ("A", 1),  ("B", 2),  ("C", 3),  ("D", 4),  ("E", 5)+                    , ("F", 6),  ("G", 7),  ("H", 8),  ("I", 9),  ("J", 10)+                    , ("K", 11), ("L", 12), ("M", 13), ("N", 14), ("O", 15)+                    , ("P", 16), ("Q", 17), ("R", 18), ("S", 19), ("T", 20)+                    , ("U", 21), ("V", 22), ("W", 23), ("X", 24), ("Y", 25)+                    , ("Z", 26)]+++bigMapBS :: ByteString+bigMapBS = "D81A814101814202814303814404814505814606814707814808814909814A0A814B0B814C0C814D0D814E0E814F0F815010815111815212815313815414815515815616815717815818815919815A1A"