binary-typed-0.3: Type-safe binary serialization

Safe HaskellSafe-Inferred
LanguageHaskell2010
Extensions
  • DeriveGeneric
  • LambdaCase

Data.Binary.Typed.Internal

Contents

Description

Internals, exposed mostly for potential use by testsuites and benchmarks.

Not recommended to be used from within other independent libraries.

Synopsis

Typed

data Typed a Source

A value suitable to be typechecked using the contained extra type information.

Constructors

Typed TypeInformation a

Using this data constructor directly is unsafe, as it allows construction of ill-typed Typed data. Use the typed smart constructor unless you really need Typed.

Instances

Show a => Show (Typed a)

"typed <format> <value>"

(Binary a, Typeable * a) => Binary (Typed a)

Ensures data is decoded as the appropriate type with high or total confidence (depending on with what TypeFormat the Typed was constructed).

data Typed' a Source

Like Typed, but the type information is not checked. Useful to read type and value, and do the typechecking externally, as required by the caching of decodeTyped. Using typecheck', this can be promoted to a proper Typed value.

Constructors

Typed' TypeInformation a 

Instances

Show a => Show (Typed' a)

"Typed' <format> <value>"

Binary a => Binary (Typed' a) 

data TypeInformation Source

Type information stored alongside a value to be serialized, so that the recipient can do consistency checks. See TypeFormat for more detailed information on the fields.

Constructors

Untyped' 
Hashed5' Hash5 
Hashed32' Hash32 
Hashed64' Hash64 
Shown' Hash32 String 
Full' TypeRep 
Cached' ByteString

Pre-serialized representation of one of the other fields.

newtype Hash5 Source

A 5-bit hash value.

Since TypeInformation needs 3 bit to store the sort of the TypeInformation, the remaining 5 bit per Word8 can be used to store a hash value at no additional space cost. For this reason, it is important that the three rightmost bits of any Hashed5 are set to zero, i.e. (.&. 7) is id on the contained Word8.

This type intentionally doesn't have a Binary instance, since its serialization is part of the TypeInformation Binary instance exclusively.

Constructors

Hash5 Word8 

Instances

mkHash5 :: Integral a => a -> Hash5 Source

Smart constructor for Hash5 values. Makes sure the rightmost three bits are not set by applying a bit mask to the input.

newtype Hash32 Source

A 32-bit hash value.

Constructors

Hash32 Word32 

newtype Hash64 Source

A 64-bit hash value.

Constructors

Hash64 Word64 

typed :: Typeable a => TypeFormat -> a -> Typed a Source

Construct a Typed value using the chosen type format.

Example:

value = typed Full ("hello", 1 :: Int, 2.34 :: Double)
encoded = encode value

The decode site can now verify whether decoding happens with the right type.

makeTypeInformation :: TypeFormat -> TypeRep -> TypeInformation Source

Create the TypeInformation to be stored inside a Typed value from a TypeRep.

data TypeFormat Source

Different ways of including/verifying type information of serialized messages.

Constructors

Untyped

Include no type information.

  • Requires one byte more compared to using Binary directly (to tag the data as untyped, required for the decoding step).
  • Encoding and decoding require negligible amount of additional computational cost compared to direct (intrinsically untyped) Binary.
Hashed5

Like Hashed32, but uses a 5-bit hash value.

  • Requires the same amount of space as Untyped, i.e. the only overhead compared to it is the computational cost to calculate the hash, which is almost identical to the one of Hashed32.
  • Collisions occur with a probability of 1/2^5 = 1/32. For this reason, this format is only recommended when minimal data size is top priority.
Hashed32

Compare types by their hash values (using the MurmurHash2 algorithm).

  • Requires five bytes more compared to using Binary directly for the type information (one to tag as Hashed32, four for the hash value)
  • Subject to false positive due to hash collisions, although in practice this should almost never happen.
  • Type errors cannot tell the provided type ("Expected X, received type with hash H")
  • Computational cost similar to Hashed64.
Hashed64

Like Hashed32, but uses a 64-bit hash value.

  • Requires nine bytes more compared to using Binary.
  • Hash collisions are even less likely to occur than with Hashed32.
  • Computational cost similar to Hashed32.
Shown

Compare String representation of types, obtained by calling show on the TypeRep, and also include a hash value (like Hashed32). The former is mostly for readable error messages, the latter provides better collision resistance.

  • Data size larger than Hashed32, but usually smaller than Full.
  • Both the hash and the shown type must match to satisfy the typechecker.
  • Useful type errors ("expected X, received Y"). All types are shown unqualified though, making Foo.X and Bar.X look identical in error messages. Remember this when you get a seemingly silly error "expected Foo, but given Foo".
Full

Compare the full representation of a data type.

  • More verbose than Shown. As a rule of thumb, transmitted data is roughly the same as Shown, but all names are fully qualified (package, module, type name).
  • Correct comparison (no false positives). An semi-exception here is when types change between package versions: package-1.0 Foo.X and package-1.1 Foo.X count as the same type.
  • Useful type errors ("expected X, received Y"). All types are shown unqualified though, making Foo.X and Bar.X look identical in error messages. Remember this when you get a seemingly silly error "expected Foo, but given Foo".

getFormat :: TypeInformation -> TypeFormat Source

Extract which TypeFormat was used to create a certain TypeInformation.

If the type is Cached', then the contained information is assumed well-formed. In the public API, this is safe to do, since only well-typed Typed values can be created in the first place.

typecheck :: Typeable a => Typed a -> Either String (Typed a) Source

Typecheck a Typed. Returns the (well-typed) input, or an error message if the types don't work out.

typecheck' :: Typeable a => Typed' a -> Either String (Typed a) Source

Typecheck a 'Typed\'' value so it can be used as a safe Typed value.

erase :: Typed a -> a Source

Extract the value of a Typed, i.e. strip off the explicit type information.

This function is safe to use for all Typed values created by the public API, since all construction sites ensure the actual type matches the contained type description.

erase (typed format x) == x

preserialize :: TypeInformation -> TypeInformation Source

Sometimes it can be beneficial to serialize the type information in advance, so that the maybe costly serialization step does not have to be repeated on every invocation of encode. Preserialization comes at a price though, as the directly contained ByteString requires its length to be included in the final serialization, yielding a 8-byte overhead for the required Int64, and one for the tag of what was serialized ("shown or full?").

This function calculates the serialized version of TypeInformation in cases where the required 9 bytes are negligible (determined by an arbitrary threshold, currently 10*9 bytes).

Used to make encodeTyped more efficient; the source there also makes a good usage example.

TypeRep

data TypeRep Source

TypeRep without the (internal) fingerprint.

Constructors

TypeRep TyCon [TypeRep] 

stripTypeRep :: TypeRep -> TypeRep Source

Strip a TypeRep off the fingerprint. Inverse of unStripTypeRep.

unStripTypeRep :: TypeRep -> TypeRep Source

Add a fingerprint to a TypeRep. Inverse of stripTypeRep.

hashType5 :: TypeRep -> Hash5 Source

Hash a TypeRep to a 5-bit digest.

hashed5Split :: Word8 -> (Word8, Hash5) Source

Split a Word8 into the last 3 bit (used to tag the constructor) and the first 5 (data payload). Used by the Binary instance of TypeInformation.

hashType32 :: TypeRep -> Hash32 Source

Hash a TypeRep to a 32-bit digest.

hashType64 :: TypeRep -> Hash64 Source

Hash a TypeRep to a 64-bit digest.

TyCon

data TyCon Source

TyCon without the (internal) fingerprint.

Constructors

TyCon String String String

Package, module, constructor name

stripTyCon :: TyCon -> TyCon Source

Strip a TyCon off the fingerprint. Inverse of unStripTyCon.

unStripTyCon :: TyCon -> TyCon Source

Add a fingerprint to a TyCon. Inverse of stripTyCon.