diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +- 0.2 (2019-05-14) + - use cryptohash-sha1, + types of structuralInfoSha1Digest and structuralInfoSha1Digest are changed. + - Use binary-instances in tests - 0.1.5.2 (2019-05-10) - generics-sop-0.5 - 0.1.5.1 (2018-09-24) diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,34 +0,0 @@ -# binary-tagged - -[![Build Status](https://travis-ci.org/phadej/binary-tagged.svg?branch=master)](https://travis-ci.org/phadej/binary-tagged) -[![Hackage](https://img.shields.io/hackage/v/binary-tagged.svg)](http://hackage.haskell.org/package/binary-tagged) -[![Stackage LTS 2](http://stackage.org/package/binary-tagged/badge/lts-2)](http://stackage.org/lts-2/package/binary-tagged) -[![Stackage LTS 3](http://stackage.org/package/binary-tagged/badge/lts-3)](http://stackage.org/lts-3/package/binary-tagged) -[![Stackage Nightly](http://stackage.org/package/binary-tagged/badge/nightly)](http://stackage.org/nightly/package/binary-tagged) - -Structurally tag binary serialisation stream. - -Say you have: - -```hs -data Record = Record - { _recordFields :: HM.HashMap Text (Integer, ByteString) - , _recordEnabled :: Bool - } - deriving (Eq, Show, Generic) - -instance Binary Record -instance HasStructuralInfo Record -instance HasSemanticVersion Record -``` - -then you can serialise and deserialise `Record` values with a structure tag by simply - -```hs -encodeTaggedFile "cachefile" record -decodeTaggedFile "cachefile" :: IO Record -``` - -If structure of `Record` changes in between, deserialisation will fail early. - -The overhead is next to non-observable, see [a simple benchmark](https://github.com/phadej/binary-tagged/blob/master/bench/Bench.hs) and the [results](https://rawgit.com/phadej/binary-tagged/master/bench.html). diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -3,7 +3,8 @@ import Control.DeepSeq import Data.ByteString.Lazy as LBS -import Data.Binary.Orphans +import Data.Binary +import Data.Binary.Instances () import Data.Binary.Tagged import Criterion.Main import qualified Data.HashMap.Strict as HM diff --git a/binary-tagged.cabal b/binary-tagged.cabal --- a/binary-tagged.cabal +++ b/binary-tagged.cabal @@ -1,141 +1,171 @@ -cabal-version: >= 1.10 -name: binary-tagged -version: 0.1.5.2 - -synopsis: Tagged binary serialisation. -category: Data -description: Check - -homepage: https://github.com/phadej/binary-tagged#readme -bug-reports: https://github.com/phadej/binary-tagged/issues -author: Oleg Grenrus -maintainer: Oleg Grenrus -license: BSD3 -license-file: LICENSE -build-type: Simple +cabal-version: >=1.10 +name: binary-tagged +version: 0.2 +synopsis: Tagged binary serialisation. +category: Data +description: + Structurally tag binary serialisation stream. + . + Say you have: + . + @ + data Record = Record + \ { _recordFields :: HM.HashMap Text (Integer, ByteString) + \ , _recordEnabled :: Bool + \ } + \ deriving (Eq, Show, Generic) + . + instance Binary Record + instance HasStructuralInfo Record + instance HasSemanticVersion Record + @ + . + then you can serialise and deserialise @Record@ values with a structure tag by simply + . + @ + encodeTaggedFile "cachefile" record + decodeTaggedFile "cachefile" :: IO Record + @ + . + If structure of @Record@ changes in between, deserialisation will fail early. + . + The overhead is next to non-observable, see [a simple benchmark](https://github.com/phadej/binary-tagged/blob/master/bench/Bench.hs). + . + @ + benchmarking encode/Binary + time 362.6 μs (361.2 μs .. 363.8 μs) + . + benchmarking encode/Tagged + time 379.2 μs (375.5 μs .. 382.2 μs) + . + benchmarking decode/Binary + time 366.3 μs (365.1 μs .. 368.1 μs) + . + benchmarking decode/Tagged + time 367.6 μs (367.0 μs .. 368.2 μs) + @ +homepage: https://github.com/phadej/binary-tagged#readme +bug-reports: https://github.com/phadej/binary-tagged/issues +author: Oleg Grenrus +maintainer: Oleg Grenrus +license: BSD3 +license-file: LICENSE +build-type: Simple tested-with: - GHC ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 + GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 extra-source-files: - CHANGELOG.md - README.md + CHANGELOG.md source-repository head - type: git + type: git location: https://github.com/phadej/binary-tagged library - hs-source-dirs: - src - ghc-options: -Wall + hs-source-dirs: src + ghc-options: -Wall -- Libraries bundled with GHC build-depends: - base >=4.7.0.2 && <4.13 - , array >=0.5.0.0 && <0.6 - , binary >=0.7.1.0 && <0.10 - , bytestring >=0.10.4.0 && <0.11 - , containers >=0.5.5.1 && <0.7 - , text >=1.2.3.0 && <1.3 - , time >=1.4.2 && <1.9 + array >=0.5.0.0 && <0.6 + , base >=4.7.0.2 && <4.13 + , binary >=0.7.1.0 && <0.10 + , bytestring >=0.10.4.0 && <0.11 + , containers >=0.5.5.1 && <0.7 + , text >=1.2.3.0 && <1.3 + , time >=1.4.2 && <1.9 -- other dependencies build-depends: - aeson >=0.8 && <1.5 - , base16-bytestring >=0.1.1.6 && <0.2 - , generics-sop >=0.3.2.0 && <0.6 - , hashable >=1.2 && <1.4 - , scientific >=0.3 && <0.4 - , SHA >=1.6 && <1.7 - , tagged >=0.7 && <0.9 - , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.13 + aeson >=0.8 && <1.5 + , base16-bytestring >=0.1.1.6 && <0.2 + , cryptohash-sha1 >=0.11.100.1 && <0.12 + , generics-sop >=0.3.2.0 && <0.6 + , hashable >=1.2 && <1.4 + , scientific >=0.3 && <0.4 + , tagged >=0.7 && <0.9 + , unordered-containers >=0.2 && <0.3 + , vector >=0.10 && <0.13 - exposed-modules: - Data.Binary.Tagged + exposed-modules: Data.Binary.Tagged default-language: Haskell2010 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.5 && <0.20 - if !impl(ghc >= 7.10) - build-depends: - nats >=1.1.2 && <1.2 + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.5 && <0.20 + if !impl(ghc >=7.10) + build-depends: nats >=1.1.2 && <1.2 + test-suite binary-tagged-test - type: exitcode-stdio-1.0 - main-is: Tests.hs - hs-source-dirs: - test - ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: Tests.hs + hs-source-dirs: test + ghc-options: -Wall build-depends: - base - , aeson + aeson , array + , base , base16-bytestring + , bifunctors , binary + , binary-instances >=1 && <1.1 + , binary-tagged , bytestring , containers , generics-sop , hashable + , quickcheck-instances , scientific - , SHA , tagged + , tasty + , tasty-quickcheck + , tasty-hunit , text , time , unordered-containers , vector - , binary-tagged - , binary-orphans - , bifunctors - , quickcheck-instances - , tasty - , tasty-quickcheck - if !impl(ghc >= 8.0) - build-depends: - semigroups - if !impl(ghc >= 7.10) - build-depends: - nats + + if !impl(ghc >=8.0) + build-depends: semigroups + + if !impl(ghc >=7.10) + build-depends: nats + other-modules: - Generators - Rec1 - Rec2 + Generators + Rec1 + Rec2 + default-language: Haskell2010 benchmark binary-tagged-bench - type: exitcode-stdio-1.0 - main-is: Bench.hs - hs-source-dirs: - bench - ghc-options: -Wall + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: bench + ghc-options: -Wall build-depends: - base - , aeson + aeson , array + , base , base16-bytestring , binary + , binary-instances + , binary-tagged , bytestring , containers + , criterion + , deepseq , generics-sop , hashable , nats , scientific - , SHA , semigroups + , SHA , tagged , text , time , unordered-containers , vector - , binary-tagged - , binary-orphans - , deepseq - , criterion + default-language: Haskell2010 diff --git a/src/Data/Binary/Tagged.hs b/src/Data/Binary/Tagged.hs --- a/src/Data/Binary/Tagged.hs +++ b/src/Data/Binary/Tagged.hs @@ -1,25 +1,25 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- We need this for Interleave -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Tagged @@ -93,60 +93,60 @@ import Control.Applicative import Control.Monad +import qualified Crypto.Hash.SHA1 as SHA1 import Data.Binary -import Data.Binary.Get (ByteOffset) -import Data.ByteString as BS -import Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Base16.Lazy as Base16 -import Data.Digest.Pure.SHA -import Data.Monoid ((<>)) -import Data.Proxy -import Generics.SOP as SOP -import Generics.SOP.GGP as SOP +import Data.Binary.Get (ByteOffset) +import Data.ByteString as BS +import qualified Data.ByteString.Base16 as Base16 +import Data.ByteString.Lazy as LBS +import Data.Monoid ((<>)) +import Data.Typeable (Typeable) +import Generics.SOP as SOP import Generics.SOP.Constraint as SOP +import Generics.SOP.GGP as SOP #if !MIN_VERSION_base(4,8,0) -import Data.Foldable (Foldable) -import Data.Traversable (Traversable) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable) #endif -import qualified GHC.Generics as GHC +import qualified GHC.Generics as GHC import GHC.TypeLits -- Instances +import qualified Data.Array.IArray as Array +import qualified Data.Array.Unboxed as Array +import qualified Data.Fixed as Fixed +import qualified Data.HashMap.Lazy as HML +import qualified Data.HashSet as HS import Data.Int -import qualified Data.Array.IArray as Array -import qualified Data.Array.Unboxed as Array -import qualified Data.Fixed as Fixed -import qualified Data.HashMap.Lazy as HML -import qualified Data.HashSet as HS -import qualified Data.IntMap as IntMap -import qualified Data.IntSet as IntSet -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map -import qualified Data.Monoid as Monoid -import qualified Data.Ratio as Ratio -import qualified Data.Semigroup as Semigroup -import qualified Data.Sequence as Seq -import qualified Data.Set as Set -import qualified Data.Text as S -import qualified Data.Text.Lazy as L -import qualified Data.Time as Time -import qualified Data.Vector as V -import qualified Data.Vector.Storable as S -import qualified Data.Vector.Unboxed as U -import qualified Data.Version as Version -import qualified Numeric.Natural as Natural +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map +import qualified Data.Monoid as Monoid +import qualified Data.Ratio as Ratio +import qualified Data.Semigroup as Semigroup +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import qualified Data.Text as S +import qualified Data.Text.Lazy as L +import qualified Data.Time as Time +import qualified Data.Vector as V +import qualified Data.Vector.Storable as S +import qualified Data.Vector.Unboxed as U +import qualified Data.Version as Version +import qualified Numeric.Natural as Natural #ifdef MIN_VERSION_aeson -import qualified Data.Aeson as Aeson +import qualified Data.Aeson as Aeson #endif -- | 'Binary' serialisable class, which tries to be less error-prone to data structure changes. -- -- Values are serialised with header consisting of version @v@ and hash of 'structuralInfo'. newtype BinaryTagged (v :: k) a = BinaryTagged { unBinaryTagged :: a } - deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, GHC.Generic, GHC.Generic1) + deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, GHC.Generic, GHC.Generic1, Typeable) -- TODO: Derive Enum, Bounded, Typeable, Data, Hashable, NFData, Numeric classes? type BinaryTagged' a = BinaryTagged (SemanticVersion a) a @@ -229,13 +229,13 @@ proxyV = Proxy :: Proxy v proxyA = Proxy :: Proxy a ver' = fromIntegral (natVal proxyV) :: Version - hash' = bytestringDigest . structuralInfoSha1Digest . structuralInfo $ proxyA + hash' = structuralInfoSha1Digest . structuralInfo $ proxyA -- | Data type structure, with (some) nominal information. data StructuralInfo = NominalType String | NominalNewtype String StructuralInfo | StructuralInfo String [[StructuralInfo]] - deriving (Eq, Ord, Show, GHC.Generic) + deriving (Eq, Ord, Show, GHC.Generic, Typeable) instance Binary StructuralInfo @@ -274,11 +274,12 @@ instance HasStructuralInfo StructuralInfo instance HasSemanticVersion StructuralInfo -structuralInfoSha1Digest :: StructuralInfo -> Digest SHA1State -structuralInfoSha1Digest = sha1 . encode +structuralInfoSha1Digest :: StructuralInfo -> BS.ByteString +structuralInfoSha1Digest = SHA1.hashlazy . encode -structuralInfoSha1ByteStringDigest :: StructuralInfo -> LBS.ByteString -structuralInfoSha1ByteStringDigest = bytestringDigest . structuralInfoSha1Digest +{-# DEPRECATED structuralInfoSha1ByteStringDigest "Use structuralInfoSha1Digest directly" #-} +structuralInfoSha1ByteStringDigest :: StructuralInfo -> BS.ByteString +structuralInfoSha1ByteStringDigest = structuralInfoSha1Digest ------------------------------------------------------------------------------- -- Generics @@ -319,8 +320,8 @@ sopNominalAdtPOP (POP np2) = sopNominalAdt np2 sopNominalAdt :: (All2 HasStructuralInfo xss) => NP (NP Proxy) xss -> [[StructuralInfo]] -sopNominalAdt Nil = [] -sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps +sopNominalAdt Nil = [] +sopNominalAdt (p :* ps) = sopStructuralInfoP p : sopNominalAdt ps sopStructuralInfoP :: (All HasStructuralInfo xs) => NP Proxy xs -> [StructuralInfo] sopStructuralInfoP Nil = [] diff --git a/test/Rec1.hs b/test/Rec1.hs --- a/test/Rec1.hs +++ b/test/Rec1.hs @@ -6,7 +6,8 @@ import Control.Applicative #endif -import Data.Binary.Orphans +import Data.Binary +import Data.Binary.Instances () import Data.Binary.Tagged import Data.Monoid import GHC.Generics diff --git a/test/Rec2.hs b/test/Rec2.hs --- a/test/Rec2.hs +++ b/test/Rec2.hs @@ -6,7 +6,8 @@ import Control.Applicative #endif -import Data.Binary.Orphans +import Data.Binary +import Data.Binary.Instances () import Data.Binary.Tagged import Data.Monoid import GHC.Generics diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where @@ -11,8 +11,12 @@ import Data.Monoid import Data.Proxy import Test.Tasty +import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.QuickCheck +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS8 + import qualified Rec1 import qualified Rec2 @@ -22,6 +26,11 @@ , wrongRoundtrips , failedRoundtrips , testProperty "Interleave" interleaveProp + , testCase "An example hash" $ do + let hash = structuralInfoSha1Digest + $ structuralInfo (Proxy :: Proxy [Either (Maybe Char) (Sum Int)]) + + Base16.encode hash @?= BS8.pack "acff3d40f6f06f87b4da8d3d3eb5682251867cc5" ] -- | We actually check that this compiles.