typed-encoding-encoding (empty) → 0.1.0.0
raw patch · 13 files changed
+920/−0 lines, 13 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, doctest, doctest-discover, encoding, hspec, quickcheck-instances, typed-encoding, typed-encoding-encoding
Files
- ChangeLog.md +6/−0
- LICENSE +30/−0
- README.md +7/−0
- Setup.hs +2/−0
- doctest/Spec.hs +1/−0
- src/Data/TypedEncoding/Pkg/Encoding.hs +39/−0
- src/Data/TypedEncoding/Pkg/Encoding/Conv.hs +259/−0
- src/Data/TypedEncoding/Pkg/Encoding/Instances.hs +105/−0
- src/Data/TypedEncoding/Pkg/Encoding/Warn/Instances.hs +133/−0
- test/Spec.hs +3/−0
- test/Test/SafeDecodingSpec.hs +125/−0
- test/Test/SanitySpec.hs +124/−0
- typed-encoding-encoding.cabal +86/−0
+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Changelog for typed-encoding-encoding++## Unreleased changes++## 0.1.0.0+Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER 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.
+ README.md view
@@ -0,0 +1,7 @@+# typed-encoding-encoding++A thin overlay over `encoding` package to add `type-encoding` type safety.++https://hackage.haskell.org/package/encoding +https://hackage.haskell.org/package/typed-encoding+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ doctest/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}
+ src/Data/TypedEncoding/Pkg/Encoding.hs view
@@ -0,0 +1,39 @@++-- | This package is a thin layer over the /encoding/ package to create types compatible+-- with /type-encoding/.+--+-- == Naming conventions+-- +-- @+-- "enc-pkg/encoding:[encoding]"+-- @ +--+-- where @"[encoding]"@ is String name used by the 'Encoding.DynEncoding' in the /encoding/ package.+--+-- Example: @"enc-pkg/encoding:cyrillic"@+--+-- == Warnings / AS-IS type wrapping+--+-- The /encoding/ package can exhibit behavior that may not map well to+-- type level guarantees that /typed-encoding/ tries to enforce, examples of this are documented in+--+-- "Data.TypedEncoding.Pkg.Encoding.Conv"+-- +-- In particular, it seems not possible to implement +-- 'Data.TypedEncoding.Common.Class.Validate.Validate' instance with a decent performance.+-- +-- For this reason module defining it is annotated with WARNING pragma and is kept separate:+--+-- "Data.TypedEncoding.Pkg.Encoding.Warn.Instances" (/typed-encoding/ Validate instance for String encodings)+++module Data.TypedEncoding.Pkg.Encoding (+ -- * Type safe versions of encode and decode functions from /encoding/ package+ module Data.TypedEncoding.Pkg.Encoding.Conv+ + -- * /typed-encoding/ class instances for /Encode/, /Decode/, /ToEncString/, and /FromEncString/ + , module Data.TypedEncoding.Pkg.Encoding.Instances+ ) where++import Data.TypedEncoding.Pkg.Encoding.Conv+import Data.TypedEncoding.Pkg.Encoding.Instances
+ src/Data/TypedEncoding/Pkg/Encoding/Conv.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++-- | +-- Contains type save equivalents of the following functions defined in /encoding/:+--+-- * 'Encoding.encodeStrictByteStringExplicit'+-- * 'Encoding.encodeLazyByteStringExplicit'+-- * 'Encoding.encString'+-- * 'Encoding.decodeStrictByteStringExplicit'+-- * 'Encoding.decodeLazyByteStringExplicit'+-- * 'Encoding.decodeStringExplicit'+--+--+-- == Warnings+--+-- These conversions are provides AS-IS and assume that /encoding/ functions behave+-- in a way consistent with /typed-encoding/ type definitions. +-- +-- For example, /typed-encoding/ effectively guarantees that decode function will never fail+-- and it is safe to use @Identity@ instance of the @UnexpectedDecodeErr@ class.+--+-- In /encoding v0.8.5/, the decoding can fail after the encoding succeeded:+--+-- >>> Encoding.encodeStringExplicit EncCP932.CP932 "\DEL"+-- Right "\DEL"+-- >>> Encoding.decodeStringExplicit EncCP932.CP932 "\DEL"+-- Left (IllegalCharacter 127)+--+-- Here are some other peculiarities:+--+-- /cp1257/ is a single bit encoding and one could expect this to fail, but it succeeds:+--+-- >>> Encoding.encodeStringExplicit (Encoding.encodingFromString "cp1257") "\x100"+-- Right "\194"+--+-- Decoding can also be surprising:+--+-- >>> Encoding.decodeStringExplicit EncASCII.ASCII "\236\239"+-- Right "\236\239"+--+-- here is UTF8 decoding+--+-- >>> Encoding.decodeStringExplicit EncUTF8.UTF8 "\192\NUL"+-- Right "\NUL"+-- >>> Encoding.encodeStringExplicit EncUTF8.UTF8 "\NUL"+-- Right "\NUL"+--+-- This package does not try to fix these issues, only provides a wrapper +-- that annotates encodings as symbols.+++module Data.TypedEncoding.Pkg.Encoding.Conv where ++import qualified Data.TypedEncoding.Instances.Support as Typed++import qualified Data.Encoding as Encoding++import GHC.TypeLits+import Data.Proxy+import qualified Data.List as L+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+++-- $setup+-- >>> :set -XOverloadedStrings -XDataKinds -XTypeApplications -XFlexibleContexts+-- >>> import Data.Functor.Identity+-- >>> import qualified Data.TypedEncoding as Usage+-- >>> import Data.Encoding.ASCII as EncASCII+-- >>> import Data.Encoding.UTF8 as EncUTF8+-- >>> import Data.Encoding.CP932 as EncCP932++type family IsDynEnc (s :: Symbol) :: Bool where+ IsDynEnc s = Typed.AcceptEq ('Text "Not encoding restriction " ':<>: ShowType s ) (CmpSymbol (Typed.TakeUntil s ":") "enc-pkg/encoding")++type DynEnc s = (KnownSymbol s, IsDynEnc s ~ 'True)++++-- * Conversion To ByteString++-- |+-- @encodeStrictByteStringExplicit@ creates values of types like+--+-- @+-- Enc '["enc-pkg/encoding:cyrillic"] () ByteString+-- @+-- +-- >>> fmap Typed.displ . encodeStrictByteStringExplicit @"enc-pkg/encoding:cyrillic" . Typed.toEncoding () $ "а на животе кнопка"+-- Right "Enc '[enc-pkg/encoding:cyrillic] () (ByteString \208 \221\208 \214\216\210\222\226\213 \218\221\222\223\218\208)"+-- +-- >>> fmap Typed.displ . encodeStrictByteStringExplicit @"enc-pkg/encoding:koi8_r" . Typed.toEncoding () $ "а на животе кнопка"+-- Right "Enc '[enc-pkg/encoding:koi8_r] () (ByteString \193 \206\193 \214\201\215\207\212\197 \203\206\207\208\203\193)"+--+-- >>> "а на животе кнопка"+-- "\1072 \1085\1072 \1078\1080\1074\1086\1090\1077 \1082\1085\1086\1087\1082\1072"+--+-- >>> "Статья"+-- "\1057\1090\1072\1090\1100\1103"+--+-- >>> fmap Typed.displ . encodeStrictByteStringExplicit @"enc-pkg/encoding:cyrillic" . Typed.toEncoding () $ "Статья"+-- Right "Enc '[enc-pkg/encoding:cyrillic] () (ByteString \193\226\208\226\236\239)"+--+-- >>> encodeStrictByteStringExplicit @"enc-pkg/encoding:ascii" . Typed.toEncoding () $ "Статья"+-- Left (EncodeEx "enc-pkg/encoding:ascii" (HasNoRepresentation '\1057'))+--+-- >>> fmap Typed.displ . encodeStrictByteStringExplicit @"enc-pkg/encoding:ascii" . Typed.toEncoding () $ "story"+-- Right "Enc '[enc-pkg/encoding:ascii] () (ByteString story)"+encodeStrictByteStringExplicit :: forall s xs c .+ (+ DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c B.ByteString)+encodeStrictByteStringExplicit s = + do + enc <- Typed.asEncodeEx p . exferDynEncoding $ p+ Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeStrictByteStringExplicit enc) s+ where + p = Proxy :: Proxy s+++-- | +-- Converts 'String' to some @Enc '["enc-pkg/encoding:..."] () BL.ByteString@ type+-- by actually encoding characters in the String into correct byte layout.+encodeLazyByteStringExplicit :: forall s xs c .+ (+ DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c BL.ByteString)+encodeLazyByteStringExplicit s = + do + enc <- Typed.asEncodeEx p $ exferDynEncoding p+ Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeLazyByteStringExplicit enc) s+ where + p = Proxy :: Proxy s++-- * Conversion to encoded String++-- | +-- Converts 'String' to some @Enc '["enc-pkg/encoding:..."] () String@ type+-- by actually encoding characters in the String into a certain byte layout.+-- +-- The resulting payload has all Characters representing bytes, that is @< \'\\255\'@+encodeStringExplicit :: forall s xs c .+ (+ DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc xs c String -> Either Typed.EncodeEx (Typed.Enc (s ': xs) c String)+encodeStringExplicit s = + do + enc <- Typed.asEncodeEx p $ exferDynEncoding p+ Typed.withUnsafeCoerceF (Typed.asEncodeEx p . Encoding.encodeStringExplicit enc) s+ where + p = Proxy :: Proxy s++++encString :: forall s xs c .+ (+ DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Encoding (Either Typed.EncodeEx) s "enc-pkg/encoding" c String+encString = Typed._mkEncoding encodeStringExplicit++++-- * Conversion From ByteString++-- |+--+-- >>> fmap Typed.displ $ decodeStrictByteStringExplicit @"enc-pkg/encoding:cyrillic" @'[] @Identity (Typed.unsafeSetPayload () "\193\226\208\226\236\239")+-- Identity "Enc '[] () (String \1057\1090\1072\1090\1100\1103)"+decodeStrictByteStringExplicit :: forall s xs f c .+ (Typed.UnexpectedDecodeErr f+ , Monad f+ , DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc (s ': xs) c B.ByteString -> f (Typed.Enc xs c String)+decodeStrictByteStringExplicit x = + do + enc <- Typed.asUnexpected @s . exferDynEncoding $ p+ Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeStrictByteStringExplicit enc) x+ where p = Proxy :: Proxy s+++decodeLazyByteStringExplicit :: forall s xs f c .+ (Typed.UnexpectedDecodeErr f+ , Monad f+ , DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc (s ': xs) c BL.ByteString -> f (Typed.Enc xs c String)+decodeLazyByteStringExplicit x = + do + enc <- Typed.asUnexpected @s . exferDynEncoding $ p+ Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeLazyByteStringExplicit enc) x+ where p = Proxy :: Proxy s+++-- * Conversion From encoded String++decodeStringExplicit :: forall s xs f c .+ (Typed.UnexpectedDecodeErr f+ , Monad f+ , DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Enc (s ': xs) c String -> f (Typed.Enc xs c String)+decodeStringExplicit x = + do + enc <- Typed.asUnexpected @s . exferDynEncoding $ p+ Typed.withUnsafeCoerceF (Typed.asUnexpected @s . Encoding.decodeStringExplicit enc) x+ where p = Proxy :: Proxy s++decString :: forall s xs f c .+ (Typed.UnexpectedDecodeErr f+ , Monad f+ , DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Decoding f s "enc-pkg/encoding" c String++decString = Typed.mkDecoding decodeStringExplicit++++-- * Helpers+-- | Provides type safety over existence of 'Encoding.DynEncoding'+getDynEncoding :: forall s xs c str. (DynEnc s) => Typed.Enc (s ': xs) c str -> Encoding.DynEncoding+getDynEncoding _ = Encoding.encodingFromString nm + where + p = Proxy :: Proxy s+ nm = L.drop 8 . symbolVal $ p++-- * Implementation++exferDynEncoding :: (KnownSymbol s, DynEnc s) => Proxy s -> Either String Encoding.DynEncoding+exferDynEncoding p = explainMaybe ("Invalid encoding " ++ nm) . Encoding.encodingFromStringExplicit $ nm + where + nm = L.drop 17 . symbolVal $ p+ explainMaybe _ (Just x) = Right x+ explainMaybe msg Nothing = Left msg+
+ src/Data/TypedEncoding/Pkg/Encoding/Instances.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++-- | +-- Key instances defined here are 'Typed.ToEncString' and 'Typed.FromEncString'.+-- These allow to create encoded @ByteString@ from a String (@ToEncString@) and decode @ByteString@ back (@ToEncString@).+--+-- The String 'Typed.Encode', 'Typed.Decode' instances is less interesting since is works with @String@ type only.+--+-- See the /warnings/ section of +-- "Data.TypedEncoding.Pkg.Encoding.Conv"+++module Data.TypedEncoding.Pkg.Encoding.Instances where ++import qualified Data.TypedEncoding.Instances.Support as Typed++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++import qualified Data.TypedEncoding.Pkg.Encoding.Conv as Conv++-- $setup+-- >>> :set -XOverloadedStrings -XDataKinds -XTypeApplications -XFlexibleContexts+-- >>> import Data.Functor.Identity+-- >>> import qualified Data.TypedEncoding as Usage+++-- |+-- +-- >>> :{+-- Usage.displ +-- <$> Usage.toEncStringF' +-- @"enc-pkg/encoding" +-- @"enc-pkg/encoding:cyrillic" +-- @(Either Usage.EncodeEx) +-- @String +-- @B.ByteString "Статья"+-- :}+-- Right "Enc '[enc-pkg/encoding:cyrillic] () (ByteString \193\226\208\226\236\239)"+instance (Conv.DynEnc s, Typed.Algorithm s "enc-pkg/encoding") => Typed.ToEncString (Either Typed.EncodeEx) s "enc-pkg/encoding" String B.ByteString where+ toEncF = Conv.encodeStrictByteStringExplicit . Typed.toEncoding () ++instance (Conv.DynEnc s, Typed.Algorithm s "enc-pkg/encoding") => Typed.ToEncString (Either Typed.EncodeEx) s "enc-pkg/encoding" String BL.ByteString where+ toEncF = Conv.encodeLazyByteStringExplicit . Typed.toEncoding () ++-- |+-- +-- >>> :{+-- Usage.displ <$> +-- Usage.fromEncStringF' +-- @"enc-pkg/encoding" +-- @"enc-pkg/encoding:cyrillic" +-- @(Either Usage.UnexpectedDecodeEx) +-- @String @B.ByteString +-- (Typed.unsafeSetPayload () "\193\226\208\226\236\239")+-- :}+-- Right "(String \1057\1090\1072\1090\1100\1103)"+instance (+ Typed.UnexpectedDecodeErr f+ , Monad f+ , Conv.DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => Typed.FromEncString f s "enc-pkg/encoding" String B.ByteString where+ fromEncF = fmap Typed.fromEncoding . Conv.decodeStrictByteStringExplicit++instance (+ Typed.UnexpectedDecodeErr f+ , Monad f+ , Conv.DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => Typed.FromEncString f s "enc-pkg/encoding" String BL.ByteString where+ fromEncF = fmap Typed.fromEncoding . Conv.decodeLazyByteStringExplicit++++instance (+ Conv.DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => Typed.Encode (Either Typed.EncodeEx) s "enc-pkg/encoding" c String where+ encoding = Conv.encString+++instance (+ Typed.UnexpectedDecodeErr f+ , Monad f+ , Conv.DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => Typed.Decode f s "enc-pkg/encoding" c String where+ decoding = Conv.decString++-- | All /encoding/ encodings map characters to bytes+-- This defines @EncSuperset s@ as @"r-CHAR8"@+instance Conv.DynEnc s => Typed.EncodingSuperset s where+ type EncSuperset s = "r-CHAR8"+
+ src/Data/TypedEncoding/Pkg/Encoding/Warn/Instances.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ConstraintKinds #-}++-- | +-- There seems to be no easy ways to verify encoding using the /encoding/ package. +--+-- /decode/ functions implemented in /encoding/ are very forgiving and work +-- on invalid encoded inputs. This forces this package to resort to checking that +--+-- @+-- Encoding.encodeXyz . Encoding.decodeXyz+-- @+-- +-- acts as the identity. This is obviously quite expensive. +-- +-- This module provides such implementation and hence the warning.+--+-- >>> Encoding.decodeStrictByteStringExplicit EncUTF8.UTF8 "\192\NUL"+-- Right "\NUL"+--+-- >>> Encoding.encodeStrictByteStringExplicit EncUTF8.UTF8 "\NUL"+-- Right "\NUL"+++module Data.TypedEncoding.Pkg.Encoding.Warn.Instances {-# WARNING "Not optimized for performance" #-} where ++import qualified Data.TypedEncoding.Instances.Support as Typed+import qualified Data.Encoding as Encoding++import GHC.TypeLits+import Data.Proxy++import Data.TypedEncoding.Pkg.Encoding.Conv+++-- import qualified Data.TypedEncoding as Usage+-- import Data.Encoding.UTF8 as EncUTF8+++-- $setup+-- >>> :set -XOverloadedStrings -XDataKinds -XTypeApplications -XFlexibleContexts+-- >>> import Data.Functor.Identity+-- >>> import qualified Data.TypedEncoding as Usage+-- >>> import Data.Encoding.UTF8 as EncUTF8+++-- * Validation Combinators (Slow)++data DecodeOrEncodeException = + DecErr Encoding.DecodingException + | EncErr Encoding.EncodingException + | DecEncMismatch + deriving (Show, Eq)+++validatingDecS :: forall s c .+ (+ DynEnc s+ , Typed.Algorithm s "enc-pkg/encoding"+ ) => + Typed.Decoding (Either Typed.UnexpectedDecodeEx) s "enc-pkg/encoding" c String+validatingDecS = Typed._implDecodingF (verifyDynDec (Proxy :: Proxy s) exferDynEncoding slowValidation) + where + -- see comments in fromDynEncB+ slowValidation enc str = do+ dec <- either (Left . DecErr) Right . Encoding.decodeStringExplicit enc $ str+ res <- either (Left . EncErr) Right . Encoding.encodeStringExplicit enc $ dec + if str == res + then Right dec+ else Left DecEncMismatch +++-- tst = fmap Usage.displ .+-- Usage.recreateFAll' +-- @'["enc-pkg/encoding"] +-- @'["enc-pkg/encoding:cyrillic"] +-- @(Either Usage.RecreateEx) +-- @() +-- @String . Usage.toEncoding () $ "\193\226\208\226\236\239"+++-- |+--+-- >>> :{ +-- fmap Usage.displ .+-- Usage.recreateFAll' +-- @'["enc-pkg/encoding"] +-- @'["enc-pkg/encoding:greek"] +-- @(Either Usage.RecreateEx) +-- @() +-- @String . Usage.toEncoding () $ "\193\226\208\226\236\255"+-- :}+-- Left (RecreateEx "enc-pkg/encoding:greek" (DecErr (IllegalCharacter 255)))+--+-- @\"Статья\"@ example:+--+-- >>> :{ +-- fmap Usage.displ .+-- Usage.recreateFAll' +-- @'["enc-pkg/encoding"] +-- @'["enc-pkg/encoding:cyrillic"] +-- @(Either Usage.RecreateEx) +-- @() +-- @String . Usage.toEncoding () $ "\193\226\208\226\236\239"+-- :}+-- Right "Enc '[enc-pkg/encoding:cyrillic] () (String \193\226\208\226\236\239)"+instance (KnownSymbol s , DynEnc s, Typed.Algorithm s "enc-pkg/encoding", Typed.RecreateErr f, Applicative f) => Typed.Validate f s "enc-pkg/encoding" c String where+ validation = Typed.validFromDec' @"enc-pkg/encoding" validatingDecS++++verifyDynDec :: forall s str err1 err2 enc a. (KnownSymbol s, Show err1, Show err2) => + Proxy s -- ^ proxy defining encoding annotation+ -> (Proxy s -> Either err1 enc) -- ^ finds encoding marker @enc@ for given annotation or fails+ -> (enc -> str -> Either err2 str) -- ^ decoder based on @enc@ marker+ -> str+ -> Either Typed.UnexpectedDecodeEx str+verifyDynDec p findenc decoder str = + do+ enc <- either (Left . Typed.UnexpectedDecodeEx p) Right . findenc $ p+ case decoder enc str of+ Left err -> Left $ Typed.UnexpectedDecodeEx p err+ Right r -> Right r
+ test/Spec.hs view
@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+-- main :: IO ()+-- main = putStrLn "Only doctest suite is implemented, no other tests"
+ test/Test/SafeDecodingSpec.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fwarn-unused-imports #-}++-- | +module Test.SafeDecodingSpec where+++import Data.TypedEncoding +import Data.TypedEncoding.Pkg.Encoding.Conv +import Data.TypedEncoding.Pkg.Encoding.Instances ()+import Data.TypedEncoding.Pkg.Encoding.Warn.Instances ()++import Data.TypedEncoding ++import Test.QuickCheck.Instances.ByteString ()+import Test.QuickCheck+import Test.QuickCheck.Property+import Test.Hspec+import GHC.TypeLits+import Data.Either++-- | decoding should never fail if encoding succeeds+propEncDec :: forall s . (Algorithm s "enc-pkg/encoding") => + Encoding (Either EncodeEx) s "enc-pkg/encoding" () String + -> Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String + -> String + -> Property+propEncDec encf decf str = property $ liftBool (_propSafeDecoding @s encf decf () str)+ ++propValidation :: forall s . (Algorithm s "enc-pkg/encoding") => + Encoding (Either EncodeEx) s "enc-pkg/encoding" () String + -> Validation (Either RecreateEx) s "enc-pkg/encoding" () String + -> Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String + -> String + -> Property+propValidation encf vf decf str = property $ liftBool (_propSafeValidatedDecoding @s vf decf () modStr)+ -- bit of ugly hack, it would be much more work to control Arbitrary outside of this call+ where + modStr = case str of + 'a': _ -> str -- most likely invalid encoding+ _ -> either (const str) getPayload . _runEncoding @s encf . toEncoding () $ str -- most likely a valid encoded string+ ++data TestSuite = OneBitOnly | All+++suite :: + TestSuite+ -> (forall s . (Algorithm s "enc-pkg/encoding", KnownSymbol s) => + Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String + -> String + -> Property) + -> SpecWith ()+suite _ prop = do + it "utf8" $ property $ prop @"enc-pkg/encoding:utf8" decString + it "jis_x_0208" $ property $ prop @"enc-pkg/encoding:jis_x_0208" decString + it "koi8_r" $ property $ prop @"enc-pkg/encoding:koi8_r" decString+ it "koi8_u" $ property $ prop @"enc-pkg/encoding:koi8_u" decString+ it "iso8859_1" $ property $ prop @"enc-pkg/encoding:iso8859_1" decString+ it "iso8859_2" $ property $ prop @"enc-pkg/encoding:iso8859_2" decString+ it "iso8859_3" $ property $ prop @"enc-pkg/encoding:iso8859_3" decString+ it "iso8859_4" $ property $ prop @"enc-pkg/encoding:iso8859_4" decString+ it "iso8859_5" $ property $ prop @"enc-pkg/encoding:iso8859_5" decString+ it "iso8859_6" $ property $ prop @"enc-pkg/encoding:iso8859_6" decString+ it "iso8859_7" $ property $ prop @"enc-pkg/encoding:iso8859_7" decString+ it "iso8859_8" $ property $ prop @"enc-pkg/encoding:iso8859_8" decString+ it "iso8859_9" $ property $ prop @"enc-pkg/encoding:iso8859_9" decString+ it "iso8859_10" $ property $ prop @"enc-pkg/encoding:iso8859_10" decString+ it "iso8859_11" $ property $ prop @"enc-pkg/encoding:iso8859_11" decString+ it "iso8859_13" $ property $ prop @"enc-pkg/encoding:iso8859_13" decString+ it "iso8859_14" $ property $ prop @"enc-pkg/encoding:iso8859_14" decString+ it "iso8859_15" $ property $ prop @"enc-pkg/encoding:iso8859_15" decString+ it "iso8859_16" $ property $ prop @"enc-pkg/encoding:iso8859_16" decString+ it "cp1250" $ property $ prop @"enc-pkg/encoding:cp1250" decString+ it "cp1251" $ property $ prop @"enc-pkg/encoding:cp1251" decString+ it "cp1252" $ property $ prop @"enc-pkg/encoding:cp1252" decString+ it "cp1253" $ property $ prop @"enc-pkg/encoding:cp1253" decString+ it "cp1254" $ property $ prop @"enc-pkg/encoding:cp1254" decString+ it "cp1255" $ property $ prop @"enc-pkg/encoding:cp1255" decString+ it "cp1256" $ property $ prop @"enc-pkg/encoding:cp1256" decString+ it "cp1257" $ property $ prop @"enc-pkg/encoding:cp1257" decString+ it "cp1258" $ property $ prop @"enc-pkg/encoding:cp1258" decString+ it "gb18030" $ property $ prop @"enc-pkg/encoding:gb18030" decString+ it "macintosh" $ property $ prop @"enc-pkg/encoding:macintosh" decString+ it "jis_x_0201" $ property $ prop @"enc-pkg/encoding:jis_x_0201" decString+ it "cp437" $ property $ prop @"enc-pkg/encoding:cp437" decString+ it "cp737" $ property $ prop @"enc-pkg/encoding:cp737" decString+ it "cp775" $ property $ prop @"enc-pkg/encoding:cp775" decString+ it "cp850" $ property $ prop @"enc-pkg/encoding:cp850" decString+ it "cp852" $ property $ prop @"enc-pkg/encoding:cp852" decString+ it "cp855" $ property $ prop @"enc-pkg/encoding:cp855" decString+ it "cp857" $ property $ prop @"enc-pkg/encoding:cp857" decString+ it "cp860" $ property $ prop @"enc-pkg/encoding:cp860" decString+ it "cp861" $ property $ prop @"enc-pkg/encoding:cp861" decString+ it "cp862" $ property $ prop @"enc-pkg/encoding:cp862" decString+ it "cp863" $ property $ prop @"enc-pkg/encoding:cp863" decString+ it "cp864" $ property $ prop @"enc-pkg/encoding:cp864" decString+ it "cp865" $ property $ prop @"enc-pkg/encoding:cp865" decString+ it "cp866" $ property $ prop @"enc-pkg/encoding:cp866" decString+ it "cp869" $ property $ prop @"enc-pkg/encoding:cp869" decString+ it "cp874" $ property $ prop @"enc-pkg/encoding:cp874" decString+ + -- /encoding/ package issue, it allows encoding on invalid character that later fails during decode:+ -- it "cp932" $ property $ prop @"enc-pkg/encoding:cp932" encString decString++++spec :: Spec +spec = + describe "Sanity" $ do+ describe "save decode after encode" $ + suite All (propEncDec encString)+ describe "save decode after validate" $ + suite All (propValidation encString validation)++runSpec :: IO ()+runSpec = hspec spec
+ test/Test/SanitySpec.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fwarn-unused-imports #-}++-- | +module Test.SanitySpec where+++import Data.TypedEncoding +import Data.TypedEncoding.Pkg.Encoding.Conv +import Data.TypedEncoding.Pkg.Encoding.Instances ()++import Data.TypedEncoding ++import Test.QuickCheck.Instances.ByteString ()+import Test.Hspec+import Data.Either++-- OneBitProblems are one bit encodings that somehow can encode chars > '\255'+data TestSuite = MultiBit | OneBit | OneBitProblems ++-- | encoding for one bit encodings should always fail string has chars > '\255'+-- this does not seem to be the case with some encodings like /cp1257/ which could be a bug+-- in encodings library+-- Even adding chars like \1057 (0x421) does not help e.g. /iso8859_5/ encodes it!+--+expectToFailEnc :: forall s . (Algorithm s "enc-pkg/encoding") => String -> Encoding (Either EncodeEx) s "enc-pkg/encoding" () String -> Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String -> Bool+expectToFailEnc str encf decf = isLeft enc+ where + enc = _runEncoding encf . toEncoding () $ str ++ +-- | encoding does not fail on numbers 0-9+expectSucceedEnc :: forall s . (Algorithm s "enc-pkg/encoding") => String -> Encoding (Either EncodeEx) s "enc-pkg/encoding" () String -> Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String -> Bool+expectSucceedEnc str encf decf = isRight enc+ where + enc = _runEncoding encf . toEncoding () $ str ++suite :: + TestSuite+ -> (forall s . (Algorithm s "enc-pkg/encoding") => + Encoding (Either EncodeEx) s "enc-pkg/encoding" () String + -> Decoding (Either UnexpectedDecodeEx) s "enc-pkg/encoding" () String + -> Bool) + -> SpecWith (Arg Bool)+suite which test = + case which of+ MultiBit -> do+ it "utf8" $ test @"enc-pkg/encoding:utf8" encString decString + it "jis_x_0208" $ test @"enc-pkg/encoding:jis_x_0208" encString decString + OneBitProblems -> do+ it "iso8859_4" $ test @"enc-pkg/encoding:iso8859_4" encString decString+ it "iso8859_10" $ test @"enc-pkg/encoding:iso8859_10" encString decString+ it "iso8859_13" $ test @"enc-pkg/encoding:iso8859_13" encString decString+ it "cp1257" $ test @"enc-pkg/encoding:cp1257" encString decString+ it "gb18030" $ test @"enc-pkg/encoding:gb18030" encString decString+ it "gb18030" $ test @"enc-pkg/encoding:gb18030" encString decString+ OneBit -> do + it "koi8_r" $ test @"enc-pkg/encoding:koi8_r" encString decString+ it "koi8_u" $ test @"enc-pkg/encoding:koi8_u" encString decString+ it "iso8859_1" $ test @"enc-pkg/encoding:iso8859_1" encString decString+ it "iso8859_2" $ test @"enc-pkg/encoding:iso8859_2" encString decString+ it "iso8859_3" $ test @"enc-pkg/encoding:iso8859_3" encString decString+ it "iso8859_5" $ test @"enc-pkg/encoding:iso8859_5" encString decString+ it "iso8859_6" $ test @"enc-pkg/encoding:iso8859_6" encString decString+ it "iso8859_7" $ test @"enc-pkg/encoding:iso8859_7" encString decString+ it "iso8859_8" $ test @"enc-pkg/encoding:iso8859_8" encString decString+ it "iso8859_9" $ test @"enc-pkg/encoding:iso8859_9" encString decString+ it "iso8859_11" $ test @"enc-pkg/encoding:iso8859_11" encString decString+ it "iso8859_14" $ test @"enc-pkg/encoding:iso8859_14" encString decString+ it "iso8859_15" $ test @"enc-pkg/encoding:iso8859_15" encString decString+ it "iso8859_16" $ test @"enc-pkg/encoding:iso8859_16" encString decString+ it "cp1250" $ test @"enc-pkg/encoding:cp1250" encString decString+ it "cp1251" $ test @"enc-pkg/encoding:cp1251" encString decString+ it "cp1252" $ test @"enc-pkg/encoding:cp1252" encString decString+ it "cp1253" $ test @"enc-pkg/encoding:cp1253" encString decString+ it "cp1254" $ test @"enc-pkg/encoding:cp1254" encString decString+ it "cp1255" $ test @"enc-pkg/encoding:cp1255" encString decString+ it "cp1256" $ test @"enc-pkg/encoding:cp1256" encString decString+ it "cp1258" $ test @"enc-pkg/encoding:cp1258" encString decString+ it "macintosh" $ test @"enc-pkg/encoding:macintosh" encString decString+ it "jis_x_0201" $ test @"enc-pkg/encoding:jis_x_0201" encString decString+ it "cp437" $ test @"enc-pkg/encoding:cp437" encString decString+ it "cp737" $ test @"enc-pkg/encoding:cp737" encString decString+ it "cp850" $ test @"enc-pkg/encoding:cp850" encString decString+ it "cp852" $ test @"enc-pkg/encoding:cp852" encString decString+ it "cp855" $ test @"enc-pkg/encoding:cp855" encString decString+ it "cp857" $ test @"enc-pkg/encoding:cp857" encString decString+ it "cp860" $ test @"enc-pkg/encoding:cp860" encString decString+ it "cp861" $ test @"enc-pkg/encoding:cp861" encString decString+ it "cp862" $ test @"enc-pkg/encoding:cp862" encString decString+ it "cp863" $ test @"enc-pkg/encoding:cp863" encString decString+ it "cp864" $ test @"enc-pkg/encoding:cp864" encString decString+ it "cp865" $ test @"enc-pkg/encoding:cp865" encString decString+ it "cp866" $ test @"enc-pkg/encoding:cp866" encString decString+ it "cp869" $ test @"enc-pkg/encoding:cp869" encString decString+ it "cp874" $ test @"enc-pkg/encoding:cp874" encString decString + -- /encoding/ package issue, it allows encoding on invalid character that later fails during decode:+ it "cp932" $ test @"enc-pkg/encoding:cp932" encString decString++++spec :: Spec +spec = + describe "Sanity" $ do+ + -- /encoding/ package issue, numerous one-bit encodings encode chars > 255 just fine!+ describe "> xFF expect to fail on onebit" $ + suite OneBit $ expectToFailEnc "\x100"+ describe "> xFF expect to fail on onebit" $ + suite OneBitProblems $ fmap not . expectToFailEnc "\x100"+ describe "succeed on digit 1" $+ suite OneBit $ expectSucceedEnc "1" -- fails on jis_x_0208 + describe "succeed on digit 1" $+ suite OneBitProblems $ expectSucceedEnc "1" ++runSpec :: IO ()+runSpec = hspec spec
+ typed-encoding-encoding.cabal view
@@ -0,0 +1,86 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 1d0bbf4ab8644c4775fdefb85f1315ea44bfd792d71390c2b95688603d3dc7eb++name: typed-encoding-encoding+version: 0.1.0.0+synopsis: Bridge between encoding and typed-encoding packages+description: Please see the README on GitHub at <https://github.com/rpeszek/typed-encoding-encoding#readme>+category: Data, Text+homepage: https://github.com/rpeszek/typed-encoding-encoding#readme+bug-reports: https://github.com/rpeszek/typed-encoding-encoding/issues+author: Robert Peszek+maintainer: robpeszek@gmail.com+copyright: 2020 Robert Peszek+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/rpeszek/typed-encoding-encoding++library+ exposed-modules:+ Data.TypedEncoding.Pkg.Encoding+ Data.TypedEncoding.Pkg.Encoding.Conv+ Data.TypedEncoding.Pkg.Encoding.Instances+ Data.TypedEncoding.Pkg.Encoding.Warn.Instances+ other-modules:+ Paths_typed_encoding_encoding+ hs-source-dirs:+ src+ ghc-options: -fwarn-unused-imports -fwarn-incomplete-patterns -fprint-explicit-kinds+ build-depends:+ base >=4.10 && <5+ , bytestring >=0.10 && <0.11+ , encoding >=0.8.5 && <0.9+ , typed-encoding >=0.4.1 && <0.5+ default-language: Haskell2010++test-suite typed-encoding-encoding-doctest+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_typed_encoding_encoding+ hs-source-dirs:+ doctest+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.10 && <5+ , bytestring >=0.10 && <0.11+ , doctest >=0.16 && <0.17+ , doctest-discover >=0.2 && <0.3+ , encoding >=0.8.5 && <0.9+ , typed-encoding >=0.4 && <0.5+ default-language: Haskell2010++test-suite typed-encoding-encoding-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.SafeDecodingSpec+ Test.SanitySpec+ Paths_typed_encoding_encoding+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.13.1 && <2.14+ , base >=4.10 && <5+ , bytestring >=0.10 && <0.11+ , doctest >=0.16 && <0.17+ , doctest-discover >=0.2 && <0.3+ , encoding >=0.8.5 && <0.9+ , hspec+ , quickcheck-instances >=0.3.20 && <0.4+ , typed-encoding >=0.4.1 && <0.5+ , typed-encoding-encoding+ default-language: Haskell2010