031ad05 · typeable/pagerduty

git.iko.soy/typeable/pagerduty

Adding MaintenanceWindows and custom query serialisation

This ensure arrays are correctly serialised in the format <key>[]=

commit031ad052c03daba3ef0ae82712dc981019de4506 authorBrendan Hay <brendan.g.hay@gmail.com> dateThu 2 Oct 2014, 17:59 (12 years ago) parentb4e24f6

12 files changed+521−164

compare with develop

unifiedsplit

pagerduty.cabal+6−5

@@ -37,18 +37,17 @@ library

3737 , Network.PagerDuty.REST.EscalationPolicies

3838 -- , Network.PagerDuty.REST.Incidents

3939 , Network.PagerDuty.REST.LogEntries

40− -- , Network.PagerDuty.REST.MaintenanceWindows

40+ , 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

47−

4847 other-modules:

49− Network.PagerDuty.Generics

50− , Network.PagerDuty.IO

48+ Network.PagerDuty.IO

5149 , Network.PagerDuty.Options

50+ , Network.PagerDuty.Query

5251 , Network.PagerDuty.TH

5352 , Network.PagerDuty.Types

5453

@@ -56,6 +55,8 @@ library

5655 aeson > 0.7 && <= 8.0

5756 , base >= 4.5 && < 5.0

5857-- , base64-bytestring >= 1.0 && < 1.1

58+ , bifunctors

59+

5960 , bytestring >= 0.9 && < 1.0

6061 , bytestring-conversion >= 0.2.1

6162 , conduit >= 0.5.5

src/Network/PagerDuty/Generics.hsdeleted−81

@@ -1,81 +0,0 @@

