diff --git a/Data/Binary/Tagged.hs b/Data/Binary/Tagged.hs --- a/Data/Binary/Tagged.hs +++ b/Data/Binary/Tagged.hs @@ -4,7 +4,7 @@ -- License : MIT -- -- Maintainer : justin@jle.im --- Stability : stable +-- Stability : unstable -- Portability : portable -- -- Provides tools for serializing and decoding data into 'ByteString' @@ -28,6 +28,8 @@ -- > > decodeTagged x :: Maybe Int -- > Just 1 -- +-- The interface is very similar to that of 'Data.Dynamic'. +-- -- Also provided here is the internal 'TagFingerprint' data type, so that -- you can categorize, sort, and queue 'Tagged' or 'ByteString' based on -- the types they represent. @@ -35,8 +37,8 @@ -- It might be significant to note that the current 'TagFingerprint' -- implementation is a little shaky; it's a bit tricky getting all GHC -- platforms to agree on a meaningful 'TypeRep' serialization, and we will --- have a better implementation eventually. For now, it just uses string --- name of the type as an identifier. So for now, don't encode/decode +-- have a better implementation eventually. For now, it just uses an MD5 +-- hash of the string name of the type. So for now, don't encode/decode -- things with the same type name but exist in different modules -- ('Data.Text.Text' or 'Data.Text.Lazy.Text', for example) through the -- same polymorphic channel! This is a bit limiting, admittedly, but until @@ -49,7 +51,8 @@ encodeTagged -- :: (Binary a, Typeable a) => a -> ByteString , decodeTagged -- :: (Binary a, Typeable a) => ByteString -> Maybe a , bsFingerprint -- :: ByteString -> Maybe TagFingerprint - -- * Fingerprint utilities + -- * Manipulating + , Tagged -- abstract, instances: Show, Eq, Binary, Typeable, Generic , TagFingerprint -- abstract, instances: Show, Eq, Ord, Binary, Typeable, Generic, Default , typeFingerprint -- :: Typeable a => a -> TagFingerprint ) where @@ -82,11 +85,4 @@ -- originally encoded data (with its tag stripped). decodeTagged :: (Binary a, Typeable a) => ByteString -> Maybe a decodeTagged bs = teaspoon =<< getTagged (decode bs) - --- | With a 'ByteString', expecting tagged data, returns the 'Fingerprint' --- that the data is tagged with. Returns @Nothing@ if the data is not --- decodable as tagged data. Might accidentally decode untagged data --- though! -bsFingerprint :: ByteString -> Maybe TagFingerprint -bsFingerprint bs = teaspoon $ tagFingerprint (decode bs :: Tagged ()) diff --git a/Data/Binary/Tagged/Internal.hs b/Data/Binary/Tagged/Internal.hs --- a/Data/Binary/Tagged/Internal.hs +++ b/Data/Binary/Tagged/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Data.Binary.Tagged.Internal @@ -7,7 +8,7 @@ -- License : MIT -- -- Maintainer : justin@jle.im --- Stability : stable +-- Stability : unstable -- Portability : portable -- -- Internals for the library, exported in case you should need it. @@ -26,25 +27,42 @@ -- * 'TagFingerprint' utilities , typeFingerprint -- :: Typeable a => a -> TagFingerprint , tagFingerprint -- :: Tagged a -> TagFingerprint + , bsFingerprint -- :: ByteString -> Maybe TagFingerprint ) where +import Control.Applicative ((<$>),(<*>)) +import Control.Monad (guard, forM_) import Data.Binary -import Data.Default -import Data.ByteString.Lazy import Data.ByteString.Lazy.Char8 as LC -import Data.Maybe (isJust) +import Data.Binary.Get +import Data.Default +import Data.Digest.Pure.MD5 +import Data.Maybe (isJust) import Data.Typeable.Internal import GHC.Generics -- | A data type tupling together data with a 'TagFingerprint', --- representing data tagged with its type. You really should never have to --- use this type; it's best to interface directly with data using --- 'encodeTagged', 'decodeTagged', etc. Use 'tag' to tag data and --- 'extractTagged' to extract data from valid tagged data. +-- representing data tagged with its type. +-- +-- It's best to interface directly with data using 'encodeTagged', +-- 'decodeTagged', etc, using 'tag' to tag data and 'extractTagged' to +-- extract data from valid tagged data. This type is exported mostly when +-- you want to specifically decode a 'ByteString' into tagged data, and +-- manually extract it yourself. If you are writing a framework, it is +-- preferred to handle this for the end user. data Tagged a = Tagged !TagFingerprint a deriving (Show, Eq, Generic, Typeable) +instance Binary a => Binary (Tagged a) where + put (Tagged fp x) = do + put TagLead + put fp + put x + get = do + _ <- get :: Get TagLead + Tagged <$> get <*> get + -- | A data type representing a fingerprint for a 'Typeable' type. -- Ideally, this would be 'Data.Typeable.Internal''s own 'Fingerprint' -- types; however, for some reason, the fingerprints for the same data type @@ -63,15 +81,28 @@ -- now, it is just an empty 'ByteString', but when fingerprinting works for -- real, think of it as a way to generate a fingerprint that will most -- likely not be matched by any type, in case the need ever comes up. -newtype TagFingerprint = TagFP ByteString +newtype TagFingerprint = TagFP MD5Digest deriving (Show, Typeable, Generic, Eq, Ord) -instance Binary a => Binary (Tagged a) instance Binary TagFingerprint +-- | 'MD5Digest' of an empty string: d41d8cd98f00b204e9800998ecf8427e instance Default TagFingerprint where - def = TagFP empty + def = TagFP (md5 "") +-- | Put at the start of a 'Tagged' to signify that it is a 'Tagged'. +data TagLead = TagLead + +instance Binary TagLead where + put _ = mapM_ put leadingBytes + get = do + forM_ leadingBytes $ \b -> + guard . (== b) =<< get + return TagLead + +leadingBytes :: [Word8] +leadingBytes = [0xfe,0xfe] + -- | Wrap data inside a 'Tagged' tuple. tag :: Typeable a => a -> Tagged a tag x = Tagged (typeFingerprint x) x @@ -84,7 +115,7 @@ -- > typeFingerprint (undefined :: Int) -- typeFingerprint :: Typeable a => a -> TagFingerprint -typeFingerprint = TagFP . LC.pack . show . typeOf +typeFingerprint = TagFP . md5 . LC.pack . show . typeOf -- | Extract data out of a 'Tagged', but only the type of the data matches -- the type represented by the fingerprint. It is polymorphic on its @@ -105,4 +136,18 @@ -- of a desired typed, 'getTagged' and 'tagMatched' might be more useful. tagFingerprint :: Tagged a -> TagFingerprint tagFingerprint (Tagged fp _) = fp + +-- | With a 'ByteString', expecting tagged data, returns the 'Fingerprint' +-- that the data is tagged with. Returns @Nothing@ if the data is not +-- decodable as tagged data. Might accidentally decode untagged data +-- though! +bsFingerprint :: ByteString -> Maybe TagFingerprint +bsFingerprint bs = case getRes of + Left _ -> Nothing + Right (_,_,fp) -> Just fp + + where + getRes = flip runGetOrFail bs $ do + _ <- get :: Get TagLead + get diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,14 @@ +Changelog +========= + +## 0.1.2.0 + +* Tagged `ByteStrings` now lead with a "TagLead" byte sequence that + signifies that a `Tagged` is coming. For now, it is statically 0xfe 0xff, + which are two bytes that are never found in any valid UTF-8 encoded + string. + +* So that all `TagFingerprint`s should be of the same length, + `TagFingerprint`s contain an `MD5Digest`, generated from the name of the + type. Its `Default` instance is the `MD5Digest` of an empty string. + diff --git a/tagged-binary.cabal b/tagged-binary.cabal --- a/tagged-binary.cabal +++ b/tagged-binary.cabal @@ -1,5 +1,5 @@ name: tagged-binary -version: 0.1.0.0 +version: 0.1.2.0 synopsis: Provides tools for serializing data tagged with type information. description: Very minimal library providing tools for serializing and @@ -37,7 +37,7 @@ copyright: Copyright (c) Justin Le 2014 category: Data, Serialization build-type: Simple --- extra-source-files: +extra-source-files: changelog.md cabal-version: >=1.10 source-repository head @@ -54,6 +54,7 @@ , bytestring >=0.10.4.0 && <0.11 , data-default >=0.5.3 && <0.6 , spoon >=0.3.1 && <0.4 + , pureMD5 >=2.1.2.1 && <3 -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wall