1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
{-# LANGUAGE CPP #-}
module Tests.UTF8
( testTree -- :: TestTree
) where
import Control.DeepSeq
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
#if ! MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import qualified Data.Text.Encoding as T
import Codec.CBOR.Decoding
import Codec.CBOR.Read
import Tests.Util
import Test.Tasty
import Test.Tasty.QuickCheck
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
-- | Wrapper for ByteString with Arbitrary instance that might produce a valid
-- UTF-8 encoding of a string.
newtype MaybeText = MaybeText BS.ByteString
deriving Show
instance Arbitrary MaybeText where
arbitrary = MaybeText . BS.pack <$> arbitrary
-- | Test that decoding of both valid and invalid CBOR strings produces output
-- without exceptions hidden within.
utf8DecodingTest :: MaybeText -> Property
utf8DecodingTest (MaybeText bs) = case T.decodeUtf8' bs of
Right _ -> collect "valid utf8" $ (and splitsOk)
Left _ -> collect "invalid utf8" $ not (or splitsOk)
where
-- We test 2-splits to check all decoder paths.
splitsOk = [ok $ deserialiseFromBytes decodeString v | v <- splits2 s]
where
ok (Right v) = deepseq v True
ok (Left v) = deepseq v False
s = mkLengthPrefix True (Length . fromIntegral $ BS.length bs)
<> BSL.fromStrict bs
----------------------------------------
testTree :: TestTree
testTree = localOption (QuickCheckTests 1000) . testGroup "UTF8" $
[testProperty
"Decoding of UTF8 encoded Text works and properly handles decoding failures" utf8DecodingTest
]
|
