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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{-# LANGUAGE DeriveGeneric #-}
import Control.Applicative
import Control.Monad (forM_, when)
import Control.Monad.IO.Class
import Data.Binary
import Data.Binary.Put
import Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Conduit.Serialization.Binary
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck.Assertions
import Test.QuickCheck.Property
import Test.QuickCheck.Monadic
import Test.QuickCheck
import Control.Monad.Trans.Resource
import GHC.Generics
import Prelude
-- | check conduitEncode =$= conduitDecode == id
prop_eq :: (Binary a,Eq a) => [a] -> Property
prop_eq xs = monadicIO $ do
xs' <- liftIO $ runConduit $ CL.sourceList xs
.| enc xs
.| dec xs
.| CL.consume
assert (xs == xs')
where enc :: (Binary a, MonadThrow m) => [a] -> ConduitT a ByteString m ()
enc _ = conduitEncode
dec :: (Binary a, MonadThrow m) => [a] -> ConduitT ByteString a m ()
dec _ = conduitDecode
prop_sink :: (Binary a,Eq a) => (a,a) -> Property
prop_sink (a,b) = monadicIO $ do
(a',b') <- liftIO $ runConduit $ CL.sourceList [a,b]
.| enc a
.| do a' <- sinkGet get
b' <- CL.consume
return (a',b')
assert $ a == a'
assert $ runPut (put b) == LBS.fromChunks b'
where enc :: (Binary a, MonadThrow m) => a -> ConduitT a ByteString m ()
enc _ = conduitEncode
prop_part2 :: [Int] -> Property
prop_part2 xs = monadicIO $ do
let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs
when (Prelude.length xs>0) $ do
forM_ [0..BS.length m] $ \l -> do
let (l1,l2) = BS.splitAt l m
a <- liftIO $ runConduit $ CL.sourceList [l1,l2]
.| conduitDecode
.| CL.consume
stop (xs ?== a)
prop_part3 :: [Int] -> Property
prop_part3 xs = monadicIO $ do
let m = BS.concat . Prelude.concatMap (LBS.toChunks . runPut . put) $ xs
when (Prelude.length xs>0) $ do
forM_ [1..BS.length m] $ \l -> do
let (l1,l2) = BS.splitAt l m
when (BS.length l2 > 0) $ do
forM_ [1..BS.length l2] $ \l' -> do
let (l2_1,l2_2) = BS.splitAt l' l2
a <- liftIO $ runConduit $ CL.sourceList [l1,l2_1,l2_2]
.| conduitDecode
.| CL.consume
stop $ xs ?== a
data A = A ByteString ByteString deriving (Eq, Show, Generic)
instance Binary A
instance Arbitrary A where
arbitrary = A <$> fmap BS.pack arbitrary
<*> fmap BS.pack arbitrary
prop_eq_plus :: (Binary a, Eq a) => [a] -> Property
prop_eq_plus xs = monadicIO $ do
x <- runConduit $ CL.sourceList xs .| CL.map encode .| CL.map LBS.toStrict .| CL.consume :: PropertyM IO [BS.ByteString]
y <- runConduit $ CL.sourceList xs .| conduitMsgEncode .| CL.consume :: PropertyM IO [BS.ByteString]
stop $ x ?== y :: PropertyM IO ()
main :: IO ()
main = hspec $ do
describe "QC properties: conduitEncode =$= conduitDecode == id" $ do
prop "int" $ (prop_eq :: [Int] -> Property)
prop "string" $ (prop_eq :: [String] -> Property)
prop "maybe int" $ (prop_eq :: [Maybe Int] -> Property)
prop "either int string" $ (prop_eq :: [Either Int String] -> Property)
prop "(Int,Int)" $ (prop_sink :: (Int,Int) -> Property)
prop "(String,String)" $ (prop_sink :: (String,String) -> Property)
prop "A" $ (prop_eq :: [A] -> Property)
describe "QC properties partial lists" $ do
prop "break data in 2 parts" $ (prop_part2)
prop "break data in 3 parts" $ (prop_part3)
describe "QC properites: CL.conduitMsgEncode returns a correct chunks" $ do
prop "int" $ (prop_eq_plus :: [Int] -> Property)
prop "string" $ (prop_eq_plus :: [String] -> Property)
prop "maybe int" $ (prop_eq_plus :: [Maybe Int] -> Property)
prop "either int string" $ (prop_eq_plus :: [Either Int String] -> Property)
prop "A" $ (prop_eq_plus :: [A] -> Property)
describe "HUnit properties:" $ do
it "decodes message splitted to chunks" $ do
let i = -32
l = runPut (put (i::Int))
(l1,l2) = LBS.splitAt (LBS.length l `div` 2) l
t = BS.concat . LBS.toChunks
x <- runConduit $ CL.sourceList [t l1,t l2] .| conduitDecode .| CL.consume
x `shouldBe` [i]
it "decodes message with list of values inside" $ do
let is = [-32,45::Int]
ls = BS.concat . Prelude.concatMap (LBS.toChunks .runPut . put) $ is
(ls1,ls2) = BS.splitAt ((BS.length ls `div` 2) +1) ls
x <- runConduit $ CL.sourceList [ls,ls] .| conduitDecode .| CL.consume
x' <- runConduit $ CL.sourceList [ls1,ls2] .| conduitDecode .| CL.consume
x `shouldBe` is++is
x' `shouldBe` is
|
