z85 (empty) → 0.0.0
raw patch · 11 files changed
+584/−0 lines, 11 filesdep +QuickCheckdep +attoparsecdep +attoparsec-binarysetup-changed
Dependencies added: QuickCheck, attoparsec, attoparsec-binary, base, bytestring, pipes, pipes-bytestring, pipes-text, quickcheck-instances, tasty, tasty-hunit, tasty-quickcheck, text, vector-sized, z85
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +12/−0
- Setup.hs +2/−0
- src/Data/Attoparsec/ByteString/Z85.hs +17/−0
- src/Data/Attoparsec/Text/Z85.hs +40/−0
- src/Data/ByteString/Z85.hs +108/−0
- src/Data/ByteString/Z85/Internal.hs +130/−0
- src/Pipes/Z85.hs +81/−0
- test/Spec.hs +83/−0
- z85.cabal +78/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for z85-bytestring++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Athan Clark (c) 2018++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 Athan Clark 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,12 @@+# z85++[z85](https://rfc.zeromq.org/spec:32/Z85/) is a binary string codec, like hexadecimal or base64, but has a higher density+of compression than the former, due to its use of a higher base value of 85 than base 64. ByteStrings just need to be+a length of a multiple of 4 (a Word32String might be a better name).++There are multiple layers of exposed implementation in this package++- `Word32 <-> Vector 4 Z85Char` for low level work+- Attoparsec `Parser ByteString <-> Parser Text` for slightly higher level parsing of strict data+- Pipes `Pipe ByteString Text <-> Pipe Text ByteString` for encoding / decoding streams of strict data+- Casual `Lazy.ByteString ~ Lazy.Text` functions for encoding / decoding lazy data.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Attoparsec/ByteString/Z85.hs view
@@ -0,0 +1,17 @@+module Data.Attoparsec.ByteString.Z85 where++import Data.ByteString.Z85.Internal (Z85Chunk, encodeWord, printZ85Chunk)+import Data.Attoparsec.ByteString (Parser)+import Data.Attoparsec.Binary (anyWord32be)+import Data.Text (Text)+import Data.Foldable (fold)+import Control.Applicative (many)++++anyWord32beEncoded :: Parser Z85Chunk+anyWord32beEncoded = encodeWord <$> anyWord32be+++z85Encoded :: Parser Text+z85Encoded = fold <$> many (printZ85Chunk <$> anyWord32beEncoded)
+ src/Data/Attoparsec/Text/Z85.hs view
@@ -0,0 +1,40 @@+module Data.Attoparsec.Text.Z85 where++import Data.ByteString.Z85.Internal (Z85Char (..), Z85Chunk, decodeWord, isZ85Char)+import qualified Data.Vector.Sized as V+import Data.Maybe (fromJust)+import Data.Word (Word32)+import Data.ByteString (ByteString, empty)+import Data.ByteString.Lazy (toStrict)+import Data.ByteString.Builder (word32BE, toLazyByteString)+import Data.Attoparsec.Text (Parser, char, satisfy, (<?>))+import Control.Applicative (optional)+import Control.Monad (replicateM)++++anyZ85Char :: Parser Z85Char+anyZ85Char = Z85Char <$> satisfy isZ85Char <?> "Z85Char character class"+++z85Char :: Z85Char -> Parser Z85Char+z85Char (Z85Char c) = Z85Char <$> char c+++anyZ85Chunk :: Parser Z85Chunk+anyZ85Chunk =+ (fromJust . V.fromList) <$> replicateM 5 anyZ85Char+++anyZ85ChunkDecoded :: Parser Word32+anyZ85ChunkDecoded = decodeWord <$> anyZ85Chunk+++z85Decoded :: Parser ByteString+z85Decoded = do+ mX <- optional anyZ85ChunkDecoded+ case mX of+ Nothing -> pure empty+ Just x ->+ let x' = toStrict (toLazyByteString (word32BE x))+ in (x' <>) <$> z85Decoded
+ src/Data/ByteString/Z85.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE+ OverloadedStrings+ #-}++module Data.ByteString.Z85 where++import qualified Pipes.Z85 as PZ+import qualified Pipes.ByteString as PB+import qualified Pipes.Text as PT+import Pipes ((>->), Producer, Effect, for, runEffect)++import qualified Data.ByteString as BS+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as T+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as LT+import Data.IORef (readIORef, newIORef, modifyIORef)+import Control.Monad.IO.Class (liftIO)+import Control.Exception (try, SomeException)+import System.IO.Unsafe (unsafePerformIO)++++data Z85Error+ = TextNotMod5+ | BSNotMod4+ | ParsingError PZ.Z85ParsingError+ deriving (Eq, Show)+++-- | Fails by checking the length is @mod 4@ - warning, checking length on a potentially infinite stream may not be possible, or may+-- cause faulty memory management. Use 'encode\'' if you want to verify offsets after.+encode :: ByteString -> Either Z85Error Text+encode bs+ | LBS.length bs `mod` 4 /= 0 = Left BSNotMod4+ | otherwise = unsafePerformIO $ do+ let go :: IO Text+ go = do+ leftoverRef <- newIORef ""+ let encoded :: Producer T.Text IO ()+ encoded = PB.fromLazy bs >-> PZ.encode leftoverRef+ PT.toLazyM encoded+ eX <- try go+ pure $ case eX of+ Left e -> Left (ParsingError e)+ Right x -> Right x++-- | Fails by checking the residual unparsed input after doing all the work -+-- use 'encode' if you want to check length early.+encode' :: ByteString -> Either Z85Error Text+encode' bs = unsafePerformIO $ do+ let go :: IO (Either Z85Error Text)+ go = do+ leftoverRef <- newIORef ""+ let encoded :: Producer T.Text IO ()+ encoded = PB.fromLazy bs >-> PZ.encode leftoverRef+ x <- PT.toLazyM encoded+ leftover <- readIORef leftoverRef+ pure $+ if BS.length leftover /= 0+ then Left BSNotMod4+ else Right x+ eX <- try go+ pure $ case eX of+ Left e -> Left (ParsingError e)+ Right x -> x++++-- | Fails by checking the length is @mod 5@ - warning, checking length on a potentially infinite stream may not be possible, or may+-- cause faulty memory management. Use 'decode\'' if you want to verify offsets after.+decode :: Text -> Either Z85Error ByteString+decode t+ | LT.length t `mod` 5 /= 0 = Left TextNotMod5+ | otherwise = unsafePerformIO $ do+ let go :: IO ByteString+ go = do+ leftoverRef <- newIORef ""+ let decoded :: Producer BS.ByteString IO ()+ decoded = PT.fromLazy t >-> PZ.decode leftoverRef+ PB.toLazyM decoded+ eX <- try go+ pure $ case eX of+ Left e -> Left (ParsingError e)+ Right x -> Right x++-- | Fails by checking the residual unparsed input after doing all the work -+-- use 'decode' if you want to check length early.+decode' :: Text -> Either Z85Error ByteString+decode' t = unsafePerformIO $ do+ let go :: IO (Either Z85Error ByteString)+ go = do+ leftoverRef <- newIORef ""+ let decoded :: Producer BS.ByteString IO ()+ decoded = PT.fromLazy t >-> PZ.decode leftoverRef+ x <- PB.toLazyM decoded+ leftover <- readIORef leftoverRef+ pure $+ if T.length leftover /= 0+ then Left TextNotMod5+ else Right x+ eX <- try go+ pure $ case eX of+ Left e -> Left (ParsingError e)+ Right x -> x++
+ src/Data/ByteString/Z85/Internal.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE+ DataKinds+ , DeriveGeneric+ #-}++module Data.ByteString.Z85.Internal where++import Data.Vector.Sized (Vector)+import qualified Data.Vector.Sized as V+import Data.Char (ord, isAlphaNum)+import Data.Text (Text, pack)+import Data.Maybe (fromJust)+import Data.Bits ((.&.), shiftR)+import Data.Word (Word32)+import Data.STRef (newSTRef, modifySTRef, readSTRef)+import Data.Traversable (traverse)+import Control.Monad (forM_)+import Control.Monad.ST (runST)+import Test.QuickCheck (Arbitrary (..))+import Test.QuickCheck.Gen (oneof)+import GHC.Generics (Generic)++++type Base85 = Word32+++newtype Z85Char = Z85Char+ { getZ85Char :: Char+ } deriving (Eq, Ord, Show, Generic)++instance Arbitrary Z85Char where+ arbitrary = oneof $ map pure $ V.toList z85Chars+++type Z85Chunk = Vector 5 Z85Char+++printZ85Chunk :: Z85Chunk -> Text+printZ85Chunk = pack . map getZ85Char . V.toList++++z85Chars :: Vector 85 Z85Char+z85Chars = Z85Char <$> fromJust (V.fromList "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ.-:+=^!/*?&<>()[]{}@%$#")+++isZ85Char :: Char -> Bool+isZ85Char c = isAlphaNum c || c `elem` ".-:+=^!/*?&<>()[]{}@%$#"++++lookupZ85Char :: Base85 -> Z85Char+lookupZ85Char idx = z85Chars `V.unsafeIndex` fromIntegral idx+++charCodeToBase85 :: Vector 96 Base85+charCodeToBase85 = fromJust (V.fromList+ [ nan, 0x44, nan, 0x54, 0x53, 0x52, 0x48, nan+ , 0x4B, 0x4C, 0x46, 0x41, nan, 0x3F, 0x3E, 0x45+ , 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07+ , 0x08, 0x09, 0x40, nan, 0x49, 0x42, 0x4A, 0x47+ , 0x51, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A+ , 0x2B, 0x2C, 0x2D, 0x2E, 0x2F, 0x30, 0x31, 0x32+ , 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3A+ , 0x3B, 0x3C, 0x3D, 0x4D, nan, 0x4E, 0x43, nan+ , nan, 0x0A, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, 0x10+ , 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18+ , 0x19, 0x1A, 0x1B, 0x1C, 0x1D, 0x1E, 0x1F, 0x20+ , 0x21, 0x22, 0x23, 0x4F, nan, 0x50, 0x00, 0x00+ ])+ where+ nan = 0+++z85CharToIndex :: Z85Char -> Int+z85CharToIndex (Z85Char c) = ord c - 32+++lookupBase85 :: Z85Char -> Base85+lookupBase85 c = V.unsafeIndex charCodeToBase85 (z85CharToIndex c)+++encodeWord :: Word32 -> Z85Chunk+encodeWord word =+ let value = runST $ do+ valueRef <- newSTRef 0+ forM_ [0..3] $ \j ->+ let base256 :: Word32+ base256 = 0xFF+ byteShift :: Int+ byteShift = 8 * (4 - j - 1)+ byteChunk :: Word32+ byteChunk = shiftR word byteShift .&. base256+ in modifySTRef valueRef (\val -> (val * 256) + byteChunk)+ readSTRef valueRef+ getC :: Word32 -> Z85Char+ getC n =+ let divisor :: Word32+ divisor = 85 ^ n+ idx :: Base85+ idx = (value `div` divisor) `mod` 85+ in lookupZ85Char idx+ in V.fromTuple (getC 4, getC 3, getC 2, getC 1, getC 0)++++decodeWord :: Z85Chunk -> Word32+decodeWord chunk =+ let value :: Word32+ value = runST $ do+ valueRef <- newSTRef 0+ let addPartValue part =+ modifySTRef valueRef (\val -> (val * 85) + part)+ _ <- traverse addPartValue base85Values+ readSTRef valueRef+ divisor :: Int -> Word32+ divisor n = 256 ^ n+ in runST $ do+ wordRef <- newSTRef 0+ forM_ [3,2..0] $ \n ->+ let go word =+ let magnitude = word * 256+ dust = (value `div` divisor n) `mod` 256+ in magnitude + dust+ in modifySTRef wordRef go+ readSTRef wordRef+ where+ base85Values :: Vector 5 Base85+ base85Values = lookupBase85 <$> chunk
+ src/Pipes/Z85.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE+ OverloadedLists+ , DeriveGeneric+ #-}++module Pipes.Z85 where++import Data.Attoparsec.ByteString.Z85 (z85Encoded)+import Data.Attoparsec.Text.Z85 (z85Decoded)++import Pipes (Pipe, await, yield)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Attoparsec.ByteString as AB+import qualified Data.Attoparsec.Text as AT+import Data.IORef (IORef, readIORef, writeIORef)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Exception (throw, Exception)+import GHC.Generics (Generic)++++data Z85ParsingError+ = EncodeError [String] String+ | DecodeError [String] String+ | CantCompletePartial+ deriving (Eq, Show, Generic)+instance Exception Z85ParsingError+++encode :: MonadIO m+ => IORef ByteString -- ^ Unparsed input+ -> Pipe ByteString Text m ()+encode leftoverRef = do+ prev <- liftIO (readIORef leftoverRef)+ r <- let f current = AB.parse z85Encoded (prev <> current)+ in f <$> await+ let onFail i es e = liftIO $ do+ writeIORef leftoverRef i+ throw (EncodeError es e)+ onDone i x = do+ liftIO (writeIORef leftoverRef i)+ yield x+ encode leftoverRef+ case r of+ AB.Fail i es e -> onFail i es e+ AB.Partial f ->+ case f BS.empty of+ AB.Fail i es e -> onFail i es e+ AB.Done i x -> onDone i x+ AB.Partial _ ->+ throw CantCompletePartial+ AB.Done i x -> onDone i x++++decode :: MonadIO m+ => IORef Text -- ^ Unparsed input+ -> Pipe Text ByteString m ()+decode leftoverRef = do+ prev <- liftIO (readIORef leftoverRef)+ r <- let f current = AT.parse z85Decoded (prev <> current)+ in f <$> await+ let onFail i es e = liftIO $ do+ writeIORef leftoverRef i+ throw (DecodeError es e)+ onDone i x = do+ liftIO (writeIORef leftoverRef i)+ yield x+ decode leftoverRef+ case r of+ AT.Fail i es e -> onFail i es e+ AT.Partial f ->+ case f T.empty of+ AT.Fail i es e -> onFail i es e+ AT.Done i x -> onDone i x+ AT.Partial _ ->+ throw CantCompletePartial+ AT.Done i x -> onDone i x
+ test/Spec.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE+ OverloadedStrings+ #-}++import qualified Data.ByteString.Z85 as Z85+import Data.ByteString.Z85.Internal (encodeWord, decodeWord, printZ85Chunk)+import Data.Attoparsec.ByteString.Z85 (z85Encoded, anyWord32beEncoded)+import Data.Attoparsec.Text.Z85 (z85Decoded, anyZ85ChunkDecoded)++import Test.Tasty (testGroup, defaultMain)+import Test.Tasty.QuickCheck (testProperty)+import Test.Tasty.HUnit (testCase, (@=?))+import Test.QuickCheck (Property, (===))+import Test.QuickCheck.Instances ()++import Data.Word (Word32)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (toStrict)+import qualified Data.ByteString.Lazy as LBS+import Data.ByteString.Builder (word8, word32BE, toLazyByteString)+import qualified Data.Attoparsec.ByteString as AB+import qualified Data.Attoparsec.Text as AT+++++main :: IO ()+main = defaultMain $ testGroup "All Tests"+ [ testGroup "Unit Tests"+ [ testCase "\"HelloWorld\" == 0x86,0x4F,0xD2,0x6F,0xB5,0x59,0xF7,0x5B" $+ let bs = toStrict $ toLazyByteString $ foldMap word8 [0x86,0x4F,0xD2,0x6F,0xB5,0x59,0xF7,0x5B]+ in AB.parseOnly z85Encoded bs @=? Right "HelloWorld"+ ]+ , testGroup "Property Tests"+ [ testProperty "decode / encode word iso" decodeWordIso+ , testProperty "decode / encode word iso over attoparsec" decodeWordIso'+ , testProperty "decode / encode sentence iso over attoparsec" encodeSentenceIsoA+ , testProperty "decode / encode sentence iso" encodeSentenceIso+ , testProperty "decode / encode sentence iso, residual failure" encodeSentenceIso'+ ]+ ]+++++decodeWordIso :: Word32 -> Property+decodeWordIso w = w === decodeWord (encodeWord w)++++decodeWordIso' :: Word32 -> Property+decodeWordIso' w =+ let bs = toStrict (toLazyByteString (word32BE w))+ in fmap (AT.parseOnly anyZ85ChunkDecoded . printZ85Chunk) (AB.parseOnly anyWord32beEncoded bs) === Right (Right w)++++encodeSentenceIsoA :: ByteString -> Property+encodeSentenceIsoA x' =+ let xMod = BS.length x' `mod` 4+ x = if xMod /= 0+ then BS.drop xMod x'+ else x'+ in fmap (AT.parseOnly z85Decoded) (AB.parseOnly z85Encoded x) === Right (Right x)+++encodeSentenceIso :: LBS.ByteString -> Property+encodeSentenceIso x' =+ let xMod = LBS.length x' `mod` 4+ x = if xMod /= 0+ then LBS.drop xMod x'+ else x'+ in fmap Z85.decode (Z85.encode x) === Right (Right x)+++encodeSentenceIso' :: LBS.ByteString -> Property+encodeSentenceIso' x' =+ let xMod = LBS.length x' `mod` 4+ x = if xMod /= 0+ then LBS.drop xMod x'+ else x'+ in fmap Z85.decode' (Z85.encode' x) === Right (Right x)
+ z85.cabal view
@@ -0,0 +1,78 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: ed975b60096b74d143e23e35a8665dd16a714f3bf9474c5879a5daa40c07abea++name: z85+version: 0.0.0+synopsis: Implementation of the z85 binary codec+description: Please see the README on GitHub at <https://github.com/githubuser/z85-bytestring#readme>+category: Data+homepage: https://github.com/athanclark/z85#readme+bug-reports: https://github.com/athanclark/z85/issues+author: Athan Clark+maintainer: athan.clark@localcooking.com+copyright: Copyright (c) 2018 Athan Clark+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/athanclark/z85++library+ exposed-modules:+ Data.Attoparsec.ByteString.Z85+ Data.Attoparsec.Text.Z85+ Data.ByteString.Z85+ Data.ByteString.Z85.Internal+ Pipes.Z85+ other-modules:+ Paths_z85+ hs-source-dirs:+ src+ build-depends:+ QuickCheck+ , attoparsec+ , attoparsec-binary+ , base >=4.7 && <5+ , bytestring+ , pipes+ , pipes-bytestring+ , pipes-text+ , text+ , vector-sized+ default-language: Haskell2010++test-suite z85-bytestring-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_z85+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , attoparsec+ , attoparsec-binary+ , base >=4.7 && <5+ , bytestring+ , pipes+ , pipes-bytestring+ , pipes-text+ , quickcheck-instances+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , text+ , vector-sized+ , z85+ default-language: Haskell2010