Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Overview
This library allows to specify and work with types like
-- Base 64 encoded bytes (could represent binary files) Enc '["enc-B64"] ByteString -- Base 64 encoded UTF8 bytes Enc '["enc-B64", "r-UTF8"] ByteString -- Text that contains only ASCII characters Enc '["r-ASCII"] Text
or to do transformations to strings like
upper :: Text -> Enc '["do-UPPER"] Text upper = ...
or define precise types to use with toEncString
and fromEncString
date :: Enc '["r-date-%d%b%Y:%X %Z"] Text date = toEncString ...
Primary focus of type-encodings is to provide type safe
- encoding
- decoding
- recreation (verification of existing payload)
- type conversions between encoded types
of string-like data (ByteString
, Text
) that is subject of some
encoding or formatting restrictions.
as well as
- toEncString
- fromEncString
conversions.
Groups of annotations
typed-encoding uses type annotations grouped into semantic categories
"r-" restriction / predicate
- encoding is a partial identity
- recreation is a partial identity (matching encoding)
- decoding is identity
Examples: "r-UTF8"
, "r-ASCII"
"do-" transformations
- encoding applies transformation to the string (could be partial)
- decoding - typically none
- recreation - typically none but, if present, verifies the payload has expected data (e.g. only uppercase chars for "do-UPPER")
Examples: "do-UPPER"
, "do-lower"
, "do-reverse"
"enc-" data encoding that is not "r-"
- encoding applies encoding transformation to the string (could be partial)
- decoding reverses the transformation (can be used as pure function)
- recreation verifies that the payload has correctly encoded data
Examples: "enc-B64"
Usage
To use this library import this module and one or more instance module.
Here is list of instance modules available in typed-encoding library itself
- Data.TypedEncoding.Instances.Enc.Base64
- Data.TypedEncoding.Instances.Restriction.Common
- Data.TypedEncoding.Instances.Restriction.ASCII
- Data.TypedEncoding.Instances.Restriction.UTF8
- Data.TypedEncoding.Instances.Do.Sample
- Data.TypedEncoding.Instances.ToEncString.Common
This list is not intended to be exhaustive, rather separate libraries can provide instances for other encodings and transformations.
To implement a new encoding import this module and
Examples
Examples of how to use this library are included in
Synopsis
- module Data.TypedEncoding.Internal.Class
- module Data.TypedEncoding.Internal.Combinators
- data Enc enc conf str
- data CheckedEnc conf str
- data EncodeEx where
- EncodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx
- data RecreateEx where
- RecreateEx :: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx
- RecreateExUnkStep :: Show e => e -> RecreateEx
- data UnexpectedDecodeEx where
- UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx
- type EncAnn = String
- module Data.TypedEncoding.Internal.Types.SomeEnc
- module Data.TypedEncoding.Internal.Types.UncheckedEnc
- getPayload :: Enc enc conf str -> str
- unsafeSetPayload :: conf -> str -> Enc enc conf str
- fromEncoding :: Enc '[] conf str -> str
- toEncoding :: conf -> str -> Enc '[] conf str
- unsafeCheckedEnc :: [EncAnn] -> c -> s -> CheckedEnc c s
- getCheckedPayload :: CheckedEnc conf str -> str
- getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str)
- toCheckedEnc :: forall xs c str. SymbolList xs => Enc xs c str -> CheckedEnc c str
- fromCheckedEnc :: forall xs c str. SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str)
- recreateErrUnknown :: Show e => e -> RecreateEx
Classes
Combinators
Types
data Enc enc conf str Source #
Instances
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 checkPrevF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 checkPrevF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(IsStringR str, IsString str, RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c str :: Type) (Enc ("r-Word8-decimal" ': xs) c str) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.Common checkPrevF :: Enc ("r-Word8-decimal" ': xs) c str -> f (Enc xs c str) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("do-UPPER" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Do.Sample | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("enc-B64" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("enc-B64" ': xs) c Text) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 | |
Applicative f => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64-len" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 checkPrevF :: Enc ("enc-B64-len" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 checkPrevF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64-len" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 checkPrevF :: Enc ("enc-B64-len" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 checkPrevF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII checkPrevF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c ByteString :: Type) (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII checkPrevF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("r-ASCII" ': xs) c Text) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("r-ASCII" ': xs) c Text) Source # | |
(RecreateErr f, Applicative f) => RecreateF (f :: Type -> Type) (Enc xs c Text :: Type) (Enc ("my-sign" ': xs) c Text) Source # | Recreation allows effectful |
Defined in Examples.TypedEncoding.DiySignEncoding | |
(HasA SizeLimit c, Applicative f) => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("do-size-limit" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Do.Sample encodeF :: Enc xs c ByteString -> f (Enc ("do-size-limit" ': xs) c ByteString) Source # | |
(HasA SizeLimit c, Applicative f) => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-size-limit" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-reverse" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-reverse" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-Title" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-Title" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-lower" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-lower" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-UPPER" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("do-UPPER" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("enc-B64" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("enc-B64" ': xs) c Text :: Type) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("enc-B64" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 encodeF :: Enc xs c ByteString -> f (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c ByteString) (Enc ("enc-B64" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 encodeF :: Enc xs c ByteString -> f (Enc ("enc-B64" ': xs) c ByteString) Source # | |
Applicative f => EncodeF (f :: Type -> Type) (Enc xs c Text) (Enc ("my-sign" ': xs) c Text :: Type) Source # | Because encoding function is pure we can create instance of EncodeF
that is polymorphic in effect |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-UTF8" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 decodeF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-UTF8" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 decodeF :: Enc ("r-UTF8" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(IsStringR str, IsString str, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("r-Word8-decimal" ': xs) c str) (Enc xs c str :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Enc.Base64 decodeF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("enc-B64" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | Effectful instance for corruption detection. This protocol is used, for example, in emails. It is a well known encoding and hackers will have no problem making undetectable changes, but error handling at this stage could verify that email was corrupted. |
Defined in Data.TypedEncoding.Instances.Enc.Base64 decodeF :: Enc ("enc-B64" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII decodeF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c ByteString) (Enc xs c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII decodeF :: Enc ("r-ASCII" ': xs) c ByteString -> f (Enc xs c ByteString) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Text) (Enc xs c Text :: Type) Source # | |
Applicative f => DecodeF (f :: Type -> Type) (Enc ("r-ASCII" ': xs) c Char) (Enc xs c Char :: Type) Source # | |
(UnexpectedDecodeErr f, Applicative f) => DecodeF (f :: Type -> Type) (Enc ("my-sign" ': xs) c Text) (Enc xs c Text :: Type) Source # | Decoding allows effectful Implementation simply uses |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | UTF8 encodings are defined for ByteString only as that would not make much sense for Text
Following test uses \(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b) |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
(IsStringR str, IsString str) => EncodeF (Either EncodeEx) (Enc xs c str) (Enc ("r-Word8-decimal" ': xs) c str :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Char) (Enc ("r-ASCII" ': xs) c Char :: Type) Source # | |
(Eq conf, Eq str) => Eq (Enc enc conf str) Source # | |
(Show conf, Show str) => Show (Enc enc conf str) Source # | |
(SymbolList xs, Show c, Displ str) => Displ (Enc xs c str) Source # |
|
data CheckedEnc conf str Source #
Represents some validated encoded string.
CheckedEnc
is untyped version of Enc
.
CheckedEnc
contains verified encoded data, encoding is visible
at the value level only.
Instances
(Eq conf, Eq str) => Eq (CheckedEnc conf str) Source # | |
Defined in Data.TypedEncoding.Internal.Types.CheckedEnc (==) :: CheckedEnc conf str -> CheckedEnc conf str -> Bool # (/=) :: CheckedEnc conf str -> CheckedEnc conf str -> Bool # | |
(Show conf, Show str) => Show (CheckedEnc conf str) Source # | |
Defined in Data.TypedEncoding.Internal.Types.CheckedEnc showsPrec :: Int -> CheckedEnc conf str -> ShowS # show :: CheckedEnc conf str -> String # showList :: [CheckedEnc conf str] -> ShowS # | |
(Show c, Displ str) => Displ (CheckedEnc c str) Source # |
|
Defined in Data.TypedEncoding.Internal.Types.CheckedEnc displ :: CheckedEnc c str -> String Source # |
Represents errors in encoding
EncodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> EncodeEx |
Instances
Show EncodeEx Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-UTF8" ': xs) c ByteString :: Type) Source # | UTF8 encodings are defined for ByteString only as that would not make much sense for Text
Following test uses \(b :: B.ByteString) -> verEncoding b (fmap (fromEncoding . decodeAll . proxiedId (Proxy :: Proxy (Enc '["r-UTF8"] _ _))) . (encodeFAll :: _ -> Either EncodeEx _). toEncoding () $ b) |
Defined in Data.TypedEncoding.Instances.Restriction.UTF8 encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-UTF8" ': xs) c ByteString) Source # | |
(IsStringR str, IsString str) => EncodeF (Either EncodeEx) (Enc xs c str) (Enc ("r-Word8-decimal" ': xs) c str :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c ByteString) (Enc ("r-ASCII" ': xs) c ByteString :: Type) Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII encodeF :: Enc xs c ByteString -> Either EncodeEx (Enc ("r-ASCII" ': xs) c ByteString) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Text) (Enc ("r-ASCII" ': xs) c Text :: Type) Source # | |
EncodeF (Either EncodeEx) (Enc xs c Char) (Enc ("r-ASCII" ': xs) c Char :: Type) Source # | |
data RecreateEx where Source #
Represents errors in recovery (recreation of encoded types).
RecreateEx :: (Show e, KnownSymbol x) => Proxy x -> e -> RecreateEx | |
RecreateExUnkStep :: Show e => e -> RecreateEx |
Instances
Show RecreateEx Source # | |
Defined in Data.TypedEncoding.Internal.Types showsPrec :: Int -> RecreateEx -> ShowS # show :: RecreateEx -> String # showList :: [RecreateEx] -> ShowS # | |
RecreateErr (Either RecreateEx) Source # | |
Defined in Data.TypedEncoding.Internal.Class.Recreate recoveryErr :: RecreateEx -> Either RecreateEx a Source # |
data UnexpectedDecodeEx where Source #
Type safety over encodings makes decoding process safe. However failures are still possible due to bugs or unsafe payload modifications. UnexpectedDecodeEx represents such errors.
UnexpectedDecodeEx :: (Show a, KnownSymbol x) => Proxy x -> a -> UnexpectedDecodeEx |
Instances
Show UnexpectedDecodeEx Source # | |
Defined in Data.TypedEncoding.Internal.Types showsPrec :: Int -> UnexpectedDecodeEx -> ShowS # show :: UnexpectedDecodeEx -> String # showList :: [UnexpectedDecodeEx] -> ShowS # | |
UnexpectedDecodeErr (Either UnexpectedDecodeEx) Source # | |
Existentially quantified version of Enc
and basic combinators
Types and combinators for not verfied encoding
Basic Enc
Combinators
getPayload :: Enc enc conf str -> str Source #
unsafeSetPayload :: conf -> str -> Enc enc conf str Source #
fromEncoding :: Enc '[] conf str -> str Source #
toEncoding :: conf -> str -> Enc '[] conf str Source #
Basic CheckedEnc
Combinators
unsafeCheckedEnc :: [EncAnn] -> c -> s -> CheckedEnc c s Source #
getCheckedPayload :: CheckedEnc conf str -> str Source #
getCheckedEncPayload :: CheckedEnc conf str -> ([EncAnn], str) Source #
toCheckedEnc :: forall xs c str. SymbolList xs => Enc xs c str -> CheckedEnc c str Source #
fromCheckedEnc :: forall xs c str. SymbolList xs => CheckedEnc c str -> Maybe (Enc xs c str) Source #
Other Basic Combinators
recreateErrUnknown :: Show e => e -> RecreateEx Source #