git.iko.soy/typeable/pagerduty
on develop help sign in
Updating Services API with correct body/query serialisation
commitbc04851d292bcb23147210bc56aa3305d4b25f32 authorBrendan Hay <brendan.g.hay@gmail.com> dateThu 2 Oct 2014, 14:12 (12 years ago) parentea2e9c1
4 files changed+78−73
pagerduty.cabal+6−6 src/Network/PagerDuty/REST/Alerts.hs+2−1 src/Network/PagerDuty/REST/Services.hs+64−64 src/Network/PagerDuty/TH.hs+6−2
pagerduty.cabal+6−6
@@ -30,17 +30,17 @@ library
3030 ghc-options: -Wall
3131
3232 exposed-modules:
33−-- Control.Monad.Trans.PagerDuty
34− -- , Network.PagerDuty.Integration
35− -- , Network.PagerDuty.REST
36−-- Network.PagerDuty.REST.Alerts
33+ Control.Monad.Trans.PagerDuty
34+ , Network.PagerDuty.Integration
35+ , Network.PagerDuty.REST
36+ , Network.PagerDuty.REST.Alerts
3737 -- , Network.PagerDuty.REST.EscalationPolicies
3838 -- , Network.PagerDuty.REST.Incidents
39− Network.PagerDuty.REST.LogEntries
39+ , Network.PagerDuty.REST.LogEntries
4040 -- , Network.PagerDuty.REST.MaintenanceWindows
4141 , Network.PagerDuty.REST.Reports
4242 -- , Network.PagerDuty.REST.Schedules
43− -- , Network.PagerDuty.REST.Services
43+ , Network.PagerDuty.REST.Services
4444 -- , Network.PagerDuty.REST.Users
4545 -- , Network.PagerDuty.REST.Webhooks
4646
src/Network/PagerDuty/REST/Alerts.hs+2−1
@@ -44,6 +44,7 @@ module Network.PagerDuty.REST.Alerts
4444
4545import Control.Lens
4646import Data.Aeson.Lens
47+import Data.Time
4748import Network.PagerDuty.TH
4849import Network.PagerDuty.Types
4950
@@ -117,4 +118,4 @@ laFilter = upd.laFilter'
117118--
118119-- Defaults to account time zone.
119120laTimeZone :: Lens' (Request ListAlerts s r) (Maybe TimeZone)
120−laTimeZone = upd.laTimeZone'._TZ
121+laTimeZone = upd.laTimeZone'.mapping _TZ
src/Network/PagerDuty/REST/Services.hs+64−64
@@ -2,6 +2,7 @@
22{-# LANGUAGE ExtendedDefaultRules #-}
33{-# LANGUAGE OverloadedStrings #-}
44{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE TypeFamilies #-}
56
67{-# OPTIONS_GHC -fno-warn-type-defaults #-}
78
@@ -139,8 +140,7 @@ data IncidentCounts = IncidentCounts
139140 , _cntTotal :: !Int
140141 } deriving (Eq, Show)
141142
142−deriveJSON ''IncidentCounts
143−makeLenses ''IncidentCounts
143+deriveRecord ''IncidentCounts
144144
145145data EmailIncidentCreation
146146 = OnNewEmail
@@ -151,7 +151,7 @@ data EmailIncidentCreation
151151 -- ^ Open a new incident only if an open incident does not already exist.
152152 deriving (Eq, Show)
153153
154−deriveJSON ''EmailIncidentCreation
154+deriveNullary ''EmailIncidentCreation
155155
156156data EmailFilterMode
157157 = AllEmail
@@ -162,7 +162,7 @@ data EmailFilterMode
162162 -- ^ Accept email only if it matches ALL of the rules below
163163 deriving (Eq, Show)
164164
165−deriveJSONWith hyphenated ''EmailFilterMode
165+deriveNullaryWith hyphenated ''EmailFilterMode
166166
167167data ServiceStatus
168168 = Active
@@ -178,7 +178,7 @@ data ServiceStatus
178178 -- ^ The service is disabled and will not have any new triggered incidents.
179179 deriving (Eq, Show)
180180
181−deriveJSON ''ServiceStatus
181+deriveNullary ''ServiceStatus
182182
183183data ServiceType
184184 = CloudKick
@@ -191,15 +191,14 @@ data ServiceType
191191 | SqlMonitor
192192 deriving (Eq, Show)
193193
194−deriveJSON ''ServiceType
194+deriveNullary ''ServiceType
195195
196196data PolicyInfo = PolicyInfo
197197 { _pinfoId :: PolicyId
198198 , _pinfoName :: Text
199199 } deriving (Eq, Show)
200200
201−makeLenses ''PolicyInfo
202−deriveJSON ''PolicyInfo
201+deriveRecord ''PolicyInfo
203202
204203data MatchMode
205204 = Always
@@ -207,7 +206,7 @@ data MatchMode
207206 | NoMatch
208207 deriving (Eq, Show)
209208
210−deriveJSONWith hyphenated ''MatchMode
209+deriveNullaryWith hyphenated ''MatchMode
211210
212211-- FIXME: Tighten up this type! Make the regex required for match/no-match.
213212data EmailFilters = EmailFilters
@@ -271,7 +270,7 @@ data SeverityFilter
271270 -- ^ SQL Monitor: Incidents are created for with high or medium severity
272271 deriving (Eq, Show)
273272
274−deriveJSONWith (dropped 3 underscored) ''SeverityFilter
273+deriveNullaryWith (dropped 3 underscored) ''SeverityFilter
275274
276275data Service = Service
277276 { _svcId :: ServiceId
@@ -321,13 +320,17 @@ makeLens "_svcAutoResolveTimeout" ''Service
321320makeLens "_svcAcknowledgementTimeout" ''Service
322321
323322-- | The date/time when this service was created.
324−makeLens "_svcCreatedAt" ''Service
323+svcCreatedAt :: Lens' Service UTCTime
324+svcCreatedAt = lens _svcCreatedAt (\s x -> s { _svcCreatedAt = x }) . _Date
325325
326326-- | The current state of the Service.
327327makeLens "_svcStatus" ''Service
328328
329329-- | The date/time when the most recent incident was created for this service.
330−makeLens "_svcLastIncidentTimestamp" ''Service
330+svcLastIncidentTimestamp :: Lens' Service (Maybe UTCTime)
331+svcLastIncidentTimestamp =
332+ lens _svcLastIncidentTimestamp
333+ (\s x -> s { _svcLastIncidentTimestamp = x }) . mapping _Date
331334
332335-- | If the service is a Generic Email service, this describes what kind of
333336-- emails create an incident.
@@ -360,8 +363,13 @@ newtype ListServices = ListServices
360363
361364instance Paginate ListServices
362365
363−deriveJSON ''ListServices
364−makeLenses ''ListServices
366+deriveQuery ''ListServices
367+
368+-- | Time zone in which dates in the result will be rendered.
369+--
370+-- Defaults to account default time zone.
371+lsTimeZone :: Lens' (Request ListServices s r) (Maybe TimeZone)
372+lsTimeZone = upd.lsTimeZone'.mapping _TZ
365373
366374-- | List existing services.
367375--
@@ -376,12 +384,6 @@ listServices =
376384 & query .~ includes
377385 & unwrap .~ key "escalation_policies"
378386
379−-- | Time zone in which dates in the result will be rendered.
380−--
381−-- Defaults to account default time zone.
382−lsTimeZone :: Lens' (Request ListServices s r) (Maybe TimeZone)
383−lsTimeZone = upd.lsTimeZone'._TZ
384−
385387data CreateService = CreateService
386388 { _csName' :: Text
387389 , _csEscalationPolicyId' :: PolicyId
@@ -393,30 +395,7 @@ data CreateService = CreateService
393395 , _csSeverityFilter' :: Maybe SeverityFilter
394396 } deriving (Eq, Show)
395397
396−deriveJSON ''CreateService
397−makeLenses ''CreateService
398−
399−-- | Creates a new service.
400−--
401−-- @POST \/services@
402−--
403−-- See: <http://developer.pagerduty.com/documentation/rest/services/create>
404−createService :: Text
405− -> PolicyId
406− -> ServiceType
407− -> Request CreateService s Service
408−createService n p t =
409− mk CreateService
410− { _csName' = n
411− , _csEscalationPolicyId' = p
412− , _csType' = t
413− , _csVendorId' = Nothing
414− , _csDescription' = Nothing
415− , _csAcknowledgementTimeout' = Nothing
416− , _csAutoResolveTimeout' = Nothing
417− , _csSeverityFilter' = Nothing
418− } & path .~ services
419− & unwrap .~ key "service"
398+deriveBody ''CreateService
420399
421400-- | The name of the service.
422401csName :: Lens' (Request CreateService s r) Text
@@ -456,6 +435,28 @@ csAutoResolveTimeout = upd.csAutoResolveTimeout'
456435csSeverityFilter :: Lens' (Request CreateService s r) (Maybe SeverityFilter)
457436csSeverityFilter = upd.csSeverityFilter'
458437
438+-- | Creates a new service.
439+--
440+-- @POST \/services@
441+--
442+-- See: <http://developer.pagerduty.com/documentation/rest/services/create>
443+createService :: Text
444+ -> PolicyId
445+ -> ServiceType
446+ -> Request CreateService s Service
447+createService n p t =
448+ mk CreateService
449+ { _csName' = n
450+ , _csEscalationPolicyId' = p
451+ , _csType' = t
452+ , _csVendorId' = Nothing
453+ , _csDescription' = Nothing
454+ , _csAcknowledgementTimeout' = Nothing
455+ , _csAutoResolveTimeout' = Nothing
456+ , _csSeverityFilter' = Nothing
457+ } & path .~ services
458+ & unwrap .~ key "service"
459+
459460-- | Get details about an existing service.
460461--
461462-- @GET services\/\:id@
@@ -476,26 +477,7 @@ data UpdateService = UpdateService
476477 , _usSeverityFilter' :: Maybe SeverityFilter
477478 } deriving (Eq, Show)
478479
479−deriveJSON ''UpdateService
480−makeLenses ''UpdateService
481−
482−-- | Update an existing service.
483−--
484−-- @PUT services\/\:id@
485−--
486−-- See: <http://developer.pagerduty.com/documentation/rest/services/update>
487−updateService :: ServiceId -> Request UpdateService s Service
488−updateService i =
489− mk UpdateService
490− { _usName' = Nothing
491− , _usEscalationPolicyId' = Nothing
492− , _usDescription' = Nothing
493− , _usAcknowledgementTimeout' = Nothing
494− , _usAutoResolveTimeout' = Nothing
495− , _usSeverityFilter' = Nothing
496− } & meth .~ PUT
497− & path .~ services % i
498− & unwrap .~ key "service"
480+deriveBody ''UpdateService
499481
500482-- | The name of the service.
501483usName :: Lens' (Request UpdateService s r) (Maybe Text)
@@ -526,6 +508,24 @@ usAutoResolveTimeout = upd.usAutoResolveTimeout'
526508usSeverityFilter :: Lens' (Request UpdateService s r) (Maybe SeverityFilter)
527509usSeverityFilter = upd.usSeverityFilter'
528510
511+-- | Update an existing service.
512+--
513+-- @PUT services\/\:id@
514+--
515+-- See: <http://developer.pagerduty.com/documentation/rest/services/update>
516+updateService :: ServiceId -> Request UpdateService s Service
517+updateService i =
518+ mk UpdateService
519+ { _usName' = Nothing
520+ , _usEscalationPolicyId' = Nothing
521+ , _usDescription' = Nothing
522+ , _usAcknowledgementTimeout' = Nothing
523+ , _usAutoResolveTimeout' = Nothing
524+ , _usSeverityFilter' = Nothing
525+ } & meth .~ PUT
526+ & path .~ services % i
527+ & unwrap .~ key "service"
528+
529529-- | Delete an existing service. Once the service is deleted, it will not be
530530-- accessible from the web UI and new incidents won't be able to be created
531531-- for this service.
src/Network/PagerDuty/TH.hs+6−2
@@ -14,6 +14,7 @@ module Network.PagerDuty.TH
1414 (
1515 -- * Compound expressions
1616 deriveNullary
17+ , deriveNullaryWith
1718 , deriveRecord
1819 , deriveQuery
1920 , deriveBody
@@ -49,8 +50,11 @@ import Network.PagerDuty.Generics
4950import Network.PagerDuty.Options
5051
5152deriveNullary :: Name -> Q [Dec]
52−deriveNullary n = concat <$> sequence
53− [ deriveJSON n
53+deriveNullary = deriveNullaryWith underscored
54+
55+deriveNullaryWith :: Options -> Name -> Q [Dec]
56+deriveNullaryWith o n = concat <$> sequence
57+ [ deriveJSONWith o n
5458 , [d|instance QueryValueLike $(conT n) where toQueryValue = value . toJSON|]
5559 ]
5660