git.iko.soy/typeable/schematic
on union help sign in
typeable/schematic/test/HelpersSpec.hs
124 lines 4.1 kB history raw
1{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
3module HelpersSpec (spec, main) where
5import Control.Lens
6import Data.Aeson
7import Data.ByteString.Char8 as C8
8import Data.ByteString.Lazy as BL
9import Data.ByteString.Lazy.Lens
10import Data.Foldable
11import Data.Functor.Identity
12import Data.Monoid
13import Data.Proxy
14import Data.Schematic
15import Data.Text as T
16import Data.Text.Lens
17import Data.Vinyl
18import Test.Hspec
21type UUIDSchema = 'SchemaObject '[ '("uuid", 'SchemaText IsUUID) ]
23-- | Taken from UUID RFC 4122
24uuid :: Text
25uuid = "f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
27type ISO8601DateSchema = 'SchemaObject '[ '("date", 'SchemaText IsDate) ]
29iso8601dates :: [Text]
30iso8601dates = [ "1985-04-12" ]
32invalidIso8601dates :: [Text]
33invalidIso8601dates = [ "1999-13-12" ]
35type ISO8601TimeSchema = 'SchemaObject '[ '("time", 'SchemaText IsTime) ]
37iso8601times :: [Text]
38iso8601times =
39 [ "19:23:00"
40 , "00:00:00"
41 , "23:47:12" ]
43invalidIso8601times :: [Text]
44invalidIso8601times =
45 [ "00:60:00"
46 , "24:01:02" ]
48type ISO8601DateTimeSchema = 'SchemaObject '[ '("datetime", 'SchemaText IsDateTime) ]
50-- | Taken from ISO8601 RFC 3339
51iso8601datetimes :: [Text]
52iso8601datetimes =
53 iso8601dates <>
54 [ "1985-04-12T23:20:50.52Z"
55 , "1996-12-19T16:39:57-08:00"
56 , "1990-12-31T23:59:60Z"
57 , "1990-12-31T15:59:60-08:00"
58 , "1937-01-01T12:00:27.87+00:20"
59 ]
61invalidIso8601datetimes :: [Text]
62invalidIso8601datetimes =
63 [ "1996-13-129T16:39:57-08:00"
64 , "1990-2-31T23:59:60Z"
65 , "1990-12-32T15:59:70"
66 , "1937-01-1T12::27.87+24:20"
67 ]
69spec :: Spec
70spec = do
71 describe "UUID: " $ do
72 it "validates correct UUID" $ do
73 let
74 uuidJson = "{\"uuid\": \"" <> (uuid ^. unpacked . packedChars) <> "\" }"
75 (decodeAndValidateJson uuidJson :: ParseResult (JsonRepr UUIDSchema))
76 `shouldSatisfy` isValid
78 it "fails to validate incorrect UUID" $ do
79 let
80 incorrectJson = "{\"uuid\": \"incorrect\" }"
81 (decodeAndValidateJson incorrectJson :: ParseResult (JsonRepr UUIDSchema))
82 `shouldSatisfy` isValidationError
84 describe "ISO8601 date: " $ do
85 for_ iso8601dates $ \dt -> do
86 it ("validates correct date - " <> dt ^. unpacked) $ do
87 let json = "{\"date\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
88 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateSchema))
89 `shouldSatisfy` isValid
91 for_ invalidIso8601dates $ \dt -> do
92 it ("fails to validate incorrect date - " <> dt ^. unpacked) $ do
93 let json = "{\"date\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
94 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateSchema))
95 `shouldSatisfy` isValidationError
97 describe "ISO8601 time: " $ do
98 for_ iso8601times $ \dt -> do
99 it ("validates correct time - " <> dt ^. unpacked) $ do
100 let json = "{\"time\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
101 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601TimeSchema))
102 `shouldSatisfy` isValid
104 for_ invalidIso8601times $ \dt -> do
105 it ("fails to validate incorrect time - " <> dt ^. unpacked) $ do
106 let json = "{\"time\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
107 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601TimeSchema))
108 `shouldSatisfy` isValidationError
110 describe "ISO8601 datetime: " $ do
111 for_ iso8601datetimes $ \dt -> do
112 it ("validates correct datetime - " <> dt ^. unpacked) $ do
113 let json = "{\"datetime\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
114 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateTimeSchema))
115 `shouldSatisfy` isValid
117 for_ invalidIso8601datetimes $ \dt -> do
118 it ("fails to validate incorrect datetime - " <> dt ^. unpacked) $ do
119 let json = "{\"datetime\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
120 (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateTimeSchema))
121 `shouldSatisfy` isValidationError
123main :: IO ()
124main = hspec spec