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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
{-# OPTIONS -fno-warn-orphans #-}
import Test.QuickCheck
(Gen, Arbitrary (..), choose, oneof)
import Test.QuickCheck.Simple (defaultMain, Test, qcTest)
import Control.Applicative ((<$>), (<*>))
import Control.Monad (replicateM)
import Data.Maybe (fromJust)
import Data.List (isPrefixOf, isSuffixOf)
import Data.Word (Word8, Word16)
import Data.PostgreSQL.NetworkAddress
import Database.PostgreSQL.Parser (Parser, evalParser)
import qualified Database.PostgreSQL.Parser as Parser
import Database.PostgreSQL.Printer (Printer, execPrinter)
import qualified Database.PostgreSQL.Printer as Printer
instance Arbitrary V4HostAddress where
arbitrary =
V4HostAddress
<$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary V6HostAddress where
arbitrary =
V6HostAddress
<$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
mask4 :: Gen Word8
mask4 = choose (0, 32)
mask6 :: Gen Word8
mask6 = choose (0, 128)
newtype A6Input =
A6Input [Word16]
deriving (Eq, Show)
instance Arbitrary A6Input where
arbitrary= A6Input <$> (choose (0, 8) >>= (`replicateM` arbitrary))
instance Arbitrary NetAddress where
arbitrary =
oneof
[ NetAddress4 <$> arbitrary <*> mask4
, NetAddress6 <$> arbitrary <*> mask6 ]
instance Arbitrary Cidr where
arbitrary =
oneof
[ fromJust <$> (cidr4' <$> arbitrary <*> mask4)
, fromJust <$> (cidr6' <$> arbitrary <*> mask6) ]
isoProp :: Eq a => Printer a -> Parser a -> a -> Bool
isoProp pr ps a =
Right a == (evalParser ps $ execPrinter pr a)
prop_v4HostAddressIso :: V4HostAddress -> Bool
prop_v4HostAddressIso =
isoProp Printer.v4HostAddress Parser.v4HostAddress
prop_v6HostAddressIso :: V6HostAddress -> Bool
prop_v6HostAddressIso =
isoProp Printer.v6HostAddress Parser.v6HostAddress
prop_v6HostAddressDcIsoL :: V6HostAddress -> Bool
prop_v6HostAddressDcIsoL a6 =
v6HostAddress [w0, w1, w2, w3, w4, w5, w6, w7] [] == Just a6
where
(w0, w1, w2, w3, w4, w5, w6, w7) = v6HostAddressWords a6
prop_v6HostAddressDcIsoR :: V6HostAddress -> Bool
prop_v6HostAddressDcIsoR a6 =
v6HostAddress [] [w0, w1, w2, w3, w4, w5, w6, w7] == Just a6
where
(w0, w1, w2, w3, w4, w5, w6, w7) = v6HostAddressWords a6
prop_v6HostAddressCons :: A6Input -> A6Input -> Bool
prop_v6HostAddressCons (A6Input il) (A6Input ir) = case v6HostAddress il ir of
Nothing -> length (il ++ ir) > 8
Just (V6HostAddress w0 w1 w2 w3 w4 w5 w6 w7)
| let ws = [w0, w1, w2, w3, w4, w5, w6, w7] ->
length (il ++ ir) <= 8 && il `isPrefixOf` ws && ir `isSuffixOf` ws
prop_netAddressPpIso :: NetAddress -> Bool
prop_netAddressPpIso =
isoProp Printer.netAddress Parser.netAddress
prop_netAddressDcIso :: NetAddress -> Bool
prop_netAddressDcIso na = dc == Just na where
dc = case na of
NetAddress4 a4 m -> netAddress4 a4 m
NetAddress6 a6 m -> netAddress6 a6 m
prop_netAddress4Cons :: V4HostAddress -> Word8 -> Bool
prop_netAddress4Cons a4 m = case netAddress4 a4 m of
Nothing -> m > 32
Just (NetAddress4 a4' m') -> a4 == a4' && m == m'
Just (NetAddress6 {}) -> False
prop_netAddress6Cons :: V6HostAddress -> Word8 -> Bool
prop_netAddress6Cons a6 m = case netAddress6 a6 m of
Nothing -> m > 128
Just (NetAddress4 {}) -> False
Just (NetAddress6 a6' m') -> a6 == a6' && m == m'
prop_cidrDcIso :: Cidr -> Bool
prop_cidrDcIso cidr@(Cidr na) = dc == Just cidr where
dc = case na of
NetAddress4 a4 m -> cidr4 a4 m
NetAddress6 a6 m -> cidr6 a6 m
prop_cidr4Cons :: V4HostAddress -> Word8 -> Bool
prop_cidr4Cons a4 m = case cidr4 a4 m of
Nothing -> m > 32 ||
case cidr4' a4 m of
Nothing -> False
Just (Cidr (NetAddress4 a4' m')) -> m' == m && a4' /= a4
Just (Cidr (NetAddress6 {})) -> False
Just (Cidr (NetAddress4 a4' m')) -> m' == m && a4' == a4
Just (Cidr (NetAddress6 {})) -> False
prop_cidr6Cons :: V6HostAddress -> Word8 -> Bool
prop_cidr6Cons a6 m = case cidr6 a6 m of
Nothing -> m > 128 ||
case cidr6' a6 m of
Nothing -> False
Just (Cidr (NetAddress4 {})) -> False
Just (Cidr (NetAddress6 a6' m')) -> m' == m && a6' /= a6
Just (Cidr (NetAddress4 {})) -> False
Just (Cidr (NetAddress6 a6' m')) -> m' == m && a6' == a6
tests :: [Test]
tests =
[ qcTest "v4 address iso - print parse" prop_v4HostAddressIso
, qcTest "v6 address iso - print parse" prop_v6HostAddressIso
, qcTest "v6 address iso - destruct construct-left" prop_v6HostAddressDcIsoL
, qcTest "v6 address iso - destruct construct-right" prop_v6HostAddressDcIsoR
, qcTest "v6 address construction" prop_v6HostAddressCons
, qcTest "network address iso - print parse" prop_netAddressPpIso
, qcTest "network address iso - destruct construct" prop_netAddressDcIso
, qcTest "network address 4 construction" prop_netAddress4Cons
, qcTest "network address 6 construction" prop_netAddress6Cons
, qcTest "cidr iso - destruct construct" prop_cidrDcIso
, qcTest "cidr-4 construction" prop_cidr4Cons
, qcTest "cidr-6 construction" prop_cidr6Cons
]
main :: IO ()
main = defaultMain tests
|
