@@ -57,28 +57,21 @@ import Data.Aeson.Types (Parser)
5757import Data.ByteString (ByteString)
5858import qualified Data.ByteString.Char8 as BS
5959import Data.ByteString.Conversion
60−import Data.Function
60+import Data.Default
6161import qualified Data.HashMap.Strict as Map
6262import Data.Monoid
6363import Data.String
6464import Data.Text (Text)
65−import qualified Data.Time as Time
66−import Data.Time hiding (TimeZone)
65+import qualified Data.Text.Encoding as Text
66+import Data.Time
6767import GHC.TypeLits
6868import Network.HTTP.Types
6969import Network.HTTP.Types.QueryLike
7070import Network.PagerDuty.TH
71+import System.Locale
7172
72−-- FIXME: Query String parameters vs JSON bodies for GET
73−
74−-- FIXME: UTCTime: http://developer.pagerduty.com/documentation/rest/types#datetime
75−newtype Date = Date { unDate :: ZonedTime }
76− deriving (Show)
77−
78−instance Eq Date where
79− (Date a) == (Date b) =
80− on (==) zonedTimeToLocalTime a b
81− || on (==) zonedTimeZone a b
73+newtype Date = Date { unDate :: UTCTime }
74+ deriving (Eq, Ord, Show)
8275
8376instance FromJSON Date where
8477 parseJSON = fmap Date . parseJSON
@@ -86,22 +79,38 @@ instance FromJSON Date where
8679instance ToJSON Date where
8780 toJSON = toJSON . unDate
8881
89−newtype TimeZone = TimeZone { unTZ :: Time.TimeZone }
82+instance ToByteString Date where
83+ builder = builder
84+ . formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ")
85+ . unDate
86+
87+instance QueryValueLike Date where
88+ toQueryValue = Just . toByteString'
89+
90+newtype TZ = TZ { unTZ :: TimeZone }
9091 deriving (Eq, Ord, Show)
9192
92−instance FromJSON TimeZone where
93+instance FromJSON TZ where
9394 parseJSON = undefined
9495
95−instance ToJSON TimeZone where
96− toJSON = undefined
96+instance ToJSON TZ where
97+ toJSON = toJSON . Text.decodeUtf8 . toByteString'
98+
99+instance ToByteString TZ where
100+ builder = builder . timeZoneName . unTZ
97101
98−data Security = Basic | Token -- None
102+instance QueryValueLike TZ where
103+ toQueryValue = Just . toByteString'
104+
105+instance Default TZ where
106+ def = TZ utc
107+
108+data Security = Basic | Token
99109 deriving (Eq, Show)
100110
101111data Auth (a :: Security) where
102112 AuthBasic :: ByteString -> ByteString -> Auth Basic
103113 AuthToken :: ByteString -> Auth Token
104−-- AuthNone :: Auth None
105114
106115deriving instance Eq (Auth a)
107116deriving instance Show (Auth a)
@@ -145,8 +154,7 @@ data IntegrationError = IntegrationError
145154 , _ieErrors :: [Text]
146155 } deriving (Eq, Show)
147156
148−deriveJSON ''IntegrationError
149−makeLenses ''IntegrationError
157+deriveRecord ''IntegrationError
150158
151159data RestError = RestError
152160 { _reCode :: Code
@@ -154,8 +162,7 @@ data RestError = RestError
154162 , _reErrors :: [Text]
155163 } deriving (Eq, Show)
156164
157−deriveJSON ''RestError
158−makeLenses ''RestError
165+deriveRecord ''RestError
159166
160167data Error
161168 = Internal String
@@ -228,43 +235,43 @@ renderPath = toByteString' . mappend v1
228235 v1 = "/api/v1"
229236
230237data Request a (s :: Security) b where
231− Request :: ToJSON a
232− => { _rqPayload :: a
233− , _rqMethod :: !StdMethod
234− , _rqPath :: Path
235− , _rqQuery :: Query
236− , _rqPager :: Maybe Pager
237− , _rqUnwrap :: Value -> Parser Value
238+ Request :: (QueryLike a, ToJSON a)
239+ => { _rqMeth :: !StdMethod
240+ , _rqPath :: Path
241+ , _rqQuery :: Query
242+ , _rqBody :: a
243+ , _rqPager :: Maybe Pager
244+ , _rqUnwrap :: Value -> Parser Value
238245 }
239246 -> Request a s b
240247
241248instance ToJSON (Request a s b) where
242249 -- Manually unwrapped to ensure GADT constraint holds.
243− toJSON (Request p _ _ _ q _) = Object $
244− let Object x = toJSON p
245− in case toJSON q of
250+ toJSON (Request _ _ _ b p _) = Object $
251+ let Object x = toJSON b
252+ in case toJSON p of
246253 (Object y) -> x <> y
247254 _ -> x
248255
249256type Unwrap = Getting (First Value) Value Value
250257
251258-- | Create a defaulted request from the payload type.
252−mk :: ToJSON a => a -> Request a s b
253−mk x = Request x GET mempty mempty Nothing pure
259+mk :: (QueryLike a, ToJSON a) => a -> Request a s b
260+mk x = Request GET mempty mempty x Nothing pure
254261
255262empty :: Request Empty s r
256263empty = mk Empty
257264
258−-- | Modify the request state.
259−upd :: ToJSON a => Lens' (Request a s b) a
260−upd = lens _rqPayload (\(Request _ m p q g u) x -> Request x m p q g u)
265+-- | Lens into the body of a request.
266+upd :: (QueryLike a, ToJSON a) => Lens' (Request a s b) a
267+upd = lens _rqBody (\(Request m p q _ g u) x -> Request m p q x g u)
261268
262269-- | Drop the security constraint.
263270auth :: Request a s b -> Request a t b
264271auth (Request x m p q g u) = Request x m p q g u
265272
266273meth :: Lens' (Request a s b) StdMethod
267−meth = lens _rqMethod (\r x -> r { _rqMethod = x })
274+meth = lens _rqMeth (\r x -> r { _rqMeth = x })
268275
269276path :: Lens' (Request a s b) Path
270277path = lens _rqPath (\r x -> r { _rqPath = x })
@@ -293,15 +300,15 @@ class Paginate a where
293300newtype Key (a :: Symbol) = Key Text
294301 deriving (Eq, Show, IsString)
295302
296−instance ToByteString (Key a) where
297− builder (Key k) = builder k
298−
299303instance FromJSON (Key a) where
300304 parseJSON = withText "key" (return . Key)
301305
302306instance ToJSON (Key a) where
303307 toJSON (Key k) = toJSON k
304308
309+instance ToByteString (Key a) where
310+ builder (Key k) = builder k
311+
305312instance QueryValueLike (Key a) where
306313 toQueryValue = Just . toByteString'
307314
@@ -311,15 +318,15 @@ type IncidentKey = Key "incident"
311318newtype Id (a :: Symbol) = Id Text
312319 deriving (Eq, Show, IsString)
313320
314−instance ToByteString (Id a) where
315− builder (Id i) = builder i
316−
317321instance FromJSON (Id a) where
318322 parseJSON = withText "id" (return . Id)
319323
320324instance ToJSON (Id a) where
321325 toJSON (Id i) = toJSON i
322326
327+instance ToByteString (Id a) where
328+ builder (Id i) = builder i
329+
323330instance QueryValueLike (Id a) where
324331 toQueryValue = Just . toByteString'
325332
@@ -345,37 +352,25 @@ instance FromJSON Empty where
345352 f !o | Map.null o = pure Empty
346353 | otherwise = fail "Unexpected non-empty JSON object."
347354
348−newtype Email = Email Text
349− deriving (Eq, Show, IsString)
350−
351−deriveJSON ''Email
352−
353−newtype Phone = Phone Text
354− deriving (Eq, Show, IsString)
355−
356−deriveJSON ''Phone
355+instance QueryLike Empty where
356+ toQuery = const []
357357
358−data Address
359− = AddrEmail Email
360− | AddrPhone Phone
361− deriving (Eq, Show)
358+newtype Address = Address Text
359+ deriving (Eq, Show)
362360
363−instance FromJSON Address where
364− parseJSON o =
365− AddrEmail <$> parseJSON o
366− <|> AddrPhone <$> parseJSON o
361+deriveJSON ''Address
367362
368−instance ToJSON Address where
369− toJSON (AddrEmail e) = toJSON e
370− toJSON (AddrPhone p) = toJSON p
363+instance ToByteString Address where
364+ builder (Address a) = builder a
371365
372−makePrisms ''Address
366+instance QueryValueLike Address where
367+ toQueryValue = Just . toByteString'
373368
374369data User = User
375370 { _userId :: UserId
376371 , _userName :: Text
377− , _userEmail :: Email
378− , _userTimeZone :: TimeZone
372+ , _userEmail :: Address
373+ , _userTimeZone :: TZ
379374 , _userColor :: Text
380375 , _userRole :: Text
381376 , _userAvatarUrl :: Text
@@ -383,5 +378,4 @@ data User = User
383378 , _userInvitationSent :: Bool
384379 } deriving (Eq, Show)
385380
386−deriveJSON ''User
387−makeLenses ''User
381+deriveRecord ''User