diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# Revision history for strict-containers-serialise + +## 0.1 -- 2021-04-20 + +- Initial release, defining serialise instances for `Data.Strict.HashMap`, + `Data.Strict.IntMap`, `Data.Strict.Map`, `Data.Strict.Sequence`, and + `Data.Strict.Vector`. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. diff --git a/src/Data/Strict/Containers/Serialise.hs b/src/Data/Strict/Containers/Serialise.hs new file mode 100644 --- /dev/null +++ b/src/Data/Strict/Containers/Serialise.hs @@ -0,0 +1,81 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Strict.Containers.Serialise + ( + ) where + +import Codec.CBOR.Decoding +import Codec.CBOR.Encoding +import Codec.Serialise.Class +import Data.Hashable (Hashable) +import Data.Semigroup (Semigroup (..)) -- helps with compatibility + +import qualified Data.Foldable as Foldable +import qualified Data.Strict.HashMap as HashMap +import qualified Data.Strict.IntMap as IntMap +import qualified Data.Strict.Map as Map +import qualified Data.Strict.Sequence as Sequence +import qualified Data.Strict.Vector as Vector + + +-- code copied from serialise + +decodeContainerSkelWithReplicate + :: (Serialise a) + => Decoder s Int + -- ^ How to get the size of the container + -> (Int -> Decoder s a -> Decoder s container) + -- ^ replicateM for the container + -> ([container] -> container) + -- ^ concat for the container + -> Decoder s container +decodeContainerSkelWithReplicate decodeLen replicateFun fromList = do + -- Look at how much data we have at the moment and use it as the limit for + -- the size of a single call to replicateFun. We don't want to use + -- replicateFun directly on the result of decodeLen since this might lead to + -- DOS attack (attacker providing a huge value for length). So if it's above + -- our limit, we'll do manual chunking and then combine the containers into + -- one. + size <- decodeLen + limit <- peekAvailable + if size <= limit + then replicateFun size decode + else do + -- Take the max of limit and a fixed chunk size (note: limit can be + -- 0). This basically means that the attacker can make us allocate a + -- container of size 128 even though there's no actual input. + let chunkSize = max limit 128 + (d, m) = size `divMod` chunkSize + buildOne s = replicateFun s decode + containers <- sequence $ buildOne m : replicate d (buildOne chunkSize) + return $! fromList containers +{-# INLINE decodeContainerSkelWithReplicate #-} + +instance (Ord k, Serialise k, Serialise v) => Serialise (Map.Map k v) where + encode = encodeMapSkel Map.size Map.foldrWithKey + decode = decodeMapSkel Map.fromList + +instance (Serialise k, Hashable k, Eq k, Serialise v) => + Serialise (HashMap.HashMap k v) where + encode = encodeMapSkel HashMap.size HashMap.foldrWithKey + decode = decodeMapSkel HashMap.fromList + +instance (Serialise a) => Serialise (IntMap.IntMap a) where + encode = encodeMapSkel IntMap.size IntMap.foldrWithKey + decode = decodeMapSkel IntMap.fromList + +instance (Serialise a) => Serialise (Sequence.Seq a) where + encode = encodeContainerSkel + encodeListLen + Sequence.length + Foldable.foldr + (\a b -> encode a <> b) + decode = decodeContainerSkelWithReplicate + decodeListLen + Sequence.replicateM + mconcat + +instance (Serialise a) => Serialise (Vector.Vector a) where + encode = encodeVector + {-# INLINE encode #-} + decode = decodeVector + {-# INLINE decode #-} diff --git a/strict-containers-serialise.cabal b/strict-containers-serialise.cabal new file mode 100644 --- /dev/null +++ b/strict-containers-serialise.cabal @@ -0,0 +1,37 @@ +Name: strict-containers-serialise +Version: 0.1 +Synopsis: Strict containers - Serialise instances +Category: Data, Data Structures, Codec +Description: + This package provides @serialise@ utilities and instances for @strict-containers@. +License: BSD3 +License-File: LICENSE +Maintainer: Ximin Luo +Copyright: (c) 2021 by Ximin Luo +Homepage: https://github.com/haskellari/strict-containers +Cabal-Version: >= 1.10 +Build-type: Simple +extra-source-files: + CHANGELOG.md +tested-with: + GHC ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.3 + || ==8.10.4 + || ==9.0.1 + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + + build-depends: + base >= 4.5.0.0 && < 5 + , cborg >= 0.2 && < 0.3 + , hashable >= 1.2.7.0 && < 1.4 + , strict-containers >= 0.1 + , serialise >= 0.2.3.0 && < 0.3 + + exposed-modules: + Data.Strict.Containers.Serialise