pagerduty (empty) → 0.0.0
raw patch · 28 files changed
+6698/−0 lines, 28 filesdep +aesondep +basedep +bifunctorssetup-changed
Dependencies added: aeson, base, bifunctors, bytestring, bytestring-conversion, conduit, data-default-class, exceptions, generics-sop, http-client, http-types, lens, lens-aeson, mmorph, monad-control, mtl, old-locale, template-haskell, text, time, transformers, transformers-base, unordered-containers
Files
- LICENSE +373/−0
- README.md +0/−0
- Setup.hs +2/−0
- pagerduty.cabal +92/−0
- src/Control/Monad/Trans/PagerDuty.hs +207/−0
- src/Network/PagerDuty/Integration.hs +292/−0
- src/Network/PagerDuty/Internal/IO.hs +76/−0
- src/Network/PagerDuty/Internal/Options.hs +56/−0
- src/Network/PagerDuty/Internal/Query.hs +109/−0
- src/Network/PagerDuty/Internal/TH.hs +96/−0
- src/Network/PagerDuty/Internal/Types.hs +480/−0
- src/Network/PagerDuty/REST.hs +104/−0
- src/Network/PagerDuty/REST/Alerts.hs +123/−0
- src/Network/PagerDuty/REST/EscalationPolicies.hs +244/−0
- src/Network/PagerDuty/REST/EscalationPolicies/EscalationRules.hs +277/−0
- src/Network/PagerDuty/REST/Incidents.hs +650/−0
- src/Network/PagerDuty/REST/Incidents/Notes.hs +108/−0
- src/Network/PagerDuty/REST/LogEntries.hs +514/−0
- src/Network/PagerDuty/REST/MaintenanceWindows.hs +289/−0
- src/Network/PagerDuty/REST/Reports.hs +188/−0
- src/Network/PagerDuty/REST/Schedules.hs +638/−0
- src/Network/PagerDuty/REST/Schedules/Overrides.hs +188/−0
- src/Network/PagerDuty/REST/Services.hs +513/−0
- src/Network/PagerDuty/REST/Services/EmailFilters.hs +180/−0
- src/Network/PagerDuty/REST/Users.hs +384/−0
- src/Network/PagerDuty/REST/Users/ContactMethods.hs +236/−0
- src/Network/PagerDuty/REST/Users/NotificationRules.hs +164/−0
- src/Network/PagerDuty/REST/Webhooks.hs +115/−0
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ README.md view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pagerduty.cabal view
@@ -0,0 +1,92 @@+name: pagerduty+version: 0.0.0+synopsis: Client library for PagerDuty Integration and REST APIs.+homepage: http://github.com/brendanhay/pagerduty+license: OtherLicense+license-file: LICENSE+author: Brendan Hay+maintainer: Brendan Hay <brendan.g.hay@gmail.com>+copyright: Copyright (c) 2013-2014 Brendan Hay, 2014 Kim Altintop+category: Network, PagerDuty, Monitoring+build-type: Simple+cabal-version: >= 1.10++description:+ PagerDuty is an alerting system for IT professionals. PagerDuty connects+ with a variety of systems (including monitoring tools and ticketing+ systems) and dispatches alerts via automated phone call, SMS and email.++ This library implements the full PagerDuty Integration and REST APIs which+ are documented here:+ .+ * Integration API - <http://developer.pagerduty.com/documentation/integration>+ * REST API - <http://developer.pagerduty.com/documentation/rest>+ .+ /Warning:/ This is an experimental preview release which is still under+ heavy development and not intended for public consumption, caveat emptor!++extra-source-files:+ README.md++source-repository head+ type: git+ location: git://github.com/brendanhay/pagerduty.git++library+ default-language: Haskell2010+ hs-source-dirs: src++ ghc-options: -Wall++ exposed-modules:+ Control.Monad.Trans.PagerDuty+ , Network.PagerDuty.Integration+ , Network.PagerDuty.REST+ , Network.PagerDuty.REST.Alerts+ , Network.PagerDuty.REST.EscalationPolicies+ , Network.PagerDuty.REST.EscalationPolicies.EscalationRules+ , Network.PagerDuty.REST.Incidents+ , Network.PagerDuty.REST.Incidents.Notes+ , Network.PagerDuty.REST.LogEntries+ , Network.PagerDuty.REST.MaintenanceWindows+ , Network.PagerDuty.REST.Reports+ , Network.PagerDuty.REST.Schedules+ , Network.PagerDuty.REST.Schedules.Overrides+ , Network.PagerDuty.REST.Services+ , Network.PagerDuty.REST.Services.EmailFilters+ , Network.PagerDuty.REST.Users+ , Network.PagerDuty.REST.Users.ContactMethods+ , Network.PagerDuty.REST.Users.NotificationRules+ , Network.PagerDuty.REST.Webhooks++ other-modules:+ Network.PagerDuty.Internal.IO+ , Network.PagerDuty.Internal.Options+ , Network.PagerDuty.Internal.Query+ , Network.PagerDuty.Internal.TH+ , Network.PagerDuty.Internal.Types++ build-depends:+ aeson > 0.7 && <= 0.8+ , base >= 4.5 && < 5.0+ , bifunctors >= 4+ , bytestring >= 0.9+ , bytestring-conversion >= 0.2.1+ , conduit >= 0.5.5+ , data-default-class >= 0.0.1+ , exceptions >= 0.6+ , generics-sop >= 0.1.0.2+ , http-client >= 0.3.6+ , http-types >= 0.8+ , lens >= 4.0+ , lens-aeson >= 1.0+ , mmorph >= 1.0+ , monad-control >= 0.3.2+ , mtl >= 2.2.1+ , old-locale >= 1.0.0.5+ , template-haskell >= 2.2+ , text >= 1.1+ , time == 1.4.*+ , transformers >= 0.4.1+ , transformers-base >= 0.4.1+ , unordered-containers >= 0.2.3
+ src/Control/Monad/Trans/PagerDuty.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++-- Module : Control.Monad.Trans.PagerDuty+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Control.Monad.Trans.PagerDuty+ (+ -- * Transformer+ PagerDuty+ , PagerDutyT++ -- * Running+ , runPagerDutyT++ -- * Configuration+ -- ** Environment+ , Env+ , envDomain+ , envAuth+ , envManager+ , envLogger+ , scoped++ -- ** Logging+ , Logger (..)+ , debug++ -- * Integration events+ , submit+ , submitCatch++ -- * REST requests+ , send+ , sendCatch+ , paginate+ , paginateCatch++ -- * Errors+ , Error(..)+ , _Internal+ , _Integration+ , _REST++ -- ** Integration+ , IntegrationError+ , status++ -- ** REST+ , RESTError+ , code++ -- ** Code+ , Code (..)+ , description++ -- ** Fields+ , message+ , errors++ -- ** Lifting+ , hoistError+ ) where++import Control.Applicative+import Control.Monad.Base+import Control.Monad.Catch+import Control.Monad.Except+import Control.Monad.Morph+import Control.Monad.Reader+import Control.Monad.Trans.Control+import Data.Aeson+import Data.Conduit+import Network.PagerDuty.Integration (Event, Response)+import qualified Network.PagerDuty.Integration as Int+import Network.PagerDuty.Internal.Types+import qualified Network.PagerDuty.REST as REST++-- | A convenient alias for 'PagerDutyT' 'IO'.+type PagerDuty s = PagerDutyT s IO++newtype PagerDutyT s m a = PagerDutyT+ { unPagerDutyT :: ReaderT (Env s) (ExceptT Error m) a+ } deriving+ ( Functor+ , Applicative+ , Monad+ , MonadIO+ , MonadThrow+ , MonadCatch+ , MonadReader (Env s)+ , MonadError Error+ )++instance MonadTrans (PagerDutyT s) where+ lift = PagerDutyT . lift . lift+ {-# INLINE lift #-}++instance MonadBase b m => MonadBase b (PagerDutyT s m) where+ liftBase = liftBaseDefault+ {-# INLINE liftBase #-}++instance MonadTransControl (PagerDutyT s) where+ newtype StT (PagerDutyT s) a = StTPDT+ { unStT :: StT (ExceptT Error) (StT (ReaderT (Env s)) a)+ }++ liftWith f = PagerDutyT $+ liftWith $ \g ->+ liftWith $ \h ->+ f (liftM StTPDT . h . g . unPagerDutyT)+ {-# INLINE liftWith #-}++ restoreT = PagerDutyT . restoreT . restoreT . liftM unStT+ {-# INLINE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (PagerDutyT s m) where+ newtype StM (PagerDutyT s m) a = StMPDT+ { unStMPDT :: ComposeSt (PagerDutyT s) m a+ }++ liftBaseWith = defaultLiftBaseWith StMPDT+ {-# INLINE liftBaseWith #-}++ restoreM = defaultRestoreM unStMPDT+ {-# INLINE restoreM #-}++instance MFunctor (PagerDutyT s) where+ hoist nat m = PagerDutyT (ReaderT (ExceptT . nat . runPagerDutyT m))+ {-# INLINE hoist #-}++instance MMonad (PagerDutyT s) where+ embed f m = ask >>= f . runPagerDutyT m >>= either throwError return+ {-# INLINE embed #-}++runPagerDutyT :: PagerDutyT s m a -> Env s -> m (Either Error a)+runPagerDutyT (PagerDutyT k) = runExceptT . runReaderT k++hoistError :: (MonadError Error m) => Either Error a -> m a+hoistError = either throwError return++scoped :: MonadReader (Env s) m => (Env s -> m a) -> m a+scoped f = ask >>= f++submit :: ( MonadIO m+ , MonadReader (Env s) m+ , MonadError Error m+ )+ => Event+ -> m Response+submit = submitCatch >=> hoistError++submitCatch :: ( MonadIO m+ , MonadReader (Env s) m+ )+ => Event+ -> m (Either Error Response)+submitCatch x = scoped $ \e -> Int.submitWith (_envManager e) (_envLogger e) x++send :: ( MonadIO m+ , MonadReader (Env s) m+ , MonadError Error m+ , FromJSON b+ )+ => Request a s b+ -> m b+send = sendCatch >=> hoistError++sendCatch :: ( MonadIO m+ , MonadReader (Env s) m+ , FromJSON b+ )+ => Request a s b+ -> m (Either Error b)+sendCatch x = scoped (`REST.sendWith` x)++paginate :: ( MonadIO m+ , MonadReader (Env s) m+ , MonadError Error m+ , Paginate a+ , FromJSON b+ )+ => Request a s b+ -> Source m b+paginate x = paginateCatch x $= awaitForever (hoistError >=> yield)++paginateCatch :: ( MonadIO m+ , MonadReader (Env s) m+ , Paginate a+ , FromJSON b+ )+ => Request a s b+ -> Source m (Either Error b)+paginateCatch x = scoped (`REST.paginateWith` x)
+ src/Network/PagerDuty/Integration.hs view
@@ -0,0 +1,292 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.PagerDuty.Integration+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | The PagerDuty event integration API is how you would add PagerDuty's+-- advanced alerting functionality to any system that can make an HTTP API+-- call. You can now add phone, SMS and email alerting to your monitoring+-- tools, ticketing systems and custom software.+--+-- The API was designed to allow you to easily integrate a+-- monitoring system with a Service in PagerDuty. Monitoring systems+-- generally send out events when problems are detected and when these+-- problems have been resolved (fixed). Some more advanced systems also+-- understand the concept of acknowledgements: problems can be acknowledged+-- by an engineer to signal he or she is working on fixing the issue.+--+-- Since monitoring systems emit events, the API is based around accepting+-- events. Incoming events (sent via the API) are routed to a PagerDuty+-- service and processed. They may result in a new incident being created,+-- or an existing incident being acknowledged or resolved.+--+-- The same event-based API can also be used to integrate a PagerDuty+-- service with ticketing systems and various other software tools.+--+-- /See:/ <http://developer.pagerduty.com/documentation/integration/events>+module Network.PagerDuty.Integration+ (+ -- * Sending events+ submit+ , submitWith++ -- ** Trigger+ , Trigger+ , trigger+ , client+ , clientUrl++ -- ** Acknowledge+ , Acknowledge+ , acknowledge++ -- ** Resolve+ , Resolve+ , resolve++ -- * Event fields+ , HasServiceKey (..)+ , HasIncidentKey (..)+ , HasDescription (..)+ , HasDetails (..)++ -- * Types+ , Event (..)+ , _Trigger+ , _Acknowledge+ , _Resolve++ , Response+ , rsStatus+ , rsMessage+ , rsIncidentKey+ ) where++import Control.Lens+import Control.Monad.IO.Class+import Data.Aeson+import Data.Default.Class+import qualified Data.HashMap.Strict as Map+import Data.Text (Text)+import Network.HTTP.Client (Manager)+import qualified Network.HTTP.Client as Client+import Network.PagerDuty.Internal.IO+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++data Response = Response+ { _rsStatus :: Text+ , _rsMessage :: Text+ , _rsIncidentKey :: IncidentKey+ } deriving (Eq, Show)++deriveJSON ''Response++-- | @success@.+makeLens "_rsStatus" ''Response++-- | @Event processed@.+makeLens "_rsMessage" ''Response++-- | The key of the incident that will be affected by the request.+makeLens "_rsIncidentKey" ''Response++class HasServiceKey s a | s -> a where+ -- | The GUID of one of your "Generic API" services. This is the "service key"+ -- listed on a Generic API's service detail page.+ serviceKey :: Lens' s a++class HasIncidentKey s a | s -> a where+ -- | Identifies the incident to which this trigger event should be applied.+ -- If there's no open (i.e. unresolved) incident with this key, a new one+ -- will be created. If there's already an open incident with a matching key,+ -- this event will be appended to that incident's log. The event key provides+ -- an easy way to "de-dup" problem reports. If this field isn't provided,+ -- PagerDuty will automatically open a new incident with a unique key.+ incidentKey :: Lens' s a++class HasDescription s a | s -> a where+ -- | A short description of the problem that led to this trigger.+ -- This field (or a truncated version) will be used when generating phone+ -- calls, SMS messages and alert emails. It will also appear on the incidents+ -- tables in the PagerDuty UI. The maximum length is 1024 characters.+ description :: Lens' s a++class HasDetails s a | s -> a where+ -- | An arbitrary JSON object containing any data you'd like included+ -- in the incident log.+ details :: Lens' s a++data Trigger = Trigger'+ { _tServiceKey' :: ServiceKey+ , _tIncidentKey' :: IncidentKey+ , _tDescription' :: Text+ , _tDetails' :: Maybe Object+ , _tClient' :: Maybe Text+ , _tClientUrl' :: Maybe Text+ } deriving (Eq, Show)++deriveRecord ''Trigger++instance HasServiceKey Trigger ServiceKey where serviceKey = tServiceKey'+instance HasIncidentKey Trigger IncidentKey where incidentKey = tIncidentKey'+instance HasDescription Trigger Text where description = tDescription'+instance HasDetails Trigger (Maybe Object) where details = tDetails'++-- | The name of the monitoring client that is triggering this event.+client :: Lens' Trigger (Maybe Text)+client = tClient'++-- | The URL of the monitoring client that is triggering this event.+clientUrl :: Lens' Trigger (Maybe Text)+clientUrl = tClientUrl'++data Generic = Generic'+ { _gServiceKey' :: ServiceKey+ , _gIncidentKey' :: IncidentKey+ , _gDescription' :: Maybe Text+ , _gDetails' :: Maybe Object+ } deriving (Eq, Show)++deriveRecord ''Generic++instance HasServiceKey Generic ServiceKey where serviceKey = gServiceKey'+instance HasIncidentKey Generic IncidentKey where incidentKey = gIncidentKey'+instance HasDescription Generic (Maybe Text) where description = gDescription'+instance HasDetails Generic (Maybe Object) where details = gDetails'++type Resolve = Generic+type Acknowledge = Generic++data Event+ = Trigger Trigger -- ^ /See:/ 'trigger'+ | Acknowledge Generic -- ^ /See:/ 'acknowledge'+ | Resolve Generic -- ^ /See:/ 'resolve'+ deriving (Eq, Show)++makePrisms ''Event++instance HasServiceKey Event ServiceKey where+ serviceKey = lens f g+ where+ f (Trigger s) = _tServiceKey' s+ f (Acknowledge s) = _gServiceKey' s+ f (Resolve s) = _gServiceKey' s++ g (Trigger s) x = Trigger $ s { _tServiceKey' = x }+ g (Acknowledge s) x = Acknowledge $ s { _gServiceKey' = x }+ g (Resolve s) x = Resolve $ s { _gServiceKey' = x }++instance HasIncidentKey Event IncidentKey where+ incidentKey = lens f g+ where+ f (Trigger s) = _tIncidentKey' s+ f (Acknowledge s) = _gIncidentKey' s+ f (Resolve s) = _gIncidentKey' s++ g (Trigger s) x = Trigger $ s { _tIncidentKey' = x }+ g (Acknowledge s) x = Acknowledge $ s { _gIncidentKey' = x }+ g (Resolve s) x = Resolve $ s { _gIncidentKey' = x }++instance HasDetails Event (Maybe Object) where+ details = lens f g+ where+ f (Trigger s) = _tDetails' s+ f (Acknowledge s) = _gDetails' s+ f (Resolve s) = _gDetails' s++ g (Trigger s) x = Trigger $ s { _tDetails' = x }+ g (Acknowledge s) x = Acknowledge $ s { _gDetails' = x }+ g (Resolve s) x = Resolve $ s { _gDetails' = x }++instance ToJSON Event where+ toJSON = \case+ Trigger x -> event "trigger" x+ Acknowledge x -> event "acknowledge" x+ Resolve x -> event "resolve" x+ where+ event k x =+ case toJSON x of+ Object o -> Object (Map.insert "event_type" (String k) o)+ v -> v++-- | Your monitoring tools should send PagerDuty a trigger event to report a new+-- or ongoing problem. When PagerDuty receives a trigger event, it will either open+-- a new incident, or add a new trigger log entry to an existing incident,+-- depending on the provided incident_key.+trigger :: ServiceKey -- ^ 'serviceKey'+ -> IncidentKey -- ^ 'incidentKey'+ -> Text -- ^ 'description'+ -> Event+trigger k i d =+ Trigger Trigger'+ { _tServiceKey' = k+ , _tDescription' = d+ , _tIncidentKey' = i+ , _tClient' = Nothing+ , _tClientUrl' = Nothing+ , _tDetails' = Nothing+ }++-- | Acknowledge events cause the referenced incident to enter the acknowledged+-- state.+--+-- While an incident is acknowledged, it won't generate any additional+-- notifications, even if it receives new trigger events. Your monitoring tools+-- should send PagerDuty an acknowledge event when they know someone is+-- presently working on the problem.+acknowledge :: ServiceKey -- ^ 'serviceKey'+ -> IncidentKey -- ^ 'incidentKey'+ -> Event+acknowledge k i =+ Acknowledge Generic'+ { _gServiceKey' = k+ , _gIncidentKey' = i+ , _gDescription' = Nothing+ , _gDetails' = Nothing+ }++-- | Resolve events cause the referenced incident to enter the resolved state.+--+-- Once an incident is resolved, it won't generate any additional+-- notifications. New trigger events with the same incident_key as a resolved+-- incident won't re-open the incident. Instead, a new incident will be+-- created. Your monitoring tools should send PagerDuty a resolve event when the+-- problem that caused the initial trigger event has been fixed.+resolve :: ServiceKey -- ^ 'serviceKey'+ -> IncidentKey -- ^ 'incidentKey'+ -> Event+resolve k i =+ Resolve Generic'+ { _gServiceKey' = k+ , _gIncidentKey' = i+ , _gDescription' = Nothing+ , _gDetails' = Nothing+ }++-- | Send an event to the integration API.+submit :: MonadIO m => Manager -> Event -> m (Either Error Response)+submit m = submitWith m None++-- | /See:/ 'submit'+submitWith :: MonadIO m+ => Manager+ -> Logger+ -> Event+ -> m (Either Error Response)+submitWith m l e = request m l e $+ def { Client.host = "events.pagerduty.com"+ , Client.path = "/generic/2010-04-15/create_event.json"+ }
+ src/Network/PagerDuty/Internal/IO.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- Module : Network.PagerDuty.Internal.IO+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.Internal.IO where++import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson hiding (Error)+import qualified Data.ByteString.Lazy as LBS+import Data.Monoid+import qualified Data.Text as Text+import Network.HTTP.Client (Manager, httpLbs)+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types+import Network.PagerDuty.Internal.Types++request :: (MonadIO m, ToJSON a, FromJSON b)+ => Manager+ -> Logger+ -> a+ -> Client.Request+ -> m (Either Error b)+request m l x rq = msg >> liftIO (httpLbs raw m) >>= response l+ where+ msg = debug l ("[Raw Request]\n" <> Text.pack (show raw))++ raw = rq+ { Client.secure = True+ , Client.port = 443+ , Client.requestHeaders = headers+ , Client.requestBody = Client.RequestBodyLBS (encode x)+ }++ headers =+ [ ("Content-Type", "application/json")+ , ("Accept", "application/json")+ ]++response :: forall m b. (MonadIO m, FromJSON b)+ => Logger+ -> Client.Response LBS.ByteString+ -> m (Either Error b)+response l rs = case statusCode (Client.responseStatus rs) of+ 200 -> success+ 201 -> success+ 400 -> failure+ 500 -> failure+ n -> return . Left $ unhandled n+ where+ success = maybe (Left unknown) Right `liftM` parse+ failure = maybe (Left unknown) Left `liftM` parse++ unhandled n = Internal $+ "PagerDuty returned unhandled status code: "+ <> Text.pack (show n)++ unknown = Internal $+ "Unable to parse response into a PagerDuty API compatible type: "+ <> Text.pack (show body)++ parse :: FromJSON a => m (Maybe a)+ parse = msg >> return (decode body)++ msg = debug l ("[Raw Response]\n" <> Text.pack (show rs))++ body = Client.responseBody rs
+ src/Network/PagerDuty/Internal/Options.hs view
@@ -0,0 +1,56 @@+-- Module : Network.PagerDuty.Internal.Options+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.Internal.Options+ ( dropped+ , hyphenated+ , underscored+ ) where++import Data.Aeson.Types+import Data.Char+import Data.List++dropped :: Int -> Options -> Options+dropped n o = o+ { constructorTagModifier = constructorTagModifier o . drop n+ }++hyphenated :: Options+hyphenated = underscored+ { fieldLabelModifier = unsuffix . hyphenate . unprefix+ , constructorTagModifier = hyphenate+ }++underscored :: Options+underscored = defaultOptions+ { fieldLabelModifier = unsuffix . underscore . unprefix+ , constructorTagModifier = underscore+ , omitNothingFields = True+ , allNullaryToStringTag = True+ }++hyphenate :: String -> String+hyphenate = intercalate "-" . map lower . splitBy isUpper++underscore :: String -> String+underscore = intercalate "_" . map lower . splitBy isUpper++lower :: String -> String+lower = map toLower++unsuffix :: String -> String+unsuffix = takeWhile (/= '\'')++unprefix :: String -> String+unprefix = dropWhile (not . isUpper)++splitBy :: (a -> Bool) -> [a] -> [[a]]+splitBy p = groupBy (const (not . p))
+ src/Network/PagerDuty/Internal/Query.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- Module : Network.PagerDuty.Internal.Query+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.Internal.Query+ ( QueryValues (..)+ , gquery+ , gqueryWith+ ) where++import Data.Aeson.Types+import Data.Bifunctor+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Conversion+import Data.Function (on)+import Data.List (groupBy)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Generics.SOP+import Network.HTTP.Types+import Network.PagerDuty.Internal.Options++class QueryValues a where+ queryValues :: a -> [ByteString]++ default queryValues :: ToByteString a => a -> [ByteString]+ queryValues = (:[]) . toByteString'++instance QueryValues a => QueryValues (Maybe a) where+ queryValues (Just x) = queryValues x+ queryValues Nothing = []++instance QueryValues Text where+ queryValues x = [Text.encodeUtf8 x]++gquery :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValues (Code a))+ => a+ -> Query+gquery = gqueryWith underscored++gqueryWith :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValues (Code a))+ => Options+ -> a+ -> Query+gqueryWith o a = case datatypeInfo (Proxy :: Proxy a) of+ ADT _ _ cs -> go cs (from a)+ Newtype _ _ c -> go (c :* Nil) (from a)+ where+ go :: (All2 QueryValues xss, SingI xss)+ => NP ConstructorInfo xss+ -> SOP I xss+ -> Query+ go cs (SOP sop) = group . unI . hcollapse $ hcliftA2' p (gctor o) cs sop++ group :: [(ByteString, ByteString)] -> Query+ group = concatMap f . groupBy ((==) `on` fst)+ where+ f [] = []+ f [(k, v)] = [(k, Just v)]+ f xs@((k,_):_) = let n = k <> "[]" in map (bimap (const n) Just) xs++gctor :: All QueryValues xs+ => Options+ -> ConstructorInfo xs+ -> NP I xs+ -> K [(ByteString, ByteString)] xs+gctor o (Constructor n) args =+ K . concat . hcollapse $ hcliftA p (K . map (k,) . queryValues . unI) args+ where+ k = BS.pack (constructorTagModifier o n)++gctor o (Record _ ns) args =+ K . concat . hcollapse $ hcliftA2 p (gfield o) ns args++gctor o (Infix n _ _) (x :* y :* Nil) =+ K $ map (k,) (queryValues (unI x) ++ queryValues (unI y))+ where+ k = BS.pack (constructorTagModifier o n)++gctor _ Infix{} _ =+ error "Network.PagerDuty.Generics.inaccessible"++gfield :: QueryValues a+ => Options+ -> FieldInfo a+ -> I a+ -> K [(ByteString, ByteString)] a+gfield o (FieldInfo f) (I a) =+ K $ map (k,) (queryValues a)+ where+ k = BS.pack (fieldLabelModifier o f)++p :: Proxy QueryValues+p = Proxy
+ src/Network/PagerDuty/Internal/TH.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.PagerDuty.Internal.TH+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.Internal.TH+ (+ -- * Requests+ jsonRequest+ , queryRequest++ -- * Compound expressions+ , deriveNullary+ , deriveNullaryWith+ , deriveRecord++ -- * JSON+ , deriveJSON+ , deriveJSONWith++ -- * Lenses+ , makeLens+ , makeFields++ -- * Re-exported generics+ , deriveGeneric++ -- * Re-exported options+ , dropped+ , hyphenated+ , underscored+ ) where++import Control.Applicative+import Control.Lens+import qualified Data.Aeson.TH as Aeson+import Data.Aeson.Types+import Data.ByteString (ByteString)+import qualified Data.Text.Encoding as Text+import Generics.SOP.TH+import Language.Haskell.TH+import Network.HTTP.Types.QueryLike+import Network.PagerDuty.Internal.Query+import Network.PagerDuty.Internal.Options++jsonRequest :: Name -> Q [Dec]+jsonRequest n = concat <$> sequence+ [ makeLenses n+ , deriveJSON n+ , [d|instance QueryLike $(conT n) where toQuery = const []|]+ ]++queryRequest :: Name -> Q [Dec]+queryRequest n = concat <$> sequence+ [ deriveGeneric n+ , makeLenses n+ , [d|instance ToJSON $(conT n) where toJSON = const (toJSON (object []))|]+ , [d|instance QueryLike $(conT n) where toQuery = gquery|]+ ]++deriveNullary :: Name -> Q [Dec]+deriveNullary = deriveNullaryWith underscored++deriveNullaryWith :: Options -> Name -> Q [Dec]+deriveNullaryWith o n = concat <$> sequence+ [ deriveJSONWith o n+ , [d|instance QueryValues $(conT n) where queryValues = value . toJSON|]+ ]++deriveRecord :: Name -> Q [Dec]+deriveRecord n = concat <$> sequence+ [ deriveJSON n+ , makeLenses n+ ]++deriveJSON :: Name -> Q [Dec]+deriveJSON = deriveJSONWith underscored++deriveJSONWith :: Options -> Name -> Q [Dec]+deriveJSONWith = Aeson.deriveJSON++makeLens :: String -> Name -> Q [Dec]+makeLens k = makeLensesWith+ $ lensRulesFor [(k, drop 1 k)]+ & simpleLenses .~ True++value :: Value -> [ByteString]+value (String t) = [Text.encodeUtf8 t]+value _ = []
+ src/Network/PagerDuty/Internal/Types.hs view
@@ -0,0 +1,480 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++-- Module : Network.PagerDuty.Internal.Types+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.Internal.Types where++import Control.Applicative+import Control.Lens hiding ((.=))+import Control.Monad.IO.Class+import Data.Aeson hiding (Error)+import Data.Aeson.Types (Parser)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Conversion hiding (List)+import Data.Default.Class+import Data.Function (on)+import qualified Data.HashMap.Strict as Map+import Data.List (deleteBy, intersperse)+import Data.Monoid+import Data.String+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Time+import GHC.TypeLits+import Network.HTTP.Client (Manager)+import Network.HTTP.Types+import Network.HTTP.Types.QueryLike+import Network.PagerDuty.Internal.Query+import Network.PagerDuty.Internal.TH+import System.Locale++-- FIXME: Verify IncidentId/IncidentKey .. *Id/*Key are actually different or needed++newtype CSV a = CSV [a]+ deriving (Eq, Show, Monoid)++makePrisms ''CSV++instance ToByteString a => QueryValues (CSV a)++instance ToByteString a => ToByteString (CSV a) where+ builder (CSV xs) = mconcat . intersperse "," $ map builder xs++instance FromJSON a => FromJSON (CSV a) where+ parseJSON = withText "comma_separated_value" $+ fmap CSV . traverse (parseJSON . String) . Text.split (== ',')++instance ToByteString a => ToJSON (CSV a) where+ toJSON = String . Text.decodeUtf8 . toByteString'++newtype List a = L [a]+ deriving (Eq, Show, Monoid)++deriveJSON ''List+makePrisms ''List++instance QueryValues a => QueryValues (List a) where+ queryValues (L xs) = concatMap queryValues xs++newtype Bool' = B Bool+ deriving (Eq, Show)++deriveJSON ''Bool'+makePrisms ''Bool'++instance ToByteString Bool' where+ builder (B True) = "true"+ builder (B False) = "false"++instance QueryValues Bool'++pattern T = B True+pattern F = B False++newtype Date = D UTCTime+ deriving (Eq, Ord, Show)++makePrisms ''Date++instance FromJSON Date where+ parseJSON = fmap D . parseJSON++instance ToJSON Date where+ toJSON (D d) = toJSON d++instance ToByteString Date where+ builder (D d) = builder+ (formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ") d)++instance QueryValues Date++newtype TZ = TZ TimeZone+ deriving (Eq, Show)++makePrisms ''TZ++instance FromJSON TZ where+ parseJSON = undefined++instance ToJSON TZ where+ toJSON = toJSON . Text.decodeUtf8 . toByteString'++instance ToByteString TZ where+ builder (TZ tz) = builder (timeZoneName tz)++instance QueryValues TZ++instance Default TZ where+ def = TZ utc++data Security = Basic | Token+ deriving (Eq, Show)++data Auth (a :: Security) where+ AuthBasic :: ByteString -> ByteString -> Auth Basic+ AuthToken :: ByteString -> Auth Token++deriving instance Eq (Auth a)+deriving instance Show (Auth a)++newtype SubDomain = SubDomain { subDomain :: ByteString }+ deriving (Eq, Show, IsString)++domain :: SubDomain -> ByteString+domain (SubDomain s)+ | base `BS.isSuffixOf` s = s+ | otherwise = s <> base+ where+ base = ".pagerduty.com"++-- | The log level and associated logger function.+data Logger+ = None+ | Debug (Text -> IO ())++-- | Log a message using the debug logger, or if none is specified noop.+debug :: MonadIO m => Logger -> Text -> m ()+debug None = const (return ())+debug (Debug f) = liftIO . f++-- | The environment containing the parameters required to+-- make PagerDuty requests.+data Env (s :: Security) = Env+ { _envDomain :: SubDomain+ , _envAuth' :: Auth s+ , _envManager :: Manager+ , _envLogger :: Logger+ }++makeLenses ''Env++envAuth :: forall s s'. Lens (Env s) (Env s') (Auth s) (Auth s')+envAuth = lens _envAuth' (\s x -> s { _envAuth' = x })++prod :: SubDomain -> Auth s -> Manager -> Env s+prod d a m = Env d a m None++newtype Code = Code Integer+ deriving (Eq, Show)++deriveJSON ''Code++description :: Code -> Text+description (Code c) =+ case c of+ 2000 -> "Internal Error"+ 2001 -> "Invalid Input Provided"+ 2002 -> "Arguments Caused Error"+ 2003 -> "Missing Arguments"+ 2004 -> "Invalid 'since' or 'until' Parameter Values"+ 2005 -> "Invalid Query Date Range"+ 2006 -> "Authentication Failed"+ 2007 -> "Account Not Found"+ 2008 -> "Account Locked"+ 2009 -> "Only HTTPS Allowed For This Call"+ 2010 -> "Access Denied"+ 2011 -> "The action requires a 'requester_id' to be specified"+ 2012 -> "Your account is expired and cannot use the API"+ _ -> "Unrecognised error code"++class HasMessage s a | s -> a where+ -- | A short human-readable message describing the error.+ message :: Lens' s a++class HasErrors s a | s -> a where+ -- | A list of human-readable reasons for the error. These values,+ -- and even their format, are subject to change.+ errors :: Lens' s a++data IntegrationError = IntegrationError+ { _ieStatus :: Text+ , _ieMessage :: Text+ , _ieErrors :: [Text]+ } deriving (Eq, Show)++deriveRecord ''IntegrationError++instance HasMessage IntegrationError Text where message = ieMessage+instance HasErrors IntegrationError [Text] where errors = ieErrors++status :: Lens' IntegrationError Text+status = ieStatus++data RESTError = RESTError+ { _reCode :: Code+ , _reMessage :: Text+ , _reErrors :: [Text]+ } deriving (Eq, Show)++deriveRecord ''RESTError++instance HasMessage RESTError Text where message = reMessage+instance HasErrors RESTError [Text] where errors = reErrors++-- | In the case of an error, the PagerDuty error code can give further details+-- on the nature of the error.+--+-- /See:/ 'description'+code :: Lens' RESTError Code+code = reCode++data Error+ = Internal Text+ | Integration IntegrationError+ | REST RESTError+ deriving (Eq, Show)++instance FromJSON Error where+ parseJSON o = (REST <$> parseJSON o)+ <|> (Integration <$> parseJSON o)++makePrisms ''Error++instance HasMessage Error Text where+ message = lens f g+ where+ f (Internal x) = x+ f (Integration s) = _ieMessage s+ f (REST s) = _reMessage s++ g (Internal _) x = Internal x+ g (Integration s) x = Integration $ s { _ieMessage = x }+ g (REST s) x = REST $ s { _reMessage = x }++data Pager = Pager+ { _pgOffset :: !Int+ -- ^ The offset used in the execution of the query.+ , _pgLimit :: !Int+ -- ^ The limit used in the execution of the query.+ , _pgTotal :: !Int+ -- ^ The total number of records available.+ , _pgQuery :: Maybe Text+ -- ^ An optional query= value to be added to the query string.+ } deriving (Eq, Show)++makeLenses ''Pager++instance FromJSON a => FromJSON (a, Maybe Pager) where+ parseJSON = withObject "paginated" $ \o -> (,)+ <$> parseJSON (Object o)+ <*> optional (parse o)+ where+ parse o = Pager+ -- The offset of the first record returned.+ -- Default is 0.+ <$> o .: "offset" .!= 0+ -- The number of records returned.+ -- Default (and max limit) is 100 for most APIs.+ <*> o .: "limit" .!= 100+ <*> o .: "total"+ <*> o .:? "query"++instance ToJSON Pager where+ toJSON p = object+ [ "offset" .= _pgOffset p+ , "limit" .= _pgLimit p+ ]++-- | A path segment.+data Path where+ Path :: Path+ Seg :: ToByteString a => a -> Path++instance Monoid Path where+ mempty = Path+ mappend x Path = x+ mappend Path y = y+ mappend (Seg x) (Seg y) = Seg (builder x <> "/" <> builder y)++instance IsString Path where+ fromString = Seg++instance ToByteString Path where+ builder Path = mempty+ builder (Seg x) = builder x++(%) :: ToByteString a => Path -> a -> Path+a % b = a <> Seg b++renderPath :: Path -> ByteString+renderPath = toByteString' . mappend v1+ where+ v1 :: Path+ v1 = "/api/v1"++data Request a (s :: Security) b where+ Request :: (QueryLike a, ToJSON a)+ => { _rqMeth :: !StdMethod+ , _rqPath :: Path+ , _rqQuery :: Query+ , _rqBody :: a+ , _rqPager :: Maybe Pager+ , _rqUnwrap :: Value -> Parser Value+ }+ -> Request a s b++instance ToJSON (Request a s b) where+ -- Manually unwrapped to ensure GADT constraint holds.+ toJSON (Request _ _ _ b p _) = Object $+ let Object x = toJSON b+ in case toJSON p of+ (Object y) -> x <> y+ _ -> x++type Unwrap = Getting (First Value) Value Value++-- | Create a defaulted request from the payload type.+mk :: (QueryLike a, ToJSON a) => a -> Request a s b+mk x = Request GET mempty mempty x Nothing pure++empty :: Request Empty s r+empty = mk Empty++-- | Lens into the body of a request.+upd :: (QueryLike a, ToJSON a) => Lens' (Request a s b) a+upd = lens _rqBody (\(Request m p q _ g u) x -> Request m p q x g u)++-- | Drop the security constraint.+auth :: Request a s b -> Request a t b+auth (Request x m p q g u) = Request x m p q g u++meth :: Lens' (Request a s b) StdMethod+meth = lens _rqMeth (\r x -> r { _rqMeth = x })++path :: Lens' (Request a s b) Path+path = lens _rqPath (\r x -> r { _rqPath = x })++query :: QueryValueLike v+ => Lens (Request a s b) (Request a s b) Query [(ByteString, v)]+query = lens _rqQuery (\r x -> r { _rqQuery = toQuery x })++pager :: Lens' (Request a s b) (Maybe Pager)+pager = lens _rqPager (\r x -> r { _rqPager = x })++unwrap :: Setter (Request a s b) (Request a s b) (Value -> Parser Value) Unwrap+unwrap f r = f (_rqUnwrap r) <&> \k -> r { _rqUnwrap = g k }+ where+ g k x = maybe (fail "Failed to extract nested keys.") return (x ^? k)++-- | Exists primarily to obtain a constraint for the 'paginate' function.+class Paginate a where+ next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)+ next rq = maybe Nothing go+ where+ go x | x^.pgTotal == 0 = Nothing+ | otherwise = Just $+ rq & pager ?~ (x & pgOffset +~ x^.pgTotal)+ & query %~ (add . clear)+ where+ add :: Query -> Query+ add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x^.pgQuery)++ clear :: Query -> Query+ clear = deleteBy ((==) `on` fst) (k, Nothing)++ k :: ByteString+ k = "query"++newtype Key (a :: Symbol) = Key Text+ deriving (Eq, Show, IsString)++instance FromJSON (Key a) where+ parseJSON = withText "key" (return . Key)++instance ToJSON (Key a) where+ toJSON (Key k) = toJSON k++instance ToByteString (Key a) where+ builder (Key k) = builder k++instance QueryValues (Key a)++instance QueryValueLike (Key a) where+ toQueryValue = Just . toByteString'++type ServiceKey = Key "service"+type IncidentKey = Key "incident"++newtype Id (a :: Symbol) = Id Text+ deriving (Eq, Show, IsString)++instance FromJSON (Id a) where+ parseJSON = withText "id" (return . Id)++instance ToJSON (Id a) where+ toJSON (Id i) = toJSON i++instance ToByteString (Id a) where+ builder (Id i) = builder i++instance QueryValues (Id a)++instance QueryValueLike (Id a) where+ toQueryValue = Just . toByteString'++type AlertId = Id "alert"+type ContactId = Id "contact"+type EmailFilterId = Id "email-filter"+type EscalationPolicyId = Id "escalation-policy"+type EscalationRuleId = Id "escalation-rule"+type IncidentId = Id "incident"+type LogEntryId = Id "log-entry"+type NoteId = Id "note"+type NotificationRuleId = Id "notification-rule"+type OverrideId = Id "schedule-override"+type RequesterId = Id "requester"+type ScheduleId = Id "schedule"+type ServiceId = Id "service"+type UserId = Id "user"+type VendorId = Id "vendor"+type WebhookId = Id "webhook"+type WindowId = Id "maintenance-window"++data Empty = Empty++instance ToJSON Empty where+ toJSON = const (object [])++instance FromJSON Empty where+ parseJSON = withObject "empty" f+ where+ f !o | Map.null o = pure Empty+ | otherwise = fail "Unexpected non-empty JSON object."++instance QueryLike Empty where+ toQuery = const []++newtype Address = Address Text+ deriving (Eq, Show)++deriveJSON ''Address+makePrisms ''Address++instance ToByteString Address where+ builder (Address a) = builder a++instance QueryValues Address
+ src/Network/PagerDuty/REST.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.PagerDuty.REST+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.PagerDuty.REST+ (++ -- * Sending requests+ send+ , paginate++ -- * Configuration+ -- ** Environment+ , Env+ , envDomain+ , envAuth+ , envManager+ , envLogger++ -- ** Requests+ , sendWith+ , paginateWith+ ) where++import Control.Applicative+import Control.Lens+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans+import Data.Aeson (FromJSON)+import Data.Conduit+import Data.Default.Class+import Data.Monoid+import Network.HTTP.Client (Manager)+import qualified Network.HTTP.Client as Client+import Network.HTTP.Types+import Network.PagerDuty.Internal.IO+import Network.PagerDuty.Internal.Types++-- FIXME: verify correct actions are all paginated+-- FIXME: Ensure RequesterId parameter is always most significant param+-- FIXME: add smart constructors for all types, for testing purposes++send :: (MonadIO m, FromJSON b)+ => SubDomain+ -> Auth s+ -> Manager+ -> Request a s b+ -> m (Either Error b)+send d a m = sendWith (prod d a m)++-- | /See:/ 'sendWith'+sendWith :: (MonadIO m, FromJSON b)+ => Env s+ -> Request a s b+ -> m (Either Error b)+sendWith e = liftM (fmap fst) . http e++paginate :: (MonadIO m, Paginate a, FromJSON b)+ => SubDomain+ -> Auth s+ -> Manager+ -> Request a s b+ -> Source m (Either Error b)+paginate d a m = paginateWith (prod d a m)++-- | /See:/ 'paginateWith'+paginateWith :: (MonadIO m, Paginate a, FromJSON b)+ => Env s+ -> Request a s b+ -> Source m (Either Error b)+paginateWith e = go+ where+ go rq = do+ rs <- lift (http e rq)+ yield (fst <$> rs)+ either (const (return ()))+ (maybe (return ()) go . next rq . snd)+ rs++http :: (MonadIO m, FromJSON b)+ => Env s+ -> Request a s b+ -> m (Either Error (b, Maybe Pager))+http e rq = request (e ^. envManager) (e ^. envLogger) rq $ raw+ { Client.host = domain (e ^. envDomain)+ , Client.path = renderPath (rq ^. path)+ , Client.queryString = renderQuery False (rq ^. query)+ }+ where+ raw = case e ^. envAuth of+ AuthBasic u p -> Client.applyBasicAuth u p def+ AuthToken t -> def+ { Client.requestHeaders = [("Authorization", "Token token=" <> t)]+ }
+ src/Network/PagerDuty/REST/Alerts.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.PagerDuty.REST.Alerts+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | When an incident is triggered or when it is escalated it creates an alert+-- (also known as a notification). Alerts are messages containing the details+-- of the incident, and can be sent through SMS, email, phone calls,+-- and push notifications.+--+-- This API allows you to access read-only data regarding what alerts have been+-- sent to your users.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/alerts>+module Network.PagerDuty.REST.Alerts+ (+ -- * List Alerts+ ListAlerts+ , listAlerts+ , laSince+ , laUntil+ , laFilter+ , laTimeZone++ -- * Types+ , AlertType (..)++ , Alert+ , alertId+ , alertType+ , alertStartedAt+ , alertUser+ , alertAddress+ ) where++import Control.Lens+import Data.Aeson.Lens+import Data.Time+import Network.PagerDuty.REST.Users (User)+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++alerts :: Path+alerts = "alerts"++data AlertType+ = SMS+ | Email+ | Phone+ | Push+ deriving (Eq, Show)++deriveNullary ''AlertType++data Alert = Alert+ { _alertId :: AlertId+ , _alertType :: AlertType+ , _alertStartedAt :: Date+ , _alertUser :: User+ , _alertAddress :: Address+ } deriving (Eq, Show)++deriveRecord ''Alert++data ListAlerts = ListAlerts+ { _laSince' :: Date+ , _laUntil' :: Date+ , _laFilter' :: Maybe AlertType+ , _laTimeZone' :: Maybe TZ+ } deriving (Eq, Show)++instance Paginate ListAlerts++queryRequest ''ListAlerts++-- | The start of the date range over which you want to search.+laSince :: Lens' (Request ListAlerts s b) UTCTime+laSince = upd.laSince'._D++-- | The end of the date range over which you want to search.+-- This should be in the same format as 'since'.+--+-- The size of the date range must be less than 3 months.+laUntil :: Lens' (Request ListAlerts s b) UTCTime+laUntil = upd.laUntil'._D++-- | Returns only the alerts of the said 'AlertType' type.+laFilter :: Lens' (Request ListAlerts s b) (Maybe AlertType)+laFilter = upd.laFilter'++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ account time zone.+laTimeZone :: Lens' (Request ListAlerts s b) (Maybe TimeZone)+laTimeZone = upd.laTimeZone'.mapping _TZ++-- | List existing alerts for a given time range, optionally filtered by type+-- (SMS, Email, Phone, or Push).+--+-- @GET \/alerts@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/alerts/list>+listAlerts :: Date -- ^ 'laSince'+ -> Date -- ^ 'laUntil'+ -> Request ListAlerts s [Alert]+listAlerts s u =+ mk ListAlerts+ { _laSince' = s+ , _laUntil' = u+ , _laFilter' = Nothing+ , _laTimeZone' = Nothing+ } & path .~ alerts+ & unwrap .~ key "alerts"
+ src/Network/PagerDuty/REST/EscalationPolicies.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.EscalationPolicies+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | This API lets you access and manipulate escalation policies and rules.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies>+module Network.PagerDuty.REST.EscalationPolicies+ (+ -- * List Policies+ ListPolicies+ , listPolicies+ , lpQuery++ -- * List On Call Policies+ , listOnCallPolicies++ -- * Create Policy+ , CreatePolicy+ , createPolicy+ , cpName+ , cpRepeatEnabled+ , cpNumLoops+ , cpEscalationRules++ -- * Get Policy+ , getPolicy++ -- * Update Policy+ , UpdatePolicy+ , updatePolicy+ , upName+ , upRepeatEnabled+ , upNumLoops+ , upEscalationRules++ -- * Delete Policy+ , deletePolicy++ -- * Types+ , Policy+ , pId+ , pName+ , pNumLoops+ , pRules+ , pServices+ ) where++import Control.Lens+import Data.Aeson.Lens+import Data.Text (Text)+import Network.HTTP.Types+import Network.PagerDuty.REST.Services (Service)+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++import Network.PagerDuty.REST.EscalationPolicies.EscalationRules++default (Path)++policies :: Path+policies = "escalation_policies"++data Policy = Policy+ { _pId :: EscalationPolicyId+ , _pName :: Text+ , _pNumLoops :: !Int+ , _pRules :: [Rule]+ , _pServices :: [Service]+ } deriving (Eq, Show)++deriveJSON ''Policy++-- | The ID of the escalation policy.+makeLens "_pId" ''Policy++-- | The name of the escalation policy.+makeLens "_pName" ''Policy++-- | The number of times the escalation policy will repeat after+-- reaching the end of its escalation.+makeLens "_pNumLoops" ''Policy++-- | A list of the policy's escalation rules in order of escalation.+makeLens "_pRules" ''Policy++-- | A list of services using this escalation policy.+makeLens "_pServices" ''Policy++newtype ListPolicies = ListPolicies+ { _lpQuery' :: Maybe Text+ } deriving (Eq, Show)++instance Paginate ListPolicies++queryRequest ''ListPolicies++-- | Filters the result, showing only the escalation policies+-- whose names match the query.+lpQuery :: Lens' (Request ListPolicies s b) (Maybe Text)+lpQuery = upd.lpQuery'++-- | List all the existing escalation policies.+--+-- @GET \/escalation_policies@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/list>+listPolicies :: Request ListPolicies s [Policy]+listPolicies =+ mk ListPolicies+ { _lpQuery' = Nothing+ } & path .~ policies+ & unwrap .~ key "escalation_policies"++-- | List all the existing escalation policies with currently on-call users.+--+-- If the start and end of an on-call object are null, then the user is always+-- on-call for an escalation policy level.+--+-- @GET \/escalation_policies\/on_call@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/on_call>+listOnCallPolicies :: Request ListPolicies s [Policy]+listOnCallPolicies = listPolicies & path .~ policies % "on_call"++data CreatePolicy = CreatePolicy+ { _cpName' :: Text+ , _cpRepeatEnabled' :: Bool'+ , _cpNumLoops' :: Maybe Int+ , _cpEscalationRules' :: [Rule] -- ^ Should be List1+ } deriving (Eq, Show)++jsonRequest ''CreatePolicy++-- | The name of the escalation policy.+cpName :: Lens' (Request CreatePolicy s b) Text+cpName = upd.cpName'++-- | Whether or not to allow this policy to repeat its escalation+-- rules after the last rule is finished.+--+-- /Default:/ false.+cpRepeatEnabled :: Lens' (Request CreatePolicy s b) Bool+cpRepeatEnabled = upd.cpRepeatEnabled'._B++-- | The number of times to loop over the set of rules in this escalation policy.+cpNumLoops :: Lens' (Request CreatePolicy s b) (Maybe Int)+cpNumLoops = upd.cpNumLoops'++-- | The escalation rules for this policy.+cpEscalationRules :: Lens' (Request CreatePolicy s b) [Rule]+cpEscalationRules = upd.cpEscalationRules'++-- | Creates an existing escalation policy and rules.+--+-- @POST \/escalation_policies@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/create>+createPolicy :: EscalationPolicyId+ -> Text -- ^ 'creName'+ -> [Rule] -- ^ 'creEscalationRules'+ -> Request CreatePolicy s Policy+createPolicy i n rs =+ mk CreatePolicy+ { _cpName' = n+ , _cpRepeatEnabled' = F+ , _cpNumLoops' = Nothing+ , _cpEscalationRules' = rs+ } & meth .~ PUT+ & path .~ policies % i+ & unwrap .~ key "escalation_policy"++-- | Get information about an existing escalation policy and its rules.+--+-- @GET \/escalation_policies\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/show>+getPolicy :: EscalationPolicyId -> Request Empty s Policy+getPolicy i = empty & path .~ policies % i & unwrap .~ key "escalation_policy"++data UpdatePolicy = UpdatePolicy+ { _upName' :: Maybe Text+ , _upRepeatEnabled' :: Maybe Bool'+ , _upNumLoops' :: Maybe Int+ , _upEscalationRules' :: [Rule]+ } deriving (Eq, Show)++jsonRequest ''UpdatePolicy++-- | The name of the escalation policy.+upName :: Lens' (Request UpdatePolicy s b) (Maybe Text)+upName = upd.upName'++-- | Whether or not to allow this policy to repeat its escalation+-- rules after the last rule is finished.+upRepeatEnabled :: Lens' (Request UpdatePolicy s b) (Maybe Bool)+upRepeatEnabled = upd.upRepeatEnabled'.mapping _B++-- | The number of times to loop over the set of rules in this escalation policy.+upNumLoops :: Lens' (Request UpdatePolicy s b) (Maybe Int)+upNumLoops = upd.upNumLoops'++-- | The escalation rules for this policy.+upEscalationRules :: Lens' (Request UpdatePolicy s b) [Rule]+upEscalationRules = upd.upEscalationRules'++-- | Updates an existing escalation policy and rules.+--+-- @PUT \/escalation_policies\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/update>+updatePolicy :: EscalationPolicyId -> Request UpdatePolicy s Policy+updatePolicy i =+ mk UpdatePolicy+ { _upName' = Nothing+ , _upRepeatEnabled' = Nothing+ , _upNumLoops' = Nothing+ , _upEscalationRules' = []+ } & meth .~ PUT+ & path .~ policies % i+ & unwrap .~ key "escalation_policy"++-- | Deletes an existing escalation policy and rules. The escalation policy+-- must not be in use by any services.+--+-- @DELETE \/escalation_policies\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/delete>+deletePolicy :: EscalationPolicyId -> Request Empty s Empty+deletePolicy i = empty & meth .~ DELETE & path .~ policies % i
+ src/Network/PagerDuty/REST/EscalationPolicies/EscalationRules.hs view
@@ -0,0 +1,277 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.EscalationPolicies.EscalationRules+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | This API lets you access and manipulate escalation rules of an existing+-- escalation policy.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules>+module Network.PagerDuty.REST.EscalationPolicies.EscalationRules+ (+ -- * List Rules+ listRules++ -- * Create Rule+ , CreateRule+ , createRule+ , crEscalationDelayInMinutes+ , crTargets++ -- * Get Rule+ , getRule++ -- * Update Rules+ , UpdateRules+ , updateRules+ , urEscalationRules++ -- * Update Rule+ , UpdateRule+ , updateRule+ , urEscalationDelayInMinutes+ , urTargets++ -- * Delete Rule+ , deleteRule++ -- * Types+ , HasUserInfo (..)++ , Target (..)+ , _TSchedule+ , _TUser++ , ScheduleTarget+ , stId+ , stName++ , Rule+ , rId+ , rEscalationDelayInMinutes+ , rTargets+ ) where++import Control.Applicative ((<$>))+import Control.Lens hiding ((.=))+import Data.Aeson+import qualified Data.HashMap.Strict as Map+import Data.Text (Text)+import Network.HTTP.Types+import Network.PagerDuty.REST.Users+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++-- FIXME: The lenses here need to operate over (Request x s b) using upd++rules :: EscalationPolicyId -> Path+rules p = "escalation_policies" % p % "escalation_rules"++data TargetType+ = TargetSchedule+ | TargetUser++deriveJSONWith (dropped 6 underscored) ''TargetType++data TargetId+ = ScheduleId ScheduleId+ | UserId UserId+ deriving (Eq, Show)++instance FromJSON TargetId where+ parseJSON = withObject "target" $ \o -> do+ t <- o .: "type"+ case t of+ TargetSchedule -> ScheduleId <$> o .: "id"+ TargetUser -> UserId <$> o .: "id"++instance ToJSON TargetId where+ toJSON (ScheduleId s) = object ["type" .= TargetSchedule, "id" .= s]+ toJSON (UserId u) = object ["type" .= TargetUser, "id" .= u]++data ScheduleTarget = ScheduleTarget+ { _stId :: ScheduleId+ , _stName :: Text+ } deriving (Eq, Show)++deriveJSON ''ScheduleTarget++-- | The id of the target.+makeLens "_stId" ''ScheduleTarget++-- | The name of the target.+makeLens "_stName" ''ScheduleTarget++data Target+ = TSchedule ScheduleTarget+ | TUser UserInfo+ deriving (Eq, Show)++makePrisms ''Target++instance FromJSON Target where+ parseJSON = withObject "target" $ \o -> do+ t <- o .: "type"+ case t of+ TargetSchedule -> TSchedule <$> parseJSON (Object o)+ TargetUser -> TUser <$> parseJSON (Object o)++instance ToJSON Target where+ toJSON t = Object (Map.insert "type" (String k) o)+ where+ (k, Object o) = case t of+ TSchedule s -> ("schedule", toJSON s)+ TUser u -> ("user", toJSON u)++data Rule = Rule+ { _rId :: EscalationRuleId+ , _rEscalationDelayInMinutes :: !Int+ , _rTargets :: [Target]+ } deriving (Eq, Show)++deriveJSON ''Rule++-- | The ID of the escalation rule.+makeLens "_rId" ''Rule++-- | The amount of time before an incident escalates away from this rule.+makeLens "_rEscalationDelayInMinutes" ''Rule++-- | A list of targets which an incident will be assigned to upon reaching this rule.+makeLens "_rTargets" ''Rule++-- | List all the escalation rules for an existing escalation policy.+--+-- @GET \/escalation_policies\/\:escalation_policy_id\/escalation_rules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/list>+listRules :: EscalationPolicyId -> Request Empty s [Rule]+listRules p = empty & path .~ rules p++-- | Show the escalation rule for an existing escalation policy.+--+-- @GET \/escalation_policies\/:escalation_policy_id\/escalation_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/show>+getRule :: EscalationPolicyId -> EscalationRuleId -> Request Empty s Rule+getRule p r = empty & path .~ rules p % r++data CreateRule = CreateRule+ { _crEscalationDelayInMinutes :: !Int+ , _crTargets :: [TargetId] -- ^ list1?+ } deriving (Eq, Show)++deriveJSON ''CreateRule++instance QueryLike CreateRule where+ toQuery = const []++-- | The escalation timeout in minutes. Must be at least 5 if the rule has+-- multiple targets, and at least 1 if not. If an incident is not acknowledged+-- within this timeout then it will escalate onto the next escalation rule.+makeLens "_crEscalationDelayInMinutes" ''CreateRule++-- | The list of the targets an incident should be assigned to upon reaching+-- this rule.+makeLens "_crTargets" ''CreateRule++-- | Creates a new escalation rule for an escalation policy and appends it to+-- the end of the existing escalation rules.+--+-- @POST \/escalation_policies\/\:escalation_policy_id\/escalation_rules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/create>+createRule :: EscalationPolicyId+ -> Int -- ^ 'crEscalationDelayInMinutes'+ -> [TargetId] -- ^ 'crTargets'+ -> Request CreateRule s Rule+createRule p n ts =+ mk CreateRule+ { _crEscalationDelayInMinutes = n+ , _crTargets = ts+ } & meth .~ POST+ & path .~ rules p++newtype UpdateRules = UpdateRules+ { _urEscalationRules :: [TargetId] -- ^ list1+ } deriving (Eq, Show)++deriveJSON ''UpdateRules++instance QueryLike UpdateRules where+ toQuery = const []++-- | An ordered array of escalation rules.+makeLens "_urEscalationRules" ''UpdateRules++-- | Updates the entire collection of escalation rules for an existing escalation+-- policy. The ordering is determined by the positions of each rule in the+-- list. To create a new rule, add it to the list without an id. To remove a+-- rule, do not include it in the list.+--+-- @PUT \/escalation_policies\/\:escalation_policy_id\/escalation_rules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/multi_update>+updateRules :: EscalationPolicyId+ -> [TargetId] -- ^ 'urEscalationRules'+ -> Request UpdateRules s [Rule]+updateRules p rs =+ mk UpdateRules+ { _urEscalationRules = rs+ } & meth .~ PUT+ & path .~ rules p++data UpdateRule = UpdateRule+ { _urEscalationDelayInMinutes :: Maybe Int+ , _urTargets :: [TargetId]+ } deriving (Eq, Show)++deriveJSON ''UpdateRule++instance QueryLike UpdateRule where+ toQuery = const []++-- | The escalation timeout in minutes. Must be at least 5 if the rule has+-- multiple targets, and at least 1 if not. If an incident is not acknowledged+-- within this timeout then it will escalate onto the next escalation rule.+makeLens "_urEscalationDelayInMinutes" ''UpdateRule++-- | The list of the targets an incident should be assigned to upon reaching+-- this rule.+makeLens "_urTargets" ''UpdateRule++-- | Updates an escalation rule.+--+-- @PUT \/escalation_policies\/\:escalation_policy_id\/escalation_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/update>+updateRule :: EscalationPolicyId -> EscalationRuleId -> Request UpdateRule s Rule+updateRule p r =+ mk UpdateRule+ { _urEscalationDelayInMinutes = Nothing+ , _urTargets = []+ } & meth .~ PUT+ & path .~ rules p % r++-- | Deletes an existing escalation rule that belongs to an escalation+-- policy. There must be a matching rule.+--+-- @DELETE \/escalation_policies\/\:escalation_policy_id\/escalation_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/delete>+deleteRule :: EscalationPolicyId -> EscalationRuleId -> Request Empty s Empty+deleteRule p r = empty & meth .~ DELETE & path .~ rules p % r
+ src/Network/PagerDuty/REST/Incidents.hs view
@@ -0,0 +1,650 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Incidents+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | PagerDuty receives updates (called events) from monitoring systems through+-- services (like Nagios, email or generic API calls). Upon receiving an event,+-- active services will create a new incident and begin escalating it as+-- defined by the service's escalation policy. Events can be de-duplicated into+-- existing incidents based on service de-duplication rules to prevent you from+-- being overwhelmed by event storms.+--+-- An incident can be open, acknowledged or resolved. Whenever an incident is+-- created, it is assigned to a user (according to the escalation process, as+-- described by escalation rules and schedules). The assigned user has a chance+-- to either acknowledge that he is working on it, or to resolve it.+--+-- Resolving an incident closes it, whereas acknowledging it halts the+-- escalation process. If the incident is not resolved by the service's+-- incident ack timeout it continues up the escalation chain.+--+-- When an incident is triggered or when it is escalated it creates alerts+-- (also known as notifications). Alerts are messages containing the details of+-- the incident, and can be sent through SMS, email and phone calls.+--+-- Incidents and Incident Counts from the last 30 days are returned by+-- default. To change this default date range, see the documentation for the+-- since, until or dateRange parameters.+--+-- Note: that to create an incident you need to trigger it through the+-- "Network.PagerDuty.Integration" API.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents>+module Network.PagerDuty.REST.Incidents+ (+ -- * List Incidents+ ListIncidents+ , listIncidents+ , lsSince+ , lsUntil+ , lsDateRange+ , lsStatus+ , lsIncidentKey+ , lsService+ , lsAssignedToUser+ , lsTimeZone+ , lsSortBy++ -- * Count Incidents+ , CountIncidents+ , countIncidents+ , cSince+ , cUntil+ , cDateRange+ , cStatus+ , cIncidentKey+ , cService+ , cAssignedToUser++ -- * Get Incident+ , getIncident++ -- * Update Incidents+ , UpdateIncidents+ , updateIncidents+ , updateIncidentsBasic+ , uiIncidents++ -- * Resolve Incident+ , resolveIncident+ , resolveIncidentBasic++ -- * Acknowledge Incident+ , acknowledgeIncident+ , acknowledgeIncidentBasic++ -- * Reassign Incident+ , ReassignIncident+ , reassignIncident+ , riEscalationPolicy+ , riEscalationLevel+ , riAssignedToUser++ -- * Types+ , Sort (..)+ , _Desc+ , _Asc++ , Field (..)++ , IncidentStatus (..)+ , UpdateStatus (..)++ , UpdateIncident+ , iiId+ , iiStatus+ , iiEscalationLevel+ , iiEscalationPolicy+ , iiAssignedToUser++ , UpdatedIncidents+ , uiId+ , uiStatus+ , uiIncidentNumber+ , uiUrl+ , uiError++ , Assignee+ , aAt+ , aObject++ , HasIncident (..)+ , Incident+ ) where++import Control.Applicative hiding (empty)+import Control.Lens+import Data.Aeson+import Data.ByteString.Conversion (ToByteString(..), toByteString')+import Data.Default.Class+import Data.Maybe+import Data.Monoid hiding (All)+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.Internal.Query+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++incidents :: Path+incidents = "incidents"++data Sort a+ = Desc a+ | Asc a+ deriving (Eq, Show)++makePrisms ''Sort++data Field+ = IncidentNumber+ -- ^ The number of your incident.+ | CreatedOn+ -- ^ The date/time the incident was triggered.+ | ResolvedOn+ -- ^ The date/time the incident was resolved.+ deriving (Eq, Show)++instance QueryValues (Sort Field) where+ queryValues s = case s of+ Desc f -> ["desc:" <> field f]+ Asc f -> ["asc:" <> field f]+ where+ field IncidentNumber = "incidentNumber"+ field CreatedOn = "createdOn"+ field ResolvedOn = "resolvedOn"++data Range = All+ deriving (Eq, Show)++instance QueryValues Range where+ queryValues All = ["all"]++data IncidentStatus+ = ITriggered+ | IAcknowledged+ | IResolved+ | IOther Text+ deriving (Eq, Show)++instance ToByteString IncidentStatus where+ builder = \case+ ITriggered -> "triggered"+ IAcknowledged -> "acknowledged"+ IResolved -> "resolved"+ IOther t -> builder t++instance FromJSON IncidentStatus where+ parseJSON = withText "status" $ pure . \case+ "triggered" -> ITriggered+ "acknowledged" -> IAcknowledged+ "resolved" -> IResolved+ t -> IOther t++instance ToJSON IncidentStatus where+ toJSON = String . Text.decodeUtf8 . toByteString'++data Assignee = Assignee+ { _aAt :: Date+ , _aObject :: Object+ } deriving (Eq, Show)++deriveRecord ''Assignee++data Incident = Incident+ { _iIncidentNumber' :: !Int+ , _iStatus' :: !IncidentStatus+ , _iCreatedOn' :: Date+ , _iHtmlUrl' :: Text+ , _iIncidentKey' :: Maybe IncidentKey+ , _iService' :: Object+ , _iEscalationPolicy' :: Maybe Object+ , _iAssignedTo' :: [Assignee]+ , _iAcknowledgers' :: [Assignee]+ , _iLastStatusChangeBy' :: Maybe Assignee+ , _iLastStatusChangeOn' :: Maybe Date+ , _iTriggerSummaryData' :: Object+ , _iTriggerDetailsHtmlUrl' :: Text+ } deriving (Eq, Show)++deriveRecord ''Incident++class HasIncident a where+ incident :: Lens' a Incident++ -- | The number of the incident. This is unique across your account.+ iIncidentNumber :: Lens' a Int++ -- | The current status of the incident. Valid statuses are:+ iStatus :: Lens' a IncidentStatus++ -- | The date/time the incident was triggered.+ iCreatedOn :: Lens' a UTCTime++ -- | The PagerDuty website URL where the incident can be viewed and further+ -- actions taken. This is not the resource URL.+ iHtmlUrl :: Lens' a Text++ -- | The incident's de-duplication key. See the PagerDuty Integration API+ -- docs for further details.+ iIncidentKey :: Lens' a (Maybe IncidentKey)++ -- | The PagerDuty service that the incident belongs to. The service will+ -- contain fields of its own.+ iService :: Lens' a Object++ -- | The escalation policy that the incident belongs to. The policy will+ -- contain fields of its own.+ iEscalationPolicy :: Lens' a (Maybe Object)++ -- | The list of assignments of the incident. An assignment is an object+ -- containing the assigned user as well as the date/time the incident was+ -- assigned to that user. The user will contain fields of its own.+ -- This list is empty if the status of the incident is resolved.+ iAssignedTo :: Lens' a [Assignee]++ -- | The list of acknowledgements of the incident. An acknowledgement is an+ -- object containing the acknowleding object (either a user or the+ -- integration API) as well as the date/time the incident was acknowledged.+ -- This field is only present if the status of the incident is acknowledged.+ -- This field is sorted in ascending order by acknowledgement time.+ iAcknowledgers :: Lens' a [Assignee]++ -- | The user who is responsible for the incident's last status change. If+ -- the incident is in the acknowledged or resolved status, this will be the user+ -- that took the first acknowledged or resolved action. If the incident was+ -- automatically resolved (say through the Event Integration API), or if the+ -- incident is in the triggered state, this will be null. User fields are the+ -- same as in the assignedToUser field above.+ iLastStatusChangeBy :: Lens' a (Maybe Assignee)++ -- | The date/time the incident's status last changed.+ iLastStatusChangeOn :: Lens' a (Maybe UTCTime)++ -- | Some condensed information regarding the initial event that triggered+ -- this incident. This data will be a set of key/value pairs that vary depending+ -- on what sort of event triggered the incident (email, Event API request,+ -- etc). For instance, if an email triggered the incident, then the+ -- triggerSummaryData will likely contain a subject. There are no guarantees+ -- o nthe full presence of this data for every incident.+ iTriggerSummaryData :: Lens' a Object++ -- | The PagerDuty website URL where the full details regarding the initial+ -- event that triggered this incident can be found. (This is not the resource+ -- URL.)+ iTriggerDetailsHtmlUrl :: Lens' a Text++ iIncidentNumber = incident.iIncidentNumber'+ iStatus = incident.iStatus'+ iCreatedOn = incident.iCreatedOn'._D+ iHtmlUrl = incident.iHtmlUrl'+ iIncidentKey = incident.iIncidentKey'+ iService = incident.iService'+ iEscalationPolicy = incident.iEscalationPolicy'+ iAssignedTo = incident.iAssignedTo'+ iAcknowledgers = incident.iAcknowledgers'+ iLastStatusChangeBy = incident.iLastStatusChangeBy'+ iLastStatusChangeOn = incident.iLastStatusChangeOn'.mapping _D+ iTriggerSummaryData = incident.iTriggerSummaryData'+ iTriggerDetailsHtmlUrl = incident.iTriggerDetailsHtmlUrl'++instance HasIncident Incident where+ incident = id++data ListIncidents = ListIncidents+ { _lsSince' :: Maybe Date+ , _lsUntil' :: Maybe Date+ , _lsDateRange' :: Maybe Range+ , _lsStatus' :: Maybe (CSV IncidentStatus)+ , _lsIncidentKey' :: Maybe IncidentKey+ , _lsService' :: Maybe (CSV ServiceId)+ , _lsAssignedToUser' :: Maybe (CSV UserId)+ , _lsTimeZone' :: !TZ+ , _lsSortBy' :: Maybe (Sort Field)+ } deriving (Eq, Show)++queryRequest ''ListIncidents++instance Paginate ListIncidents++-- | The start of the date range over which you want to search.+lsSince :: Lens' (Request ListIncidents s b) (Maybe UTCTime)+lsSince = upd.lsSince'.mapping _D++-- | The end of the date range over which you want to search.+--+-- /Note: If you leave off either since or until, a 30 day default range is+-- applied to your open ended range. Not including the since parameter will set+-- the date range to until - 30 days. Likewise, if you leave off until,+-- it is set to since + 30 days.+--+-- Defaults to the last 30 days if you leave off both. The size of the date+-- range must be less than 180 days.+lsUntil :: Lens' (Request ListIncidents s b) (Maybe UTCTime)+lsUntil = upd.lsUntil'.mapping _D++-- | When set, the since and until parameters and defaults are+-- ignored. Use this to get all incidents since the account was created.+lsDateRange :: Lens' (Request ListIncidents s b) Bool+lsDateRange = upd.lens get_ (flip set_)+ where+ get_ = (Just All ==) . view lsDateRange'+ set_ x = lsDateRange' .~ listToMaybe [All | x]++-- | Returns only the incidents currently in the passed status(es).+lsStatus :: Lens' (Request ListIncidents s b) (Maybe [IncidentStatus])+lsStatus = upd.lsStatus'.mapping _CSV++-- | Returns only the incidents with the passed de-duplication key.+--+-- /See:/ "Network.PagerDuty.Integration"+lsIncidentKey :: Lens' (Request ListIncidents s b) (Maybe IncidentKey)+lsIncidentKey = upd.lsIncidentKey'++-- | Returns only the incidents associated with the passed service(s). This+-- expects one or more service IDs.+lsService :: Lens' (Request ListIncidents s b) (Maybe [ServiceId])+lsService = upd.lsService'.mapping _CSV++-- | Returns only the incidents currently assigned to the passed user(s). This+-- expects one or more user IDs.+--+-- /Note:/ When using the assignedToUser filter, you will only receive+-- incidents with statuses of triggered or acknowledged. This is because resolved+-- incidents are not assigned to any user.+lsAssignedToUser :: Lens' (Request ListIncidents s b) (Maybe [UserId])+lsAssignedToUser = upd.lsAssignedToUser'.mapping _CSV++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ 'UTC'.+lsTimeZone :: Lens' (Request ListIncidents s b) TimeZone+lsTimeZone = upd.lsTimeZone'._TZ++-- | Used to specify both the field you wish to sort the results on, as well as+-- the direction (ascending/descending) of the results.+lsSortBy :: Lens' (Request ListIncidents s b) (Maybe (Sort Field))+lsSortBy = upd.lsSortBy'++-- | The PagerDuty incidents query API can be used to query current and+-- historical PagerDuty incidents over a date range, letting you build custom+-- dashboards or incident reports. The API allows for searching for incidents+-- with multiple filters or query parameters, various sorts, and also supports+-- the pagination of results.+--+-- @GET \/incidents@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/list>+listIncidents :: Request ListIncidents s [Incident]+listIncidents =+ mk ListIncidents+ { _lsSince' = Nothing+ , _lsUntil' = Nothing+ , _lsDateRange' = Nothing+ , _lsStatus' = Nothing+ , _lsIncidentKey' = Nothing+ , _lsService' = Nothing+ , _lsAssignedToUser' = Nothing+ , _lsTimeZone' = def+ , _lsSortBy' = Nothing+ } & path .~ incidents++-- | Get detailed information about an incident. Accepts either an incident id,+-- or an incident number.+--+-- @GET \/incidents\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/show>+getIncident :: IncidentId -> Request Empty s Incident+getIncident i = empty & path .~ incidents % i++data CountIncidents = CountIncidents+ { _cSince' :: Maybe Date+ , _cUntil' :: Maybe Date+ , _cDateRange' :: Maybe Range+ , _cStatus' :: Maybe (CSV IncidentStatus)+ , _cIncidentKey' :: Maybe IncidentKey+ , _cService' :: Maybe (CSV ServiceId)+ , _cAssignedToUser' :: Maybe (CSV UserId)+ } deriving (Eq, Show)++queryRequest ''CountIncidents++-- | The start of the date range over which you want to search.+cSince :: Lens' (Request CountIncidents s b) (Maybe UTCTime)+cSince = upd.cSince'.mapping _D++-- | The end of the date range over which you want to search.+--+-- /Note: If you leave off either since or until, a 30 day default range is+-- applied to your open ended range. Not including the since parameter will set+-- the date range to until - 30 days. Likewise, if you leave off until,+-- it is set to since + 30 days.+--+-- Defaults to the last 30 days if you leave off both. The size of the date+-- range must be less than 180 days.+cUntil :: Lens' (Request CountIncidents s b) (Maybe UTCTime)+cUntil = upd.cUntil'.mapping _D++-- | When set, the since and until parameters and defaults are+-- ignored. Use this to get all counts since the account was created.+cDateRange :: Lens' (Request CountIncidents s b) Bool+cDateRange = upd.lens get_ (flip set_)+ where+ get_ = (Just All ==) . view cDateRange'+ set_ x = cDateRange' .~ listToMaybe [All | x]++-- | Only counts the incidents currently in the passed status(es).+cStatus :: Lens' (Request CountIncidents s b) (Maybe [IncidentStatus])+cStatus = upd.cStatus'.mapping _CSV++-- | Returns only the incidents with the passed de-duplication key.+--+-- /See:/ "Network.PagerDuty.Integration"+cIncidentKey :: Lens' (Request CountIncidents s b) (Maybe IncidentKey)+cIncidentKey = upd.cIncidentKey'++-- | Only counts the incidents associated with the passed service(s).+-- This is expecting one or more service IDs.+cService :: Lens' (Request CountIncidents s b) (Maybe [ServiceId]) -- list1+cService = upd.cService'.mapping _CSV++-- | Only counts the incidents currently assigned to the passed user(s).+-- This is expecting one or more user IDs.+--+-- /Note:/ When using the assigned_to_user filter, you will only count+-- incidents with statuses of triggered or acknowledged. This is because resolved+-- incidents are not assigned to any user.+cAssignedToUser :: Lens' (Request CountIncidents s b) (Maybe [UserId]) -- list1+cAssignedToUser = upd.cAssignedToUser'.mapping _CSV++newtype Count = Count Int+ deriving (Eq, Ord, Show, Bounded, Enum, Num, Integral, Real)++instance FromJSON Count where+ parseJSON = withObject "count" $ \o -> Count <$> o .: "total"++-- | Use this query if you are simply looking for the count of incidents that+-- match a given query. This should be used if you don't need access to the+-- actual incident details.+--+-- @GET \/incidents\/count@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/count>+countIncidents :: Request CountIncidents s Count+countIncidents =+ mk CountIncidents+ { _cSince' = Nothing+ , _cUntil' = Nothing+ , _cDateRange' = Nothing+ , _cStatus' = Nothing+ , _cIncidentKey' = Nothing+ , _cService' = Nothing+ , _cAssignedToUser' = Nothing+ } & path .~ incidents % "count"+++data UpdateStatus+ = UAcknowledged+ | UResolved+ deriving (Eq, Show)++deriveNullary ''UpdateStatus++data UpdateIncident = UpdateIncident+ { _iiId :: IncidentId+ , _iiStatus :: Maybe UpdateStatus+ , _iiEscalationLevel :: Maybe Int+ , _iiEscalationPolicy :: Maybe EscalationPolicyId+ , _iiAssignedToUser :: Maybe (CSV UserId)+ } deriving (Eq, Show)++deriveJSON ''UpdateIncident++-- | The id of the incident to update.+makeLens "_iiId" ''UpdateIncident++-- | The new status of the incident.+makeLens "_iiStatus" ''UpdateIncident++-- | Escalate incident to this level in the escalation policy.+makeLens "_iiEscalationLevel" ''UpdateIncident++-- | Delegate this incident to the specified escalation policy id.+-- This restarts the incident's escalation following the new policy.+makeLens "_iiEscalationPolicy" ''UpdateIncident++-- | List of user IDs to assign this incident to.+makeLens "_iiAssignedToUser" ''UpdateIncident++data UpdatedIncidents = UpdatedIncidents+ { _uiId :: IncidentId+ , _uiStatus :: IncidentStatus+ , _uiIncidentNumber :: !Int+ , _uiUrl :: Text+ , _uiError :: Maybe Object+ } deriving (Eq, Show)++deriveRecord ''UpdatedIncidents++data UpdateIncidents = UpdateIncidents+ { _uiIncidents' :: [UpdateIncident]+ } deriving (Eq, Show)++jsonRequest ''UpdateIncidents++uiIncidents :: Lens' (Request UpdateIncidents s b) [UpdateIncident]+uiIncidents = upd.uiIncidents'++-- | Acknowledge, resolve, escalate or reassign one or more incidents.+--+-- @PUT \/incidents@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/update>+updateIncidents :: RequesterId -> Request UpdateIncidents s [UpdatedIncidents]+updateIncidents r = auth updateIncidentsBasic & query .~ [("requester_id", r)]++-- | A version of 'updateIncidents' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+updateIncidentsBasic :: Request UpdateIncidents Basic [UpdatedIncidents]+updateIncidentsBasic =+ mk UpdateIncidents+ { _uiIncidents' = []+ } & meth .~ PUT+ & path .~ incidents++-- | Resolve an incident.+--+-- @PUT \/incidents\/\:id\/resolve@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/resolve>+resolveIncident :: IncidentId+ -> RequesterId+ -> Request Empty s Empty+resolveIncident i r =+ auth (resolveIncidentBasic i) & query .~ [("requester_id", r)]++-- | A version of 'resolveIncident' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+resolveIncidentBasic :: IncidentId -> Request Empty s Empty+resolveIncidentBasic i = empty & meth .~ PUT & path .~ incidents % i % "resolve"++-- | Acknowledge an incident.+--+-- @PUT \/incidents\/\:id\/acknowledge@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/acknowledge>+acknowledgeIncident :: IncidentId+ -> RequesterId+ -> Request Empty s Empty+acknowledgeIncident i r =+ auth (acknowledgeIncidentBasic i) & query .~ [("requester_id", r)]++-- | A version of 'acknowledgeIncident' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+acknowledgeIncidentBasic :: IncidentId -> Request Empty s Empty+acknowledgeIncidentBasic i =+ empty & meth .~ PUT & path .~ incidents % i % "acknowledge"++data ReassignIncident = ReassignIncident+ { _riEscalationPolicy' :: Maybe EscalationPolicyId+ , _riEscalationLevel' :: Maybe Int+ , _riAssignedToUser' :: Maybe (CSV UserId)+ } deriving (Eq, Show)++jsonRequest ''ReassignIncident++-- | The ID of an escalation policy. Delegate the incident to this escalation+-- policy.+riEscalationPolicy :: Lens' (Request ReassignIncident s b) (Maybe EscalationPolicyId)+riEscalationPolicy = upd.riEscalationPolicy'++-- | Escalate incident to this level in the escalation policy.+riEscalationLevel :: Lens' (Request ReassignIncident s b) (Maybe Int)+riEscalationLevel = upd.riEscalationLevel'++-- | Comma separated list of user IDs to assign this incident to.+riAssignedToUser :: Lens' (Request ReassignIncident s b) (Maybe [UserId])+riAssignedToUser = upd.riAssignedToUser'.mapping _CSV++-- | Reassign an incident.+--+-- @PUT \/incidents\/\:id\/reassign@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/reassign>+reassignIncident :: IncidentId+ -> RequesterId+ -> Request ReassignIncident s Empty+reassignIncident i r =+ auth (reassignIncidentBasic i) & query .~ [("requester_id", r)]++-- | A version of 'reassignIncident' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+reassignIncidentBasic :: IncidentId -> Request ReassignIncident s Empty+reassignIncidentBasic i =+ mk ReassignIncident+ { _riEscalationPolicy' = Nothing+ , _riEscalationLevel' = Nothing+ , _riAssignedToUser' = Nothing+ } & meth .~ PUT+ & path .~ incidents % i % "reassign"
+ src/Network/PagerDuty/REST/Incidents/Notes.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Incidents.Notes+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | The Incident Notes API allows you to add notes to a specified incident.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes>+module Network.PagerDuty.REST.Incidents.Notes+ (+ -- * List Notes+ listNotes++ -- * Create Note+ , CreateNote+ , createNote+ , createNoteBasic+ , cnContent++ -- * Types+ , Note+ , nId+ , nCreatedAt+ , nUser+ , nContent+ ) where++import Control.Lens hiding ((.=))+import Data.Aeson+import Data.Text (Text)+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Users+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++notes :: IncidentId -> Path+notes i = "incidents" % i % "notes"++data Note = Note+ { _nId :: NoteId+ , _nCreatedAt :: Date+ , _nUser :: User+ , _nContent :: Text+ } deriving (Eq, Show)++deriveJSON ''Note++makeLens "_nId" ''Note+makeLens "_nUser" ''Note+makeLens "_nContent" ''Note++nCreatedAt :: Lens' Note UTCTime+nCreatedAt = lens _nCreatedAt (\n x -> n { _nCreatedAt = x }) . _D++-- | List existing notes for the specified incident.+--+-- @GET \/incidents\/\:incident_id\/notes@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes/create>+listNotes :: IncidentId -> Request Empty s [Note]+listNotes i = empty & path .~ notes i++newtype CreateNote = CreateNote+ { _cnContent' :: Maybe Text+ } deriving (Eq, Show)++makeLenses ''CreateNote++instance ToJSON CreateNote where+ toJSON cn = object ["note" .= object ["content" .= _cnContent' cn]]++instance QueryLike CreateNote where+ toQuery = const []++-- | The note content.+cnContent :: Lens' (Request CreateNote s b) (Maybe Text)+cnContent = upd.cnContent'++-- | Create a new note for the specified incident.+--+-- @POST \/incidents\/\:incident_id\/notes@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes/create>+createNote :: IncidentId -> RequesterId -> Request CreateNote s Note+createNote i r = auth (createNoteBasic i) & query .~ [("requester_id", r)]++-- | A version of 'createNote' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+createNoteBasic :: IncidentId -> Request CreateNote s Note+createNoteBasic i =+ mk CreateNote+ { _cnContent' = Nothing+ } & meth .~ POST+ & path .~ notes i
+ src/Network/PagerDuty/REST/LogEntries.hs view
@@ -0,0 +1,514 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.PagerDuty.REST.LogEntries+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | PagerDuty keeps a log of all the events that happen to an incident. The+-- following APIs provide fine-grained access to this incident log entry data to+-- give you more insight into how your team or organization is handling your+-- incidents. Log entry data includes details about the event(s) that triggered+-- the incident, who was notified and when, how they were notified, and who+-- acknowledged or resolved it, amongst a few other things.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries>+module Network.PagerDuty.REST.LogEntries+ (+ -- * List Logs+ ListLogs+ , listLogs+ , listUserLogs+ , listIncidentLogs+ , llTimeZone+ , llSince+ , llUntil+ , llIsOverview++ -- * Get Log+ , GetLog+ , getLog+ , glTimeZone++ -- * Types+ -- ** Channels+ , Channel (..)+ , _ChanNagios+ , _ChanAPI+ , _ChanEmail+ , _ChanUserEmail+ , _ChanWebTrigger+ , _ChanSMS+ , _ChanWeb+ , _ChanNote+ , _ChanAuto+ , _ChanTimeout++ , NagiosChannel+ , ncSummary+ , ncHost+ , ncService+ , ncState+ , ncDetails++ , APIChannel+ , acSummary+ , acServiceKey+ , acDescription+ , acIncidentKey+ , acDetails++ , EmailType (..)+ , EmailChannel+ , ecSummary+ , ecTo+ , ecFrom+ , ecSubject+ , ecBody+ , ecBodyContentType+ , ecRawUrl+ , ecHtmlUrl++ , WebTriggerChannel+ , wcSummary+ , wcSubject+ , wcDetails++ -- ** Entries+ , Entry (..)+ , _LogEntry+ , _NotifyEntry++ , LogEntryType (..)+ , LogEntry+ , leId+ , leType+ , leCreatedAt+ , leNote+ , leAssignedUser+ , leChannel++ , NotifyEntry+ , neCreatedAt+ , neUser+ , neNotification++ , NotificationType (..)+ , NotificationStatus (..)++ , Notification+ , nType+ , nStatus+ , nAddress+ ) where++import Control.Applicative+import Control.Lens+import Data.Aeson+import Data.Aeson.Lens+import Data.Default.Class+import qualified Data.HashMap.Strict as Map+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Users (User)+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++logs :: Path+logs = "log_entries"++includes :: Query+includes =+ [ ("include[]", Just "channel")+ , ("include[]", Just "incident")+ , ("include[]", Just "service")+ ]++data NagiosChannel = NagiosChannel+ { _ncSummary :: Text+ , _ncHost :: Text+ , _ncService :: Maybe Text+ , _ncState :: Text+ , _ncDetails :: Object+ } deriving (Eq, Show)++deriveJSON ''NagiosChannel++-- | Same as host.+makeLens "_ncSummary" ''NagiosChannel++-- | Nagios host.+makeLens "_ncHost" ''NagiosChannel++-- | Nagios service that created the event, if applicable.+makeLens "_ncService" ''NagiosChannel++-- | State the caused the event.+makeLens "_ncState" ''NagiosChannel++-- | Additional details of the incident.+makeLens "_ncDetails" ''NagiosChannel++data APIChannel = APIChannel+ { _acSummary :: Text+ , _acServiceKey :: ServiceKey+ , _acDescription :: Text+ , _acIncidentKey :: IncidentKey+ , _acDetails :: Object+ } deriving (Eq, Show)++deriveJSON ''APIChannel++-- | Same as description.+makeLens "_acSummary" ''APIChannel++-- | API service key.+makeLens "_acServiceKey" ''APIChannel++-- | Description of the event.+makeLens "_acDescription" ''APIChannel++-- | Incident deduping string.+makeLens "_acIncidentKey" ''APIChannel++-- | Additional details of the incident, if any.+makeLens "_acDetails" ''APIChannel++data EmailType+ = Plain+ | HTML+ deriving (Eq, Show)++deriveNullary ''EmailType++data EmailChannel = EmailChannel+ { _ecSummary :: Text+ , _ecTo :: Text+ , _ecFrom :: Text+ , _ecSubject :: Text+ , _ecBody :: Text+ , _ecBodyContentType :: EmailType+ , _ecRawUrl :: Text+ , _ecHtmlUrl :: Maybe Text+ } deriving (Eq, Show)++deriveJSON ''EmailChannel++-- | Same as subject.+makeLens "_ecSummary" ''EmailChannel++-- | To address of the email.+makeLens "_ecTo" ''EmailChannel++-- | From address of the email.+makeLens "_ecFrom" ''EmailChannel++-- | Subject of the email.+makeLens "_ecSubject" ''EmailChannel++-- | Body of the email.+makeLens "_ecBody" ''EmailChannel++-- | Content type of the email body.+makeLens "_ecBodyContentType" ''EmailChannel++-- | URL for raw text of email.+makeLens "_ecRawUrl" ''EmailChannel++-- | URL for html rendered version of the email.+--+-- Only present if content_type is 'HTML'.+makeLens "_ecHtmlUrl" ''EmailChannel++data WebTriggerChannel = WebTriggerChannel+ { _wcSummary :: Text+ , _wcSubject :: Text+ , _wcDetails :: Maybe Text+ } deriving (Eq, Show)++deriveJSON ''WebTriggerChannel++-- | Same as subject.+makeLens "_wcSummary" ''WebTriggerChannel++-- | Subject of the web trigger.+makeLens "_wcSubject" ''WebTriggerChannel++-- | Details about the web trigger.+makeLens "_wcDetails" ''WebTriggerChannel++-- | Representation of the means by which the action was channeled.+data Channel+ = ChanNagios NagiosChannel+ | ChanAPI APIChannel+ | ChanEmail EmailChannel+ | ChanUserEmail User EmailChannel+ | ChanWebTrigger User WebTriggerChannel+ | ChanSMS User+ | ChanWeb User+ | ChanNote User+ | ChanAuto+ | ChanTimeout+ deriving (Eq, Show)++makePrisms ''Channel++instance FromJSON Channel where+ parseJSON = withObject "agent+channel" $ \o -> do+ t <- o .: "channel" >>= (.: "type")+ let u = Map.member "user" o+ case t of+ -- service+ "email" | not u -> ChanEmail <$> o .: "channel"+ "nagios" -> ChanNagios <$> o .: "channel"+ "api" -> ChanAPI <$> o .: "channel"+ -- user+ "email" | u -> ChanUserEmail <$> o .: "user" <*> o .: "channel"+ "web_trigger" -> ChanWebTrigger <$> o .: "user" <*> o .: "channel"+ "sms" -> ChanSMS <$> o .: "user"+ "web" -> ChanWeb <$> o .: "user"+ "note" -> ChanNote <$> o .: "user"+ -- empty+ "auto" -> pure ChanAuto+ "timeout" -> pure ChanTimeout+ _ -> fail $+ "unrecognised service channel type: " ++ Text.unpack t++data LogEntryType+ = Trigger+ -- ^ The incident was triggered.+ | Acknowledge+ -- ^ The incident was acknowledged.+ | Unacknowledge+ -- ^ The incident was unacknowledged.+ | Resolve+ -- ^ The incident was resolved.+ | Escalate+ -- ^ The incident was escalated.+ | Assign+ -- ^ The incident was assigned to a user.+ | Annotate+ -- ^ A note was added to the incident.+ | ReachTriggerLimit+ -- ^ The incident has reached the log entry trigger limit and+ -- will not create any more.+ | RepeatEscalationPath+ -- ^ The incident has reached the end of its escalation policy+ -- and will restart.+ | ExhaustEscalationPath+ -- ^ The incident has cycled through its escalation policy the+ -- max allowed number of times.+ | Notify+ -- ^ A user was notified.+ deriving (Eq, Show)++deriveNullary ''LogEntryType++-- | The raw log event.+data LogEntry = LogEntry'+ { _leId :: LogEntryId+ , _leType :: LogEntryType+ , _leCreatedAt :: Date+ , _leNote :: Maybe Text+ , _leAssignedUser :: Maybe User+ , _leChannel :: Channel+ } deriving (Eq, Show)++instance FromJSON LogEntry where+ parseJSON = withObject "log_entry" $ \o ->+ LogEntry' <$> o .: "id"+ <*> o .: "type"+ <*> o .: "created_at"+ <*> o .:? "note"+ <*> o .:? "assigned_user"+ <*> parseJSON (Object o)++-- | Id of the log entry.+makeLens "_leId" ''LogEntry++-- | Time at which the log entry was created.+makeLens "_leCreatedAt" ''LogEntry++-- | The type of the log entry.+makeLens "_leType" ''LogEntry++-- | Optional field containing an action note, if one was included+-- with the action.+makeLens "_leNote" ''LogEntry++-- | Only for assign, escalate log entries. The user to which the incident is+-- assigned.+makeLens "_leAssignedUser" ''LogEntry++-- | Representation of the means by which the action was channeled and the+-- possible perfomer of this action.+makeLens "_leChannel" ''LogEntry++data NotificationType+ = SMS+ | Email+ | Phone+ | IosPushNotification+ deriving (Eq, Show)++deriveNullary ''NotificationType++data NotificationStatus+ = Success+ | Blocked+ | Busy+ | Failed+ | NoAnswer+ | BadAddress+ deriving (Eq, Show)++deriveNullary ''NotificationStatus++data Notification = Notification+ { _nType :: !NotificationType+ , _nStatus :: !NotificationStatus+ , _nAddress :: Address+ } deriving (Eq, Show)++deriveJSON ''Notification++-- | Type of notification.+makeLens "_nType" ''Notification++-- | The current status of the notification.+makeLens "_nStatus" ''Notification++-- | The address to which the notification was sent. I.e., an email address,+-- phone number, or iPhone name.+makeLens "_nAddress" ''Notification++-- | Notify log entries correspond to notifications sent to users. They have a+-- distinct format from action log entries.+data NotifyEntry = NotifyEntry'+ { _neCreatedAt' :: Date+ , _neUser' :: User+ , _neNotification' :: Notification+ } deriving (Eq, Show)++deriveRecord ''NotifyEntry++-- | Time at which the log entry was created+neCreatedAt :: Lens' NotifyEntry UTCTime+neCreatedAt = neCreatedAt'._D++-- | User who was notified+neUser :: Lens' NotifyEntry User+neUser = neUser'++-- | Object representing the notification itself+neNotification :: Lens' NotifyEntry Notification+neNotification = neNotification'++data Entry+ = LogEntry LogEntry+ -- ^ Log entries come in a wide variety of types. Most types use this format,+ -- the exception being the 'NotifyEntry' type.+ | NotifyEntry NotifyEntry+ -- ^ A user was notified.+ deriving (Eq, Show)++makePrisms ''Entry++data ListLogs = ListLogs+ { _llTimeZone' :: TZ+ , _llSince' :: Maybe Date+ , _llUntil' :: Maybe Date+ , _llIsOverview' :: Bool'+ } deriving (Eq, Show)++instance Paginate ListLogs++queryRequest ''ListLogs++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ UTC.+llTimeZone :: Lens' (Request ListLogs s b) TimeZone+llTimeZone = upd.llTimeZone'._TZ++-- | The start of the date range over which you want to search.+llSince :: Lens' (Request ListLogs s b) (Maybe UTCTime)+llSince = upd.llSince'.mapping _D++-- | The end of the date range over which you want to search.+llUntil :: Lens' (Request ListLogs s b) (Maybe UTCTime)+llUntil = upd.llUntil'.mapping _D++-- | If true, will only return log entries of type trigger, acknowlldge, or resolve.+--+-- /Default:/ false.+llIsOverview :: Lens' (Request ListLogs s b) Bool+llIsOverview = upd.llIsOverview'._B++-- | List all incident log entries across the entire account.+--+-- @GET \/log_entries@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/list>+listLogs :: Request ListLogs s [LogEntry]+listLogs =+ mk ListLogs+ { _llTimeZone' = def+ , _llSince' = Nothing+ , _llUntil' = Nothing+ , _llIsOverview' = F+ } & path .~ logs+ & query .~ includes+ & unwrap .~ key "log_entries"++-- | List all incident log entries that describe interactions with a specific user.+--+-- @GET \/users\/\:user_id\/log_entries@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/user_log_entries>+listUserLogs :: UserId -> Request ListLogs s [LogEntry]+listUserLogs u = listLogs & path .~ "users" % u % logs++-- | List all incident log entries for a specific incident.+--+-- @GET \/incidents\/\:incident_id\/log_entries@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/incident_log_entries>+listIncidentLogs :: IncidentKey -> Request ListLogs s [LogEntry]+listIncidentLogs i = listLogs & path .~ "incidents" % i % logs++newtype GetLog = GetLog+ { _glTimeZone' :: TZ+ } deriving (Eq, Show)++queryRequest ''GetLog++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ UTC.+glTimeZone :: Lens' (Request GetLog s b) TimeZone+glTimeZone = upd.glTimeZone'._TZ++-- | Get details for a specific incident log entry. This method provides additional+-- information you can use to get at raw event data.+--+-- @GET \/log_entries\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/show>+getLog :: LogEntryId -> Request GetLog s LogEntry+getLog l =+ mk GetLog+ { _glTimeZone' = def+ } & path .~ logs % l+ & query .~ includes
+ src/Network/PagerDuty/REST/MaintenanceWindows.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.PagerDuty.REST.MaintenanceWindows+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Maintenance windows allow you to schedule service maintenance periods,+-- during which no incidents will be created.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows>+module Network.PagerDuty.REST.MaintenanceWindows+ (+ -- * List Windows+ ListWindows+ , listWindows+ , lwQuery+ , lwServiceIds+ , lwFilter++ , ListWindowsResponse+ , lwMaintenanceWindows+ , lwCounts++ -- * Create Window+ , CreateWindow+ , createWindow+ , createWindowBasic+ , cwStartTime+ , cwEndTime+ , cwDescription+ , cwServiceIds++ -- * Get Window+ , getWindow++ -- * Update Window+ , UpdateWindow+ , updateWindow+ , uwStartTime+ , uwEndTime+ , uwDescription+ , uwServiceIds++ -- * Delete Window+ , deleteWindow++ -- * Types+ , ServiceInfo+ , siId+ , siName+ , siUrl++ , Counts+ , cOngoing+ , cFuture+ , cPast+ , cAll++ , MaintenanceWindow+ , mwSequenceNumber+ , mwStartTime+ , mwEndTime+ , mwDescription+ , mwCreatedBy+ , mwServices+ ) where++import Control.Lens+import Data.Monoid+import Data.Text (Text)+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Users (User)+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++windows :: Path+windows = "maintenance_windows"++data ServiceInfo = ServiceInfo+ { _siId :: ServiceId+ , _siName :: Text+ , _siUrl :: Text+ } deriving (Eq, Show)++deriveRecord ''ServiceInfo++data MaintenanceWindow = MaintenanceWindow+ { _mwSequenceNumber :: !Int+ , _mwStartTime :: Date+ , _mwEndTime :: Date+ , _mwDescription :: Maybe Text+ , _mwCreatedBy :: User+ , _mwServices :: [ServiceInfo]+ } deriving (Eq, Show)++deriveRecord ''MaintenanceWindow++data ListWindows = ListWindows+ { _lwQuery' :: Maybe Text+ , _lwServiceIds' :: List ServiceId+ , _lwFilter' :: Maybe Text+ }++queryRequest ''ListWindows++-- | Filters the results, showing only the maintenance windows whose+-- descriptions contain the query.+lwQuery :: Lens' (Request ListWindows s b) (Maybe Text)+lwQuery = upd.lwQuery'++-- | An list of service IDs, specifying services whose maintenance+-- windows shall be returned.+lwServiceIds :: Lens' (Request ListWindows s b) [ServiceId]+lwServiceIds = upd.lwServiceIds'._L++-- | Only return maintenance windows that are of this type. Possible values+-- are past, future, ongoing. If this parameter is omitted, all maintenance+-- windows will be returned.+lwFilter :: Lens' (Request ListWindows s b) (Maybe Text)+lwFilter = upd.lwFilter'++data Counts = Counts+ { _cOngoing :: !Int+ , _cFuture :: !Int+ , _cPast :: !Int+ , _cAll :: !Int+ } deriving (Eq, Show)++deriveRecord ''Counts++data ListWindowsResponse = ListWindowsResponse+ { _lwMaintenanceWindows :: [MaintenanceWindow]+ , _lwCounts :: Counts+ } deriving (Eq, Show)++deriveRecord ''ListWindowsResponse++-- | List existing maintenance windows, optionally filtered by service,+-- or whether they are from the past, present or future.+--+-- @GET \/maintenance_windows@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/list>+listWindows :: Request ListWindows s ListWindowsResponse+listWindows =+ mk ListWindows+ { _lwQuery' = Nothing+ , _lwServiceIds' = mempty+ , _lwFilter' = Nothing+ } & path .~ windows++data CreateWindow' = CreateWindow'+ { _cwStartTime' :: Date+ , _cwEndTime' :: Date+ , _cwDescription' :: Maybe Text+ , _cwServiceIds' :: [ServiceId] -- ^ List1+ } deriving (Eq, Show)++deriveRecord ''CreateWindow'++data CreateWindow = CreateWindow+ { _cwRequesterId' :: Maybe RequesterId+ , _cwMaintenanceWindow' :: CreateWindow'+ } deriving (Eq, Show)++jsonRequest ''CreateWindow++-- | This maintenance window's start time. This is when the services will stop+-- creating incidents. If this date is in the past, it will be updated to be the+-- current time.+cwStartTime :: Lens' (Request CreateWindow s b) UTCTime+cwStartTime = upd.cwMaintenanceWindow'.cwStartTime'._D++-- | This maintenance window's end time. This is when the services will start+-- creating incidents again. This date must be in the future and after the+-- start_time.+cwEndTime :: Lens' (Request CreateWindow s b) UTCTime+cwEndTime = upd.cwMaintenanceWindow'.cwEndTime'._D++-- | A description for this maintenance window.+cwDescription :: Lens' (Request CreateWindow s b) (Maybe Text)+cwDescription = upd.cwMaintenanceWindow'.cwDescription'++-- | The ids of the services that are affected by this maintenance window.+cwServiceIds :: Lens' (Request CreateWindow s b) [ServiceId]+cwServiceIds = upd.cwMaintenanceWindow'.cwServiceIds'++-- | Create a new maintenance window for the specified services. No new+-- incidents will be created for a service that is currently in maintenance.+--+-- @POST \/maintenance_windows@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/create>+createWindow :: RequesterId+ -> UTCTime -- ^ 'cwStartTime'+ -> UTCTime -- ^ 'cwEndTime'+ -> [ServiceId] -- ^ 'cwServiceIds'+ -> Request CreateWindow s MaintenanceWindow+createWindow r s e xs =+ auth (createWindowBasic s e xs) & upd.cwRequesterId' ?~ r++-- | A version of 'createWindow' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+createWindowBasic :: UTCTime -- ^ 'cwStartTime'+ -> UTCTime -- ^ 'cwEndTime'+ -> [ServiceId] -- ^ 'cwServiceIds'+ -> Request CreateWindow Basic MaintenanceWindow+createWindowBasic s e xs =+ mk CreateWindow+ { _cwRequesterId' = Nothing+ , _cwMaintenanceWindow' = CreateWindow'+ { _cwStartTime' = D s+ , _cwEndTime' = D e+ , _cwDescription' = Nothing+ , _cwServiceIds' = xs+ }+ } & meth .~ POST+ & path .~ windows++-- | Get details about an existing maintenance window.+--+-- @GET \/maintenance_windows\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/show>+getWindow :: WindowId -> Request Empty s MaintenanceWindow+getWindow w = empty & path .~ windows % w++data UpdateWindow = UpdateWindow+ { _uwStartTime' :: Maybe Date+ , _uwEndTime' :: Maybe Date+ , _uwDescription' :: Maybe Text+ , _uwServiceIds' :: Maybe [ServiceId]+ } deriving (Eq, Show)++jsonRequest ''UpdateWindow++-- | The maintenance window's start time. Can only be updated on future+-- maintenance windows. If the start_time is set to a date in the past, it will be+-- updated to the current date.+uwStartTime :: Lens' (Request UpdateWindow s b) (Maybe Date)+uwStartTime = upd.uwStartTime'++-- | The maintenance window's end time. Can only be updated on ongoing and+-- future maintenance windows, and cannot be set to a value before start_time.+uwEndTime :: Lens' (Request UpdateWindow s b) (Maybe Date)+uwEndTime = upd.uwEndTime'++-- | Description for this maintenance window. Can only be updated on ongoing+-- and future maintenance windows.+uwDescription :: Lens' (Request UpdateWindow s b) (Maybe Text)+uwDescription = upd.uwDescription'++-- | Services that are affected by this maintenance window. Can only be updated+-- on future maintenance windows.+uwServiceIds :: Lens' (Request UpdateWindow s b) (Maybe [ServiceId])+uwServiceIds = upd.uwServiceIds'++-- | Update an existing maintenance window.+--+-- @PUT \/maintenance_windows\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/update>+updateWindow :: WindowId -> Request UpdateWindow s MaintenanceWindow+updateWindow w =+ mk UpdateWindow+ { _uwStartTime' = Nothing+ , _uwEndTime' = Nothing+ , _uwDescription' = Nothing+ , _uwServiceIds' = Nothing+ } & meth .~ PUT+ & path .~ windows % w++-- | Cancel or delete an existing maintenance window.+--+-- @DELETE \/maintenance_windows\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/delete>+deleteWindow :: WindowId -> Request Empty s Empty+deleteWindow w = empty & meth .~ DELETE & path .~ windows % w
+ src/Network/PagerDuty/REST/Reports.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Reports+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Access high level reports about alerts and incidents.+-- Useful for creating graphs.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports>+module Network.PagerDuty.REST.Reports+ (+ -- * Alerts Per Time+ alertsPerTime++ -- * Incidents Per Time+ , incidentsPerTime++ -- * Types+ , Report+ , rSince+ , rUntil+ , rRollup++ , Rollup (..)++ , AlertReport+ , arStart+ , arEnd+ , arNumberOfAlerts+ , arNumberOfPhoneAlerts+ , arNumberOfSmsAlerts+ , arNumberOfEmailAlerts++ , AlertTotals+ , atAlerts+ , atTotalNumberOfAlerts+ , atTotalNumberOfPhoneAlerts+ , atTotalNumberOfSmsAlerts+ , atTotalNumberOfEmailAlerts+ , atTotalNumberOfBillableAlerts++ , IncidentReport+ , irStart+ , irEnd+ , irNumberOfIncidents+ ) where++import Control.Lens+import Data.Aeson.Lens+import Data.Time+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++reports :: Path+reports = "reports"++data Rollup+ = Daily+ | Weekly+ | Monthly+ deriving (Eq, Show)++deriveNullary ''Rollup++data Report = Report+ { _rSince' :: Date+ , _rUntil' :: Date+ , _rRollup' :: !Rollup+ } deriving (Eq, Show)++queryRequest ''Report++-- | Start of the date range over which you want to search. The time element+-- is optional.+rSince :: Lens' (Request Report s b) UTCTime+rSince = upd.rSince'._D++-- | The end of the date range over which you want to search. This should be+-- in the same format as since.+rUntil :: Lens' (Request Report s b) UTCTime+rUntil = upd.rUntil'._D++-- | Specifies the bucket duration for each summation.+--+-- /Default:/ monthly.+--+-- Example: A time window of two years (based on since and until) with a+-- rollup of monthly will result in 24 sets of data points being returned+-- (one for each month in the span).+rRollup :: Lens' (Request Report s b) Rollup+rRollup = upd.rRollup'++data AlertReport = AlertReport+ { _arStart :: Date+ , _arEnd :: Date+ , _arNumberOfAlerts :: !Int+ , _arNumberOfPhoneAlerts :: !Int+ , _arNumberOfSmsAlerts :: !Int+ , _arNumberOfEmailAlerts :: !Int+ } deriving (Eq, Show)++deriveJSON ''AlertReport++arStart :: Lens' AlertReport UTCTime+arStart = lens _arStart (\r x -> r { _arStart = x }) ._D++arEnd :: Lens' AlertReport UTCTime+arEnd = lens _arEnd (\r x -> r { _arEnd = x }) ._D++makeLens "_arNumberOfAlerts" ''AlertReport+makeLens "_arNumberOfPhoneAlerts" ''AlertReport+makeLens "_arNumberOfSmsAlerts" ''AlertReport+makeLens "_arNumberOfEmailAlerts" ''AlertReport++data AlertTotals = AlertTotals+ { _atAlerts :: [AlertReport]+ , _atTotalNumberOfAlerts :: !Int+ , _atTotalNumberOfPhoneAlerts :: !Int+ , _atTotalNumberOfSmsAlerts :: !Int+ , _atTotalNumberOfEmailAlerts :: !Int+ , _atTotalNumberOfBillableAlerts :: !Int+ } deriving (Eq, Show)++deriveRecord ''AlertTotals++-- | Get high level statistics about the number of alerts (SMSes, phone calls and+-- emails) sent for the desired time period, summed daily, weekly or monthly.+--+-- @GET \/reports\/alerts_per_time@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports/alerts_per_time>+alertsPerTime :: UTCTime -- ^ 'rSince'+ -> UTCTime -- ^ 'rUntil'+ -> Request Report s AlertTotals+alertsPerTime s u =+ mk Report+ { _rSince' = D s+ , _rUntil' = D u+ , _rRollup' = Monthly+ } & path .~ reports % "alerts_per_time"++data IncidentReport = IncidentReport+ { _irStart :: Date+ , _irEnd :: Date+ , _irNumberOfIncidents :: !Int+ } deriving (Eq, Show)++deriveJSON ''IncidentReport++irStart :: Lens' IncidentReport UTCTime+irStart = lens _irStart (\r x -> r { _irStart = x }) . _D++irEnd :: Lens' IncidentReport UTCTime+irEnd = lens _irEnd (\r x -> r { _irEnd = x }) . _D++makeLens "_irNumberOfIncidents" ''IncidentReport++-- | Get high level statistics about the number of incidents created for the+-- desired time period, summed daily, weekly or monthly.+--+-- @GET \/reports\/incidents_per_time@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports/incidents_per_time>+incidentsPerTime :: UTCTime -- ^ 'rSince'+ -> UTCTime -- ^ 'rUntil'+ -> Request Report s [IncidentReport]+incidentsPerTime s u =+ mk Report+ { _rSince' = D s+ , _rUntil' = D u+ , _rRollup' = Monthly+ } & path .~ reports % "incidents_per_time"+ & unwrap .~ key "incidents"
+ src/Network/PagerDuty/REST/Schedules.hs view
@@ -0,0 +1,638 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Schedules+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | On call schedules determine the time periods that users are on-call. Only when+-- a user is on-call he is eligible to receive alerts from incidents.+--+-- This API allows users to manipulate on-call schedules.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides>+module Network.PagerDuty.REST.Schedules+ (+ -- * List Schedules+ ListSchedules+ , listSchedules+ , lsQuery++ -- * Get Schedule+ , GetSchedule+ , getSchedule+ , gsSince+ , gsUntil+ , gsTimeZone++ -- * Get Schedule Users+ , GetScheduleUsers+ , getScheduleUsers+ , gsuSince+ , gsuUntil++ -- * Get Schedule Entries+ , GetScheduleEntries+ , getScheduleEntries+ , gseSince+ , gseUntil+ , gseOverflow+ , gseTimeZone+ , gseUserId++ -- * Create Schedule+ , CreateSchedule+ , createSchedule+ , csName+ , csOverflow+ , csTimeZone+ , csScheduleLayers++ -- * Update Schedule+ , UpdateSchedule+ , updateSchedule+ , usOverflow+ , usTimeZone+ , usScheduleLayers++ -- * Preview Schedule+ , PreviewSchedule+ , previewSchedule+ , psSince+ , psUntil+ , psOverflow+ , psName+ , psTimeZone+ , psScheduleLayers++ -- * Delete Schedule+ , deleteSchedule++ -- * Types+ , RestrictionType (..)+ , Restriction+ , rStartTimeOfDay+ , rDurationSeconds++ , Rotation+ , rMemberOrder+ , rUser++ , ScheduleLayer+ , slName+ , slRenderedScheduleEntries+ , slRestrictionType+ , slRestrictions+ , slPriority+ , slStart+ , slEnd+ , slRenderedCoveragePercentage+ , slRotationTurnLengthSeconds+ , slRotationVirtualStart+ , slUsers++ , HasScheduleInfo (..)+ , ScheduleInfo+ , Schedule+ , sScheduleLayers+ , sOverridesSubschedule+ , sFinalSchedule+ ) where++import Control.Lens hiding ((.=))+import Data.Aeson+import Data.Text (Text)+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Users (User)+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++schedules :: Path+schedules = "schedules"++data RestrictionType+ = Daily+ | Weekly+ deriving (Eq, Show)++deriveNullary ''RestrictionType++data Restriction = Restriction+ { _rStartTimeOfDay :: Date+ , _rDurationSeconds :: !Int+ } deriving (Eq, Show)++deriveJSON ''Restriction++rStartTimeOfDay :: Lens' Restriction UTCTime+rStartTimeOfDay =+ lens _rStartTimeOfDay (\r x -> r { _rStartTimeOfDay = x }) . _D++makeLens "_rDurationSeconds" ''Restriction++data Rotation = Rotation+ { _rMemberOrder :: !Int+ , _rUser :: User+ } deriving (Eq, Show)++deriveRecord ''Rotation++-- | A schedule is composed of multiple schedule layers.+--+-- A layer is composed of a group of people who will rotate through the same+-- shift. In a basic weekly schedule, you create a single layer where each member+-- is on-call for one week, with a set day and time for transferring on-call duty.+--+-- When a schedule has multiple layers, the layer can be ordered using the+-- priority field. The layer with the highest priority has precedence over the+-- layers with lower priority. You can use restrictions to control how layers+-- overlap.+--+-- The override layer is a special layer where all the override entries are+-- stored.+--+-- The final layer is a special layer that contains the result of all the previous+-- layers put together. This layer cannot be edited.+data ScheduleLayer = ScheduleLayer+ { _slName :: Text+ , _slRenderedScheduleEntries :: [ScheduleId] -- FIXME: what is this a list of?+ , _slRestrictionType :: !RestrictionType+ , _slRestrictions :: [Restriction]+ , _slPriority :: !Int+ , _slStart :: Date+ , _slEnd :: Date+ , _slRenderedCoveragePercentage :: !Double+ , _slRotationTurnLengthSeconds :: !Int+ , _slRotationVirtualStart :: Date+ , _slUsers :: [Rotation]+ } deriving (Eq, Show)++-- FIXME: most of these fields are maybes++deriveJSON ''ScheduleLayer++makeLens "_slName" ''ScheduleLayer++-- | This is a list of entries to be rendered for the current time range.+makeLens "_slRenderedScheduleEntries" ''ScheduleLayer++-- | This specifies the type of restrictions present on this layer.+makeLens "_slRestrictionType" ''ScheduleLayer++-- | A list of time restrictions for this layer.+makeLens "_slRestrictions" ''ScheduleLayer++-- | The priority of the layer. Layers with higher priority will override+-- layers with a lower priority.+makeLens "_slPriority" ''ScheduleLayer++-- | The effective start date of the layer+makeLens "_slStart" ''ScheduleLayer++-- | The effective end date of the layer. If 'Nothing', the layer has no end date.+makeLens "_slEnd" ''ScheduleLayer++-- | The percentage of the time range covered by this layer.+makeLens "_slRenderedCoveragePercentage" ''ScheduleLayer++-- | The duration of each on-call shift in seconds.+makeLens "_slRotationTurnLengthSeconds" ''ScheduleLayer++-- | The effective start time of the layer. This can be before the start+-- time of the schedule.+makeLens "_slRotationVirtualStart" ''ScheduleLayer++-- | An ordered list of users in this layer. The member_order field controls+-- the order in which the users apear in the rotation.+makeLens "_slUsers" ''ScheduleLayer++data ScheduleInfo = ScheduleInfo+ { _siId' :: ScheduleId+ , _siName' :: Text+ , _siTimeZone' :: TZ+ , _siToday' :: Date+ , _siEscalationPolicies' :: [EscalationPolicyId]+ } deriving (Eq, Show)++deriveRecord ''ScheduleInfo++class HasScheduleInfo a where+ scheduleInfo :: Lens' a ScheduleInfo++ -- | The unique identifier of the schedule.+ sId :: Lens' a ScheduleId+ -- | The name of the schedule.+ sName :: Lens' a Text+ -- | The time zone of the schedule.+ sTimeZone :: Lens' a TimeZone+ -- | The current day in the schedule's time zone.+ sToday :: Lens' a UTCTime+ -- | An list of all the escalation policies that uses this schedule.+ sEscalationPolicies :: Lens' a [EscalationPolicyId]++ sId = scheduleInfo.siId'+ sName = scheduleInfo.siName'+ sTimeZone = scheduleInfo.siTimeZone'._TZ+ sToday = scheduleInfo.siToday'._D+ sEscalationPolicies = scheduleInfo.siEscalationPolicies'++instance HasScheduleInfo ScheduleInfo where+ scheduleInfo = id++data Schedule = Schedule+ { _sInfo :: ScheduleInfo+ , _sScheduleLayers :: [ScheduleLayer]+ , _sOverridesSubschedule :: ScheduleLayer+ , _sFinalSchedule :: ScheduleLayer+ } deriving (Eq, Show)++deriveJSON ''Schedule++instance HasScheduleInfo Schedule where+ scheduleInfo = lens _sInfo (\s x -> s { _sInfo = x })++-- | A list of schedule layers. See the schedule layers parameters for details.+makeLens "_sScheduleLayers" ''Schedule++-- | The schedule layer object where all the overrides are stored.+makeLens "_sOverridesSubschedule" ''Schedule++-- | The final schedule layer object.+makeLens "_sFinalSchedule" ''Schedule++newtype ListSchedules = ListSchedules+ { _lsQuery' :: Maybe Text+ } deriving (Eq, Show)++queryRequest ''ListSchedules++-- | Filters the result, showing only the schedules whose name matches the query.+lsQuery :: Lens' (Request ListSchedules s b) (Maybe Text)+lsQuery = upd.lsQuery'++instance Paginate ListSchedules++-- | List existing on-call schedules.+--+-- @GET \/schedules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/list>+listSchedules :: RequesterId -> Request ListSchedules s [ScheduleInfo]+listSchedules r = auth listSchedulesBasic & query .~ [("requester_id", r)]++-- | A version of 'listSchedules' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+listSchedulesBasic :: Request ListSchedules s [ScheduleInfo]+listSchedulesBasic =+ mk ListSchedules+ { _lsQuery' = Nothing+ } & path .~ schedules++data GetSchedule = GetSchedule+ { _gsSince' :: Maybe Date+ , _gsUntil' :: Maybe Date+ , _gsTimeZone' :: Maybe TZ+ } deriving (Eq, Show)++queryRequest ''GetSchedule++-- | The start of the date range over which you want to return on-call schedule+-- entries and on-call schedule layers.+gsSince :: Lens' (Request GetSchedule s b) (Maybe UTCTime)+gsSince = upd.gsSince'.mapping _D++-- | The end of the date range over which you want to return schedule entries+-- and on-call schedule layers.+gsUntil :: Lens' (Request GetSchedule s b) (Maybe UTCTime)+gsUntil = upd.gsUntil'.mapping _D++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ account time zone.+gsTimeZone :: Lens' (Request GetSchedule s b) (Maybe TimeZone)+gsTimeZone = upd.gsTimeZone'.mapping _TZ++-- | Show detailed information about a schedule, including entries for each+-- layer and sub-schedule.+--+-- @GET \/schedules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/show>+getSchedule :: Request GetSchedule s Schedule+getSchedule =+ mk GetSchedule+ { _gsSince' = Nothing+ , _gsUntil' = Nothing+ , _gsTimeZone' = Nothing+ } & path .~ schedules+++data GetScheduleUsers = GetScheduleUsers+ { _gsuSince' :: Maybe Date+ , _gsuUntil' :: Maybe Date+ } deriving (Eq, Show)++queryRequest ''GetScheduleUsers++-- | The start of the date range over which you want to return on-call users.+gsuSince :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)+gsuSince = upd.gsuSince'.mapping _D++-- | The end time of the date range over which you want to return on-call users.+gsuUntil :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)+gsuUntil = upd.gsuUntil'.mapping _D++-- | List all the users on-call in a given schedule for a given time range.+--+-- @GET \/schedules\/\:id\/users@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/users>+getScheduleUsers :: UserId -> Request GetScheduleUsers s [User]+getScheduleUsers u =+ mk GetScheduleUsers+ { _gsuSince' = Nothing+ , _gsuUntil' = Nothing+ } & path .~ schedules % u % "users"++data GetScheduleEntries = GetScheduleEntries+ { _gseSince' :: Date+ , _gseUntil' :: Date+ , _gseOverflow' :: !Bool'+ , _gseTimeZone' :: Maybe TZ+ , _gseUserId' :: Maybe UserId+ } deriving (Eq, Show)++queryRequest ''GetScheduleEntries++-- | The start of the date range over which you want to return on-call+-- schedule entries.+-- The maximum range queryable at once is three months.+gseSince :: Lens' (Request GetScheduleEntries s b) UTCTime+gseSince = upd.gseSince'._D++-- | The end of the date range over which you want to return schedule entries.+gseUntil :: Lens' (Request GetScheduleEntries s b) UTCTime+gseUntil = upd.gseUntil'._D++-- | Any on-call schedule entries that pass the date range bounds will be+-- truncated at the bounds, unless the parameter overflow=true is passed.+--+-- Default: false.+--+-- Example: if your schedule is a rotation that changes daily at midnight UTC,+-- and your date range is from 2011-06-01T10:00:00Z to 2011-06-01T14:00:00Z: If+-- you don't pass the overflow=true parameter, you will get one schedule entry+-- returned with a start of 2011-06-01T10:00:00Z and end of 2011-06-01T14:00:00Z.+-- If you do pass the overflow=true parameter, you will get one schedule entry+-- returned with a start of 2011-06-01T00:00:00Z and end of 2011-06-02T00:00:00Z.+gseOverflow :: Lens' (Request GetScheduleEntries s b) Bool+gseOverflow = upd.gseOverflow'._B++-- | Time zone in which dates in the result will be rendered.+--+-- Default: account time zone.+gseTimeZone :: Lens' (Request GetScheduleEntries s b) (Maybe TimeZone)+gseTimeZone = upd.gseTimeZone'.mapping _TZ++-- | To filter the returned on-call schedule entries by a specific user, you+-- can optionally add the user_id parameter to the query.+gseUserId :: Lens' (Request GetScheduleEntries s b) (Maybe UserId)+gseUserId = upd.gseUserId'++-- | List schedule entries that are active for a given time range for a+-- specified on-call schedule.+--+-- @GET \/schedules\/\:id\/entries@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/entries>+getScheduleEntries :: UserId+ -> Date -- ^ 'gseSince'+ -> Date -- ^ 'gseUntil'+ -> Request GetScheduleEntries s b+getScheduleEntries i s u =+ mk GetScheduleEntries+ { _gseSince' = s+ , _gseUntil' = u+ , _gseOverflow' = F+ , _gseTimeZone' = Nothing+ , _gseUserId' = Nothing+ } & path .~ schedules % i++data CreateSchedule = CreateSchedule+ { _csName' :: Text+ , _csOverflow' :: !Bool'+ , _csTimeZone' :: TZ+ , _csScheduleLayers' :: [ScheduleLayer]+ } deriving (Eq, Show)++makeLenses ''CreateSchedule++instance ToJSON CreateSchedule where+ toJSON cs = object+ [ "name" .= _csName' cs+ , "overflow" .= _csOverflow' cs+ , "schedule" .= object+ [ "time_zone" .= _csTimeZone' cs+ , "schedule_layers" .= _csScheduleLayers' cs+ ]+ ]++instance QueryLike CreateSchedule where+ toQuery = const []++-- | Any on-call schedule entries that pass the date range bounds will be+-- truncated at the bounds, unless 'csOverflow' is set to 'True'.+--+-- Default: 'False'.+csOverflow :: Lens' (Request CreateSchedule s b) Bool+csOverflow = upd.csOverflow'._B++-- | The name of the schedule.+csName :: Lens' (Request CreateSchedule s b) Text+csName = upd.csName'++-- | The time zone of the schedule.+--+-- Default: 'UTC'.+csTimeZone :: Lens' (Request CreateSchedule s b) TimeZone+csTimeZone = upd.csTimeZone'._TZ++-- | A list of schedule layers.+csScheduleLayers :: Lens' (Request CreateSchedule s b) [ScheduleLayer]+csScheduleLayers = upd.csScheduleLayers'++-- | Create a new on-call schedule.+--+-- @POST \/schedules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/create>+createSchedule :: Text -- ^ 'csName'+ -> TimeZone -- ^ 'csTimeZone'+ -> [ScheduleLayer] -- ^ 'csScheduleLayers'+ -> Request CreateSchedule s Schedule+createSchedule n z ls =+ mk CreateSchedule+ { _csName' = n+ , _csOverflow' = F+ , _csTimeZone' = TZ z+ , _csScheduleLayers' = ls+ } & meth .~ POST+ & path .~ schedules++data UpdateSchedule = UpdateSchedule+ { _usOverflow' :: !Bool'+ , _usTimeZone' :: TZ+ , _usScheduleLayers' :: [ScheduleLayer]+ } deriving (Eq, Show)++makeLenses ''UpdateSchedule++instance ToJSON UpdateSchedule where+ toJSON us = object+ [ "overflow" .= _usOverflow' us+ , "schedule" .= object+ [ "time_zone" .= _usTimeZone' us+ , "schedule_layers" .= _usScheduleLayers' us+ ]+ ]++instance QueryLike UpdateSchedule where+ toQuery = const []++-- | Any on-call schedule entries that pass the date range bounds will be+-- truncated at the bounds, unless 'usOverflow' is set to 'True'.+--+-- Default: 'False'.+usOverflow :: Lens' (Request UpdateSchedule s b) Bool+usOverflow = upd.usOverflow'._B++-- | The time zone of the schedule.+usTimeZone :: Lens' (Request UpdateSchedule s b) TimeZone+usTimeZone = upd.usTimeZone'._TZ++-- | A list of schedule layers.+usScheduleLayers :: Lens' (Request UpdateSchedule s b) [ScheduleLayer]+usScheduleLayers = upd.usScheduleLayers'++-- | Update an existing on-call schedule.+--+-- /Note:/ You cannot delete schedule layers. You must include all layers in+-- your update request. To delete a layer, set the end parameter to schedule its+-- termination.+--+-- @PUT \/schedules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/update>+updateSchedule :: ScheduleId+ -> TimeZone -- ^ 'usTimeZone'+ -> [ScheduleLayer] -- ^ 'usScheduleLayers'+ -> Request UpdateSchedule s Schedule+updateSchedule s z ls =+ mk UpdateSchedule+ { _usOverflow' = F+ , _usTimeZone' = TZ z+ , _usScheduleLayers' = ls+ } & meth .~ PUT+ & path .~ schedules % s++data PreviewSchedule = PreviewSchedule+ { _psSince' :: Maybe Date+ , _psUntil' :: Maybe Date+ , _psName' :: Text+ , _psOverflow' :: !Bool'+ , _psTimeZone' :: TZ+ , _psScheduleLayers' :: [ScheduleLayer]+ } deriving (Eq, Show)++makeLenses ''PreviewSchedule++instance ToJSON PreviewSchedule where+ toJSON ps = object+ [ "since" .= _psSince' ps+ , "until" .= _psUntil' ps+ , "name" .= _psName' ps+ , "overflow" .= _psOverflow' ps+ , "schedule" .= object+ [ "time_zone" .= _psTimeZone' ps+ , "schedule_layers" .= _psScheduleLayers' ps+ ]+ ]++instance QueryLike PreviewSchedule where+ toQuery = const []++-- | The start of the date range over which you want to return on-call schedule+-- entries and on-call schedule layers.+psSince :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)+psSince = upd.psSince'.mapping _D++-- | The end of the date range over which you want to return schedule entries+-- and on-call schedule layers.+psUntil :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)+psUntil = upd.psUntil'.mapping _D++-- | Any on-call schedule entries that pass the date range bounds will be+-- truncated at the bounds, unless 'psOverflow' is set to 'True'.+--+-- Default: 'False'.+psOverflow :: Lens' (Request PreviewSchedule s b) Bool+psOverflow = upd.psOverflow'._B++-- | The name of the schedule.+psName :: Lens' (Request PreviewSchedule s b) Text+psName = upd.psName'++-- | The time zone of the schedule.+--+-- Default: 'UTC'.+psTimeZone :: Lens' (Request PreviewSchedule s b) TimeZone+psTimeZone = upd.psTimeZone'._TZ++-- | A list of schedule layers.+psScheduleLayers :: Lens' (Request PreviewSchedule s b) [ScheduleLayer]+psScheduleLayers = upd.psScheduleLayers'++-- | Preview what a schedule would look like without saving it. This work the+-- same as the update or create actions, except that the result is not+-- persisted. Preview optionally takes two additional arguments, since and until,+-- deliminating the span of the preview.+--+-- @POST \/schedules\/preview@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/preview>+previewSchedule :: Text -- ^ 'psName'+ -> TimeZone -- ^ 'psTimeZone'+ -> [ScheduleLayer] -- ^ 'psScheduleLayers'+ -> Request PreviewSchedule s Schedule+previewSchedule n z ls =+ mk PreviewSchedule+ { _psSince' = Nothing+ , _psUntil' = Nothing+ , _psName' = n+ , _psOverflow' = F+ , _psTimeZone' = TZ z+ , _psScheduleLayers' = ls+ } & meth .~ POST+ & path .~ schedules % "preview"++-- | Delete an on-call schedule.+--+-- @DELETE \/schedules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/delete>+deleteSchedule :: ScheduleId -> Request Empty s Empty+deleteSchedule s = empty & meth .~ DELETE & path .~ schedules % s
+ src/Network/PagerDuty/REST/Schedules/Overrides.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Schedules+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Schedule overrides are custom, non-recurring exceptions to your regular+-- on-call schedules. Use them when your team members go on vacation, swap shifts,+-- or when you simply cannot achieve your normal scheduling with recurring layers.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules>+module Network.PagerDuty.REST.Schedules.Overrides+ (+ -- * List Overrides+ ListOverrides+ , listOverrides+ , lsSince+ , lsUntil+ , lsEditable+ , lsOverflow++ -- * Create Override+ , CreateOverride+ , createOverride+ , coUserId+ , coStart+ , coEnd++ -- * Delete Override+ , deleteOverride++ -- * Types+ , HasUserInfo (..)+ , Override+ , oId+ , oStart+ , oEnd+ , oUser+ ) where++import Control.Lens+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Users+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++overrides :: ScheduleId -> Path+overrides i = "schedules" % i % "overrides"++data Override = Override+ { _oId :: Maybe OverrideId+ , _oStart :: Date+ , _oEnd :: Date+ , _oUser :: UserInfo+ } deriving (Eq, Show)++deriveRecord ''Override++instance HasUserInfo Override where+ userInfo = oUser++data ListOverrides = ListOverrides+ { _lsSince' :: Date+ , _lsUntil' :: Date+ , _lsEditable' :: Bool'+ , _lsOverflow' :: Bool'+ } deriving (Eq, Show)++queryRequest ''ListOverrides++-- | The start time of the date range you want to retrieve override for.+--+-- The maximum date range queryable is 3 months.+lsSince :: Lens' (Request ListOverrides s b) UTCTime+lsSince = upd.lsSince'._D++-- | The end time of the date range you want to retrieve override for.+lsUntil :: Lens' (Request ListOverrides s b) UTCTime+lsUntil = upd.lsUntil'._D++-- | When 'True', only editable overrides will be returned.+--+-- The result will onlyinclude the id the override if this parameter is present.+-- Only future overrides are editable.+--+-- /Default:/ 'False.'+lsEditable :: Lens' (Request ListOverrides s b) Bool+lsEditable = upd.lsEditable'._B++-- | Any on-call schedule entries that pass the date range bounds will be+-- truncated at the bounds, unless @lsEditable .~ True@ is specified.+--+-- /Default:/ 'False.'+lsOverflow :: Lens' (Request ListOverrides s b) Bool+lsOverflow = upd.lsOverflow'._B++-- | List overrides for a given time range.+--+-- @GET \/schedules\/\:schedule_id\/overrides@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/list>+listOverrides :: ScheduleId+ -> Date -- ^ 'lsSince'+ -> Date -- ^ 'lsUntil'+ -> Request ListOverrides s [Override]+listOverrides i s u =+ mk ListOverrides+ { _lsSince' = s+ , _lsUntil' = u+ , _lsEditable' = F+ , _lsOverflow' = F+ } & path .~ overrides i++data CreateOverride = CreateOverride+ { _coStart' :: Date+ , _coEnd' :: Date+ , _coUserId' :: UserId+ } deriving (Eq, Show)++jsonRequest ''CreateOverride++-- | The start date and time for the override.+coStart :: Lens' (Request CreateOverride s b) UTCTime+coStart = upd.coStart'._D++-- | The end date and time for the override.+coEnd :: Lens' (Request CreateOverride s b) UTCTime+coEnd = upd.coEnd'._D++-- | The ID of the user who will be on call for the duration of the override.+coUserId :: Lens' (Request CreateOverride s b) UserId+coUserId = upd.coUserId'++-- | Create an override for a specific user covering the specified time range. If+-- you create an override on top of an existing one, the last created override+-- will have priority.+--+-- If no time zone information is present in the since and until parameters, the+-- schedule's time zone will be used.+--+-- /Note:/ You cannot create overrides in the past.+--+-- @POST \/schedules\/\:schedule_id\/overrides@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/create>+createOverride :: ScheduleId+ -> UserId -- ^ 'coUserId'+ -> Date -- ^ 'coStart'+ -> Date -- ^ 'coEnd'+ -> Request CreateOverride s Override+createOverride i u s e =+ mk CreateOverride+ { _coUserId' = u+ , _coStart' = s+ , _coEnd' = e+ } & meth .~ POST+ & path .~ overrides i++-- | Remove an override.+--+-- You cannot remove a past override. If the override start+-- time is before the current time, but the end time is after the current time,+-- the override will be truncated to the current time. If the override is+-- truncated, the status code will be 200 OK, as opposed to a 204 No Content for a+-- successful delete.+--+-- @DELETE \/schedules\/\:schedule_id\/overrides\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/delete>++-- FIXME: How to parse whether truncated or deleted?+deleteOverride :: ScheduleId -> OverrideId -> Request Empty s Empty+deleteOverride i o = empty+ & meth .~ DELETE+ & path .~ overrides i % o
+ src/Network/PagerDuty/REST/Services.hs view
@@ -0,0 +1,513 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Services+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | This API lets you access and manipulate the services across your account.+--+-- A service is an endpoint (like Nagios, email, or an API call) that+-- generates events, which Pagerduty normalizes and dedupes, creating incidents.+--+-- When a service is shown inlined in other resources, a deleted service will+-- have its @html_url@ attribute set to 'Nothing'.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services>+module Network.PagerDuty.REST.Services+ (+ -- * List Services+ ListServices+ , listServices+ , lsTimeZone++ -- * Create Service+ , CreateService+ , createService+ , csName+ , csDescription+ , csType+ , csVendorId+ , csEscalationPolicyId+ , csAcknowledgementTimeout+ , csAutoResolveTimeout+ , csSeverityFilter++ -- * Get Service+ , getService++ -- * Update Service+ , UpdateService+ , updateService+ , usName+ , usEscalationPolicyId+ , usDescription+ , usAcknowledgementTimeout+ , usAutoResolveTimeout+ , usSeverityFilter++ -- * Delete Service+ , deleteService++ -- * Enable Service+ , enableService++ -- * Disable Service+ , disableService++ -- * Regenerate Key+ , regenerateKey++ -- * Types+ , EmailFilterMode (..)+ , EmailIncidentCreation (..)+ , ServiceStatus (..)+ , ServiceType (..)+ , SeverityFilter (..)++ , IncidentCounts+ , cntTriggered+ , cntAcknowledged+ , cntResolved+ , cntTotal++ , PolicyInfo+ , pinfoId+ , pinfoName++ , Service+ , svcId+ , svcName+ , svcDescription+ , svcServiceUrl+ , svcServiceKey+ , svcAutoResolveTimeout+ , svcAcknowledgementTimeout+ , svcCreatedAt+ , svcStatus+ , svcLastIncidentTimestamp+ , svcEmailIncidentCreation+ , svcIncidentCounts+ , svcEmailFilterMode+ , svcType+ , svcEscalationPolicy+ , svcEmailFilters+ , svcSeverityFilter+ ) where++import Control.Lens+import Data.Aeson.Lens+import Data.Text (Text)+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.REST.Services.EmailFilters+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++services :: Path+services = "services"++includes :: Query+includes =+ [ ("include[]", Just "escalation_policy")+ , ("include[]", Just "email_filters")+ ]++data IncidentCounts = IncidentCounts+ { _cntTriggered :: !Int+ , _cntAcknowledged :: !Int+ , _cntResolved :: !Int+ , _cntTotal :: !Int+ } deriving (Eq, Show)++deriveRecord ''IncidentCounts++data EmailIncidentCreation+ = OnNewEmail+ -- ^ Open a new incident for each trigger email.+ | OnNewEmailSubject+ -- ^ Open a new incident for each new trigger email subject.+ | OnlyIfNoOpenIncidents+ -- ^ Open a new incident only if an open incident does not already exist.+ deriving (Eq, Show)++deriveNullary ''EmailIncidentCreation++data EmailFilterMode+ = AllEmail+ -- ^ Accept all incoming email+ | OrRulesEmail+ -- ^ Accept email only if it matches ONE OR MORE rules below+ | AndRulesEmail+ -- ^ Accept email only if it matches ALL of the rules below+ deriving (Eq, Show)++deriveNullaryWith hyphenated ''EmailFilterMode++data ServiceStatus+ = Active+ -- ^ The service is enabled and has no open incidents.+ | Warning+ -- ^ The service is enabled and has one or more acknowledged incidents.+ | Critical+ -- ^ The service is enabled and has one or more triggered incidents.+ | Maintenance+ -- ^ The service is under maintenance, no new incidents will be+ -- triggered during maintenance mode.+ | Disabled+ -- ^ The service is disabled and will not have any new triggered incidents.+ deriving (Eq, Show)++deriveNullary ''ServiceStatus++data ServiceType+ = CloudKick+ | GenericEmail+ | GenericEventsApi+ | Keynote+ | Nagios+ | Pingdom+ | ServerDensity+ | SqlMonitor+ deriving (Eq, Show)++deriveNullary ''ServiceType++data PolicyInfo = PolicyInfo+ { _pinfoId :: EscalationPolicyId+ , _pinfoName :: Text+ } deriving (Eq, Show)++deriveRecord ''PolicyInfo++data SeverityFilter+ = SevCritical+ -- ^ Incidents are created when an alarm enters the Critical state.+ | SevCriticalOrWarning+ -- ^ Incidents are created when an alarm enters the Critical OR Warning states+ | SevOnAny+ -- ^ SQL Monitor: Incidents are created for alerts of any severity.+ | SevOnHigh+ -- ^ SQL Monitor: Incidents are created for alerts with high severity.+ | SevOnMediumHigh+ -- ^ SQL Monitor: Incidents are created for with high or medium severity+ deriving (Eq, Show)++deriveNullaryWith (dropped 3 underscored) ''SeverityFilter++data Service = Service+ { _svcId :: ServiceId+ , _svcName :: Text+ , _svcDescription :: Text+ , _svcServiceUrl :: Text+ , _svcServiceKey :: ServiceKey+ , _svcAutoResolveTimeout :: Maybe Int+ , _svcAcknowledgementTimeout :: Maybe Int+ , _svcCreatedAt :: Date+ , _svcStatus :: ServiceStatus+ , _svcLastIncidentTimestamp :: Maybe Date+ , _svcEmailIncidentCreation :: Maybe EmailIncidentCreation+ , _svcIncidentCounts :: IncidentCounts+ , _svcEmailFilterMode :: EmailFilterMode+ , _svcType :: ServiceType+ , _svcEscalationPolicy :: Maybe PolicyInfo -- FIXME: extract from inline.+ , _svcEmailFilters :: Maybe [EmailFilterInfo] -- FIXME: extract from inline.+ , _svcSeverityFilter :: Maybe SeverityFilter+ } deriving (Eq, Show)++deriveJSON ''Service++-- | A unique identifier for this service.+makeLens "_svcId" ''Service++-- | The name of the service.+makeLens "_svcName" ''Service++-- | The description of the service+makeLens "_svcDescription" ''Service++-- | Relative URL that corresponds to this service.+makeLens "_svcServiceUrl" ''Service++-- | For Email services, the serviceKey is the associated email address+-- for the service.+-- For all other service types, this is the unique key used for API calls.+makeLens "_svcServiceKey" ''Service++-- | Time in seconds that an incident changes to the Triggered State after+-- being Acknowledged. Value is 'Nothing' if the feature is disabled.+makeLens "_svcAutoResolveTimeout" ''Service++-- | Time in seconds that an incident is automatically resolved if left open for+-- that long. Value is 'Nothing' is the feature is disabled.+makeLens "_svcAcknowledgementTimeout" ''Service++-- | The date/time when this service was created.+svcCreatedAt :: Lens' Service UTCTime+svcCreatedAt = lens _svcCreatedAt (\s x -> s { _svcCreatedAt = x }) . _D++-- | The current state of the Service.+makeLens "_svcStatus" ''Service++-- | The date/time when the most recent incident was created for this service.+svcLastIncidentTimestamp :: Lens' Service (Maybe UTCTime)+svcLastIncidentTimestamp =+ lens _svcLastIncidentTimestamp+ (\s x -> s { _svcLastIncidentTimestamp = x }) . mapping _D++-- | If the service is a Generic Email service, this describes what kind of+-- emails create an incident.+makeLens "_svcEmailIncidentCreation" ''Service++-- | An object with the number of incidents corresponding to these states.+makeLens "_svcIncidentCounts" ''Service++-- | If the service is a Generic Email service, this describes which types of+-- email will generate an incident.+makeLens "_svcEmailFilterMode" ''Service++-- | The service type.+makeLens "_svcType" ''Service++-- | An object containing the ID and name of the escalation policy used by this+-- service.+makeLens "_svcEscalationPolicy" ''Service++-- | An object containing inline Email Filters.+-- Note that only genericEmail services have filters.+makeLens "_svcEmailFilters" ''Service++-- | Specifies what severity levels will create a new open incident.+makeLens "_svcSeverityFilter" ''Service++newtype ListServices = ListServices+ { _lsTimeZone' :: Maybe TZ+ } deriving (Eq, Show)++instance Paginate ListServices++queryRequest ''ListServices++-- | Time zone in which dates in the result will be rendered.+--+-- /Default:/ account default time zone.+lsTimeZone :: Lens' (Request ListServices s r) (Maybe TimeZone)+lsTimeZone = upd.lsTimeZone'.mapping _TZ++-- | List existing services.+--+-- @GET \/services@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/list>+listServices :: Request ListServices s [Service]+listServices =+ mk ListServices+ { _lsTimeZone' = Nothing+ } & path .~ services+ & query .~ includes+ & unwrap .~ key "escalation_policies"++data CreateService = CreateService+ { _csName' :: Text+ , _csEscalationPolicyId' :: EscalationPolicyId+ , _csType' :: !ServiceType+ , _csVendorId' :: Maybe VendorId+ , _csDescription' :: Maybe Text+ , _csAcknowledgementTimeout' :: Maybe Int+ , _csAutoResolveTimeout' :: Maybe Int+ , _csSeverityFilter' :: Maybe SeverityFilter+ } deriving (Eq, Show)++jsonRequest ''CreateService++-- | The name of the service.+csName :: Lens' (Request CreateService s r) Text+csName = upd.csName'++-- | A description for your service. 1024 character maximum.+csDescription :: Lens' (Request CreateService s r) (Maybe Text)+csDescription = upd.csDescription'++-- | The type of service to create.+csType :: Lens' (Request CreateService s r) ServiceType+csType = upd.csType'++-- | PagerDuty's internal vendor identifier for this service. For more information+-- about a specific vendor, please contact PagerDuty Support.+csVendorId :: Lens' (Request CreateService s r) (Maybe VendorId)+csVendorId = upd.csVendorId'++-- | The id of the escalation policy to be used by this service.+csEscalationPolicyId :: Lens' (Request CreateService s r) EscalationPolicyId+csEscalationPolicyId = upd.csEscalationPolicyId'++-- | The duration in seconds before an incidents acknowledged in this service+-- become triggered again.+--+-- /Default:/ 30 minutes.+csAcknowledgementTimeout :: Lens' (Request CreateService s r) (Maybe Int)+csAcknowledgementTimeout = upd.csAcknowledgementTimeout'++-- | The duration in seconds before a triggered incident auto-resolves itself.+--+-- /Default:/ 4 hours.+csAutoResolveTimeout :: Lens' (Request CreateService s r) (Maybe Int)+csAutoResolveTimeout = upd.csAutoResolveTimeout'++-- | Specifies what severity levels will create a new open incident.+csSeverityFilter :: Lens' (Request CreateService s r) (Maybe SeverityFilter)+csSeverityFilter = upd.csSeverityFilter'++-- | Creates a new service.+--+-- @POST \/services@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/create>+createService :: Text+ -> EscalationPolicyId+ -> ServiceType+ -> Request CreateService s Service+createService n p t =+ mk CreateService+ { _csName' = n+ , _csEscalationPolicyId' = p+ , _csType' = t+ , _csVendorId' = Nothing+ , _csDescription' = Nothing+ , _csAcknowledgementTimeout' = Nothing+ , _csAutoResolveTimeout' = Nothing+ , _csSeverityFilter' = Nothing+ } & path .~ services+ & unwrap .~ key "service"++-- | Get details about an existing service.+--+-- @GET services\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/show>+getService :: ServiceId -> Request Empty s Service+getService i = empty+ & path .~ services % i+ & query <>~ includes+ & unwrap .~ key "service"++data UpdateService = UpdateService+ { _usName' :: Maybe Text+ , _usDescription' :: Maybe Text+ , _usEscalationPolicyId' :: Maybe EscalationPolicyId+ , _usAcknowledgementTimeout' :: Maybe Int+ , _usAutoResolveTimeout' :: Maybe Int+ , _usSeverityFilter' :: Maybe SeverityFilter+ } deriving (Eq, Show)++jsonRequest ''UpdateService++-- | The name of the service.+usName :: Lens' (Request UpdateService s r) (Maybe Text)+usName = upd.usName'++-- | A description for your service. 1024 character maximum.+usDescription :: Lens' (Request UpdateService s r) (Maybe Text)+usDescription = upd.usDescription'++-- | The id of the escalation policy to be used by this service.+usEscalationPolicyId :: Lens' (Request UpdateService s r) (Maybe EscalationPolicyId)+usEscalationPolicyId = upd.usEscalationPolicyId'++-- | The duration in seconds before an incidents acknowledged in this service+-- become triggered again.+--+-- /Default:/ 30 minutes.+usAcknowledgementTimeout :: Lens' (Request UpdateService s r) (Maybe Int)+usAcknowledgementTimeout = upd.usAcknowledgementTimeout'++-- | The duration in seconds before a triggered incident auto-resolves itself.+--+-- /Default:/ 4 hours.+usAutoResolveTimeout :: Lens' (Request UpdateService s r) (Maybe Int)+usAutoResolveTimeout = upd.usAutoResolveTimeout'++-- | Specifies what severity levels will create a new open incident.+usSeverityFilter :: Lens' (Request UpdateService s r) (Maybe SeverityFilter)+usSeverityFilter = upd.usSeverityFilter'++-- | Update an existing service.+--+-- @PUT services\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/update>+updateService :: ServiceId -> Request UpdateService s Service+updateService i =+ mk UpdateService+ { _usName' = Nothing+ , _usEscalationPolicyId' = Nothing+ , _usDescription' = Nothing+ , _usAcknowledgementTimeout' = Nothing+ , _usAutoResolveTimeout' = Nothing+ , _usSeverityFilter' = Nothing+ } & meth .~ PUT+ & path .~ services % i+ & unwrap .~ key "service"++-- | Delete an existing service. Once the service is deleted, it will not be+-- accessible from the web UI and new incidents won't be able to be created+-- for this service.+--+-- @DELETE \/services/:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/delete>+deleteService :: ServiceId -> Request Empty s Empty+deleteService i = empty & meth .~ DELETE & path .~ services % i++-- | Enable a previously disabled service.+--+-- @PUT services\/\:id\/enable@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/enable>+enableService :: RequesterId -> ServiceId -> Request Empty s Empty+enableService r i =+ auth (enableServiceBasic i) & query .~ [("requester_id", r)]++-- | A version of 'enableService' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+enableServiceBasic :: ServiceId -> Request Empty Basic Empty+enableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "enable"++-- | Disable a service. Once a service is disabled, it will not be able to+-- create incidents until it is enabled again.+--+-- @PUT services\/\:id\/disable@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/disable>+disableService :: RequesterId -> ServiceId -> Request Empty s Empty+disableService r i =+ auth (disableServiceBasic i) & query .~ [("requester_id", r)]++-- | A version of 'disableService' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+disableServiceBasic :: ServiceId -> Request Empty Basic Empty+disableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "disable"++-- | Regenerate a new service key for an existing service.+--+-- _Warning! The service's previous key will be invalidated, and existing+-- monitoring integrations will need to be modified to use the new key!_+--+-- @POST services\/\:id\/regenerate_key@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/regenerate_key>+regenerateKey :: ServiceId -> Request Empty s Service+regenerateKey i = empty & meth .~ POST & path .~ services % i % "regenerate_key"
+ src/Network/PagerDuty/REST/Services/EmailFilters.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Services.EmailFilters+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Email Filters are a set of rules that are applied to triggering email's body,+-- subject and from address. It only applies to generic_email kind of+-- Services. The way multiple filters are combined depends on the+-- email_filter_mode attribute of the service.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters>+module Network.PagerDuty.REST.Services.EmailFilters+ (+ -- * Create Email Filter+ createEmailFilter++ -- * Update Email Filter+ , updateEmailFilter++ -- * Delete Email Filter+ , deleteEmailFilter++ -- * Types+ , MatchMode (..)+ , HasEmailFilterInfo (..)+ , EmailFilterInfo+ , EmailFilter+ , efId+ ) where++import Control.Applicative hiding (empty)+import Control.Lens hiding ((.=))+import Data.Aeson+import Data.Default.Class+import Data.Monoid+import Data.Text (Text)+import Network.HTTP.Types+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++filters :: ServiceId -> Path+filters s = "services" % s % "email_filters"++data MatchMode+ = Always+ | Match+ | NoMatch+ deriving (Eq, Show)++deriveNullaryWith hyphenated ''MatchMode++-- FIXME: Tighten up this type! Make the regex required for match/no-match and+-- encode the conditional invariants.+data EmailFilterInfo = EmailFilterInfo+ { _efSubjectMode' :: Maybe MatchMode+ , _efSubjectRegex' :: Maybe Text+ , _efBodyMode' :: Maybe MatchMode+ , _efBodyRegex' :: Maybe Text+ , _efFromEmailMode' :: Maybe MatchMode+ , _efFromEmailRegex' :: Maybe Text+ } deriving (Eq, Show)++deriveRecord ''EmailFilterInfo++instance Default EmailFilterInfo where+ def = EmailFilterInfo Nothing Nothing Nothing Nothing Nothing Nothing++instance QueryLike EmailFilterInfo where+ toQuery = const []++class HasEmailFilterInfo a where+ emailFilterInfo :: Lens' a EmailFilterInfo++ -- | One of always, match, no-match, which, respectively, means to not+ -- filter the email trigger by subject, filter it if the email subject+ -- matches the given regex, or filter if it doesn't match the given regex.+ --+ -- /Default:/ always.+ efSubjectMode :: Lens' a (Maybe MatchMode)++ -- | The regex to be used when subject_mode is match or no-match.+ -- It is a required parameter on such cases.+ efSubjectRegex :: Lens' a (Maybe Text)++ -- | One of always, match, no-match, which, respectively, means to not filter+ -- the email trigger by body, filter it if the body email matches the given+ -- regex, or filter if it doesn't match the given regex.+ --+ -- /Default:/ always.+ efBodyMode :: Lens' a (Maybe MatchMode)++ -- | The regex to be used when body_mode is match or no-match.+ -- It is a required parameter on such cases.+ efBodyRegex :: Lens' a (Maybe Text)++ -- | One of always, match, no-match, which, respectively, means to not filter+ -- the email trigger by its from address, filter it if the email from address+ -- matches the given regex, or filter if it doesn't match the given regex.+ --+ -- /Default:/ always.+ efFromEmailMode :: Lens' a (Maybe MatchMode)++ -- | The regex to be used when from_email_mode is match or no-match.+ -- It is a required parameter on such cases.+ efFromEmailRegex :: Lens' a (Maybe Text)++ efSubjectMode = emailFilterInfo.efSubjectMode'+ efSubjectRegex = emailFilterInfo.efSubjectRegex'+ efBodyMode = emailFilterInfo.efBodyMode'+ efBodyRegex = emailFilterInfo.efBodyRegex'+ efFromEmailMode = emailFilterInfo.efFromEmailMode'+ efFromEmailRegex = emailFilterInfo.efFromEmailRegex'++instance (QueryLike a, ToJSON a, HasEmailFilterInfo a)+ => HasEmailFilterInfo (Request a s b) where+ emailFilterInfo = upd.emailFilterInfo++instance HasEmailFilterInfo EmailFilterInfo where+ emailFilterInfo = id++data EmailFilter = EmailFilter+ { _efId :: EmailFilterId+ , _efInfo :: EmailFilterInfo+ } deriving (Eq, Show)++instance FromJSON EmailFilter where+ parseJSON = withObject "email_filter" $ \o ->+ EmailFilter <$> parseJSON (Object o)+ <*> o .: "id"++instance ToJSON EmailFilter where+ toJSON e = Object (x <> y)+ where+ Object x = toJSON (_efInfo e)+ Object y = object ["id" .= _efId e]++instance HasEmailFilterInfo EmailFilter where+ emailFilterInfo = lens _efInfo (\e x -> e { _efInfo = x })++-- | The email filter ID.+makeLens "_efId" ''EmailFilter++-- | Create a new Email Filter for the specified service.+--+-- @POST \/services\/\:service_id\/email_filters@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/create>+createEmailFilter :: ServiceId -> Request EmailFilterInfo s EmailFilter+createEmailFilter s = mk def & meth .~ POST & path .~ filters s++-- | Update an existing Email Filter.+--+-- @PUT \/services\/\:service_id\/email_filters\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/update>+updateEmailFilter :: ServiceId+ -> EmailFilterId+ -> Request EmailFilterInfo s Empty+updateEmailFilter s e = mk def & meth .~ PUT & path .~ filters s % e++-- | Delete an existing Email Filter.+--+-- @DELETE \/services\/\:service_id\/email_filters\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/delete>+deleteEmailFilter :: ServiceId -> EmailFilterId -> Request Empty s Empty+deleteEmailFilter s e = empty & meth .~ DELETE & path .~ filters s % e
+ src/Network/PagerDuty/REST/Users.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Users+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Access and manipulate user data for your PagerDuty account. When a user is+-- shown inlined in other resources, a deleted user will have its @html_url@ attribute+-- set to null.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users>+module Network.PagerDuty.REST.Users+ (+ -- * List Users+ ListUsers+ , listUsers+ , luQuery++ -- * List On Call Users+ , listOnCallUsers++ -- * Create User+ , CreateUser+ , createUser+ , cuName+ , cuEmail+ , cuRole+ , cuJobTitle+ , cuTimeZone++ -- * Get User+ , getUser++ -- * Get User On Call+ , getUserOnCall++ -- * Update User+ , UpdateUser+ , updateUser+ , uuName+ , uuEmail+ , uuRole+ , uuJobTitle+ , uuTimeZone++ -- * Delete User+ , deleteUser++ -- * Types+ , PolicyInfo+ , piId+ , piName++ , OnCall+ , ocLevel+ , ocStart+ , ocEnd+ , ocEscalationPolicy++ , Role (..)++ , HasUserInfo (..)+ , UserInfo+ , User+ , uRole+ , uAvatarUrl+ , uUserUrl+ , uInvitationSent+ , uJobTitle+ ) where++import Control.Applicative hiding (empty)+import Control.Lens hiding ((.=))+import Data.Aeson+import Data.Default.Class+import Data.Monoid+import Data.Text (Text)+import Data.Time+import Network.HTTP.Types+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++users :: Path+users = "users"++includes :: Query+includes =+ [ ("include[]", Just "contact_methods")+ , ("include[]", Just "notification_rules")+ ]++data UserInfo = UserInfo+ { _uId' :: UserId+ , _uName' :: Text+ , _uEmail' :: Address+ , _uColor' :: Text+ , _uTimeZone' :: TZ+ } deriving (Eq, Show)++deriveRecord ''UserInfo++class HasUserInfo a where+ userInfo :: Lens' a UserInfo++ -- | The id of the user.+ uId :: Lens' a UserId++ -- | The name of the user.+ uName :: Lens' a Text++ -- | The user's email address.+ uEmail :: Lens' a Address++ -- | The color used to represent the user in schedules.+ uColor :: Lens' a Text++ -- | The user's personal time zone.+ uTimeZone :: Lens' a TimeZone++ uId = userInfo.uId'+ uName = userInfo.uName'+ uEmail = userInfo.uEmail'+ uColor = userInfo.uColor'+ uTimeZone = userInfo.uTimeZone'._TZ++instance (QueryLike a, ToJSON a, HasUserInfo a)+ => HasUserInfo (Request a s b) where+ userInfo = upd.userInfo++instance HasUserInfo UserInfo where+ userInfo = id++data PolicyInfo = PolicyInfo+ { _piId :: EscalationPolicyId+ , _piName :: Text+ } deriving (Eq, Show)++deriveRecord ''PolicyInfo++data OnCall = OnCall+ { _ocLevel :: !Int+ , _ocStart :: Maybe Date+ , _ocEnd :: Maybe Date+ , _ocEscalationPolicy :: PolicyInfo+ } deriving (Eq, Show)++deriveRecord ''OnCall++data Role+ = RoleAdmin+ | RoleUser+ | RoleLimitedUser+ deriving (Eq, Show)++deriveNullaryWith (dropped 4 underscored) ''Role++instance Default Role where+ def = RoleUser++data User = User+ { _uInfo :: UserInfo+ , _uRole :: !Role+ , _uAvatarUrl :: Text+ , _uUserUrl :: Text+ , _uInvitationSent' :: !Bool'+ , _uJobTitle :: Maybe Text+ } deriving (Eq, Show)++ -- FIXME: add notification_rules, contact_methods, on_call++makeLenses ''User++instance FromJSON User where+ parseJSON = withObject "user" $ \o ->+ User <$> parseJSON (Object o)+ <*> o .: "role"+ <*> o .: "avatar_url"+ <*> o .: "user_url"+ <*> o .: "invitation_sent"+ <*> o .:? "job_title"++instance ToJSON User where+ toJSON u = Object (x <> y)+ where+ Object x = toJSON (_uInfo u)+ Object y = object+ [ "role" .= _uRole u+ , "avatar_url" .= _uAvatarUrl u+ , "user_url" .= _uUserUrl u+ , "invitation_sent" .= _uInvitationSent' u+ , "job_title" .= _uJobTitle u+ ]++instance HasUserInfo User where+ userInfo = uInfo++uInvitationSent :: Lens' User Bool+uInvitationSent = uInvitationSent'._B++newtype ListUsers = ListUsers+ { _luQuery' :: Maybe Text+ }++queryRequest ''ListUsers++instance Paginate ListUsers++-- | Filters the result, showing only the users whose names or email addresses+-- match the query.+luQuery :: Lens' (Request ListUsers s b) (Maybe Text)+luQuery = upd.luQuery'++-- | List users of your PagerDuty account, optionally filtered by a search query.+--+-- @GET \/users@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/list>+listUsers :: Request ListUsers s [User]+listUsers =+ mk ListUsers+ { _luQuery' = Nothing+ } & path .~ users+ & query .~ includes++-- | List all the existing escalation policies with currently on-call users.+--+-- If the start and end of an on-call object are null, then the user is always+-- on-call for an escalation policy level.+--+-- @GET \/escalation_policies\/on_call@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/on_call>+listOnCallUsers :: Request ListUsers s [User]+listOnCallUsers = listUsers & path .~ users % "on_call"++-- | Get information about an existing user.+--+-- @GET \/users\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/show>+getUser :: UserId -> Request Empty s User+getUser u = empty & path .~ users % u & query .~ includes++-- | Get a user object with that user's current on-call status. If the on-call+-- object is an empty list, the user is never on-call.+--+-- If the start and end of an on-call object are null, then the user is always+-- on-call for an escalation policy level.+--+-- @GET \/users\/\:id\/on_call@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/show_on_call>+getUserOnCall :: UserId -> Request Empty s User+getUserOnCall u = empty & path .~ users % u % "on_call" & query .~ includes++data CreateUser = CreateUser+ { _cuName' :: Text+ , _cuEmail' :: Address+ , _cuRole' :: Maybe Role+ , _cuJobTitle' :: Maybe Text+ , _cuTimeZone' :: Maybe TZ+ } deriving (Eq, Show)++jsonRequest ''CreateUser++-- | The name of the user.+cuName :: Lens' (Request CreateUser s b) Text+cuName = upd.cuName'++-- | The email of the user. The newly created user will receive an email asking+-- to confirm the subscription.+cuEmail :: Lens' (Request CreateUser s b) Address+cuEmail = upd.cuEmail'++-- | The user's role.+cuRole :: Lens' (Request CreateUser s b) (Maybe Role)+cuRole = upd.cuRole'++-- | The job title of the user.+cuJobTitle :: Lens' (Request CreateUser s b) (Maybe Text)+cuJobTitle = upd.cuJobTitle'++-- | The time zone the user is in. If not specified, the time zone of the+-- account making the API call will be used.+cuTimeZone :: Lens' (Request CreateUser s b) (Maybe TimeZone)+cuTimeZone = upd.cuTimeZone'.mapping _TZ++-- | Create a new user for your account. An invite email will be sent asking+-- the user to choose a password.+--+-- @POST \/users@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/create>+createUser :: RequesterId+ -> Text -- ^ 'cuName'+ -> Address -- ^ 'cuEmail'+ -> Request CreateUser s User+createUser r n e = auth (createUserBasic n e) & query .~ [("requester_id", r)]++-- | A version of 'disableService' which uses HTTP Basic authentication and+-- doesn't require a 'RequesterId'.+createUserBasic :: Text -- ^ 'cuName'+ -> Address -- ^ 'cuEmail'+ -> Request CreateUser Basic User+createUserBasic n e =+ mk CreateUser+ { _cuName' = n+ , _cuEmail' = e+ , _cuRole' = Nothing+ , _cuJobTitle' = Nothing+ , _cuTimeZone' = Nothing+ } & meth .~ POST+ & path .~ users++data UpdateUser = UpdateUser+ { _uuName' :: Maybe Text+ , _uuEmail' :: Maybe Address+ , _uuRole' :: Maybe Role+ , _uuJobTitle' :: Maybe Text+ , _uuTimeZone' :: Maybe TZ+ } deriving (Eq, Show)++jsonRequest ''UpdateUser++-- | The name of the user.+uuName :: Lens' (Request UpdateUser s b) (Maybe Text)+uuName = upd.uuName'++-- | The email of the user. The newly created user will receive an email asking+-- to confirm the subscription.+uuEmail :: Lens' (Request UpdateUser s b) (Maybe Address)+uuEmail = upd.uuEmail'++-- | The user's role.+uuRole :: Lens' (Request UpdateUser s b) (Maybe Role)+uuRole = upd.uuRole'++-- | The job title of the user.+uuJobTitle :: Lens' (Request UpdateUser s b) (Maybe Text)+uuJobTitle = upd.uuJobTitle'++-- | The time zone the user is in. If not specified, the time zone of the+-- account making the API call will be used.+uuTimeZone :: Lens' (Request UpdateUser s b) (Maybe TimeZone)+uuTimeZone = upd.uuTimeZone'.mapping _TZ++-- | Update an existing user.+--+-- @PUT \/users\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/update>+updateUser :: UserId -> Request UpdateUser s User+updateUser u =+ mk UpdateUser+ { _uuName' = Nothing+ , _uuEmail' = Nothing+ , _uuRole' = Nothing+ , _uuJobTitle' = Nothing+ , _uuTimeZone' = Nothing+ } & meth .~ PUT+ & path .~ users % u++-- | Remove an existing user.+--+-- @DELETE \/users\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/delete>+deleteUser :: UserId -> Request Empty s Empty+deleteUser u = empty & meth .~ DELETE & path .~ users % u+-- FIXME: deal with conflict errors
+ src/Network/PagerDuty/REST/Users/ContactMethods.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Users.ContactMethods+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Contact methods describe the various channels (phone numbers, SMS numbers+-- and email addresses) used to contact a user when an incident is assigned to+-- the user.+--+-- Access and manipulate the contact methods for a user.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods>+module Network.PagerDuty.REST.Users.ContactMethods+ (+ -- * List Contacts+ listContacts++ -- * Create Contact+ , CreateContact+ , createContact+ , ccType+ , ccAddress+ , ccCountryCode+ , ccLabel+ , ccSendShortEmail++ -- * Get Contact+ , getContact++ -- * Update Contact+ , UpdateContact+ , updateContact+ , ucAddress+ , ucCountryCode+ , ucLabel+ , ucSendShortEmail++ -- * Delete Contact+ , deleteContact++ -- * Types+ , ContactType (..)++ , HasContact (..)+ , Contact+ ) where++import Control.Lens+import Data.Aeson.Lens+import Data.Text (Text)+import Network.HTTP.Types+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++contacts :: UserId -> Path+contacts u = "users" % u % "contact_methods"++data ContactType+ = SMS+ | Phone+ | Email+ deriving (Eq, Show)++deriveNullary ''ContactType++data Contact = Contact+ { _cId :: ContactId+ , _cUserId :: UserId+ , _cLabel :: Text+ , _cAddress :: Address+ , _cType :: !ContactType+ , _cCountryCode :: Maybe Int+ , _cSendShortEmail :: Maybe Bool'+ , _cBlacklisted :: Maybe Bool'+ } deriving (Eq, Show)++deriveJSON ''Contact+makeClassy ''Contact++-- | List existing contact methods for the specified user.+--+-- @GET \/users\/\:user_id\/contact_methods@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/list>+listContacts :: UserId -> Request Empty s [Contact]+listContacts u = empty & path .~ contacts u++-- | Get details for a contact method.+--+-- @GET \/users\/\:user_id\/contact_methods\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/show>+getContact :: UserId -> ContactId -> Request Empty s Contact+getContact u c = empty & path .~ contacts u % c++data CreateContact = CreateContact+ { _ccType' :: !ContactType+ , _ccAddress' :: Address+ , _ccCountryCode' :: Maybe Int+ , _ccLabel' :: Maybe Text+ , _ccSendShortEmail' :: Maybe Bool'+ } deriving (Eq, Show)++jsonRequest ''CreateContact++-- | The type of the contact method.+ccType :: Lens' (Request CreateContact s b) ContactType+ccType = upd.ccType'++-- | The id of the contact method. For 'SMS' and 'Phone' it is the number, and for+-- 'Email' it is the email address.+ccAddress :: Lens' (Request CreateContact s b) Address+ccAddress = upd.ccAddress'++-- | The number code for your country. Not used for 'Email'.+--+-- /Default:/ 1+ccCountryCode :: Lens' (Request CreateContact s b) (Maybe Int)+ccCountryCode = upd.ccCountryCode'++-- | A human friendly label for the contact method.+--+-- /Example:/ "Home Phone", "Work Email", etc.+--+-- /Default:/ The type of the contact method and the address (with country code+-- for phone numbers).+ccLabel :: Lens' (Request CreateContact s b) (Maybe Text)+ccLabel = upd.ccLabel'++-- | Send an abbreviated email message instead of the standard email+-- output. Useful for email-to-SMS gateways and email based pagers. Only valid for+-- 'Email' contact methods.+--+-- /Default:/ false.+ccSendShortEmail :: Lens' (Request CreateContact s b) (Maybe Bool)+ccSendShortEmail = upd.ccSendShortEmail'.mapping _B++-- | Create a new contact method for a given user. A contact method can be one+-- of the following types: SMS, email, and phone. push_notification contact+-- methods cannot be created using this API, they are added automatically during+-- device registration.+--+-- @POST \/users\/\:user_id\/contact_methods@+--+-- /Note:/ The contact info must be unique.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/create>+createContact :: UserId+ -> ContactType+ -> Address+ -> Request CreateContact s Contact+createContact u t a =+ mk CreateContact+ { _ccType' = t+ , _ccAddress' = a+ , _ccCountryCode' = Nothing+ , _ccLabel' = Nothing+ , _ccSendShortEmail' = Nothing+ } & meth .~ POST+ & path .~ contacts u+ & unwrap .~ key "contact_method"++data UpdateContact = UpdateContact+ { _ucAddress' :: Maybe Address+ , _ucCountryCode' :: Maybe Int+ , _ucLabel' :: Maybe Text+ , _ucSendShortEmail' :: Maybe Bool'+ } deriving (Eq, Show)++jsonRequest ''UpdateContact++-- | The id of the contact method. For 'SMS' and 'Phone' it is the number, and for+-- 'Email' it is the email address.+ucAddress :: Lens' (Request UpdateContact s b) (Maybe Address)+ucAddress = upd.ucAddress'++-- | The number code for your country. Not used for 'Email'.+--+-- /Default:/ 1+ucCountryCode :: Lens' (Request UpdateContact s b) (Maybe Int)+ucCountryCode = upd.ucCountryCode'++-- | A human friendly label for the contact method.+--+-- /Example:/ "Home Phone", "Work Email", etc.+--+-- /Default:/ The type of the contact method and the address (with country code+-- for phone numbers).+ucLabel :: Lens' (Request UpdateContact s b) (Maybe Text)+ucLabel = upd.ucLabel'++-- | Send an abbreviated email message instead of the standard email+-- output. Useful for email-to-SMS gateways and email based pagers. Only valid for+-- 'Email' contact methods.+--+-- /Default:/ false.+ucSendShortEmail :: Lens' (Request UpdateContact s b) (Maybe Bool)+ucSendShortEmail = upd.ucSendShortEmail'.mapping _B++-- | Update an existing contact method of a given user. Note that you cannot+-- change the type of an existing method.+--+-- @PUT \/users\/\:user_id\/contact_methods\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/update>+updateContact :: UserId -> ContactId -> Request UpdateContact s Contact+updateContact u c =+ mk UpdateContact+ { _ucAddress' = Nothing+ , _ucCountryCode' = Nothing+ , _ucLabel' = Nothing+ , _ucSendShortEmail' = Nothing+ } & meth .~ PUT+ & path .~ contacts u % c+ & unwrap .~ key "contact_method"++-- | Remove a contact method and any corresponding notification rules.+--+-- @DELETE \/users\/\:user_id\/contact_methods\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/delete>+deleteContact :: UserId -> ContactId -> Request Empty s Empty+deleteContact u c = empty & meth .~ DELETE & path .~ contacts u % c
+ src/Network/PagerDuty/REST/Users/NotificationRules.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-type-defaults #-}++-- Module : Network.PagerDuty.REST.Users.NotificationRules+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | When a user is assigned an incident, the user's notification rules are+-- used to determine which contact method will be used to alert the user and how+-- long after the incident to do so.+--+-- Access and manipulate the notification rules for a user.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules>+module Network.PagerDuty.REST.Users.NotificationRules+ (+ -- * List Rules+ listRules++ -- * Create Rule+ , CreateRule+ , createRule+ , crStartDelayInMinutes+ , crContactMethodId++ -- * Get Rule+ , getRule++ -- * Update Rule+ , UpdateRule+ , updateRule+ , urStartDelayInMinutes+ , urContactMethodId++ -- * Delete Rule+ , deleteRule++ -- * Types+ , Rule+ , rId+ , rStartDelayInMinutes+ , rContactMethod+ ) where++import Control.Lens+import Data.Aeson.Lens+import Network.HTTP.Types+import Network.PagerDuty.REST.Users.ContactMethods+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++default (Path)++rules :: UserId -> Path+rules u = "users" % u % "notification_rules"++data Rule = Rule+ { _rId :: NotificationRuleId+ , _rStartDelayInMinutes :: !Int+ , _rContactMethod :: Contact+ } deriving (Eq, Show)++deriveJSON ''Rule+makeLenses ''Rule++instance HasContact Rule where+ contact = rContactMethod++-- | List existing notification rules for the specified user.+--+-- @GET \/users\/\:user_id\/notification_rules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/list>+listRules :: UserId -> Request Empty s Rule+listRules u = empty & path .~ rules u++-- | Get details for a notification rule.+--+-- @GET \/users\/\:user_id\/notification_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/show>+getRule :: UserId -> NotificationRuleId -> Request Empty s Rule+getRule u n = empty & path .~ rules u % n++data CreateRule = CreateRule+ { _crStartDelayInMinutes' :: !Int+ , _crContactMethodId' :: ContactId+ } deriving (Eq, Show)++jsonRequest ''CreateRule++-- | Number of minutes it will take for the notification rule to be activated+-- (from the time the incident is assigned to the owning user) and an alert be+-- fired.+crStartDelayInMinutes :: Lens' (Request CreateRule s b) Int+crStartDelayInMinutes = upd.crStartDelayInMinutes'++-- | The id of the contact method.+crContactMethodId :: Lens' (Request CreateRule s b) ContactId+crContactMethodId = upd.crContactMethodId'++-- | Create a new notification rule for the specified user.+--+-- @POST \/users\/\:user_id\/notification_rules@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/create>+createRule :: UserId -> ContactId -> Int -> Request CreateRule s Rule+createRule u c n =+ mk CreateRule+ { _crStartDelayInMinutes' = n+ , _crContactMethodId' = c+ } & meth .~ POST+ & path .~ rules u+ & unwrap .~ key "notification_rule"++data UpdateRule = UpdateRule+ { _urStartDelayInMinutes' :: Maybe Int+ , _urContactMethodId' :: Maybe ContactId+ } deriving (Eq, Show)++jsonRequest ''UpdateRule++-- | Number of minutes it will take for the notification rule to be activated+-- (from the time the incident is assigned to the owning user) and an alert be+-- fired.+urStartDelayInMinutes :: Lens' (Request UpdateRule s b) (Maybe Int)+urStartDelayInMinutes = upd.urStartDelayInMinutes'++-- | The id of the contact method.+urContactMethodId :: Lens' (Request UpdateRule s b) (Maybe ContactId)+urContactMethodId = upd.urContactMethodId'++-- | Update an existing notification rule.+--+-- @PUT \/users\/\:user_id\/notification_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/update>+updateRule :: UserId -> NotificationRuleId -> Request UpdateRule s Rule+updateRule u r =+ mk UpdateRule+ { _urStartDelayInMinutes' = Nothing+ , _urContactMethodId' = Nothing+ } & meth .~ PUT+ & path .~ rules u % r+ & unwrap .~ key "notification_rule"++-- | Remove a notification rule.+--+-- @DELETE \/users\/\:user_id\/notification_rules\/\:id@+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/delete>+deleteRule :: UserId+ -> NotificationRuleId+ -> Request Empty s Empty+deleteRule u n = empty & meth .~ DELETE & path .~ rules u % n
+ src/Network/PagerDuty/REST/Webhooks.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.PagerDuty.REST.Webhooks+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- License : This Source Code Form is subject to the terms of+-- the Mozilla Public License, v. 2.0.+-- A copy of the MPL can be found in the LICENSE file or+-- you can obtain it at http://mozilla.org/MPL/2.0/.+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Webhooks let you recieve HTTP callbacks when interesting events happen within+-- your PagerDuty account. Details surrounding the interesting event will be sent+-- via HTTP to a URL that you specify.+--+-- PagerDuty currently supports incident-based webhooks. After adding a webhook+-- URL to a PagerDuty service, the triggering of new incidents on that service+-- will cause outgoing webhook messages to be sent to that URL. In addition,+-- certain interesting changes to an incident's state will cause other types of+-- incident webhook messages to be sent: Generally, any change to the @status@ or+-- @assigned_to_user@ of an incident will cause an outgoing message to be sent.+--+-- /See:/ <http://developer.pagerduty.com/documentation/rest/webhooks>+module Network.PagerDuty.REST.Webhooks+ ( WebhookType (..)+ , Webhook+ , wId+ , wType+ , wCreatedOn+ ) where++import Control.Applicative hiding (empty)+import Control.Lens+import Data.Aeson+import Data.ByteString.Conversion (ToByteString(..), toByteString')+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Data.Time+import Network.PagerDuty.REST.Incidents+import Network.PagerDuty.Internal.TH+import Network.PagerDuty.Internal.Types++data WebhookType+ = WTrigger+ -- ^ Sent when an incident is newly created/triggered.+ | WAcknowledge+ -- ^ Sent when an incident has had its status changed from triggered to+ -- acknowledged.+ | WUnacknowledge+ -- ^ Sent when an incident is unacknowledged due to timeout.+ | WResolve+ -- ^ Sent when an incident has been resolved.+ | WAssign+ -- ^ Sent when an incident has been manually reassigned to another user+ -- in a different escalation chain.+ | WEscalate+ -- ^ Sent when an incident has been escalated to another user in the+ -- same escalation chain.+ | WDelegate+ -- ^ Sent when an incident has been reassigned to another escalation chain.+ | WOther Text+ -- ^ /Note:/ As new types of incident actions are supported,+ -- new incident webhook message types will be added.+ deriving (Eq, Show)++instance ToByteString WebhookType where+ builder = \case+ WTrigger -> "incident.trigger"+ WAcknowledge -> "incident.acknowledge"+ WUnacknowledge -> "incident.unacknowledge"+ WResolve -> "incident.resolve"+ WAssign -> "incident.assign"+ WEscalate -> "incident.escalate"+ WDelegate -> "incident.delegate"+ WOther t -> builder t++instance FromJSON WebhookType where+ parseJSON = withText "status" $ pure . \case+ "incident.trigger" -> WTrigger+ "incident.acknowledge" -> WAcknowledge+ "incident.unacknowledge" -> WUnacknowledge+ "incident.resolve" -> WResolve+ "incident.assign" -> WAssign+ "incident.escalate" -> WEscalate+ "incident.delegate" -> WDelegate+ t -> (WOther t)++instance ToJSON WebhookType where+ toJSON = String . Text.decodeUtf8 . toByteString'++data Webhook = Webhook+ { _wId :: WebhookId+ , _wType :: !WebhookType+ , _wCreatedOn :: !Date+ , _wData :: Incident+ } deriving (Eq, Show)++deriveJSON ''Webhook++instance HasIncident Webhook where+ incident = lens _wData (\s x -> s { _wData = x })++-- | Uniquely identifies this outgoing webhook message; can be used for+-- idempotency when processing the messages.+makeLens "_wId" ''Webhook++-- | The webhook message type.+makeLens "_wType" ''Webhook++-- | The date/time when the incident changed state.+wCreatedOn :: Lens' Webhook UTCTime+wCreatedOn = lens _wCreatedOn (\i x -> i { _wCreatedOn = x }) . _D