1{-# LANGUAGE QuasiQuotes #-}
2module Hpack.Syntax.DefaultsSpec (spec) where
3
4import           Helper
5
6import           Data.Aeson.Config.FromValueSpec hiding (spec)
7
8import           Data.Aeson.Config.FromValue
9import           Hpack.Syntax.Defaults
10
11defaultsGithub :: String -> String -> String -> [FilePath] -> Defaults
12defaultsGithub owner repo ref path = DefaultsGithub $ Github owner repo ref path
13
14spec :: Spec
15spec = do
16  describe "isValidOwner" $ do
17    it "rejects the empty string" $ do
18      isValidOwner "" `shouldBe` False
19
20    it "accepts valid owner names" $ do
21      isValidOwner "Foo-Bar-23" `shouldBe` True
22
23    it "rejects dots" $ do
24      isValidOwner "foo.bar" `shouldBe` False
25
26    it "rejects multiple consecutive hyphens" $ do
27      isValidOwner "foo--bar" `shouldBe` False
28
29    it "rejects hyphens at the beginning" $ do
30      isValidOwner "-foo" `shouldBe` False
31
32    it "rejects hyphens at the end" $ do
33      isValidOwner "foo-" `shouldBe` False
34
35  describe "isValidRepo" $ do
36    it "rejects the empty string" $ do
37      isValidRepo "" `shouldBe` False
38
39    it "rejects ." $ do
40      isValidRepo "." `shouldBe` False
41
42    it "rejects .." $ do
43      isValidRepo ".." `shouldBe` False
44
45    it "accepts underscores" $ do
46      isValidRepo "foo_bar" `shouldBe` True
47
48    it "accepts dots" $ do
49      isValidRepo "foo.bar" `shouldBe` True
50
51    it "accepts hyphens" $ do
52      isValidRepo "foo-bar" `shouldBe` True
53
54  describe "fromValue" $ do
55    context "when parsing Defaults" $ do
56      let
57        left :: String -> Result Defaults
58        left = Left
59      context "with Object" $ do
60        it "fails when neither github nor local is present" $ do
61          [yaml|
62          defaults:
63            foo: one
64            bar: two
65          library: {}
66          |] `shouldDecodeTo` left "Error while parsing $ - neither key \"github\" nor key \"local\" present"
67
68        it "accepts Defaults from GitHub" $ do
69          [yaml|
70          github: sol/hpack
71          ref: 0.1.0
72          path: defaults.yaml
73          |] `shouldDecodeTo_` defaultsGithub "sol" "hpack" "0.1.0" ["defaults.yaml"]
74
75        it "rejects invalid owner names" $ do
76          [yaml|
77          github: ../hpack
78          ref: 0.1.0
79          path: defaults.yaml
80          |] `shouldDecodeTo` left "Error while parsing $.github - invalid owner name \"..\""
81
82        it "rejects invalid repository names" $ do
83          [yaml|
84          github: sol/..
85          ref: 0.1.0
86          path: defaults.yaml
87          |] `shouldDecodeTo` left "Error while parsing $.github - invalid repository name \"..\""
88
89        it "rejects invalid Git references" $ do
90          [yaml|
91          github: sol/hpack
92          ref: ../foo/bar
93          path: defaults.yaml
94          |] `shouldDecodeTo` left "Error while parsing $.ref - invalid Git reference \"../foo/bar\""
95
96        it "rejects \\ in path" $ do
97          [yaml|
98          github: sol/hpack
99          ref: 0.1.0
100          path: hpack\defaults.yaml
101          |] `shouldDecodeTo` left "Error while parsing $.path - rejecting '\\' in \"hpack\\\\defaults.yaml\", please use '/' to separate path components"
102
103        it "rejects : in path" $ do
104          [yaml|
105          github: sol/hpack
106          ref: 0.1.0
107          path: foo:bar.yaml
108          |] `shouldDecodeTo` left "Error while parsing $.path - rejecting ':' in \"foo:bar.yaml\""
109
110        it "rejects absolute paths" $ do
111          [yaml|
112          github: sol/hpack
113          ref: 0.1.0
114          path: /defaults.yaml
115          |] `shouldDecodeTo` left "Error while parsing $.path - rejecting absolute path \"/defaults.yaml\""
116
117        it "rejects .. in path" $ do
118          [yaml|
119          github: sol/hpack
120          ref: 0.1.0
121          path: ../../defaults.yaml
122          |] `shouldDecodeTo` left "Error while parsing $.path - rejecting \"..\" in \"../../defaults.yaml\""
123
124      context "with String" $ do
125        it "accepts Defaults from GitHub" $ do
126          [yaml|
127          sol/hpack@0.1.0
128          |] `shouldDecodeTo_` defaultsGithub "sol" "hpack" "0.1.0" [".hpack", "defaults.yaml"]
129
130        it "rejects invalid owner names" $ do
131          [yaml|
132          ../hpack@0.1.0
133          |] `shouldDecodeTo` left "Error while parsing $ - invalid owner name \"..\""
134
135        it "rejects invalid repository names" $ do
136          [yaml|
137          sol/..@0.1.0
138          |] `shouldDecodeTo` left "Error while parsing $ - invalid repository name \"..\""
139
140        it "rejects invalid Git references" $ do
141          [yaml|
142          sol/pack@../foo/bar
143          |] `shouldDecodeTo` left "Error while parsing $ - invalid Git reference \"../foo/bar\""
144
145        it "rejects missing Git reference" $ do
146          [yaml|
147          sol/hpack
148          |] `shouldDecodeTo` left "Error while parsing $ - missing Git reference for \"sol/hpack\", the expected format is owner/repo@ref"
149
150      context "with neither Object nor String" $ do
151        it "fails" $ do
152          [yaml|
153          10
154          |] `shouldDecodeTo` left "Error while parsing $ - expected Object or String, but encountered Number"
155