1−{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE GADTs #-}

3−{-# LANGUAGE OverloadedStrings #-}

4−{-# LANGUAGE ScopedTypeVariables #-}

5−{-# LANGUAGE TupleSections #-}

6−

7−-- Module : Network.PagerDuty.Generics

9−-- License : This Source Code Form is subject to the terms of

10−-- the Mozilla Public License, v. 2.0.

11−-- A copy of the MPL can be found in the LICENSE file or

12−-- you can obtain it at http://mozilla.org/MPL/2.0/.

13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

14−-- Stability : experimental

15−-- Portability : non-portable (GHC extensions)

16−

17−module Network.PagerDuty.Generics

18− ( gquery

19− , gqueryWith

20− ) where

21−

22−import Data.Aeson.Types

23−import Data.ByteString (ByteString)

24−import qualified Data.ByteString.Char8 as BS

25−import Generics.SOP

26−import Network.HTTP.Types

27−import Network.HTTP.Types.QueryLike

28−import Network.PagerDuty.Options

29−

30−gquery :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValueLike (Code a))

31− => a

32− -> Query

33−gquery = gqueryWith underscored

34−

35−gqueryWith :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValueLike (Code a))

36− => Options

37− -> a

38− -> Query

39−gqueryWith o a = case datatypeInfo (Proxy :: Proxy a) of

40− ADT _ _ cs -> go cs (from a)

41− Newtype _ _ c -> go (c :* Nil) (from a)

42− where

43− go :: (All2 QueryValueLike xss, SingI xss)

44− => NP ConstructorInfo xss

45− -> SOP I xss

46− -> Query

47− go cs (SOP sop) = unI . hcollapse $ hcliftA2' p (gctor o) cs sop

48−

49−gctor :: All QueryValueLike xs

50− => Options

51− -> ConstructorInfo xs

52− -> NP I xs

53− -> K Query xs

54−gctor o (Constructor n) args =

55− K . hcollapse $ hcliftA p (K . (k,) . toQueryValue . unI) args

56− where

57− k = BS.pack $ (constructorTagModifier o) n

58−

59−gctor o (Record _ ns) args =

60− K . hcollapse $ hcliftA2 p (gfield o) ns args

61−

62−gctor o (Infix n _ _) (x :* y :* Nil) =

63− K [ (k, toQueryValue (unI x))

64− , (k, toQueryValue (unI y))

65− ]

66− where

67− k = BS.pack $ (constructorTagModifier o) n

68−

69−gctor _ (Infix _ _ _) _ =

70− error "Network.PagerDuty.Generics.inaccessible"

71−

72−gfield :: QueryValueLike a

73− => Options

74− -> FieldInfo a

75− -> I a

76− -> K (ByteString, Maybe ByteString) a

77−gfield o (FieldInfo f) (I a) =

78− K (BS.pack $ (fieldLabelModifier o) f, toQueryValue a)

79−

80−p :: Proxy QueryValueLike

81−p = Proxy

src/Network/PagerDuty/Query.hsnew file+109

@@ -0,0 +1,109 @@

1+{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE DefaultSignatures #-}

3+{-# LANGUAGE GADTs #-}

4+{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

6+{-# LANGUAGE TupleSections #-}

8+-- Module : Network.PagerDuty.Query

10+-- License : This Source Code Form is subject to the terms of

11+-- the Mozilla Public License, v. 2.0.

12+-- A copy of the MPL can be found in the LICENSE file or

13+-- you can obtain it at http://mozilla.org/MPL/2.0/.

14+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

15+-- Stability : experimental

16+-- Portability : non-portable (GHC extensions)

17+

18+module Network.PagerDuty.Query

19+ ( ToQuery (..)

20+ , gquery

21+ , gqueryWith

22+ ) where

23+

24+import Data.Aeson.Types

25+import Data.Bifunctor

26+import Data.ByteString (ByteString)

27+import qualified Data.ByteString.Char8 as BS

28+import Data.ByteString.Conversion

29+import Data.Function (on)

30+import Data.List (groupBy)

31+import Data.Monoid ((<>))

32+import Data.Text (Text)

33+import qualified Data.Text.Encoding as Text

34+import Generics.SOP

35+import Network.HTTP.Types

36+import Network.PagerDuty.Options

37+

38+class ToQuery a where

39+ queryValues :: a -> [ByteString]

40+

41+ default queryValues :: ToByteString a => a -> [ByteString]

42+ queryValues = (:[]) . toByteString'

43+

44+instance ToQuery a => ToQuery (Maybe a) where

45+ queryValues (Just x) = queryValues x

46+ queryValues Nothing = []

47+

48+instance ToQuery Text where

49+ queryValues x = [Text.encodeUtf8 x]

50+

51+gquery :: forall a. (Generic a, HasDatatypeInfo a, All2 ToQuery (Code a))

52+ => a

53+ -> Query

54+gquery = gqueryWith underscored

55+

56+gqueryWith :: forall a. (Generic a, HasDatatypeInfo a, All2 ToQuery (Code a))

57+ => Options

58+ -> a

59+ -> Query

60+gqueryWith o a = case datatypeInfo (Proxy :: Proxy a) of

61+ ADT _ _ cs -> go cs (from a)

62+ Newtype _ _ c -> go (c :* Nil) (from a)

63+ where

64+ go :: (All2 ToQuery xss, SingI xss)

65+ => NP ConstructorInfo xss

66+ -> SOP I xss

67+ -> Query

68+ go cs (SOP sop) = group . unI . hcollapse $ hcliftA2' p (gctor o) cs sop

69+

70+ group :: [(ByteString, ByteString)] -> Query

71+ group = concatMap f . groupBy ((==) `on` fst)

72+ where

73+ f [] = []

74+ f [(k, v)] = [(k, Just v)]

75+ f xs@((k,_):_) = let n = k <> "[]" in map (bimap (const n) Just) xs

76+

77+gctor :: All ToQuery xs

78+ => Options

79+ -> ConstructorInfo xs

80+ -> NP I xs

81+ -> K [(ByteString, ByteString)] xs

82+gctor o (Constructor n) args =

83+ K . concat . hcollapse $ hcliftA p (K . map (k,) . queryValues . unI) args

84+ where

85+ k = BS.pack $ (constructorTagModifier o) n

86+

87+gctor o (Record _ ns) args =

88+ K . concat . hcollapse $ hcliftA2 p (gfield o) ns args

89+

90+gctor o (Infix n _ _) (x :* y :* Nil) =

91+ K $ map (k,) (queryValues (unI x) ++ queryValues (unI y))

92+ where

93+ k = BS.pack $ (constructorTagModifier o) n

94+

95+gctor _ (Infix _ _ _) _ =

96+ error "Network.PagerDuty.Generics.inaccessible"

97+

98+gfield :: ToQuery a

99+ => Options

100+ -> FieldInfo a

101+ -> I a

102+ -> K [(ByteString, ByteString)] a

103+gfield o (FieldInfo f) (I a) =

104+ K $ map (k,) (queryValues a)

105+ where

106+ k = BS.pack $ (fieldLabelModifier o) f

107+

108+p :: Proxy ToQuery

109+p = Proxy

src/Network/PagerDuty/REST/Alerts.hs+7−6

@@ -46,6 +46,7 @@ module Network.PagerDuty.REST.Alerts

4646import Control.Lens

4747import Data.Aeson.Lens

4848import Data.Time

49+import Network.PagerDuty.REST.Users (User)

4950import Network.PagerDuty.TH

5051import Network.PagerDuty.Types

5152

@@ -101,22 +102,22 @@ listAlerts s u =

101102 & unwrap .~ key "alerts"

102103

103104-- | The start of the date range over which you want to search.

104−laSince :: Lens' (Request ListAlerts s r) UTCTime

105−laSince = upd.laSince'._Date

105+laSince :: Lens' (Request ListAlerts s b) UTCTime

106+laSince = upd.laSince'._D

106107

107108-- | The end of the date range over which you want to search.

108109-- This should be in the same format as 'since'.

109110--

110111-- The size of the date range must be less than 3 months.

111−laUntil :: Lens' (Request ListAlerts s r) UTCTime

112−laUntil = upd.laUntil'._Date

112+laUntil :: Lens' (Request ListAlerts s b) UTCTime

113+laUntil = upd.laUntil'._D

113114

114115-- | Returns only the alerts of the said 'AlertType' type.

115−laFilter :: Lens' (Request ListAlerts s r) (Maybe AlertType)

116+laFilter :: Lens' (Request ListAlerts s b) (Maybe AlertType)

116117laFilter = upd.laFilter'

117118

118119-- | Time zone in which dates in the result will be rendered.

119120--

120121-- Defaults to account time zone.

121−laTimeZone :: Lens' (Request ListAlerts s r) (Maybe TimeZone)

122+laTimeZone :: Lens' (Request ListAlerts s b) (Maybe TimeZone)

122123laTimeZone = upd.laTimeZone'.mapping _TZ

src/Network/PagerDuty/REST/EscalationPolicies.hs+9−9

@@ -206,7 +206,7 @@ deriveQuery ''ListPolicies

206206

207207-- | Filters the result, showing only the escalation policies

208208-- whose names match the query.

209−lpQuery :: Lens' (Request ListPolicies s r) (Maybe Text)

209+lpQuery :: Lens' (Request ListPolicies s b) (Maybe Text)

210210lpQuery = upd.lpQuery'

211211

212212-- | List all the existing escalation policies.

@@ -231,22 +231,22 @@ data CreatePolicy = CreatePolicy

231231deriveBody ''CreatePolicy

232232

233233-- | The name of the escalation policy.

234−cpName :: Lens' (Request CreatePolicy s r) Text

234+cpName :: Lens' (Request CreatePolicy s b) Text

235235cpName = upd.cpName'

236236

237237-- | Whether or not to allow this policy to repeat its escalation

238238-- rules after the last rule is finished.

239239--

240240-- Defaults to false.

241−cpRepeatEnabled :: Lens' (Request CreatePolicy s r) Bool

241+cpRepeatEnabled :: Lens' (Request CreatePolicy s b) Bool

242242cpRepeatEnabled = upd.cpRepeatEnabled'._B

243243

244244-- | The number of times to loop over the set of rules in this escalation policy.

245−cpNumLoops :: Lens' (Request CreatePolicy s r) (Maybe Int)

245+cpNumLoops :: Lens' (Request CreatePolicy s b) (Maybe Int)

246246cpNumLoops = upd.cpNumLoops'

247247

248248-- | The escalation rules for this policy.

249−cpEscalationRules :: Lens' (Request CreatePolicy s r) [Rule]

249+cpEscalationRules :: Lens' (Request CreatePolicy s b) [Rule]

250250cpEscalationRules = upd.cpEscalationRules'

251251

252252-- | Creates an existing escalation policy and rules.

@@ -286,20 +286,20 @@ data UpdatePolicy = UpdatePolicy

286286deriveBody ''UpdatePolicy

287287

288288-- | The name of the escalation policy.

289−upName :: Lens' (Request UpdatePolicy s r) (Maybe Text)

289+upName :: Lens' (Request UpdatePolicy s b) (Maybe Text)

290290upName = upd.upName'

291291

292292-- | Whether or not to allow this policy to repeat its escalation

293293-- rules after the last rule is finished.

294−upRepeatEnabled :: Lens' (Request UpdatePolicy s r) (Maybe Bool)

294+upRepeatEnabled :: Lens' (Request UpdatePolicy s b) (Maybe Bool)

295295upRepeatEnabled = upd.upRepeatEnabled'.mapping _B

296296

297297-- | The number of times to loop over the set of rules in this escalation policy.

298−upNumLoops :: Lens' (Request UpdatePolicy s r) (Maybe Int)

298+upNumLoops :: Lens' (Request UpdatePolicy s b) (Maybe Int)

299299upNumLoops = upd.upNumLoops'

300300

301301-- | The escalation rules for this policy.

302−upEscalationRules :: Lens' (Request UpdatePolicy s r) [Rule]

302+upEscalationRules :: Lens' (Request UpdatePolicy s b) [Rule]

303303upEscalationRules = upd.upEscalationRules'

304304

305305-- | Updates an existing escalation policy and rules.

src/Network/PagerDuty/REST/LogEntries.hs+3−3

@@ -402,7 +402,7 @@ deriveRecord ''NotifyEntry

402402

403403-- | Time at which the log entry was created

404404neCreatedAt :: Lens' NotifyEntry UTCTime

405−neCreatedAt = neCreatedAt'._Date

405+neCreatedAt = neCreatedAt'._D

406406

407407-- | User who was notified

408408neUser :: Lens' NotifyEntry User

@@ -441,11 +441,11 @@ llTimeZone = upd.llTimeZone'._TZ

441441

442442-- | The start of the date range over which you want to search.

443443llSince :: Lens' (Request ListLogs s b) (Maybe UTCTime)

444−llSince = upd.llSince'.mapping _Date

444+llSince = upd.llSince'.mapping _D

445445

446446-- | The end of the date range over which you want to search.

447447llUntil :: Lens' (Request ListLogs s b) (Maybe UTCTime)

448−llUntil = upd.llUntil'.mapping _Date

448+llUntil = upd.llUntil'.mapping _D

449449

450450-- | If true, will only return log entries of type trigger, acknowlldge, or resolve.

451451--

src/Network/PagerDuty/REST/MaintenanceWindows.hs+267−2

@@ -1,5 +1,7 @@

1+{-# LANGUAGE DataKinds #-}

12{-# LANGUAGE OverloadedStrings #-}

23{-# LANGUAGE TemplateHaskell #-}

4+{-# LANGUAGE TypeFamilies #-}

46-- Module : Network.PagerDuty.REST.MaintenanceWindows

@@ -15,8 +17,271 @@

1517-- during which no incidents will be created.

1618module Network.PagerDuty.REST.MaintenanceWindows

1719 (

20+ -- * List Windows

21+ ListWindows

22+ , listWindows

23+ , lwQuery

24+ , lwServiceIds

25+ , lwFilter

1826

27+ , ListwindowsResponse

28+ , lwMatenanceWindows

29+ , lwCounts

30+

31+ -- * Create Window

32+ , CreateWindow

33+ , createWindow

34+ , createWindowBasic

35+ , cwStartTime

36+ , cwEndTime

37+ , cwDescription

38+ , cwServiceIds

39+

40+ -- * Get Window

41+ , getWindow

42+

43+ -- * Update Window

44+ , UpdateWindow

45+ , updateWindow

46+ , uwStartTime

47+ , uwEndTime

48+ , uwDescription

49+ , uwServiceIds

50+

51+ -- * Delete Window

52+ , deleteWindow

53+

54+ -- * Types

55+ , ServiceInfo

56+ , siId

57+ , siName

58+ , siUrl

59+

60+ , Counts

61+ , cOngoing

62+ , cFuture

63+ , cPast

64+ , cAll

65+

66+ , MaintenanceWindow

67+ , mwSequenceNumber

68+ , mwStartTime

69+ , mwEndTime

70+ , mwDescription

71+ , mwCreatedBy

72+ , mwServices

1973 ) where

2074

21−maintenance :: Path

22−maintenance = "maintenance_windows"

75+import Control.Lens

76+import Data.Monoid

77+import Data.Text (Text)

78+import Data.Time

79+import Network.HTTP.Types

80+import Network.PagerDuty.REST.Users (User)

81+import Network.PagerDuty.TH

82+import Network.PagerDuty.Types

83+

84+windows :: Path

85+windows = "maintenance_windows"

86+

87+data ServiceInfo = ServiceInfo

88+ { _siId :: ServiceId

89+ , _siName :: Text

90+ , _siUrl :: Text

91+ } deriving (Eq, Show)

92+

93+deriveRecord ''ServiceInfo

94+

95+data MaintenanceWindow = MaintenanceWindow

96+ { _mwSequenceNumber :: !Int

97+ , _mwStartTime :: Date

98+ , _mwEndTime :: Date

99+ , _mwDescription :: Maybe Text

100+ , _mwCreatedBy :: User

101+ , _mwServices :: [ServiceInfo]

102+ } deriving (Eq, Show)

103+

104+deriveRecord ''MaintenanceWindow

105+

106+data ListWindows = ListWindows

107+ { _lwQuery' :: Maybe Text

108+ , _lwServiceIds' :: List ServiceId

109+ , _lwFilter' :: Maybe Text

110+ }

111+

112+deriveQuery ''ListWindows

113+

114+-- | Filters the results, showing only the maintenance windows whose

115+-- descriptions contain the query.

116+lwQuery :: Lens' (Request ListWindows s b) (Maybe Text)

117+lwQuery = upd.lwQuery'

118+

119+-- | An array of service IDs, specifying services whose maintenance

120+-- windows shall be returned.

121+lwServiceIds :: Lens' (Request ListWindows s b) [ServiceId]

122+lwServiceIds = upd.lwServiceIds'._L

123+

124+-- | Only return maintenance windows that are of this type. Possible values

125+-- are past, future, ongoing. If this parameter is omitted, all maintenance

126+-- windows will be returned.

127+lwFilter :: Lens' (Request ListWindows s b) (Maybe Text)

128+lwFilter = upd.lwFilter'

129+

130+data Counts = Counts

131+ { _cOngoing :: !Int

132+ , _cFuture :: !Int

133+ , _cPast :: !Int

134+ , _cAll :: !Int

135+ } deriving (Eq, Show)

136+

137+deriveRecord ''Counts

138+

139+data ListWindowsResponse = ListWindowsResponse

140+ { _lwMaintenanceWindows :: [MaintenanceWindow]

141+ , _lwCounts :: Counts

142+ } deriving (Eq, Show)

143+

144+deriveRecord ''ListWindowsResponse

145+

146+-- | List existing maintenance windows, optionally filtered by service,

147+-- or whether they are from the past, present or future.

148+--

149+-- @GET maintenance_windows@

150+--

151+-- See: <http://developer.pagerduty.com/documentation/rest/maintenance_windows/list>

152+listWindows :: Request ListWindows s ListWindowsResponse

153+listWindows =

154+ mk ListWindows

155+ { _lwQuery' = Nothing

156+ , _lwServiceIds' = mempty

157+ , _lwFilter' = Nothing

158+ } & path .~ windows

159+

160+data CreateWindow' = CreateWindow'

161+ { _cwStartTime' :: Date

162+ , _cwEndTime' :: Date

163+ , _cwDescription' :: Maybe Text

164+ , _cwServiceIds' :: [ServiceId] -- ^ List1

165+ } deriving (Eq, Show)

166+

167+deriveRecord ''CreateWindow'

168+

169+data CreateWindow = CreateWindow

170+ { _cwRequesterId' :: Maybe RequesterId

171+ , _cwMaintenanceWindow' :: CreateWindow'

172+ } deriving (Eq, Show)

173+

174+deriveBody ''CreateWindow

175+

176+-- | This maintenance window's start time. This is when the services will stop

177+-- creating incidents. If this date is in the past, it will be updated to be the

178+-- current time.

179+cwStartTime :: Lens' (Request CreateWindow s b) UTCTime

180+cwStartTime = upd.cwMaintenanceWindow'.cwStartTime'._D

181+

182+-- | This maintenance window's end time. This is when the services will start

183+-- creating incidents again. This date must be in the future and after the

184+-- start_time.

185+cwEndTime :: Lens' (Request CreateWindow s b) UTCTime

186+cwEndTime = upd.cwMaintenanceWindow'.cwEndTime'._D

187+

188+-- | A description for this maintenance window.

189+cwDescription :: Lens' (Request CreateWindow s b) (Maybe Text)

190+cwDescription = upd.cwMaintenanceWindow'.cwDescription'

191+

192+-- | The ids of the services that are affected by this maintenance window.

193+cwServiceIds :: Lens' (Request CreateWindow s b) [ServiceId]

194+cwServiceIds = upd.cwMaintenanceWindow'.cwServiceIds'

195+

196+-- | Create a new maintenance window for the specified services. No new

197+-- incidents will be created for a service that is currently in maintenance.

198+--

199+-- @POST maintenance_windows@

200+--

201+-- See: <http://developer.pagerduty.com/documentation/rest/maintenance_windows/create>

202+createWindow :: RequesterId

203+ -> UTCTime -- ^ 'cwStartTime'

204+ -> UTCTime -- ^ 'cwEndTime'

205+ -> [ServiceId] -- ^ 'cwServiceIds'

206+ -> Request CreateWindow s MaintenanceWindow

207+createWindow r s e xs =

208+ auth (createWindowBasic s e xs) & upd.cwRequesterId' ?~ r

209+

210+-- | A version of 'createWindow' which uses HTTP Basic authentication and

211+-- doesn't require a 'RequesterId'.

212+createWindowBasic :: UTCTime -- ^ 'cwStartTime'

213+ -> UTCTime -- ^ 'cwEndTime'

214+ -> [ServiceId] -- ^ 'cwServiceIds'

215+ -> Request CreateWindow Basic MaintenanceWindow

216+createWindowBasic s e xs =

217+ mk CreateWindow

218+ { _cwRequesterId' = Nothing

219+ , _cwMaintenanceWindow' = CreateWindow'

220+ { _cwStartTime' = D s

221+ , _cwEndTime' = D e

222+ , _cwDescription' = Nothing

223+ , _cwServiceIds' = xs

224+ }

225+ } & meth .~ POST

226+ & path .~ windows

227+

228+-- | Get details about an existing maintenance window.

229+--

230+-- @GET maintenance_windows/:id@

231+--

232+-- See: <http://developer.pagerduty.com/documentation/rest/maintenance_windows/show>

233+getWindow :: WindowId -> Request Empty s MaintenanceWindow

234+getWindow w = empty & path .~ windows % w

235+

236+data UpdateWindow = UpdateWindow

237+ { _uwStartTime' :: Maybe Date

238+ , _uwEndTime' :: Maybe Date

239+ , _uwDescription' :: Maybe Text

240+ , _uwServiceIds' :: Maybe [ServiceId]

241+ } deriving (Eq, Show)

242+

243+deriveBody ''UpdateWindow

244+

245+-- | The maintenance window's start time. Can only be updated on future

246+-- maintenance windows. If the start_time is set to a date in the past, it will be

247+-- updated to the current date.

248+uwStartTime :: Lens' (Request UpdateWindow s b) (Maybe Date)

249+uwStartTime = upd.uwStartTime'

250+

251+-- | The maintenance window's end time. Can only be updated on ongoing and

252+-- future maintenance windows, and cannot be set to a value before start_time.

253+uwEndTime :: Lens' (Request UpdateWindow s b) (Maybe Date)

254+uwEndTime = upd.uwEndTime'

255+

256+-- | Description for this maintenance window. Can only be updated on ongoing

257+-- and future maintenance windows.

258+uwDescription :: Lens' (Request UpdateWindow s b) (Maybe Text)

259+uwDescription = upd.uwDescription'

260+

261+-- | Services that are affected by this maintenance window. Can only be updated

262+-- on future maintenance windows.

263+uwServiceIds :: Lens' (Request UpdateWindow s b) (Maybe [ServiceId])

264+uwServiceIds = upd.uwServiceIds'

265+

266+-- | Update an existing maintenance window.

267+--

268+-- @PUT maintenance_windows/:id@

269+--

270+-- See: <http://developer.pagerduty.com/documentation/rest/maintenance_windows/update>

271+updateWindow :: WindowId -> Request UpdateWindow s MaintenanceWindow

272+updateWindow w =

273+ mk UpdateWindow

274+ { _uwStartTime' = Nothing

275+ , _uwEndTime' = Nothing

276+ , _uwDescription' = Nothing

277+ , _uwServiceIds' = Nothing

278+ } & meth .~ PUT

279+ & path .~ windows % w

280+

281+-- | Cancel or delete an existing maintenance window.

282+--

283+-- @DELETE maintenance_windows/:id@

284+--

285+-- See: <http://developer.pagerduty.com/documentation/rest/maintenance_windows/delete>

286+deleteWindow :: WindowId -> Request Empty s Empty

287+deleteWindow w = empty & meth .~ DELETE & path .~ windows % w

src/Network/PagerDuty/REST/Reports.hs+10−10

@@ -87,12 +87,12 @@ deriveQuery ''Report

8787-- | Start of the date range over which you want to search. The time element

8888-- is optional.

8989rSince :: Lens' (Request Report s b) UTCTime

90−rSince = upd.rSince'._Date

90+rSince = upd.rSince'._D

9191

9292-- | The end of the date range over which you want to search. This should be

9393-- in the same format as since.

9494rUntil :: Lens' (Request Report s b) UTCTime

95−rUntil = upd.rUntil'._Date

95+rUntil = upd.rUntil'._D

9696

9797-- | Specifies the bucket duration for each summation.

9898--

@@ -116,10 +116,10 @@ data AlertReport = AlertReport

116116deriveJSON ''AlertReport

117117

118118arStart :: Lens' AlertReport UTCTime

119−arStart = lens _arStart (\r x -> r { _arStart = x }) ._Date

119+arStart = lens _arStart (\r x -> r { _arStart = x }) ._D

120120

121121arEnd :: Lens' AlertReport UTCTime

122−arEnd = lens _arEnd (\r x -> r { _arEnd = x }) ._Date

122+arEnd = lens _arEnd (\r x -> r { _arEnd = x }) ._D

123123

124124makeLens "_arNumberOfAlerts" ''AlertReport

125125makeLens "_arNumberOfPhoneAlerts" ''AlertReport

@@ -148,8 +148,8 @@ alertsPerTime :: UTCTime -- ^ 'rSince'

148148 -> Request Report s AlertTotals

149149alertsPerTime s u =

150150 mk Report

151− { _rSince' = Date s

152− , _rUntil' = Date u

151+ { _rSince' = D s

152+ , _rUntil' = D u

153153 , _rRollup' = Monthly

154154 } & path .~ reports % "alerts_per_time"

155155

@@ -162,10 +162,10 @@ data IncidentReport = IncidentReport

162162deriveJSON ''IncidentReport

163163

164164irStart :: Lens' IncidentReport UTCTime

165−irStart = lens _irStart (\r x -> r { _irStart = x }) . _Date

165+irStart = lens _irStart (\r x -> r { _irStart = x }) . _D

166166

167167irEnd :: Lens' IncidentReport UTCTime

168−irEnd = lens _irEnd (\r x -> r { _irEnd = x }) . _Date

168+irEnd = lens _irEnd (\r x -> r { _irEnd = x }) . _D

169169

170170makeLens "_irNumberOfIncidents" ''IncidentReport

171171

@@ -180,8 +180,8 @@ incidentsPerTime :: UTCTime -- ^ 'rSince'

180180 -> Request Report s [IncidentReport]

181181incidentsPerTime s u =

182182 mk Report

183− { _rSince' = Date s

184− , _rUntil' = Date u

183+ { _rSince' = D s

184+ , _rUntil' = D u

185185 , _rRollup' = Monthly

186186 } & path .~ reports % "incidents_per_time"

187187 & unwrap .~ key "incidents"

src/Network/PagerDuty/REST/Services.hs+2−2

@@ -324,7 +324,7 @@ makeLens "_svcAcknowledgementTimeout" ''Service

324324

325325-- | The date/time when this service was created.

326326svcCreatedAt :: Lens' Service UTCTime

327−svcCreatedAt = lens _svcCreatedAt (\s x -> s { _svcCreatedAt = x }) . _Date

327+svcCreatedAt = lens _svcCreatedAt (\s x -> s { _svcCreatedAt = x }) . _D

328328

329329-- | The current state of the Service.

330330makeLens "_svcStatus" ''Service

@@ -333,7 +333,7 @@ makeLens "_svcStatus" ''Service

333333svcLastIncidentTimestamp :: Lens' Service (Maybe UTCTime)

334334svcLastIncidentTimestamp =

335335 lens _svcLastIncidentTimestamp

336− (\s x -> s { _svcLastIncidentTimestamp = x }) . mapping _Date

336+ (\s x -> s { _svcLastIncidentTimestamp = x }) . mapping _D

337337

338338-- | If the service is a Generic Email service, this describes what kind of

339339-- emails create an incident.

src/Network/PagerDuty/REST/Users.hs+48

@@ -17,7 +17,55 @@

1717module Network.PagerDuty.REST.Users

1818 (

1919

20+ -- * Types

21+ User

22+ , uId

23+ , uName

24+ , uEmail

25+ , uTimeZone

26+ , uColor

27+ , uRole

28+ , uAvatarUrl

29+ , uUrl

30+ , uInvitationSent

2031 ) where

2132

33+import Control.Lens

34+import Data.Monoid

35+import Data.Text (Text)

36+import Data.Time

37+import Network.HTTP.Types

38+import Network.PagerDuty.TH

39+import Network.PagerDuty.Types

40+

2241users :: Path

2342users = "users"

43+

44+data User = User

45+ { _uId :: UserId

46+ , _uName :: Text

47+ , _uEmail :: Address

48+ , _uTimeZone :: TZ

49+ , _uColor :: Text

50+ , _uRole :: Text

51+ , _uAvatarUrl :: Text

52+ , _uUrl :: Text

53+ , _uInvitationSent :: Bool'

54+ } deriving (Eq, Show)

55+

56+deriveJSON ''User

57+

58+makeLens "_uId" ''User

59+makeLens "_uName" ''User

60+makeLens "_uEmail" ''User

61+makeLens "_uColor" ''User

62+makeLens "_uRole" ''User

63+makeLens "_uAvatarUrl" ''User

64+makeLens "_uUrl" ''User

65+

66+uTimeZone :: Lens' User TimeZone

67+uTimeZone = lens _uTimeZone (\u x -> u { _uTimeZone = x }) . _TZ

68+

69+uInvitationSent :: Lens' User Bool

70+uInvitationSent =

71+ lens _uInvitationSent (\u x -> u { _uInvitationSent = x }) . _B

src/Network/PagerDuty/TH.hs+5−7

@@ -28,8 +28,6 @@ module Network.PagerDuty.TH

2828

2929 -- * Re-exported generics

3030 , deriveGeneric

31− , gquery

32− , gqueryWith

3331

3432 -- * Re-exported options

3533 , dropped

@@ -46,7 +44,7 @@ import qualified Data.Text.Encoding as Text

4644import Generics.SOP.TH

4745import Language.Haskell.TH

4846import Network.HTTP.Types.QueryLike

49−import Network.PagerDuty.Generics

47+import Network.PagerDuty.Query

5048import Network.PagerDuty.Options

5149

5250deriveNullary :: Name -> Q [Dec]

@@ -55,7 +53,7 @@ deriveNullary = deriveNullaryWith underscored

5553deriveNullaryWith :: Options -> Name -> Q [Dec]

5654deriveNullaryWith o n = concat <$> sequence

5755 [ deriveJSONWith o n

58− , [d|instance QueryValueLike $(conT n) where toQueryValue = value . toJSON|]

56+ , [d|instance ToQuery $(conT n) where queryValues = value . toJSON|]

5957 ]

6058

6159deriveRecord :: Name -> Q [Dec]

@@ -90,6 +88,6 @@ makeLens k = makeLensesWith

9088 $ lensRulesFor [(k, drop 1 k)]

9189 & simpleLenses .~ True

9290

93−value :: Value -> Maybe ByteString

94−value (String t) = Just (Text.encodeUtf8 t)

95−value _ = Nothing

91+value :: Value -> [ByteString]

92+value (String t) = [Text.encodeUtf8 t]

93+value _ = []

src/Network/PagerDuty/Types.hs+55−39

@@ -8,6 +8,7 @@

88{-# LANGUAGE RankNTypes #-}

99{-# LANGUAGE StandaloneDeriving #-}

1010{-# LANGUAGE TemplateHaskell #-}

11+{-# LANGUAGE TupleSections #-}

1112{-# LANGUAGE ViewPatterns #-}

1213

1314-- Module : Network.PagerDuty.Types

@@ -56,9 +57,11 @@ import Data.Aeson hiding (Error)

5657import Data.Aeson.Types (Parser)

5758import Data.ByteString (ByteString)

5859import qualified Data.ByteString.Char8 as BS

59−import Data.ByteString.Conversion

60+import Data.ByteString.Conversion hiding (List)

6061import Data.Default

62+import Data.Function (on)

6163import qualified Data.HashMap.Strict as Map

64+import Data.List (deleteBy)

6265import Data.Monoid

6366import Data.String

6467import Data.Text (Text)

@@ -67,41 +70,51 @@ import Data.Time

6770import GHC.TypeLits

6871import Network.HTTP.Types

6972import Network.HTTP.Types.QueryLike

73+import Network.PagerDuty.Query

7074import Network.PagerDuty.TH

7175import System.Locale

7276

7377-- FIXME: Verify IncidentId/IncidentKey .. *Id/*Key are actually different or needed

7478

79+newtype List a = L [a]

80+ deriving (Eq, Show, Monoid)

81+

82+deriveJSON ''List

83+makePrisms ''List

84+

85+instance ToQuery a => ToQuery (List a) where

86+ queryValues (L xs) = concatMap queryValues xs

87+

7588newtype Bool' = B Bool

7689 deriving (Eq, Show)

7790

7891deriveJSON ''Bool'

7992makePrisms ''Bool'

8093

81−instance QueryValueLike Bool' where

82− toQueryValue (B True) = Just "true"

83− toQueryValue (B False) = Just "false"

94+instance ToByteString Bool' where

95+ builder (B True) = "true"

96+ builder (B False) = "false"

97+

98+instance ToQuery Bool'

8499

85−newtype Date = Date { unDate :: UTCTime }

100+newtype Date = D UTCTime

86101 deriving (Eq, Ord, Show)

87102

88103makePrisms ''Date

89104

90105instance FromJSON Date where

91− parseJSON = fmap Date . parseJSON

106+ parseJSON = fmap D . parseJSON

92107

93108instance ToJSON Date where

94− toJSON = toJSON . unDate

109+ toJSON (D d) = toJSON d

95110

96111instance ToByteString Date where

97− builder = builder

98− . formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ")

99− . unDate

112+ builder (D d) = builder

113+ (formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ") d)

100114

101−instance QueryValueLike Date where

102− toQueryValue = Just . toByteString'

115+instance ToQuery Date

103116

104−newtype TZ = TZ { unTZ :: TimeZone }

117+newtype TZ = TZ TimeZone

105118 deriving (Eq, Show)

106119

107120makePrisms ''TZ

@@ -113,10 +126,9 @@ instance ToJSON TZ where

113126 toJSON = toJSON . Text.decodeUtf8 . toByteString'

114127

115128instance ToByteString TZ where

116− builder = builder . timeZoneName . unTZ

129+ builder (TZ tz) = builder (timeZoneName tz)

117130

118−instance QueryValueLike TZ where

119− toQueryValue = Just . toByteString'

131+instance ToQuery TZ

120132

121133instance Default TZ where

122134 def = TZ utc

@@ -199,6 +211,8 @@ data Pager = Pager

199211 -- ^ The limit used in the execution of the query.

200212 , _pgTotal :: !Int

201213 -- ^ The total number of records available.

214+ , _pgQuery :: Maybe Text

215+ -- ^ An optional query= value to be added to the query string.

202216 } deriving (Eq, Show)

203217

204218makeLenses ''Pager

@@ -214,8 +228,9 @@ instance FromJSON a => FromJSON (a, Maybe Pager) where

214228 <$> o .: "offset" .!= 0

215229 -- The number of records returned.

216230 -- Default (and max limit) is 100 for most APIs.

217− <*> o .: "limit" .!= 100

218− <*> o .: "total"

231+ <*> o .: "limit" .!= 100

232+ <*> o .: "total"

233+ <*> o .:? "query"

219234

220235instance ToJSON Pager where

221236 toJSON p = object

@@ -304,14 +319,24 @@ unwrap f r = f (_rqUnwrap r) <&> \k -> r { _rqUnwrap = g k }

304319 where

305320 g k x = maybe (fail "Failed to extract nested keys.") return (x ^? k)

306321

307−-- | Primarily to obtain a constraint for the pagination function, as well as

308−-- the overrideable flexibility.

322+-- | Exists primarily to obtain a constraint for the 'paginate' function.

309323class Paginate a where

310324 next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)

311− next _ Nothing = Nothing

312− next rq (Just x)

313− | x^.pgTotal == 0 = Nothing

314− | otherwise = Just (rq & pager ?~ (x & pgOffset +~ x^.pgTotal))

325+ next rq = maybe Nothing go

326+ where

327+ go x | x^.pgTotal == 0 = Nothing

328+ | otherwise = Just $

329+ rq & pager ?~ (x & pgOffset +~ x^.pgTotal)

330+ & query %~ (add . clear)

331+ where

332+ add :: Query -> Query

333+ add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x^.pgQuery)

334+

335+ clear :: Query -> Query

336+ clear = deleteBy ((==) `on` fst) (k, Nothing)

337+

338+ k :: ByteString

339+ k = "query"

315340

316341newtype Key (a :: Symbol) = Key Text

317342 deriving (Eq, Show, IsString)

@@ -325,6 +350,8 @@ instance ToJSON (Key a) where

325350instance ToByteString (Key a) where

326351 builder (Key k) = builder k

327352

353+instance ToQuery (Key a)

354+

328355instance QueryValueLike (Key a) where

329356 toQueryValue = Just . toByteString'

330357

@@ -343,6 +370,8 @@ instance ToJSON (Id a) where

343370instance ToByteString (Id a) where

344371 builder (Id i) = builder i

345372

373+instance ToQuery (Id a)

374+

346375instance QueryValueLike (Id a) where

347376 toQueryValue = Just . toByteString'

348377

@@ -357,6 +386,7 @@ type ServiceId = Id "service"

357386type TargetId = Id "target"

358387type UserId = Id "user"

359388type VendorId = Id "vendor"

389+type WindowId = Id "maintenance-window"

360390

361391data Empty = Empty

362392

@@ -381,19 +411,5 @@ makePrisms ''Address

381411instance ToByteString Address where

382412 builder (Address a) = builder a

383413

384−instance QueryValueLike Address where

385− toQueryValue = Just . toByteString'

386−

387−data User = User

388− { _userId :: UserId

389− , _userName :: Text

390− , _userEmail :: Address

391− , _userTimeZone :: TZ

392− , _userColor :: Text

393− , _userRole :: Text

394− , _userAvatarUrl :: Text

395− , _userUrl :: Text

396− , _userInvitationSent :: Bool'

397− } deriving (Eq, Show)

414+instance ToQuery Address

398415

399−deriveRecord ''User