1-- Copyright (C) 2010-2012 John Millikin <john@john-millikin.com>
2--
3-- Licensed under the Apache License, Version 2.0 (the "License");
4-- you may not use this file except in compliance with the License.
5-- You may obtain a copy of the License at
6--
7--     http://www.apache.org/licenses/LICENSE-2.0
8--
9-- Unless required by applicable law or agreed to in writing, software
10-- distributed under the License is distributed on an "AS IS" BASIS,
11-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12-- See the License for the specific language governing permissions and
13-- limitations under the License.
14
15module DBusTests.BusName (test_BusName) where
16
17import Data.List (intercalate)
18import Data.Maybe (isJust)
19import Test.QuickCheck
20import Test.Tasty
21import Test.Tasty.HUnit
22import Test.Tasty.QuickCheck
23
24import DBus
25import DBusTests.Util
26
27test_BusName :: TestTree
28test_BusName = testGroup "BusName"
29    [ test_Parse
30    , test_ParseInvalid
31    , test_IsVariant
32    ]
33
34test_Parse :: TestTree
35test_Parse = testProperty "parse" prop where
36    prop = forAll gen_BusName check
37    check x = case parseBusName x of
38        Nothing -> False
39        Just parsed -> formatBusName parsed == x
40
41test_ParseInvalid :: TestTree
42test_ParseInvalid = testCase "parse-invalid" $ do
43    -- empty
44    Nothing @=? parseBusName ""
45
46    -- well-known starting with a digit
47    Nothing @=? parseBusName "foo.0bar"
48
49    -- well-known with one element
50    Nothing @=? parseBusName "foo"
51
52    -- unique with one element
53    Nothing @=? parseBusName ":foo"
54
55    -- trailing characters
56    Nothing @=? parseBusName "foo.bar!"
57
58    -- at most 255 characters
59    assertBool "valid parse failed"
60        $ isJust (parseBusName (":0." ++ replicate 251 'y'))
61    assertBool "valid parse failed"
62        $ isJust (parseBusName (":0." ++ replicate 252 'y'))
63    Nothing @=? parseBusName (":0." ++ replicate 253 'y')
64
65test_IsVariant :: TestTree
66test_IsVariant = testCase "IsVariant" $
67    assertVariant TypeString (busName_ "foo.bar")
68
69gen_BusName :: Gen String
70gen_BusName = oneof [unique, wellKnown] where
71    alpha = ['a'..'z'] ++ ['A'..'Z'] ++ "_-"
72    alphanum = alpha ++ ['0'..'9']
73
74    unique = trim $ do
75        x <- chunks alphanum
76        return (":" ++ x)
77    wellKnown = trim (chunks alpha)
78
79    trim gen = do
80        x <- gen
81        if length x > 255
82            then return (dropWhileEnd (== '.') (take 255 x))
83            else return x
84
85    chunks start = do
86        x <- chunk start
87        xs <- listOf1 (chunk start)
88        return (intercalate "." (x:xs))
89    chunk start = do
90        x <- elements start
91        xs <- listOf (elements alphanum)
92        return (x:xs)
93
94instance Arbitrary BusName where
95    arbitrary = fmap busName_ gen_BusName
96