Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- class Typeable a => ToCBOR a where
- withWordSize :: ( Integral s, Integral a) => s -> a
- module Codec.CBOR.Encoding
- toCBORMaybe :: (a -> Encoding ) -> Maybe a -> Encoding
- data Range b = Range { }
- szEval :: ( forall t. ToCBOR t => ( Proxy t -> Size ) -> Proxy t -> Range Natural ) -> Size -> Range Natural
- type Size = Fix SizeF
- data Case t = Case Text t
- caseValue :: Case t -> t
- newtype LengthOf xs = LengthOf xs
-
data
SizeOverride
- = SizeConstant Size
- | SizeExpression (( forall a. ToCBOR a => Proxy a -> Size ) -> Size )
- | SelectCases [ Text ]
- isTodo :: Size -> Bool
- szCases :: [ Case Size ] -> Size
- szLazy :: ToCBOR a => Proxy a -> Size
- szGreedy :: ToCBOR a => Proxy a -> Size
- szForce :: Size -> Size
- szWithCtx :: ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size
- szSimplify :: Size -> Either Size ( Range Natural )
- apMono :: Text -> ( Natural -> Natural ) -> Size -> Size
- szBounds :: ToCBOR a => a -> Either Size ( Range Natural )
- serialize :: ToCBOR a => a -> LByteString
- serialize' :: ToCBOR a => a -> ByteString
- serializeBuilder :: ToCBOR a => a -> Builder
- serializeEncoding :: Encoding -> LByteString
- serializeEncoding' :: Encoding -> ByteString
- encodeNestedCbor :: ToCBOR a => a -> Encoding
- encodeNestedCborBytes :: LByteString -> Encoding
- nestedCborSizeExpr :: Size -> Size
- nestedCborBytesSizeExpr :: Size -> Size
- newtype Raw = Raw ByteString
- class Typeable a => FromCBOR a where
- data DecoderError
- enforceSize :: Text -> Int -> Decoder s ()
- matchSize :: Text -> Int -> Int -> Decoder s ()
- module Codec.CBOR.Decoding
- fromCBORMaybe :: Decoder s a -> Decoder s ( Maybe a)
- decodeListWith :: Decoder s a -> Decoder s [a]
- decodeMapSkel :: ( Ord k, FromCBOR k, FromCBOR v) => ([(k, v)] -> m) -> Decoder s m
- type Dropper s = Decoder s ()
- dropBytes :: Dropper s
- dropInt32 :: Dropper s
- dropList :: Dropper s -> Dropper s
- dropMap :: Dropper s -> Dropper s -> Dropper s
- dropSet :: Dropper s -> Dropper s
- dropTuple :: Dropper s -> Dropper s -> Dropper s
- dropTriple :: Dropper s -> Dropper s -> Dropper s -> Dropper s
- dropWord8 :: Dropper s
- dropWord64 :: Dropper s
- unsafeDeserialize :: FromCBOR a => LByteString -> a
- unsafeDeserialize' :: FromCBOR a => ByteString -> a
- toStrictByteString :: Encoding -> ByteString
- decodeFull :: forall a. FromCBOR a => LByteString -> Either DecoderError a
- decodeFull' :: forall a. FromCBOR a => ByteString -> Either DecoderError a
- decodeFullDecoder :: Text -> ( forall s. Decoder s a) -> LByteString -> Either DecoderError a
- decodeNestedCbor :: FromCBOR a => Decoder s a
- decodeNestedCborBytes :: Decoder s ByteString
-
data
Annotated
b a =
Annotated
{
- unAnnotated :: !b
- annotation :: !a
- data ByteSpan = ByteSpan ! ByteOffset ! ByteOffset
-
class
Decoded
t
where
- type BaseType t :: Type
- recoverBytes :: t -> ByteString
- annotationBytes :: Functor f => LByteString -> f ByteSpan -> f ByteString
- annotatedDecoder :: Decoder s a -> Decoder s ( Annotated a ByteSpan )
- slice :: ByteString -> ByteSpan -> LByteString
- fromCBORAnnotated :: FromCBOR a => Decoder s ( Annotated a ByteSpan )
- decodeFullAnnotatedBytes :: Functor f => Text -> ( forall s. Decoder s (f ByteSpan )) -> LByteString -> Either DecoderError (f ByteString )
- reAnnotate :: ToCBOR a => Annotated a b -> Annotated a ByteString
-
newtype
Annotator
a =
Annotator
{
- runAnnotator :: FullByteString -> a
- annotatorSlice :: Decoder s ( Annotator ( LByteString -> a)) -> Decoder s ( Annotator a)
- decodeAnnotator :: Text -> ( forall s. Decoder s ( Annotator a)) -> LByteString -> Either DecoderError a
- withSlice :: Decoder s a -> Decoder s (a, Annotator LByteString )
- newtype FullByteString = Full LByteString
Documentation
class Typeable a => ToCBOR a where Source #
toCBOR :: a -> Encoding Source #
encodedSizeExpr :: ( forall t. ToCBOR t => Proxy t -> Size ) -> Proxy a -> Size Source #
encodedListSizeExpr :: ( forall t. ToCBOR t => Proxy t -> Size ) -> Proxy [a] -> Size Source #
Instances
withWordSize :: ( Integral s, Integral a) => s -> a Source #
Compute encoded size of an integer
module Codec.CBOR.Encoding
Size of expressions
A range of values. Should satisfy the invariant
forall x. lo x <= hi x
.
Instances
( Ord b, Num b) => Num ( Range b) Source # |
The
|
Defined in Cardano.Binary.ToCBOR |
|
Buildable ( Range Natural ) Source # | |
szEval :: ( forall t. ToCBOR t => ( Proxy t -> Size ) -> Proxy t -> Range Natural ) -> Size -> Range Natural Source #
Fully evaluate a size expression by applying the given function to any
suspended computations.
szEval g
effectively turns each "thunk"
of the form
TodoF f x
into
g x
, then evaluates the result.
type Size = Fix SizeF Source #
Expressions describing the statically-computed size bounds on a type's possible values.
An individual labeled case.
A type used to represent the length of a value in
Size
computations.
LengthOf xs |
data SizeOverride Source #
Override mechanisms to be used with
szWithCtx
.
SizeConstant Size |
Replace with a fixed
|
SizeExpression (( forall a. ToCBOR a => Proxy a -> Size ) -> Size ) |
Recursively compute the size. |
SelectCases [ Text ] |
Select only a specific case from a
|
szLazy :: ToCBOR a => Proxy a -> Size Source #
Evaluate the expression lazily, by immediately creating a thunk that will evaluate its contents lazily.
ghci> putStrLn $ pretty $ szLazy (Proxy @TxAux) (_ :: TxAux)
szGreedy :: ToCBOR a => Proxy a -> Size Source #
Evaluate an expression greedily. There may still be thunks in the
result, for types that did not provide a custom
encodedSizeExpr
method
in their
ToCBOR
instance.
ghci> putStrLn $ pretty $ szGreedy (Proxy @TxAux) (0 + { TxAux=(2 + ((0 + (((1 + (2 + ((_ :: LengthOf [TxIn]) * (2 + { TxInUtxo=(2 + ((1 + 34) + { minBound=1 maxBound=5 })) })))) + (2 + ((_ :: LengthOf [TxOut]) * (0 + { TxOut=(2 + ((0 + ((2 + ((2 + withWordSize((((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + (((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + { minBound=1 maxBound=5 })) + { minBound=1 maxBound=9 })) })))) + (_ :: Attributes ()))) + (_ :: Vector TxInWitness))) })
szForce :: Size -> Size Source #
Force any thunks in the given
Size
expression.
ghci> putStrLn $ pretty $ szForce $ szLazy (Proxy @TxAux) (0 + { TxAux=(2 + ((0 + (_ :: Tx)) + (_ :: Vector TxInWitness))) })
szWithCtx :: ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size Source #
Greedily compute the size bounds for a type, using the given context to override sizes for specific types.
szSimplify :: Size -> Either Size ( Range Natural ) Source #
Simplify the given
Size
, resulting in either the simplified
Size
or,
if it was fully simplified, an explicit upper and lower bound.
apMono :: Text -> ( Natural -> Natural ) -> Size -> Size Source #
Apply a monotonically increasing function to the expression.
There are three cases when applying
f
to a
Size
expression:
* When applied to a value
x
, compute
f x
.
* When applied to cases, apply to each case individually.
* In all other cases, create a deferred application of
f
.
serialize :: ToCBOR a => a -> LByteString Source #
Serialize a Haskell value with a
ToCBOR
instance to an external binary
representation.
The output is represented as a lazy
LByteString
and is constructed
incrementally.
serialize' :: ToCBOR a => a -> ByteString Source #
Serialize a Haskell value to an external binary representation.
The output is represented as a strict
ByteString
.
serializeBuilder :: ToCBOR a => a -> Builder Source #
Serialize into a Builder. Useful if you want to throw other ByteStrings around it.
serializeEncoding :: Encoding -> LByteString Source #
Serialize a Haskell value to an external binary representation using the
provided CBOR
Encoding
The output is represented as an
LByteString
and is constructed
incrementally.
serializeEncoding' :: Encoding -> ByteString Source #
A strict version of
serializeEncoding
CBOR in CBOR
encodeNestedCbor :: ToCBOR a => a -> Encoding Source #
Encode and serialise the given
a
and sorround it with the semantic tag 24
In CBOR diagnostic notation:
>>> 24(h
DEADBEEF
)
encodeNestedCborBytes :: LByteString -> Encoding Source #
Like
encodeNestedCbor
, but assumes nothing about the shape of
input object, so that it must be passed as a binary
ByteString
blob. It's
the caller responsibility to ensure the input
ByteString
correspond
indeed to valid, previously-serialised CBOR data.
nestedCborSizeExpr :: Size -> Size Source #
nestedCborBytesSizeExpr :: Size -> Size Source #
A wrapper over
ByteString
for signalling that a bytestring should be
processed as a sequence of bytes, not as a separate entity. It's used in
crypto and binary code.
class Typeable a => FromCBOR a where Source #
Instances
data DecoderError Source #
DecoderErrorCanonicityViolation Text | |
DecoderErrorCustom Text Text |
Custom decoding error, usually due to some validation failure |
DecoderErrorDeserialiseFailure Text DeserialiseFailure | |
DecoderErrorEmptyList Text | |
DecoderErrorLeftover Text ByteString | |
DecoderErrorSizeMismatch Text Int Int |
A size mismatch
|
DecoderErrorUnknownTag Text Word8 | |
DecoderErrorVoid |
Instances
Eq DecoderError Source # | |
Defined in Cardano.Binary.FromCBOR (==) :: DecoderError -> DecoderError -> Bool Source # (/=) :: DecoderError -> DecoderError -> Bool Source # |
|
Show DecoderError Source # | |
Defined in Cardano.Binary.FromCBOR |
|
Exception DecoderError Source # | |
Defined in Cardano.Binary.FromCBOR |
|
Buildable DecoderError Source # | |
Defined in Cardano.Binary.FromCBOR build :: DecoderError -> Builder Source # |
enforceSize :: Text -> Int -> Decoder s () Source #
Enforces that the input size is the same as the decoded one, failing in case it's not
matchSize :: Text -> Int -> Int -> Decoder s () Source #
Compare two sizes, failing if they are not equal
module Codec.CBOR.Decoding
Helper tools to build instances
decodeMapSkel :: ( Ord k, FromCBOR k, FromCBOR v) => ([(k, v)] -> m) -> Decoder s m Source #
Checks canonicity by comparing the new key being decoded with the previous one, to enfore these are sorted the correct way. See: https://tools.ietf.org/html/rfc7049#section-3.9 "[..]The keys in every map must be sorted lowest value to highest.[...]"
dropList :: Dropper s -> Dropper s Source #
Drop a list of values using the supplied
Dropper
for each element
dropWord64 :: Dropper s Source #
Unsafe deserialization
unsafeDeserialize :: FromCBOR a => LByteString -> a Source #
Deserialize a Haskell value from the external binary representation
(which must have been made using
serialize
or related function).
Throws
:
if the given external
representation is invalid or does not correspond to a value of the
expected type.
DeserialiseFailure
unsafeDeserialize' :: FromCBOR a => ByteString -> a Source #
Strict variant of
deserialize
.
:: Encoding |
The
|
-> ByteString |
The encoded value. |
Turn an
Encoding
into a strict
ByteString
in CBOR binary
format.
Since: cborg-0.2.0.0
Backward-compatible functions
decodeFull :: forall a. FromCBOR a => LByteString -> Either DecoderError a Source #
Deserialize a Haskell value from the external binary representation,
failing if there are leftovers. In a nutshell, the
full
here implies
the contract of this function is that what you feed as input needs to
be consumed entirely.
decodeFull' :: forall a. FromCBOR a => ByteString -> Either DecoderError a Source #
:: Text |
Label for error reporting |
-> ( forall s. Decoder s a) |
The parser for the
|
-> LByteString |
The
|
-> Either DecoderError a |
CBOR in CBOR
decodeNestedCbor :: FromCBOR a => Decoder s a Source #
Remove the the semantic tag 24 from the enclosed CBOR data item,
decoding back the inner
ByteString
as a proper Haskell type.
Consume its input in full.
decodeNestedCborBytes :: Decoder s ByteString Source #
Like
decodeKnownCborDataItem
, but assumes nothing about the Haskell
type we want to deserialise back, therefore it yields the
ByteString
Tag 24 surrounded (stripping such tag away).
In CBOR notation, if the data was serialised as:
>>>
24(h'DEADBEEF')
then
decodeNestedCborBytes
yields the inner
DEADBEEF
, unchanged.
Annotated | |
|
Instances
A pair of offsets delimiting the beginning and end of a substring of a ByteString
Instances
Show ByteSpan Source # | |
Generic ByteSpan Source # | |
ToJSON ByteSpan Source # | |
type Rep ByteSpan Source # | |
Defined in Cardano.Binary.Annotated
type
Rep
ByteSpan
=
D1
('
MetaData
"ByteSpan" "Cardano.Binary.Annotated" "cardano-binary-1.5.0-Ie8ou29t5ce4OKqm69DtmT" '
False
) (
C1
('
MetaCons
"ByteSpan" '
PrefixI
'
False
) (
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
ByteOffset
)
:*:
S1
('
MetaSel
('
Nothing
::
Maybe
Symbol
) '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
ByteOffset
)))
|
class Decoded t where Source #
recoverBytes :: t -> ByteString Source #
Instances
Decoded ( Annotated b ByteString ) Source # | |
Defined in Cardano.Binary.Annotated type BaseType ( Annotated b ByteString ) Source # recoverBytes :: Annotated b ByteString -> ByteString Source # |
annotationBytes :: Functor f => LByteString -> f ByteSpan -> f ByteString Source #
annotatedDecoder :: Decoder s a -> Decoder s ( Annotated a ByteSpan ) Source #
A decoder for a value paired with an annotation specifying the start and end of the consumed bytes.
slice :: ByteString -> ByteSpan -> LByteString Source #
Extract a substring of a given ByteString corresponding to the offsets.
fromCBORAnnotated :: FromCBOR a => Decoder s ( Annotated a ByteSpan ) Source #
A decoder for a value paired with an annotation specifying the start and end of the consumed bytes.
decodeFullAnnotatedBytes :: Functor f => Text -> ( forall s. Decoder s (f ByteSpan )) -> LByteString -> Either DecoderError (f ByteString ) Source #
Decodes a value from a ByteString, requiring that the full ByteString is consumed, and replaces ByteSpan annotations with the corresponding substrings of the input string.
reAnnotate :: ToCBOR a => Annotated a b -> Annotated a ByteString Source #
Reconstruct an annotation by re-serialising the payload to a ByteString.
A value of type `Annotator a` is one that needs access to the entire | bytestring used during decoding to finish construction.
Annotator | |
|
annotatorSlice :: Decoder s ( Annotator ( LByteString -> a)) -> Decoder s ( Annotator a) Source #
The argument is a decoder for a annotator that needs access to the bytes that | were decoded. This function constructs and supplies the relevant piece.
decodeAnnotator :: Text -> ( forall s. Decoder s ( Annotator a)) -> LByteString -> Either DecoderError a Source #
Supplies the bytestring argument to both the decoder and the produced annotator.
withSlice :: Decoder s a -> Decoder s (a, Annotator LByteString ) Source #
Pairs the decoder result with an annotator.
newtype FullByteString Source #
This marks the entire bytestring used during decoding, rather than the | piece we need to finish constructing our value.