git.iko.soy/typeable/pagerduty
on dc8e923 help sign in
5ad1d87
swap
0 ahead, 132 behind
.gitignore−1
since splitsnapshots
unifiedsplit
@@ -9,7 +9,6 @@
9cabal.sandbox.config
9cabal.sandbox.config
10
10
11# Dirs
11# Dirs
12−.stack-work
13cabal-dev
12cabal-dev
14bin
13bin
15dist
14dist
.travis.ymldeleted−30
@@ -1,30 +0,0 @@
1−sudo: false
2−
3−cache:
4− apt: true
5− directories:
6− - ~/.stack
7−
8−branches:
9− only:
10− - master
11− - develop
12−
13−before_install:
14− - export PATH=/opt/ghc/$GHCVER/bin:$PATH
15− - export PATH=~/.local/bin:$PATH
16− - ./script/travis-lifecycle-before_install
17−
18−install:
19− - ./script/travis-lifecycle-install
20−
21−script:
22− - ./script/travis-lifecycle-script
23−
24−matrix:
25− fast_finish: true
26− include:
27− - env: GHCVER=8.0.1
28− addons: { apt: { packages: [ghc-8.0.1], sources: [hvr-ghc] } }
29− - env: GHCVER=7.10.3
30− addons: { apt: { packages: [ghc-7.10.3], sources: [hvr-ghc] } }
Makefilenew file+17
@@ -0,0 +1,17 @@
1+FLAGS := -j --disable-documentation --disable-library-coverage
2+
3+build:
4+ cabal build $(addprefix -,$(findstring j,$(MAKEFLAGS)))
5+
6+install: cabal.sandbox.config
7+ cabal install $(FLAGS) --only-dependencies
8+
9+clean:
10+ cabal clean
11+ rm -rf cabal.sandbox.config .cabal-sandbox
12+
13+doc:
14+ cabal haddock
15+
16+cabal.sandbox.config:
17+ cabal sandbox init
README.md−14
@@ -1,14 +0,0 @@
1−# PagerDuty
2−
3−[![Build Status](https://travis-ci.org/brendanhay/amazonka.svg?branch=develop)](https://travis-ci.org/brendanhay/pagerduty)
4−
5−* [Contribute](#contribute)
6−* [Licence](#licence)
7−
8−## Contribute
9−
10−For any problems, comments, or feedback please create an issue [here on GitHub](https://github.com/brendanhay/pagerduty/issues).
11−
12−## Licence
13−
14−PagerDuty is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/).
pagerduty.cabal+42−65
@@ -1,32 +1,20 @@
1name: pagerduty
1name: pagerduty
2−version: 0.0.8
2+version: 0.1.0
3−synopsis: Client library for PagerDuty Integration and REST APIs.
3+synopsis: Pager Duty API Client
4homepage: http://github.com/brendanhay/pagerduty
4homepage: http://github.com/brendanhay/pagerduty
5license: OtherLicense
5license: OtherLicense
6license-file: LICENSE
6license-file: LICENSE
7−author: Brendan Hay
7+author: Brendan Hay, Kim Altintop
8−maintainer: Brendan Hay <brendan.g.hay@gmail.com>
8+maintainer: Brendan Hay <brendan.g.hay@gmail.com>, Kim Altintop <kim.altintop@gmail.com>
9−copyright: Copyright (c) 2013-2015 Brendan Hay, 2014 Kim Altintop
9+copyright: Copyright (c) 2013-2014 Brendan Hay, 2014 Kim Altintop
10−category: Network, PagerDuty, Monitoring
10+category: Network, Monitoring
11build-type: Simple
11build-type: Simple
12cabal-version: >= 1.10
12cabal-version: >= 1.10
13
13
14description:
14description:
15− PagerDuty is an alerting system for IT professionals. PagerDuty connects
15+ Simple API client that wraps the PagerDuty REST APIs documented here:
16− with a variety of systems (including monitoring tools and ticketing
17− systems) and dispatches alerts via automated phone call, SMS and email.
18−
19− This library implements the full PagerDuty Integration and REST APIs which
20− are documented here:
21− .
22− * Integration API - <http://developer.pagerduty.com/documentation/integration>
23− .
24− * REST API - <http://developer.pagerduty.com/documentation/rest>
25 .
16 .
26− /Warning:/ This is an experimental preview release which is still under
17+ * Integration API - <http://developer.pagerduty.com/documentation/integration/events>
27− heavy development and not intended for public consumption, caveat emptor!
28− .
29− /Note:/ An alternative source for Haddock documentation can be found <http://brendanhay.nz/pagerduty here>.
30
18
31extra-source-files:
19extra-source-files:
32 README.md
20 README.md
@@ -42,56 +30,45 @@ library
42 ghc-options: -Wall
30 ghc-options: -Wall
43
31
44 exposed-modules:
32 exposed-modules:
45− Control.Monad.Trans.PagerDuty
33+ Network.PagerDuty
34+ -- , Network.PagerDuty.Alerts
35+ -- , Network.PagerDuty.EscalationPolicies
36+ -- , Network.PagerDuty.Services
46 , Network.PagerDuty.Integration
37 , Network.PagerDuty.Integration
47− , Network.PagerDuty.REST
38+
48− , Network.PagerDuty.REST.Alerts
39+ , Network.PagerDuty.HTTP
49− , Network.PagerDuty.REST.EscalationPolicies
40+
50− , Network.PagerDuty.REST.EscalationPolicies.EscalationRules
51− , Network.PagerDuty.REST.Incidents
41+ -- , Network.PagerDuty.Incidents
52− , Network.PagerDuty.REST.Incidents.Notes
42+ -- , Network.PagerDuty.Integration
53− , Network.PagerDuty.REST.LogEntries
43+ -- , Network.PagerDuty.LogEntries
54− , Network.PagerDuty.REST.MaintenanceWindows
44+ -- , Network.PagerDuty.MaintenanceWindows
55− , Network.PagerDuty.REST.Reports
45+ -- , Network.PagerDuty.Reports
56− , Network.PagerDuty.REST.Schedules
57− , Network.PagerDuty.REST.Schedules.Overrides
46+ -- , Network.PagerDuty.Schedules
58− , Network.PagerDuty.REST.Services
59− , Network.PagerDuty.REST.Services.EmailFilters
60− , Network.PagerDuty.REST.Users
61− , Network.PagerDuty.REST.Users.ContactMethods
47+ -- , Network.PagerDuty.Users
62− , Network.PagerDuty.REST.Users.NotificationRules
63− , Network.PagerDuty.REST.Webhooks
64
48
65 other-modules:
49 other-modules:
66− Network.PagerDuty.Internal.IO
50+ Network.PagerDuty.Alerts.Types
67− , Network.PagerDuty.Internal.Options
51+ , Network.PagerDuty.EscalationPolicies.Types
68− , Network.PagerDuty.Internal.Query
52+ , Network.PagerDuty.Services.Types
69− , Network.PagerDuty.Internal.TH
53+ , Network.PagerDuty.TH
70− , Network.PagerDuty.Internal.Types
71 , Network.PagerDuty.Types
54 , Network.PagerDuty.Types
72
55
73 build-depends:
56 build-depends:
74− aeson >= 2.0
57+ aeson >= 0.7 && < 1.0
75− , base >= 4.7 && < 5
58+ , base >= 4.5 && < 5.0
76− , bifunctors >= 4.1
59+ , base64-bytestring >= 1.0 && < 1.1
77− , bytestring >= 0.9
60+ , bytestring >= 0.9 && < 1.0
78 , bytestring-conversion >= 0.2.1
61 , bytestring-conversion >= 0.2.1
79− , conduit > 1.1
62+ , conduit >= 0.5.5
80− , data-default-class >= 0.0.1
63+ , data-default >= 0.5
81− , exceptions >= 0.6
64+ , formatting >= 5.4
82− , generics-sop >= 0.5.0.0
83− , http-client >= 0.5 && < 1
65+ , http-client >= 0.3.6 && < 0.5
66+ , http-client-lens >= 0.1
84− , http-types >= 0.8
67+ , http-types >= 0.8 && < 1.0
85− , lens >= 4.4
68+ , lens >= 4.0 && < 5.0
86− , lens-aeson >= 1
69+ , lens-aeson >= 1.0
87− , mmorph >= 1
88− , monad-control >= 1
89− , mtl >= 2.1.3.1
70+ , mtl >= 2.1 && < 3.0
90− , template-haskell >= 2.2
91− , text >= 1.1
71+ , text >= 1.1 && < 2.0
92− , time >= 1.2
72+ , time >= 1.4 && < 2.0
93− , time-locale-compat >= 0.1.0.1
94− , transformers >= 0.2
95− , transformers-compat >= 0.3
73+ , transformers >= 0.3 && < 0.5
96− , transformers-base >= 0.4.2
97 , unordered-containers >= 0.2.3
74 , unordered-containers >= 0.2.3
script/travis-lifecycle-before_installdeleted−11
@@ -1,11 +0,0 @@
1−#!/usr/bin/env bash
2−
3−set -e
4−
5−mkdir -p ~/.local/bin
6−
7−curl -L https://www.stackage.org/stack/linux-x86_64 | \
8− tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
9−
10−ghc --version
11−stack --version
script/travis-lifecycle-installdeleted−13
@@ -1,13 +0,0 @@
1−#!/usr/bin/env bash
2−
3−set -e
4−
5−GHCVER=${GHCVER?"GHCVER needs to be set."}
6−
7−path=$(cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd)
8−
9−$path/travis-timeout \
10− stack --no-terminal --skip-ghc-check --stack-yaml stack-$GHCVER.yaml setup
11−
12−$path/travis-timeout \
13− stack --no-terminal --skip-ghc-check --stack-yaml stack-$GHCVER.yaml test pagerduty --only-snapshot
script/travis-lifecycle-scriptdeleted−9
@@ -1,9 +0,0 @@
1−#!/usr/bin/env bash
2−
3−set -e
4−
5−GHCVER=${GHCVER?"GHCVER needs to be set."}
6−
7−path=$(cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd)
8−
9−stack --no-terminal --skip-ghc-check --stack-yaml stack-$GHCVER.yaml test pagerduty
script/travis-timeoutdeleted−15
@@ -1,15 +0,0 @@
1−#!/usr/bin/env bash
2−
3−$* &
4−pidA=$!
5−minutes=0
6−
7−while true; do sleep 60; ((minutes++)); echo -e "\033[0;32m$minutes minute(s) elapsed running '$*'\033[0m."; done &
8−pidB=$!
9−wait $pidA
10−resA=$?
11−
12−echo -e "\033[0;32m'$*' exited with status ${resA}.\033[0m"
13−kill -9 $pidB
14−
15−exit $resA
src/Control/Monad/Trans/PagerDuty.hsdeleted−172
@@ -1,172 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−
9−-- Module : Control.Monad.Trans.PagerDuty
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−module Control.Monad.Trans.PagerDuty
20− (
21− -- * Transformer
22− PagerDuty
23− , PagerDutyT
24−
25− -- * Running
26− , runPagerDutyT
27−
28− -- * Integration events
29− , submit
30− , submitCatch
31−
32− -- * REST requests
33− , send
34− , sendCatch
35− , paginate
36− , paginateCatch
37−
38− -- ** Lifting errors
39− , hoistError
40−
41− , module Network.PagerDuty.Types
42− ) where
43−
44−import Control.Applicative
45−import Control.Monad
46−import Control.Monad.Base
47−import Control.Monad.Catch
48−import Control.Monad.Except (MonadError (..))
49−import Control.Monad.Morph
50−import Control.Monad.Reader
51−import Control.Monad.Trans.Control
52−import Control.Monad.Trans.Except
53−import Data.Aeson
54−import Data.Conduit
55−import Network.PagerDuty.Integration (Event, Response)
56−import qualified Network.PagerDuty.Integration as Int
57−import Network.PagerDuty.Internal.Types
58−import qualified Network.PagerDuty.REST as REST
59−import Network.PagerDuty.Types
60−
61−-- | A convenient alias for 'PagerDutyT' 'IO'.
62−type PagerDuty s = PagerDutyT s IO
63−
64−newtype PagerDutyT s m a = PagerDutyT
65− { unPagerDutyT :: ReaderT (Env s) (ExceptT Error m) a
66− } deriving
67− ( Functor
68− , Applicative
69− , Monad
70− , MonadIO
71− , MonadThrow
72− , MonadCatch
73− , MonadReader (Env s)
74− , MonadError Error
75− )
76−
77−instance MonadTrans (PagerDutyT s) where
78− lift = PagerDutyT . lift . lift
79− {-# INLINE lift #-}
80−
81−instance MonadBase b m => MonadBase b (PagerDutyT s m) where
82− liftBase = liftBaseDefault
83− {-# INLINE liftBase #-}
84−
85−instance MonadTransControl (PagerDutyT s) where
86− type StT (PagerDutyT s) a = StT (ExceptT Error) (StT (ReaderT (Env s)) a)
87−
88− liftWith f = PagerDutyT $
89− liftWith $ \g ->
90− liftWith $ \h ->
91− f (h . g . unPagerDutyT)
92− {-# INLINE liftWith #-}
93−
94− restoreT = PagerDutyT . restoreT . restoreT
95− {-# INLINE restoreT #-}
96−
97−instance MonadBaseControl b m => MonadBaseControl b (PagerDutyT s m) where
98− type StM (PagerDutyT s m) a = ComposeSt (PagerDutyT s) m a
99−
100− liftBaseWith = defaultLiftBaseWith
101− {-# INLINE liftBaseWith #-}
102−
103− restoreM = defaultRestoreM
104− {-# INLINE restoreM #-}
105−
106−instance MFunctor (PagerDutyT s) where
107− hoist nat m = PagerDutyT (ReaderT (ExceptT . nat . runPagerDutyT m))
108− {-# INLINE hoist #-}
109−
110−instance MMonad (PagerDutyT s) where
111− embed f m = ask >>= f . runPagerDutyT m >>= either throwError return
112− {-# INLINE embed #-}
113−
114−runPagerDutyT :: PagerDutyT s m a -> Env s -> m (Either Error a)
115−runPagerDutyT (PagerDutyT k) = runExceptT . runReaderT k
116−
117−hoistError :: (MonadError Error m) => Either Error a -> m a
118−hoistError = either throwError return
119−
120−scoped :: MonadReader (Env s) m => (Env s -> m a) -> m a
121−scoped f = ask >>= f
122−
123−submit :: ( MonadIO m
124− , MonadReader (Env s) m
125− , MonadError Error m
126− )
127− => Event
128− -> m Response
129−submit = submitCatch >=> hoistError
130−
131−submitCatch :: ( MonadIO m
132− , MonadReader (Env s) m
133− )
134− => Event
135− -> m (Either Error Response)
136−submitCatch x = scoped $ \e -> Int.submitWith (_envManager e) (_envLogger e) x
137−
138−send :: ( MonadIO m
139− , MonadReader (Env s) m
140− , MonadError Error m
141− , FromJSON b
142− )
143− => Request a s b
144− -> m b
145−send = sendCatch >=> hoistError
146−
147−sendCatch :: ( MonadIO m
148− , MonadReader (Env s) m
149− , FromJSON b
150− )
151− => Request a s b
152− -> m (Either Error b)
153−sendCatch x = scoped (`REST.sendWith` x)
154−
155−paginate :: ( MonadIO m
156− , MonadReader (Env s) m
157− , MonadError Error m
158− , Paginate a
159− , FromJSON b
160− )
161− => Request a s b
162− -> Source m b
163−paginate x = paginateCatch x $= awaitForever (hoistError >=> yield)
164−
165−paginateCatch :: ( MonadIO m
166− , MonadReader (Env s) m
167− , Paginate a
168− , FromJSON b
169− )
170− => Request a s b
171− -> Source m (Either Error b)
172−paginateCatch x = scoped (`REST.paginateWith` x)
src/Network/PagerDuty.hsnew file+84
@@ -0,0 +1,84 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE GADTs #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+
6+-- Module : Network.PagerDuty
7+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
8+-- License : This Source Code Form is subject to the terms of
9+-- the Mozilla Public License, v. 2.0.
10+-- A copy of the MPL can be found in the LICENSE file or
11+-- you can obtain it at http://mozilla.org/MPL/2.0/.
12+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
13+-- Stability : experimental
14+-- Portability : non-portable (GHC extensions)
15+
16+module Network.PagerDuty
17+ (
18+ -- * Run PagerDuty actions
19+ send
20+ , paginate
21+
22+ , module Network.PagerDuty.Types
23+ ) where
24+
25+import Control.Applicative
26+import Control.Lens
27+import Control.Monad
28+import Control.Monad.IO.Class
29+import Control.Monad.Trans
30+import Data.Aeson hiding (Error)
31+import qualified Data.ByteString.Lazy as LBS
32+import Data.Conduit
33+import Data.Default
34+import Data.Monoid
35+import Network.HTTP.Client (Manager, applyBasicAuth)
36+import qualified Network.HTTP.Client.Lens as Lens
37+import Network.HTTP.Types
38+import Network.PagerDuty.HTTP
39+import Network.PagerDuty.Types
40+
41+-- data Env (s :: Security) = Env
42+-- { _envDomain :: Domain
43+-- , _envAuth :: Auth s
44+-- , _envManager :: Manager
45+-- }
46+
47+send :: (MonadIO m, FromJSON b)
48+ => Auth s
49+ -> SubDomain
50+ -> Manager
51+ -> Request a s b
52+ -> m (Either Error b)
53+send a s m = liftM (fmap fst) . http a s m
54+
55+paginate :: (MonadIO m, Paginate a, FromJSON b)
56+ => Auth s
57+ -> SubDomain
58+ -> Manager
59+ -> Request a s b
60+ -> Source m (Either Error b)
61+paginate a d m = go
62+ where
63+ go rq = do
64+ rs <- lift (http a d m rq)
65+ yield (fst <$> rs)
66+ either (const (return ()))
67+ (maybe (return ()) go . next rq . snd)
68+ rs
69+
70+http :: (MonadIO m, FromJSON b)
71+ => Auth s
72+ -> SubDomain
73+ -> Manager
74+ -> Request a s b
75+ -> m (Either Error (b, Maybe Pager))
76+http a (SubDomain h) m rq = request m rq $ raw
77+ & Lens.host .~ h
78+ & Lens.path .~ renderPath (rq ^. path)
79+ & Lens.queryString .~ renderQuery False (rq ^. query)
80+ where
81+ raw = case a of
82+ AuthBasic u p -> applyBasicAuth u p def
83+ AuthToken t -> def & Lens.requestHeaders <>~
84+ [("Authorization", "Token token=" <> t)]
src/Network/PagerDuty/API.hsnew file+30
@@ -0,0 +1,30 @@
1+-- Module : Network.PagerDuty.API
2+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
3+-- License : This Source Code Form is subject to the terms of
4+-- the Mozilla Public License, v. 2.0.
5+-- A copy of the MPL can be found in the LICENSE file or
6+-- you can obtain it at http://mozilla.org/MPL/2.0/.
7+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
8+-- Stability : experimental
9+-- Portability : non-portable (GHC extensions)
10+
11+-- | Re-exports of the supported PagerDuty APIs.
12+module Network.PagerDuty.API where
13+ -- (
14+ -- -- * Supported APIs
15+ -- module Network.PagerDuty.API.Integration
16+ -- , module Network.PagerDuty.API.MaintenanceWindows
17+ -- , module Network.PagerDuty.API.Services
18+ -- -- -- * Common Types
19+ -- -- , PagerDuty
20+ -- -- , SubDomain (..)
21+ -- -- , Token (..)
22+ -- -- , BasicAuth (..)
23+ -- -- , Code (..)
24+ -- -- , Error (..)
25+ -- ) where
26+
27+-- import Network.PagerDuty.API.Integration
28+-- import Network.PagerDuty.API.MaintenanceWindows
29+-- import Network.PagerDuty.API.Services
30+-- import Network.PagerDuty.Types
src/Network/PagerDuty/API/Integration.hsnew file+77
@@ -0,0 +1,77 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+-- Module : Network.PagerDuty.Integration
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
7+-- License : This Source Code Form is subject to the terms of
8+-- the Mozilla Public License, v. 2.0.
9+-- A copy of the MPL can be found in the LICENSE file or
10+-- you can obtain it at http://mozilla.org/MPL/2.0/.
11+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12+-- Stability : experimental
13+-- Portability : non-portable (GHC extensions)
14+
15+-- | The "Integration API"
16+--
17+-- <http://developer.pagerduty.com/documentation/integration/events>
18+--
19+module Network.PagerDuty.API.Integration
20+ ( Event (..)
21+ , submitEvent
22+
23+ -- * Re-exported
24+ , ServiceKey
25+ , IncidentKey
26+ ) where
27+
28+import Control.Applicative
29+import Data.Aeson
30+import Data.Maybe (catMaybes)
31+import Data.Text (Text)
32+import GHC.Generics
33+import Network.PagerDuty.IO
34+import Network.PagerDuty.Types
35+
36+submitEvent :: Event -> PagerDuty a (Either Error IncidentKey)
37+submitEvent = fmap (fmap incident_key) . request defaultRequest
38+ { method = methodPost
39+ , host = "events.pagerduty.com"
40+ , path = "/generic/2010-04-15/create_event.json"
41+ }
42+
43+data Event
44+ = Trigger !ServiceKey !(Maybe IncidentKey) !Text !(Maybe Object)
45+ | Acknowledge !ServiceKey !IncidentKey !(Maybe Text) !(Maybe Object)
46+ | Resolve !ServiceKey !IncidentKey !(Maybe Text) !(Maybe Object)
47+ deriving (Eq, Show)
48+
49+instance ToJSON Event where
50+ toJSON (Trigger svc minc desc mdets) =
51+ jsonEvent "trigger" svc minc (Just desc) mdets
52+ toJSON (Acknowledge svc inc mdesc mdets) =
53+ jsonEvent "acknowledge" svc (Just inc) mdesc mdets
54+ toJSON (Resolve svc inc mdesc mdets) =
55+ jsonEvent "resolve" svc (Just inc) mdesc mdets
56+
57+jsonEvent :: Text
58+ -> ServiceKey
59+ -> Maybe IncidentKey
60+ -> Maybe Text
61+ -> Maybe Object
62+ -> Value
63+jsonEvent typ skey ikey desc dets = object $ catMaybes
64+ [ Just $ "event_type" .= typ
65+ , Just $ "service_key" .= skey
66+ , ("incident_key" .=) <$> ikey
67+ , ("description" .=) <$> desc
68+ , ("details" .=) <$> dets
69+ ]
70+
71+data EventResponse = ER
72+ { status :: !Text
73+ , incident_key :: !IncidentKey
74+ , message :: !Text
75+ } deriving (Show, Generic)
76+
77+instance FromJSON EventResponse
src/Network/PagerDuty/API/LogEntries.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+
3+-- Module : Network.PagerDuty.API.LogEntries
4+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
5+-- License : This Source Code Form is subject to the terms of
6+-- the Mozilla Public License, v. 2.0.
7+-- A copy of the MPL can be found in the LICENSE file or
8+-- you can obtain it at http://mozilla.org/MPL/2.0/.
9+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
10+-- Stability : experimental
11+-- Portability : non-portable (GHC extensions)
12+
13+module Network.PagerDuty.API.LogEntries where
14+
15+import Data.Aeson
16+import GHC.Generics
17+import Network.PagerDuty.Types
18+
19+data LogEntries = LogEntries
20+ { lesTotal :: !Int
21+ , leslogEntries :: [LogEntry]
22+ } deriving (Eq, Show, Generic)
23+
24+instance FromJSON LogEntries
25+instance ToJSON LogEntries
26+
27+logEntries :: PagerDuty Authenticated (Either Error LogEntries)
28+logEntries = undefined
src/Network/PagerDuty/API/MaintenanceWindows.hsnew file+232
@@ -0,0 +1,232 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+-- Module : Network.PagerDuty.API.MaintenanceWindows
5+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
6+-- License : This Source Code Form is subject to the terms of
7+-- the Mozilla Public License, v. 2.0.
8+-- A copy of the MPL can be found in the LICENSE file or
9+-- you can obtain it at http://mozilla.org/MPL/2.0/.
10+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
11+-- Stability : experimental
12+-- Portability : non-portable (GHC extensions)
13+
14+module Network.PagerDuty.API.MaintenanceWindows
15+ ( CreateMaintenanceWindow (..)
16+ , MaintenanceWindowCounts (..)
17+ , MaintenanceWindowCreatorDetails (..)
18+ , MaintenanceWindowCreatorId
19+ , MaintenanceWindowDetails (..)
20+ , MaintenanceWindowFilter (..)
21+ , MaintenanceWindowId
22+ , ServiceInfo (..)
23+ , UpdateMaintenanceWindow (..)
24+
25+ , createMaintenanceWindow
26+ , createMaintenanceWindow'
27+ , updateMaintenanceWindow
28+ , listMaintenanceWindows
29+ , getMaintenanceWindow
30+ , deleteMaintenaceWindow
31+ ) where
32+
33+import Control.Applicative
34+import Data.Aeson
35+import Data.ByteString (ByteString)
36+import Data.Maybe
37+import Data.Monoid
38+import Data.Text (Text)
39+import qualified Data.Text as T
40+import Data.Text.Encoding
41+import Data.Time (UTCTime)
42+import GHC.Generics
43+import Network.PagerDuty.Internal
44+import Network.PagerDuty.IO
45+import Network.PagerDuty.Types
46+
47+type A a = Authenticated a
48+
49+bASE_PATH :: ByteString
50+bASE_PATH = "/api/v1/maintenance_windows/"
51+
52+createMaintenanceWindow :: CreateMaintenanceWindow
53+ -> RequesterId
54+ -> PagerDuty (A Token) (Either Error MaintenanceWindowDetails)
55+createMaintenanceWindow mw rid =
56+ fmap (fmap dr_maintenance_window)
57+ . request defaultRequest
58+ { method = methodPost
59+ , path = bASE_PATH
60+ }
61+ $ CreateMaintenanceWindowRequest
62+ { cmwr_maintenance_window = mw
63+ , cmwr_requester_id = Just rid
64+ }
65+
66+createMaintenanceWindow' :: CreateMaintenanceWindow
67+ -> PagerDuty (A BasicAuth) (Either Error MaintenanceWindowDetails)
68+createMaintenanceWindow' mw =
69+ fmap (fmap dr_maintenance_window)
70+ . request defaultRequest
71+ { method = methodPost
72+ , path = bASE_PATH
73+ }
74+ $ CreateMaintenanceWindowRequest
75+ { cmwr_maintenance_window = mw
76+ , cmwr_requester_id = Nothing
77+ }
78+
79+updateMaintenanceWindow :: MaintenanceWindowId
80+ -> UpdateMaintenanceWindow
81+ -> PagerDuty (A a) (Either Error MaintenanceWindowDetails)
82+updateMaintenanceWindow (Id mwid) =
83+ fmap (fmap dr_maintenance_window)
84+ . request defaultRequest
85+ { method = methodPut
86+ , path = bASE_PATH <> encodeUtf8 mwid
87+ }
88+
89+listMaintenanceWindows :: Maybe Text
90+ -> [ServiceId]
91+ -> Maybe MaintenanceWindowFilter
92+ -> PagerDuty (A a) (Either Error (MaintenanceWindowCounts, [MaintenanceWindowDetails]))
93+listMaintenanceWindows qry sids filt =
94+ fmap (fmap (liftA2 (,) lr_counts lr_maintenance_windows))
95+ . request defaultRequest
96+ { method = methodGet
97+ , path = bASE_PATH
98+ , queryString = renderSimpleQuery True mkQuery
99+ }
100+ $ T.empty
101+ where
102+ mkQuery :: [(ByteString, ByteString)]
103+ mkQuery = (catMaybes [ fmap ((,) "query" . encodeUtf8) qry
104+ , fmap ((,) "filter" . filterToBS) filt
105+ ])
106+ ++ map (\ (Id sid) -> ("service_ids[]", encodeUtf8 sid)) sids
107+
108+getMaintenanceWindow :: MaintenanceWindowId
109+ -> PagerDuty (A a) (Either Error MaintenanceWindowDetails)
110+getMaintenanceWindow (Id mwid) =
111+ fmap (fmap dr_maintenance_window)
112+ . request defaultRequest
113+ { method = methodGet
114+ , path = bASE_PATH <> encodeUtf8 mwid
115+ }
116+ $ T.empty
117+
118+deleteMaintenaceWindow :: MaintenanceWindowId
119+ -> PagerDuty (A a) (Either Error Empty)
120+deleteMaintenaceWindow (Id mwid) = request defaultRequest
121+ { method = methodDelete
122+ , path = bASE_PATH <> encodeUtf8 mwid
123+ } $ T.empty
124+
125+data MaintenanceWindow
126+data MaintenanceWindowCreator
127+
128+type MaintenanceWindowId = Id MaintenanceWindow
129+type MaintenanceWindowCreatorId = Id MaintenanceWindowCreator
130+
131+data CreateMaintenanceWindow = CreateMaintenanceWindow
132+ { cmw_start_time :: !UTCTime
133+ , cmw_end_time :: !UTCTime
134+ , cmw_description :: Maybe Text
135+ , cmw_service_ids :: [ServiceId]
136+ } deriving (Show, Generic)
137+
138+instance ToJSON CreateMaintenanceWindow where
139+ toJSON = gToJson "cmw_"
140+
141+data UpdateMaintenanceWindow = UpdateMaintenanceWindow
142+ { umw_start_time :: Maybe UTCTime
143+ , umw_end_time :: Maybe UTCTime
144+ , umw_description :: Maybe Text
145+ , umw_service_ids :: [ServiceId]
146+ } deriving (Show, Generic)
147+
148+instance ToJSON UpdateMaintenanceWindow where
149+ toJSON = gToJson "umw_"
150+
151+data CreateMaintenanceWindowRequest = CreateMaintenanceWindowRequest
152+ { cmwr_maintenance_window :: !CreateMaintenanceWindow
153+ , cmwr_requester_id :: Maybe RequesterId
154+ } deriving (Show, Generic)
155+
156+instance ToJSON CreateMaintenanceWindowRequest where
157+ toJSON = gToJson "cmwr_"
158+
159+data MaintenanceWindowDetails = MaintenanceWindowDetails
160+ { mwd_id :: !MaintenanceWindowId
161+ , mwd_sequence_number :: !Int
162+ , mwd_start_time :: !UTCTime
163+ , mwd_end_time :: !UTCTime
164+ , mwd_description :: Maybe Text
165+ , mwd_created_by :: !MaintenanceWindowCreatorDetails
166+ , mwd_services :: [ServiceInfo]
167+ } deriving (Show, Generic)
168+
169+instance FromJSON MaintenanceWindowDetails where
170+ parseJSON = gFromJson "mwd_"
171+
172+-- possibly used elsewhere (UserDetails or somesuch)
173+data MaintenanceWindowCreatorDetails = MaintenanceWindowCreatorDetails
174+ { mwcd_id :: !MaintenanceWindowCreatorId
175+ , mwcd_name :: !Text
176+ , mwcd_email :: !Text
177+ , mwcd_time_zone :: !Text
178+ , mwcd_color :: !Text -- wtf?
179+ , mwcd_role :: !Text
180+ , mwcd_avatar_url :: !Text
181+ , mwcd_user_url :: !Text
182+ , mwcd_invitation_sent :: !Bool
183+ } deriving (Show, Generic)
184+
185+instance FromJSON MaintenanceWindowCreatorDetails where
186+ parseJSON = gFromJson "mwcd_"
187+
188+data ServiceInfo = ServiceInfo
189+ { si_name :: !Text
190+ , si_url :: !Text
191+ , si_id :: !ServiceId
192+ } deriving (Show, Generic)
193+
194+instance FromJSON ServiceInfo where
195+ parseJSON = gFromJson "si_"
196+
197+data ListResponse = ListResponse
198+ { lr_maintenance_windows :: [MaintenanceWindowDetails]
199+ , lr_query :: Maybe Text
200+ , lr_counts :: !MaintenanceWindowCounts
201+ } deriving (Show, Generic)
202+
203+instance FromJSON ListResponse where
204+ parseJSON = gFromJson "lr_"
205+
206+data MaintenanceWindowCounts = MaintenanceWindowCounts
207+ { mwc_ongoing :: !Int
208+ , mwc_future :: !Int
209+ , mwc_past :: !Int
210+ , mwc_all :: !Int
211+ } deriving (Show, Generic)
212+
213+instance FromJSON MaintenanceWindowCounts where
214+ parseJSON = gFromJson "mwc_"
215+
216+newtype DetailsResponse = DetailsResponse
217+ { dr_maintenance_window :: MaintenanceWindowDetails
218+ } deriving (Show, Generic)
219+
220+instance FromJSON DetailsResponse where
221+ parseJSON = gFromJson "dr_"
222+
223+data MaintenanceWindowFilter
224+ = Past
225+ | Future
226+ | Ongoing
227+ deriving Show
228+
229+filterToBS :: MaintenanceWindowFilter -> ByteString
230+filterToBS Past = "past"
231+filterToBS Future = "future"
232+filterToBS Ongoing = "ongoing"
src/Network/PagerDuty/API/Services.hsnew file+292
@@ -0,0 +1,292 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+-- Module : Network.PagerDuty.API.Services
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
7+-- License : This Source Code Form is subject to the terms of
8+-- the Mozilla Public License, v. 2.0.
9+-- A copy of the MPL can be found in the LICENSE file or
10+-- you can obtain it at http://mozilla.org/MPL/2.0/.
11+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12+-- Stability : experimental
13+-- Portability : non-portable (GHC extensions)
14+
15+module Network.PagerDuty.API.Services
16+ ( ServiceDetails (..)
17+ , CreateService (..)
18+ , UpdateService (..)
19+ , ServiceStatus (..)
20+ , ServiceType (..)
21+ , EmailFilterMode (..)
22+ , IncidentCounts (..)
23+ , EmailIncidentCreation (..)
24+
25+ , createService
26+ , updateService
27+ , listServices
28+ , getService
29+ , deleteService
30+ , disableService
31+ , disableService'
32+ , enableService
33+ , enableService'
34+ , regenerateServiceKey
35+ ) where
36+
37+import Control.Applicative
38+import Control.Monad
39+import Data.Aeson
40+import Data.ByteString (ByteString)
41+import Data.Monoid
42+import Data.Text (Text)
43+import qualified Data.Text as T
44+import Data.Text.Encoding
45+import Data.Time
46+import GHC.Generics
47+import Network.PagerDuty.Internal
48+import Network.PagerDuty.IO
49+import Network.PagerDuty.Types
50+
51+type A a = Authenticated a
52+
53+bASE_PATH :: ByteString
54+bASE_PATH = "/api/v1/services/"
55+
56+createService :: CreateService -> PagerDuty (A a) (Either Error ServiceDetails)
57+createService = fmap (fmap service) . request defaultRequest
58+ { method = methodPost
59+ , path = bASE_PATH
60+ }
61+ . CreateServiceRequest
62+
63+updateService :: ServiceId
64+ -> UpdateService
65+ -> PagerDuty (A a) (Either Error ServiceDetails)
66+updateService (Id sid) = fmap (fmap service) . request defaultRequest
67+ { method = methodPut
68+ , path = bASE_PATH <> encodeUtf8 sid
69+ }
70+ . UpdateServiceRequest
71+
72+listServices :: PagerDuty (A a) (Either Error [ServiceDetails])
73+listServices = fmap (fmap services) . request defaultRequest
74+ { method = methodGet
75+ , path = bASE_PATH
76+ , queryString = "?include[]=escalation_policy&include[]=email_filters"
77+ } $ T.empty
78+
79+getService :: ServiceId -> PagerDuty (A a) (Either Error ServiceDetails)
80+getService (Id sid) = fmap (fmap service) . request defaultRequest
81+ { method = methodGet
82+ , path = bASE_PATH <> encodeUtf8 sid
83+ , queryString = "?include[]=escalation_policy&include[]=email_filters"
84+ } $ T.empty
85+
86+deleteService :: ServiceId -> PagerDuty (A a) (Either Error Empty)
87+deleteService (Id sid) = request defaultRequest
88+ { method = methodDelete
89+ , path = bASE_PATH <> encodeUtf8 sid
90+ } $ T.empty
91+
92+disableService :: ServiceId
93+ -> RequesterId
94+ -> PagerDuty (A Token) (Either Error Empty)
95+disableService (Id sid) (Id rid) = request defaultRequest
96+ { method = methodPut
97+ , path = bASE_PATH <> encodeUtf8 sid <> "/disable"
98+ , queryString = "?requester_id=" <> encodeUtf8 rid
99+ } $ T.empty
100+
101+disableService' :: ServiceId -> PagerDuty (A BasicAuth) (Either Error Empty)
102+disableService' (Id sid) = request defaultRequest
103+ { method = methodPut
104+ , path = bASE_PATH <> encodeUtf8 sid <> "/disable"
105+ } $ T.empty
106+
107+enableService :: ServiceId
108+ -> RequesterId
109+ -> PagerDuty (A Token) (Either Error Empty)
110+enableService (Id sid) (Id rid) = request defaultRequest
111+ { method = methodPut
112+ , path = bASE_PATH <> encodeUtf8 sid <> "/enable"
113+ , queryString = "?requester_id=" <> encodeUtf8 rid
114+ } $ T.empty
115+
116+enableService' :: ServiceId -> PagerDuty (A BasicAuth) (Either Error Empty)
117+enableService' (Id sid) = request defaultRequest
118+ { method = methodPut
119+ , path = bASE_PATH <> encodeUtf8 sid <> "/enable"
120+ } $ T.empty
121+
122+regenerateServiceKey :: ServiceId -> PagerDuty (A a) (Either Error ServiceKey)
123+regenerateServiceKey (Id sid) = fmap (fmap (sd_service_key . service)) . request defaultRequest
124+ { method = methodPost
125+ , path = bASE_PATH <> encodeUtf8 sid <> "/regenerate_key"
126+ } $ T.empty
127+
128+newtype CreateServiceRequest = CreateServiceRequest
129+ { csr_service :: CreateService
130+ } deriving (Show, Generic)
131+
132+instance ToJSON CreateServiceRequest where
133+ toJSON = gToJson "csr_"
134+
135+newtype UpdateServiceRequest = UpdateServiceRequest
136+ { usr_service :: UpdateService
137+ } deriving (Show, Generic)
138+
139+instance ToJSON UpdateServiceRequest where
140+ toJSON = gToJson "usr_"
141+
142+newtype DetailsListResponse = DLR { services :: [ServiceDetails] }
143+ deriving (Show, Generic)
144+
145+instance FromJSON DetailsListResponse
146+
147+newtype DetailsResponse = DR { service :: ServiceDetails }
148+ deriving (Show, Generic)
149+
150+instance FromJSON DetailsResponse
151+
152+data CreateService = CreateService
153+ { cs_name :: !Text
154+ , cs_escalation_policy_id :: !Text
155+ , cs_type :: !ServiceType
156+ , cs_description :: Maybe Text
157+ , cs_acknowledgement_timeout :: Maybe Int
158+ , cs_auto_resolve_timeout :: Maybe Int
159+ , cs_severity_filter :: Maybe Text
160+ } deriving (Show, Generic)
161+
162+instance ToJSON CreateService where toJSON = gToJson "cs_"
163+
164+data UpdateService = UpdateService
165+ { us_name :: Maybe Text
166+ , us_escalation_policy_id :: Maybe Text
167+ , us_type :: Maybe ServiceType
168+ , us_description :: Maybe Text
169+ , us_acknowledgement_timeout :: Maybe Int
170+ , us_auto_resolve_timeout :: Maybe Int
171+ , us_severity_filter :: Maybe Text
172+ } deriving (Show, Generic)
173+
174+instance ToJSON UpdateService where toJSON = gToJson "us_"
175+
176+data ServiceDetails = ServiceDetails
177+ { sd_id :: !ServiceId
178+ , sd_name :: !Text
179+ , sd_description :: !Text
180+ , sd_service_url :: !Text
181+ , sd_service_key :: !ServiceKey
182+ , sd_auto_resolve_timeout :: !Int
183+ , sd_acknowledgement_timeout :: !Int
184+ , sd_created_at :: !ZonedTime
185+ , sd_deleted_at :: Maybe ZonedTime
186+ , sd_status :: !ServiceStatus
187+ , sd_last_incident_timestamp :: Maybe ZonedTime
188+ , sd_email_incident_creation :: Maybe EmailIncidentCreation
189+ , sd_incident_counts :: !IncidentCounts
190+ , sd_email_filter_mode :: !EmailFilterMode
191+ , sd_type :: !ServiceType
192+ , sd_escalation_policy :: Maybe Object -- todo
193+ , sd_email_filters :: Maybe Object -- todo
194+ , sd_severity_filter :: Maybe Text -- todo?
195+ } deriving (Show, Generic)
196+
197+instance FromJSON ServiceDetails where
198+ parseJSON = gFromJson "sd_"
199+
200+data ServiceStatus
201+ = Active
202+ | Warning
203+ | Critical
204+ | Maintenance
205+ | Disabled
206+ deriving (Eq, Show)
207+
208+instance FromJSON ServiceStatus where
209+ parseJSON (String s) = case s of
210+ "active" -> pure Active
211+ "warning" -> pure Warning
212+ "critical" -> pure Critical
213+ "maintenance" -> pure Maintenance
214+ "disabled" -> pure Disabled
215+ _ -> mzero
216+
217+ parseJSON _ = mzero
218+
219+data IncidentCounts = IncidentCounts
220+ { triggered :: !Int
221+ , acknowledged :: !Int
222+ , resolved :: !Int
223+ , total :: !Int
224+ } deriving (Show, Generic)
225+
226+instance FromJSON IncidentCounts
227+
228+data EmailIncidentCreation
229+ = OnNewEmail
230+ | OnNewEmailSubject
231+ | OnlyIfNoOpenIncidents
232+ deriving (Eq, Show)
233+
234+instance FromJSON EmailIncidentCreation where
235+ parseJSON (String s) = case s of
236+ "on_new_email" -> pure OnNewEmail
237+ "on_new_email_subject" -> pure OnNewEmailSubject
238+ "only_if_no_open_incidents" -> pure OnlyIfNoOpenIncidents
239+ _ -> mzero
240+
241+ parseJSON _ = mzero
242+
243+data EmailFilterMode
244+ = AllEmail
245+ | OrRulesEmail
246+ | AndRulesEmail
247+ deriving (Eq, Show)
248+
249+instance FromJSON EmailFilterMode where
250+ parseJSON (String s) = case s of
251+ "all-email" -> pure AllEmail
252+ "or-rules-email" -> pure OrRulesEmail
253+ "and-rules-email" -> pure AndRulesEmail
254+ _ -> mzero
255+
256+ parseJSON _ = mzero
257+
258+data ServiceType
259+ = CloudKick
260+ | GenericEmail
261+ | GenericEventsApi
262+ | Keynote
263+ | Nagios
264+ | Pingdom
265+ | ServerDensity
266+ | SqlMonitor
267+ deriving (Eq, Show)
268+
269+instance FromJSON ServiceType where
270+ parseJSON (String s) = case s of
271+ "cloudkick" -> pure CloudKick
272+ "generic_email" -> pure GenericEmail
273+ "generic_events_api" -> pure GenericEventsApi
274+ "keynote" -> pure Keynote
275+ "nagios" -> pure Nagios
276+ "pingdom" -> pure Pingdom
277+ "server_density" -> pure ServerDensity
278+ "sql_monitor" -> pure SqlMonitor
279+ _ -> mzero
280+
281+ parseJSON _ = mzero
282+
283+instance ToJSON ServiceType where
284+ toJSON st = String $ case st of
285+ CloudKick -> "cloudkick"
286+ GenericEmail -> "generic_email"
287+ GenericEventsApi -> "generic_events_api"
288+ Keynote -> "keynote"
289+ Nagios -> "nagios"
290+ Pingdom -> "pingdom"
291+ ServerDensity -> "server_density"
292+ SqlMonitor -> "sql_monitor"
src/Network/PagerDuty/REST/Alerts.hs → src/Network/PagerDuty/Alerts.hsrenamed+35−56
@@ -1,10 +1,9 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
4−{-# LANGUAGE TypeFamilies #-}
5
4
6−-- Module : Network.PagerDuty.REST.Alerts
5+-- Module : Network.PagerDuty.Alerts
7−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
8-- License : This Source Code Form is subject to the terms of
7-- License : This Source Code Form is subject to the terms of
9-- the Mozilla Public License, v. 2.0.
8-- the Mozilla Public License, v. 2.0.
10-- A copy of the MPL can be found in the LICENSE file or
9-- A copy of the MPL can be found in the LICENSE file or
@@ -21,12 +20,11 @@
21-- This API allows you to access read-only data regarding what alerts have been
20-- This API allows you to access read-only data regarding what alerts have been
22-- sent to your users.
21-- sent to your users.
23--
22--
24−-- /See:/ <http://developer.pagerduty.com/documentation/rest/alerts>
23+-- See: <http://developer.pagerduty.com/documentation/rest/alerts>
25−module Network.PagerDuty.REST.Alerts
24+module Network.PagerDuty.Alerts
26 (
25 (
27 -- * List Alerts
26 -- * List Alerts
28− ListAlerts
29− , listAlerts
27+ listAlerts
30 , laSince
28 , laSince
31 , laUntil
29 , laUntil
32 , laFilter
30 , laFilter
@@ -43,73 +41,33 @@ module Network.PagerDuty.REST.Alerts
43 , alertAddress
41 , alertAddress
44 ) where
42 ) where
45
43
46−import Control.Lens hiding (Empty)
44+import Control.Lens
47−import Data.Aeson.Lens
45+import Data.Aeson.Lens
48−import Data.Time
46+import Network.PagerDuty.Alerts.Types
49−import Network.PagerDuty.Internal.TH
47+import Network.PagerDuty.TH
50−import Network.PagerDuty.Internal.Types
48+import Network.PagerDuty.Types
51−import Network.PagerDuty.REST.Users (User)
52
49
53alerts :: Path
50alerts :: Path
54alerts = "alerts"
51alerts = "alerts"
55
52
56−data AlertType
57− = SMS
58− | Email
59− | Phone
60− | Push
61− deriving (Eq, Show)
62−
63−deriveNullary ''AlertType
64−
65−data Alert = Alert
66− { _alertId :: AlertId
67− , _alertType :: AlertType
68− , _alertStartedAt :: Date
69− , _alertUser :: User
70− , _alertAddress :: Address
71− } deriving (Eq, Show)
72−
73−deriveRecord ''Alert
74−
75data ListAlerts = ListAlerts
53data ListAlerts = ListAlerts
76 { _laSince' :: Date
54 { _laSince' :: Date
77 , _laUntil' :: Date
55 , _laUntil' :: Date
78 , _laFilter' :: Maybe AlertType
56 , _laFilter' :: Maybe AlertType
79− , _laTimeZone' :: Maybe TZ
57+ , _laTimeZone' :: Maybe TimeZone
80 } deriving (Eq, Show)
58 } deriving (Eq, Show)
81
59
82instance Paginate ListAlerts
60instance Paginate ListAlerts
83
61
84−queryRequest ''ListAlerts
62+deriveJSON ''ListAlerts
85−
63+makeLenses ''ListAlerts
86−-- | The start of the date range over which you want to search.
87−laSince :: Lens' (Request ListAlerts s b) UTCTime
88−laSince = upd.laSince'._D
89−
90−-- | The end of the date range over which you want to search.
91−-- This should be in the same format as 'since'.
92−--
93−-- The size of the date range must be less than 3 months.
94−laUntil :: Lens' (Request ListAlerts s b) UTCTime
95−laUntil = upd.laUntil'._D
96−
97−-- | Returns only the alerts of the said 'AlertType' type.
98−laFilter :: Lens' (Request ListAlerts s b) (Maybe AlertType)
99−laFilter = upd.laFilter'
100−
101−-- | Time zone in which dates in the result will be rendered.
102−--
103−-- /Default:/ account time zone.
104−laTimeZone :: Lens' (Request ListAlerts s b) (Maybe TimeZone)
105−laTimeZone = upd.laTimeZone'.mapping _TZ
106
64
107-- | List existing alerts for a given time range, optionally filtered by type
65-- | List existing alerts for a given time range, optionally filtered by type
108-- (SMS, Email, Phone, or Push).
66-- (SMS, Email, Phone, or Push).
109--
67--
110-- @GET \/alerts@
68-- @GET \/alerts@
111--
69--
112−-- /See:/ <http://developer.pagerduty.com/documentation/rest/alerts/list>
70+-- See: <http://developer.pagerduty.com/documentation/rest/alerts/list>
113listAlerts :: Date -- ^ 'laSince'
71listAlerts :: Date -- ^ 'laSince'
114 -> Date -- ^ 'laUntil'
72 -> Date -- ^ 'laUntil'
115 -> Request ListAlerts s [Alert]
73 -> Request ListAlerts s [Alert]
@@ -121,3 +79,24 @@ listAlerts s u =
121 , _laTimeZone' = Nothing
79 , _laTimeZone' = Nothing
122 } & path .~ alerts
80 } & path .~ alerts
123 & unwrap .~ key "alerts"
81 & unwrap .~ key "alerts"
82+
83+-- | The start of the date range over which you want to search.
84+laSince :: Lens' (Request ListAlerts s r) Date
85+laSince = upd.laSince'
86+
87+-- | The end of the date range over which you want to search.
88+-- This should be in the same format as 'since'.
89+--
90+-- The size of the date range must be less than 3 months.
91+laUntil :: Lens' (Request ListAlerts s r) Date
92+laUntil = upd.laUntil'
93+
94+-- | Returns only the alerts of the said 'AlertType' type.
95+laFilter :: Lens' (Request ListAlerts s r) (Maybe AlertType)
96+laFilter = upd.laFilter'
97+
98+-- | Time zone in which dates in the result will be rendered.
99+--
100+-- Defaults to account time zone.
101+laTimeZone :: Lens' (Request ListAlerts s r) (Maybe TimeZone)
102+laTimeZone = upd.laTimeZone'
src/Network/PagerDuty/Alerts/Types.hsnew file+39
@@ -0,0 +1,39 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
4+
5+-- Module : Network.PagerDuty.Alerts.Types
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
7+-- License : This Source Code Form is subject to the terms of
8+-- the Mozilla Public License, v. 2.0.
9+-- A copy of the MPL can be found in the LICENSE file or
10+-- you can obtain it at http://mozilla.org/MPL/2.0/.
11+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12+-- Stability : experimental
13+-- Portability : non-portable (GHC extensions)
14+
15+module Network.PagerDuty.Alerts.Types where
16+
17+import Control.Lens
18+import Network.PagerDuty.TH
19+import Network.PagerDuty.Types
20+
21+data AlertType
22+ = SMS
23+ | Email
24+ | Phone
25+ | Push
26+ deriving (Eq, Show)
27+
28+deriveJSON ''AlertType
29+
30+data Alert = Alert
31+ { _alertId :: AlertId
32+ , _alertType :: AlertType
33+ , _alertStartedAt :: Date
34+ , _alertUser :: User
35+ , _alertAddress :: Address
36+ } deriving (Eq, Show)
37+
38+deriveJSON ''Alert
39+makeLenses ''Alert
src/Network/PagerDuty/REST/EscalationPolicies.hs → src/Network/PagerDuty/EscalationPolicies.hsrenamed+99−127
@@ -1,13 +1,9 @@
1−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
3+{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6
4
7−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8−
9−-- Module : Network.PagerDuty.REST.EscalationPolicies
5+-- Module : Network.PagerDuty.EscalationPolicies
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
11-- License : This Source Code Form is subject to the terms of
7-- License : This Source Code Form is subject to the terms of
12-- the Mozilla Public License, v. 2.0.
8-- the Mozilla Public License, v. 2.0.
13-- A copy of the MPL can be found in the LICENSE file or
9-- A copy of the MPL can be found in the LICENSE file or
@@ -18,19 +14,14 @@
18
14
19-- | This API lets you access and manipulate escalation policies and rules.
15-- | This API lets you access and manipulate escalation policies and rules.
20--
16--
21−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies>
17+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies>
22−module Network.PagerDuty.REST.EscalationPolicies
18+module Network.PagerDuty.EscalationPolicies
23 (
19 (
24 -- * List Policies
20 -- * List Policies
25− ListPolicies
26− , listPolicies
21+ listPolicies
27 , lpQuery
22 , lpQuery
28
23
29− -- * List On Call Policies
30− , listOnCallPolicies
31−
32 -- * Create Policy
24 -- * Create Policy
33− , CreatePolicy
34 , createPolicy
25 , createPolicy
35 , cpName
26 , cpName
36 , cpRepeatEnabled
27 , cpRepeatEnabled
@@ -41,7 +32,6 @@ module Network.PagerDuty.REST.EscalationPolicies
41 , getPolicy
32 , getPolicy
42
33
43 -- * Update Policy
34 -- * Update Policy
44− , UpdatePolicy
45 , updatePolicy
35 , updatePolicy
46 , upName
36 , upName
47 , upRepeatEnabled
37 , upRepeatEnabled
@@ -52,54 +42,44 @@ module Network.PagerDuty.REST.EscalationPolicies
52 , deletePolicy
42 , deletePolicy
53
43
54 -- * Types
44 -- * Types
45+ , Target (..)
46+ , _TSchedule
47+ , _TUser
48+
49+ , ScheduleTarget
50+ , stgtId
51+ , stgtName
52+
53+ , UserTarget
54+ , utgtId
55+ , utgtName
56+ , utgtEmail
57+ , utgtTimeZone
58+ , utgtColor
59+
60+ , Rule
61+ , ruleId
62+ , ruleEscalationDelayInMinutes
63+ , ruleTargets
64+
55 , Policy
65 , Policy
56− , pId
66+ , policyId
57− , pName
67+ , policyName
58− , pNumLoops
68+ , policyNumLoops
59− , pRules
69+ , policyRules
60− , pServices
70+ , policyServices
61 ) where
71 ) where
62
72
63−import Control.Lens hiding (Empty)
73+import Control.Lens
64−import Data.Aeson.Lens
74+import Data.Aeson.Lens
65−import Data.Text (Text)
75+import Data.Text (Text)
66−import Network.HTTP.Types
76+import Network.HTTP.Types
67−import Network.PagerDuty.Internal.TH
68−import Network.PagerDuty.Internal.Types
69−import Network.PagerDuty.REST.Services (Service)
70−
71−import Network.PagerDuty.REST.EscalationPolicies.EscalationRules
77+import Network.PagerDuty.EscalationPolicies.Types
72−
78+import Network.PagerDuty.TH
73−default (Path)
79+import Network.PagerDuty.Types
74
80
75policies :: Path
81policies :: Path
76−policies = "escalation_policies"
82+policies = "policies"
77−
78−data Policy = Policy
79− { _pId :: EscalationPolicyId
80− , _pName :: Text
81− , _pNumLoops :: !Int
82− , _pRules :: [Rule]
83− , _pServices :: [Service]
84− } deriving (Eq, Show)
85−
86−deriveJSON ''Policy
87−
88−-- | The ID of the escalation policy.
89−makeLens "_pId" ''Policy
90−
91−-- | The name of the escalation policy.
92−makeLens "_pName" ''Policy
93−
94−-- | The number of times the escalation policy will repeat after
95−-- reaching the end of its escalation.
96−makeLens "_pNumLoops" ''Policy
97−
98−-- | A list of the policy's escalation rules in order of escalation.
99−makeLens "_pRules" ''Policy
100−
101−-- | A list of services using this escalation policy.
102−makeLens "_pServices" ''Policy
103
83
104newtype ListPolicies = ListPolicies
84newtype ListPolicies = ListPolicies
105 { _lpQuery' :: Maybe Text
85 { _lpQuery' :: Maybe Text
@@ -107,18 +87,14 @@ newtype ListPolicies = ListPolicies
107
87
108instance Paginate ListPolicies
88instance Paginate ListPolicies
109
89
110−queryRequest ''ListPolicies
90+deriveJSON ''ListPolicies
111−
91+makeLenses ''ListPolicies
112−-- | Filters the result, showing only the escalation policies
113−-- whose names match the query.
114−lpQuery :: Lens' (Request ListPolicies s b) (Maybe Text)
115−lpQuery = upd.lpQuery'
116
92
117-- | List all the existing escalation policies.
93-- | List all the existing escalation policies.
118--
94--
119-- @GET \/escalation_policies@
95-- @GET \/escalation_policies@
120--
96--
121−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/list>
97+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies/list>
122listPolicies :: Request ListPolicies s [Policy]
98listPolicies :: Request ListPolicies s [Policy]
123listPolicies =
99listPolicies =
124 mk ListPolicies
100 mk ListPolicies
@@ -126,104 +102,83 @@ listPolicies =
126 } & path .~ policies
102 } & path .~ policies
127 & unwrap .~ key "escalation_policies"
103 & unwrap .~ key "escalation_policies"
128
104
129−-- | List all the existing escalation policies with currently on-call users.
105+-- | Filters the result, showing only the escalation policies
130−--
106+-- whose names match the query.
131−-- If the start and end of an on-call object are null, then the user is always
132−-- on-call for an escalation policy level.
133−--
134−-- @GET \/escalation_policies\/on_call@
135−--
136−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/on_call>
137−listOnCallPolicies :: Request ListPolicies s [Policy]
107+lpQuery :: Lens' (Request ListPolicies s r) (Maybe Text)
138−listOnCallPolicies = listPolicies & path .~ policies % "on_call"
108+lpQuery = upd.lpQuery'
139
109
140data CreatePolicy = CreatePolicy
110data CreatePolicy = CreatePolicy
141 { _cpName' :: Text
111 { _cpName' :: Text
142− , _cpRepeatEnabled' :: Bool'
112+ , _cpRepeatEnabled' :: Maybe Bool
143 , _cpNumLoops' :: Maybe Int
113 , _cpNumLoops' :: Maybe Int
144 , _cpEscalationRules' :: [Rule] -- ^ Should be List1
114 , _cpEscalationRules' :: [Rule] -- ^ Should be List1
145 } deriving (Eq, Show)
115 } deriving (Eq, Show)
146
116
147−jsonRequest ''CreatePolicy
117+deriveJSON ''CreatePolicy
148−
118+makeLenses ''CreatePolicy
149−-- | The name of the escalation policy.
150−cpName :: Lens' (Request CreatePolicy s b) Text
151−cpName = upd.cpName'
152−
153−-- | Whether or not to allow this policy to repeat its escalation
154−-- rules after the last rule is finished.
155−--
156−-- /Default:/ false.
157−cpRepeatEnabled :: Lens' (Request CreatePolicy s b) Bool
158−cpRepeatEnabled = upd.cpRepeatEnabled'._B
159−
160−-- | The number of times to loop over the set of rules in this escalation policy.
161−cpNumLoops :: Lens' (Request CreatePolicy s b) (Maybe Int)
162−cpNumLoops = upd.cpNumLoops'
163−
164−-- | The escalation rules for this policy.
165−cpEscalationRules :: Lens' (Request CreatePolicy s b) [Rule]
166−cpEscalationRules = upd.cpEscalationRules'
167
119
168-- | Creates an existing escalation policy and rules.
120-- | Creates an existing escalation policy and rules.
169--
121--
170-- @POST \/escalation_policies@
122-- @POST \/escalation_policies@
171--
123--
172−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/create>
124+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies/create>
173−createPolicy :: EscalationPolicyId
125+createPolicy :: PolicyId
174 -> Text -- ^ 'creName'
126 -> Text -- ^ 'creName'
175 -> [Rule] -- ^ 'creEscalationRules'
127 -> [Rule] -- ^ 'creEscalationRules'
176 -> Request CreatePolicy s Policy
128 -> Request CreatePolicy s Policy
177createPolicy i n rs =
129createPolicy i n rs =
178 mk CreatePolicy
130 mk CreatePolicy
179 { _cpName' = n
131 { _cpName' = n
180− , _cpRepeatEnabled' = F
132+ , _cpRepeatEnabled' = Nothing
181 , _cpNumLoops' = Nothing
133 , _cpNumLoops' = Nothing
182 , _cpEscalationRules' = rs
134 , _cpEscalationRules' = rs
183 } & meth .~ PUT
135 } & meth .~ PUT
184 & path .~ policies % i
136 & path .~ policies % i
185 & unwrap .~ key "escalation_policy"
137 & unwrap .~ key "escalation_policy"
186
138
139+-- | The name of the escalation policy.
140+cpName :: Lens' (Request CreatePolicy s r) Text
141+cpName = upd.cpName'
142+
143+-- | Whether or not to allow this policy to repeat its escalation
144+-- rules after the last rule is finished.
145+--
146+-- Defaults to false.
147+cpRepeatEnabled :: Lens' (Request CreatePolicy s r) (Maybe Bool)
148+cpRepeatEnabled = upd.cpRepeatEnabled'
149+
150+-- | The number of times to loop over the set of rules in this escalation policy.
151+cpNumLoops :: Lens' (Request CreatePolicy s r) (Maybe Int)
152+cpNumLoops = upd.cpNumLoops'
153+
154+-- | The escalation rules for this policy.
155+cpEscalationRules :: Lens' (Request CreatePolicy s r) [Rule]
156+cpEscalationRules = upd.cpEscalationRules'
157+
187-- | Get information about an existing escalation policy and its rules.
158-- | Get information about an existing escalation policy and its rules.
188--
159--
189-- @GET \/escalation_policies\/\:id@
160-- @GET \/escalation_policies\/\:id@
190--
161--
191−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/show>
162+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies/show>
192−getPolicy :: EscalationPolicyId -> Request Empty s Policy
163+getPolicy :: PolicyId -> Request Empty s Policy
193getPolicy i = empty & path .~ policies % i & unwrap .~ key "escalation_policy"
164getPolicy i = empty & path .~ policies % i & unwrap .~ key "escalation_policy"
194
165
195data UpdatePolicy = UpdatePolicy
166data UpdatePolicy = UpdatePolicy
196 { _upName' :: Maybe Text
167 { _upName' :: Maybe Text
197− , _upRepeatEnabled' :: Maybe Bool'
168+ , _upRepeatEnabled' :: Maybe Bool
198 , _upNumLoops' :: Maybe Int
169 , _upNumLoops' :: Maybe Int
199 , _upEscalationRules' :: [Rule]
170 , _upEscalationRules' :: [Rule]
200 } deriving (Eq, Show)
171 } deriving (Eq, Show)
201
172
202−jsonRequest ''UpdatePolicy
173+deriveJSON ''UpdatePolicy
203−
174+makeLenses ''UpdatePolicy
204−-- | The name of the escalation policy.
205−upName :: Lens' (Request UpdatePolicy s b) (Maybe Text)
206−upName = upd.upName'
207−
208−-- | Whether or not to allow this policy to repeat its escalation
209−-- rules after the last rule is finished.
210−upRepeatEnabled :: Lens' (Request UpdatePolicy s b) (Maybe Bool)
211−upRepeatEnabled = upd.upRepeatEnabled'.mapping _B
212−
213−-- | The number of times to loop over the set of rules in this escalation policy.
214−upNumLoops :: Lens' (Request UpdatePolicy s b) (Maybe Int)
215−upNumLoops = upd.upNumLoops'
216−
217−-- | The escalation rules for this policy.
218−upEscalationRules :: Lens' (Request UpdatePolicy s b) [Rule]
219−upEscalationRules = upd.upEscalationRules'
220
175
221-- | Updates an existing escalation policy and rules.
176-- | Updates an existing escalation policy and rules.
222--
177--
223-- @PUT \/escalation_policies\/\:id@
178-- @PUT \/escalation_policies\/\:id@
224--
179--
225−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/update>
180+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies/update>
226−updatePolicy :: EscalationPolicyId -> Request UpdatePolicy s Policy
181+updatePolicy :: PolicyId -> Request UpdatePolicy s Policy
227updatePolicy i =
182updatePolicy i =
228 mk UpdatePolicy
183 mk UpdatePolicy
229 { _upName' = Nothing
184 { _upName' = Nothing
@@ -234,11 +189,28 @@ updatePolicy i =
234 & path .~ policies % i
189 & path .~ policies % i
235 & unwrap .~ key "escalation_policy"
190 & unwrap .~ key "escalation_policy"
236
191
192+-- | The name of the escalation policy.
193+upName :: Lens' (Request UpdatePolicy s r) (Maybe Text)
194+upName = upd.upName'
195+
196+-- | Whether or not to allow this policy to repeat its escalation
197+-- rules after the last rule is finished.
198+upRepeatEnabled :: Lens' (Request UpdatePolicy s r) (Maybe Bool)
199+upRepeatEnabled = upd.upRepeatEnabled'
200+
201+-- | The number of times to loop over the set of rules in this escalation policy.
202+upNumLoops :: Lens' (Request UpdatePolicy s r) (Maybe Int)
203+upNumLoops = upd.upNumLoops'
204+
205+-- | The escalation rules for this policy.
206+upEscalationRules :: Lens' (Request UpdatePolicy s r) [Rule]
207+upEscalationRules = upd.upEscalationRules'
208+
237-- | Deletes an existing escalation policy and rules. The escalation policy
209-- | Deletes an existing escalation policy and rules. The escalation policy
238-- must not be in use by any services.
210-- must not be in use by any services.
239--
211--
240-- @DELETE \/escalation_policies\/\:id@
212-- @DELETE \/escalation_policies\/\:id@
241--
213--
242−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/delete>
214+-- See: <http://developer.pagerduty.com/documentation/rest/escalation_policies/delete>
243−deletePolicy :: EscalationPolicyId -> Request Empty s Empty
215+deletePolicy :: PolicyId -> Request Empty s Empty
244deletePolicy i = empty & meth .~ DELETE & path .~ policies % i
216deletePolicy i = empty & meth .~ DELETE & path .~ policies % i
src/Network/PagerDuty/EscalationPolicies/Types.hsnew file+132
@@ -0,0 +1,132 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
4+
5+-- Module : Network.PagerDuty.EscalationPolicies.Types
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
7+-- License : This Source Code Form is subject to the terms of
8+-- the Mozilla Public License, v. 2.0.
9+-- A copy of the MPL can be found in the LICENSE file or
10+-- you can obtain it at http://mozilla.org/MPL/2.0/.
11+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12+-- Stability : experimental
13+-- Portability : non-portable (GHC extensions)
14+
15+module Network.PagerDuty.EscalationPolicies.Types where
16+
17+import Control.Applicative
18+import Control.Lens.TH
19+import Data.Aeson
20+import qualified Data.HashMap.Strict as Map
21+import Data.Text (Text)
22+import qualified Data.Text as Text
23+import Network.PagerDuty.Services.Types (Service)
24+import Network.PagerDuty.TH
25+import Network.PagerDuty.Types
26+
27+data ScheduleTarget = ScheduleTarget
28+ { _stgtId :: ScheduleId
29+ , _stgtName :: Text
30+ } deriving (Eq, Show)
31+
32+deriveJSON ''ScheduleTarget
33+
34+-- | The id of the target.
35+makeLens "_stgtId" ''ScheduleTarget
36+
37+-- | The name of the target.
38+makeLens "_stgtName" ''ScheduleTarget
39+
40+data UserTarget = UserTarget
41+ { _utgtId :: UserId
42+ , _utgtName :: Text
43+ , _utgtEmail :: Email
44+ , _utgtTimeZone :: TimeZone
45+ , _utgtColor :: Text
46+ } deriving (Eq, Show)
47+
48+deriveJSON ''UserTarget
49+
50+-- | The id of the user.
51+makeLens "_utgtId" ''UserTarget
52+
53+-- | The name of the user.
54+makeLens "_utgtName" ''UserTarget
55+
56+-- | The user's email address.
57+makeLens "_utgtEmail" ''UserTarget
58+
59+-- | The user's personal time zone.
60+makeLens "_utgtTimeZone" ''UserTarget
61+
62+-- | The color used to represent the user in schedules.
63+makeLens "_utgtColor" ''UserTarget
64+
65+data Target
66+ = TSchedule ScheduleTarget
67+ | TUser UserTarget
68+ deriving (Eq, Show)
69+
70+-- type: A representation of the type of the target.
71+-- Will be either schedule or user.
72+instance FromJSON Target where
73+ parseJSON = withObject "target" $ \o -> do
74+ t <- o .: "type"
75+ case t of
76+ "schedule" -> f o TSchedule
77+ "user" -> f o TUser
78+ _ -> fail $ "Unrecognised target type: " ++ Text.unpack t
79+ where
80+ f o g = g <$> parseJSON (Object o)
81+
82+instance ToJSON Target where
83+ toJSON t = Object (Map.insert "type" (String k) o)
84+ where
85+ (k, Object o) = case t of
86+ TSchedule s -> ("schedule", toJSON s)
87+ TUser u -> ("user", toJSON u)
88+
89+makePrisms ''Target
90+
91+data Rule = Rule
92+ { _ruleId :: RuleId
93+ , _ruleEscalationDelayInMinutes :: !Int
94+ , _ruleTargets :: [Target]
95+ } deriving (Eq, Show)
96+
97+deriveJSON ''Rule
98+
99+-- | The ID of the escalation rule.
100+makeLens "_ruleId" ''Rule
101+
102+-- | The amount of time before an incident escalates away from this rule.
103+makeLens "_ruleEscalationDelayInMinutes" ''Rule
104+
105+-- | A list of targets which an incident will be assigned to upon reaching this rule.
106+makeLens "_ruleTargets" ''Rule
107+
108+data Policy = Policy
109+ { _policyId :: PolicyId
110+ , _policyName :: Text
111+ , _policyNumLoops :: !Int
112+ , _policyRules :: [Rule]
113+ , _policyServices :: [Service]
114+ } deriving (Eq, Show)
115+
116+deriveJSON ''Policy
117+
118+-- | The ID of the escalation policy.
119+makeLens "_policyId" ''Policy
120+
121+-- | The name of the escalation policy.
122+makeLens "_policyName" ''Policy
123+
124+-- | The number of times the escalation policy will repeat after
125+-- reaching the end of its escalation.
126+makeLens "_policyNumLoops" ''Policy
127+
128+-- | A list of the policy's escalation rules in order of escalation.
129+makeLens "_policyRules" ''Policy
130+
131+-- | A list of services using this escalation policy.
132+makeLens "_policyServices" ''Policy
src/Network/PagerDuty/HTTP.hsnew file+67
@@ -0,0 +1,67 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- Module : Network.PagerDuty.HTTP
4+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
5+-- License : This Source Code Form is subject to the terms of
6+-- the Mozilla Public License, v. 2.0.
7+-- A copy of the MPL can be found in the LICENSE file or
8+-- you can obtain it at http://mozilla.org/MPL/2.0/.
9+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
10+-- Stability : experimental
11+-- Portability : non-portable (GHC extensions)
12+
13+module Network.PagerDuty.HTTP where
14+
15+import Control.Lens
16+import Control.Monad
17+import Control.Monad.IO.Class
18+import Data.Aeson hiding (Error)
19+import qualified Data.ByteString.Lazy as LBS
20+import Network.HTTP.Client (Manager, httpLbs)
21+import qualified Network.HTTP.Client as Client
22+import qualified Network.HTTP.Client.Lens as Lens
23+import Network.HTTP.Types
24+import Network.PagerDuty.Types
25+
26+request :: (MonadIO m, ToJSON a, FromJSON b)
27+ => Manager
28+ -> a
29+ -> Client.Request
30+ -> m (Either Error b)
31+request m x rq = liftIO (httpLbs raw m) >>= response
32+ where
33+ raw = rq
34+ & Lens.secure .~ True
35+ & Lens.port .~ 443
36+ & Lens.requestHeaders .~ headers
37+ & Lens.requestBody .~ Client.RequestBodyLBS (encode x)
38+
39+ headers =
40+ [ ("Content-Type", "application/json")
41+ , ("Accept", "application/json")
42+ ]
43+
44+response :: (MonadIO m, FromJSON b)
45+ => Client.Response LBS.ByteString
46+ -> m (Either Error b)
47+response rs = case statusCode (Client.responseStatus rs) of
48+ 200 -> success
49+ 201 -> success
50+ 400 -> failure
51+ 500 -> failure
52+ n -> return . Left $ unhandled n
53+ where
54+ success = maybe (Left unknown) Right `liftM` parse
55+ failure = maybe (Left unknown) Left `liftM` parse
56+
57+ unhandled n = Internal
58+ $ "PagerDuty returned unhandled status code: " ++ show n
59+
60+ unknown = Internal
61+ $ "Unable to parse response into a PagerDuty API compatible type: "
62+ ++ show body
63+
64+ parse :: (Monad m, FromJSON a) => m (Maybe a)
65+ parse = return (decode body)
66+
67+ body = Client.responseBody rs
src/Network/PagerDuty/Integration.hs+174−190
@@ -1,12 +1,10 @@
1−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE FunctionalDependencies #-}
2+{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE LambdaCase #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
5−{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE TemplateHaskell #-}
4+{-# LANGUAGE TemplateHaskell #-}
7
5
8-- Module : Network.PagerDuty.Integration
6-- Module : Network.PagerDuty.Integration
9−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
7+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
10-- License : This Source Code Form is subject to the terms of
8-- License : This Source Code Form is subject to the terms of
11-- the Mozilla Public License, v. 2.0.
9-- the Mozilla Public License, v. 2.0.
12-- A copy of the MPL can be found in the LICENSE file or
10-- A copy of the MPL can be found in the LICENSE file or
@@ -35,60 +33,62 @@
35-- The same event-based API can also be used to integrate a PagerDuty
33-- The same event-based API can also be used to integrate a PagerDuty
36-- service with ticketing systems and various other software tools.
34-- service with ticketing systems and various other software tools.
37--
35--
38−-- /See:/ <http://developer.pagerduty.com/documentation/integration/events>
36+-- See: <http://developer.pagerduty.com/documentation/integration/events>
39module Network.PagerDuty.Integration
37module Network.PagerDuty.Integration
40 (
38 (
41− -- * Sending events
39+ -- * Events
42 submit
40 submit
43− , submitWith
44
41
45 -- ** Trigger
42 -- ** Trigger
46 , Trigger
43 , Trigger
47 , trigger
44 , trigger
48− , client
45+ , tDescription
49− , clientUrl
46+ , tIncidentKey
47+ , tClient
48+ , tClientUrl
49+ , tDetails
50
50
51 -- ** Acknowledge
51 -- ** Acknowledge
52 , Acknowledge
52 , Acknowledge
53 , acknowledge
53 , acknowledge
54+ , aDescription
55+ , aDetails
54
56
55 -- ** Resolve
57 -- ** Resolve
56 , Resolve
58 , Resolve
57 , resolve
59 , resolve
58−
60+ , rDescription
59− -- * Fields
61+ , rDetails
60− , HasServiceKey (..)
61− , HasIncidentKey (..)
62− , HasDescription (..)
63− , HasDetails (..)
64
62
65 -- * Types
63 -- * Types
66− , Event (..)
64+ , AnyEvent (..)
67− , _Trigger
68− , _Acknowledge
69− , _Resolve
70
65
71 , Response
66 , Response
72 , rsStatus
67 , rsStatus
73 , rsMessage
68 , rsMessage
74 , rsIncidentKey
69 , rsIncidentKey
75
70
76− , Generic
71+ , Error
77−
72+ , ieStatus
78− , module Network.PagerDuty.Types
73+ , ieMessage
74+ , ieErrors
79 ) where
75 ) where
80
76
77+import Control.Applicative
81import Control.Lens
78import Control.Lens
82import Control.Monad.IO.Class
79import Control.Monad.IO.Class
83import Data.Aeson
80import Data.Aeson
84−import qualified Data.Aeson.KeyMap as Map
81+import Data.Aeson.Types
82+import Data.Default
83+import qualified Data.HashMap.Strict as Map
85−import Data.Text (Text)
84+import Data.Monoid
85+import Data.Text (Text)
86+import qualified Data.Text as Text
86−import Network.HTTP.Client (Manager)
87+import Network.HTTP.Client (Manager)
87−import qualified Network.HTTP.Client as Client
88+import qualified Network.HTTP.Client.Lens as Lens
88−import Network.PagerDuty.Internal.IO
89+import Network.PagerDuty.HTTP
89−import Network.PagerDuty.Internal.TH
90+import Network.PagerDuty.TH
90−import Network.PagerDuty.Internal.Types
91+import Network.PagerDuty.Types (ServiceKey, IncidentKey)
91−import Network.PagerDuty.Types hiding (description, message)
92
92
93data Response = Response
93data Response = Response
94 { _rsStatus :: Text
94 { _rsStatus :: Text
@@ -107,161 +107,143 @@ makeLens "_rsMessage" ''Response
107-- | The key of the incident that will be affected by the request.
107-- | The key of the incident that will be affected by the request.
108makeLens "_rsIncidentKey" ''Response
108makeLens "_rsIncidentKey" ''Response
109
109
110−class HasServiceKey s a | s -> a where
110+data Error = Error
111− -- | The GUID of one of your "Generic API" services. This is the "service key"
111+ { _ieStatus :: Text
112− -- listed on a Generic API's service detail page.
112+ , _ieMessage :: Text
113− serviceKey :: Lens' s a
113+ , _ieErrors :: [Text]
114−
115−class HasIncidentKey s a | s -> a where
116− -- | Identifies the incident to which this trigger event should be applied.
117− -- If there's no open (i.e. unresolved) incident with this key, a new one
118− -- will be created. If there's already an open incident with a matching key,
119− -- this event will be appended to that incident's log. The event key provides
120− -- an easy way to "de-dup" problem reports. If this field isn't provided,
121− -- PagerDuty will automatically open a new incident with a unique key.
122− incidentKey :: Lens' s a
123−
124−class HasDescription s a | s -> a where
125− -- | A short description of the problem that led to this trigger.
126− -- This field (or a truncated version) will be used when generating phone
127− -- calls, SMS messages and alert emails. It will also appear on the incidents
128− -- tables in the PagerDuty UI. The maximum length is 1024 characters.
129− description :: Lens' s a
130−
131−class HasDetails s a | s -> a where
132− -- | An arbitrary JSON object containing any data you'd like included
133− -- in the incident log.
134− details :: Lens' s a
135−
136−data Trigger = Trigger'
137− { _tServiceKey' :: ServiceKey
138− , _tIncidentKey' :: IncidentKey
139− , _tDescription' :: Text
140− , _tDetails' :: Maybe Object
141− , _tClient' :: Maybe Text
142− , _tClientUrl' :: Maybe Text
143 } deriving (Eq, Show)
114 } deriving (Eq, Show)
144
115
145−deriveRecord ''Trigger
116+deriveJSON ''Error
146
117
147−instance HasServiceKey Trigger ServiceKey where serviceKey = tServiceKey'
118+-- | @invalid event@
148−instance HasIncidentKey Trigger IncidentKey where incidentKey = tIncidentKey'
119+makeLens "_ieStatus" ''Error
149−instance HasDescription Trigger Text where description = tDescription'
150−instance HasDetails Trigger (Maybe Object) where details = tDetails'
151
120
152−-- | The name of the monitoring client that is triggering this event.
121+-- | A description of the problem.
153−client :: Lens' Trigger (Maybe Text)
122+makeLens "_ieMessage" ''Error
154−client = tClient'
155
123
156−-- | The URL of the monitoring client that is triggering this event.
124+-- | A list of specific error messages.
157−clientUrl :: Lens' Trigger (Maybe Text)
125+makeLens "_ieErrors" ''Error
158−clientUrl = tClientUrl'
126+
159−
127+class Event a where
128+ eventType :: a -> Text
129+ eventPayload :: a -> Object
130+
131+ default eventPayload :: ToJSON a => a -> Object
132+ eventPayload x = let Object o = toJSON x in o
133+
134+data AnyEvent where
135+ Event :: Event a => a -> AnyEvent
136+
137+instance Event AnyEvent where
138+ eventType (Event x) = eventType x
139+ eventPayload (Event x) = eventPayload x
140+
160−data Generic = Generic'
141+data Generic = Generic
161− { _gServiceKey' :: ServiceKey
142+ { _gServiceKey :: ServiceKey
162− , _gIncidentKey' :: IncidentKey
163− , _gDescription' :: Maybe Text
143+ , _gDescription :: Maybe Text
144+ , _gIncidentKey :: IncidentKey
164− , _gDetails' :: Maybe Object
145+ , _gDetails :: Object
146+ } deriving (Eq, Show)
147+
148+deriveJSON ''Generic
149+makeLenses ''Generic
150+
151+data Trigger = Trigger
152+ { _tServiceKey :: ServiceKey
153+ , _tDescription :: Text
154+ , _tIncidentKey :: Maybe IncidentKey
155+ , _tClient :: Maybe Text
156+ , _tClientUrl :: Maybe Text
157+ , _tDetails :: Object
165 } deriving (Eq, Show)
158 } deriving (Eq, Show)
166
159
167−deriveRecord ''Generic
160+deriveJSON ''Trigger
168−
161+
169−instance HasServiceKey Generic ServiceKey where serviceKey = gServiceKey'
162+instance Event Trigger where
170−instance HasIncidentKey Generic IncidentKey where incidentKey = gIncidentKey'
163+ eventType = const "trigger"
171−instance HasDescription Generic (Maybe Text) where description = gDescription'
172−instance HasDetails Generic (Maybe Object) where details = gDetails'
173−
174−type Resolve = Generic
175−type Acknowledge = Generic
176−
177−data Event
178− = Trigger Trigger -- ^ /See:/ 'trigger'
179− | Acknowledge Generic -- ^ /See:/ 'acknowledge'
180− | Resolve Generic -- ^ /See:/ 'resolve'
181− deriving (Eq, Show)
182−
183−makePrisms ''Event
184−
185−instance HasServiceKey Event ServiceKey where
186− serviceKey = lens f g
187− where
188− f (Trigger s) = _tServiceKey' s
189− f (Acknowledge s) = _gServiceKey' s
190− f (Resolve s) = _gServiceKey' s
191−
192− g (Trigger s) x = Trigger $ s { _tServiceKey' = x }
193− g (Acknowledge s) x = Acknowledge $ s { _gServiceKey' = x }
194− g (Resolve s) x = Resolve $ s { _gServiceKey' = x }
195−
196−instance HasIncidentKey Event IncidentKey where
197− incidentKey = lens f g
198− where
199− f (Trigger s) = _tIncidentKey' s
200− f (Acknowledge s) = _gIncidentKey' s
201− f (Resolve s) = _gIncidentKey' s
202−
203− g (Trigger s) x = Trigger $ s { _tIncidentKey' = x }
204− g (Acknowledge s) x = Acknowledge $ s { _gIncidentKey' = x }
205− g (Resolve s) x = Resolve $ s { _gIncidentKey' = x }
206−
207−instance HasDetails Event (Maybe Object) where
208− details = lens f g
209− where
210− f (Trigger s) = _tDetails' s
211− f (Acknowledge s) = _gDetails' s
212− f (Resolve s) = _gDetails' s
213−
214− g (Trigger s) x = Trigger $ s { _tDetails' = x }
215− g (Acknowledge s) x = Acknowledge $ s { _gDetails' = x }
216− g (Resolve s) x = Resolve $ s { _gDetails' = x }
217−
218−instance ToJSON Event where
219− toJSON = \case
220− Trigger x -> event "trigger" x
221− Acknowledge x -> event "acknowledge" x
222− Resolve x -> event "resolve" x
223− where
224− event k x =
225− case toJSON x of
226− Object o -> Object (Map.insert "event_type" (String k) o)
227− v -> v
228
164
229-- | Your monitoring tools should send PagerDuty a trigger event to report a new
165-- | Your monitoring tools should send PagerDuty a trigger event to report a new
230-- or ongoing problem. When PagerDuty receives a trigger event, it will either open
166-- or ongoing problem. When PagerDuty receives a trigger event, it will either open
231-- a new incident, or add a new trigger log entry to an existing incident,
167-- a new incident, or add a new trigger log entry to an existing incident,
232-- depending on the provided incident_key.
168-- depending on the provided incident_key.
233−trigger :: ServiceKey -- ^ 'serviceKey'
169+trigger :: ServiceKey
234− -> IncidentKey -- ^ 'incidentKey'
170+ -> Text -- ^ 'tDescription'
235− -> Text -- ^ 'description'
171+ -> Trigger
236− -> Event
237−trigger k i d =
172+trigger k d =
238− Trigger Trigger'
173+ Trigger
239− { _tServiceKey' = k
174+ { _tServiceKey = k
240− , _tDescription' = d
175+ , _tDescription = d
241− , _tIncidentKey' = i
176+ , _tIncidentKey = Nothing
242− , _tClient' = Nothing
177+ , _tClient = Nothing
243− , _tClientUrl' = Nothing
178+ , _tClientUrl = Nothing
244− , _tDetails' = Nothing
179+ , _tDetails = mempty
245 }
180 }
246
181
182+-- | A short description of the problem that led to this trigger.
183+-- This field (or a truncated version) will be used when generating phone
184+-- calls, SMS messages and alert emails. It will also appear on the incidents
185+-- tables in the PagerDuty UI. The maximum length is 1024 characters.
186+makeLens "_tDescription" ''Trigger
187+
188+-- | Identifies the incident to which this trigger event should be applied.
189+-- If there's no open (i.e. unresolved) incident with this key, a new one
190+-- will be created. If there's already an open incident with a matching key,
191+-- this event will be appended to that incident's log. The event key provides
192+-- an easy way to "de-dup" problem reports. If this field isn't provided,
193+-- PagerDuty will automatically open a new incident with a unique key.
194+makeLens "_tIncidentKey" ''Trigger
195+
196+-- | The name of the monitoring client that is triggering this event.
197+makeLens "_tClient" ''Trigger
198+
199+-- | The URL of the monitoring client that is triggering this event.
200+makeLens "_tClientUrl" ''Trigger
201+
202+-- | An arbitrary JSON object containing any data you'd like included
203+-- in the incident log.
204+makeLens "_tDetails" ''Trigger
205+
206+newtype Acknowledge = Acknowledge Generic
207+
208+deriveJSON ''Acknowledge
209+makePrisms ''Acknowledge
210+
211+instance Event Acknowledge where
212+ eventType = const "acknowledge"
213+
247-- | Acknowledge events cause the referenced incident to enter the acknowledged
214-- | Acknowledge events cause the referenced incident to enter the acknowledged
248-- state.
215-- state.
249--
216--
250-- While an incident is acknowledged, it won't generate any additional
217-- While an incident is acknowledged, it won't generate any additional
251-- notifications, even if it receives new trigger events. Your monitoring tools
218-- notifications, even if it receives new trigger events. Your monitoring tools
252−-- should send PagerDuty an acknowledge event when they know someone is
219+-- should send PagerDuty an acknowledge event when they know someone is presently
253−-- presently working on the problem.
220+-- working on the problem.
254−acknowledge :: ServiceKey -- ^ 'serviceKey'
221+acknowledge :: ServiceKey -> IncidentKey -> Acknowledge
255− -> IncidentKey -- ^ 'incidentKey'
256− -> Event
257acknowledge k i =
222acknowledge k i =
258− Acknowledge Generic'
223+ Acknowledge Generic
259− { _gServiceKey' = k
224+ { _gServiceKey = k
225+ , _gDescription = Nothing
260− , _gIncidentKey' = i
226+ , _gIncidentKey = i
261− , _gDescription' = Nothing
262− , _gDetails' = Nothing
227+ , _gDetails = mempty
263 }
228 }
264
229
230+-- | Text that will appear in the incident's log associated with this event.
231+aDescription :: Lens' Acknowledge (Maybe Text)
232+aDescription = _Acknowledge.gDescription
233+
234+-- | An arbitrary JSON object containing any data you'd like included
235+-- in the incident log.
236+aDetails :: Lens' Acknowledge Object
237+aDetails = _Acknowledge.gDetails
238+
239+newtype Resolve = Resolve Generic
240+
241+deriveJSON ''Resolve
242+makePrisms ''Resolve
243+
244+instance Event Resolve where
245+ eventType = const "acknowledge"
246+
265-- | Resolve events cause the referenced incident to enter the resolved state.
247-- | Resolve events cause the referenced incident to enter the resolved state.
266--
248--
267-- Once an incident is resolved, it won't generate any additional
249-- Once an incident is resolved, it won't generate any additional
@@ -269,30 +251,32 @@ acknowledge k i =
269-- incident won't re-open the incident. Instead, a new incident will be
251-- incident won't re-open the incident. Instead, a new incident will be
270-- created. Your monitoring tools should send PagerDuty a resolve event when the
252-- created. Your monitoring tools should send PagerDuty a resolve event when the
271-- problem that caused the initial trigger event has been fixed.
253-- problem that caused the initial trigger event has been fixed.
272−resolve :: ServiceKey -- ^ 'serviceKey'
254+resolve :: ServiceKey -> IncidentKey -> Resolve
273− -> IncidentKey -- ^ 'incidentKey'
274− -> Event
275resolve k i =
255resolve k i =
276− Resolve Generic'
256+ Resolve Generic
277− { _gServiceKey' = k
257+ { _gServiceKey = k
258+ , _gDescription = Nothing
278− , _gIncidentKey' = i
259+ , _gIncidentKey = i
279− , _gDescription' = Nothing
280− , _gDetails' = Nothing
260+ , _gDetails = mempty
281 }
261 }
282
262
283−-- | Send an event to the integration API.
263+-- | Text that will appear in the incident's log associated with this event.
284−submit :: MonadIO m => Manager -> Event -> m (Either Error Response)
264+rDescription :: Lens' Resolve (Maybe Text)
285−submit m = submitWith m None
265+rDescription = _Resolve.gDescription
286−
266+
287−-- | /See:/ 'submit'
267+-- | An arbitrary JSON object containing any data youd like included
288−submitWith :: MonadIO m
268+-- in the incident log.
289− => Manager
269+rDetails :: Lens' Resolve Object
290− -> Logger
270+rDetails = _Resolve.gDetails
291− -> Event
271+
292− -> m (Either Error Response)
272+submit :: (MonadIO m, Event a) => Manager -> a -> m (Either Error Response)
293−submitWith m l e = request m l e $
273+submit x m = request m (Object payload) $ def
294− Client.defaultRequest
295− { Client.host = "events.pagerduty.com"
274+ & Lens.host .~ "events.pagerduty.com"
296− , Client.path = "/generic/2010-04-15/create_event.json"
275+ & Lens.path .~ "/generic/2010-04-15/create_event.json"
297− , Client.method = "POST"
276+ where
298− }
277+ payload = Map.insert "event_type" (String (eventType x)) (eventPayload x)
278+
279+ headers =
280+ [ ("Content-Type", "application/json")
281+ , ("Accept", "application/json")
282+ ]
src/Network/PagerDuty/Internal/IO.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−-- Module : Network.PagerDuty.Internal.IO
5−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
6−-- License : This Source Code Form is subject to the terms of
7−-- the Mozilla Public License, v. 2.0.
8−-- A copy of the MPL can be found in the LICENSE file or
9−-- you can obtain it at http://mozilla.org/MPL/2.0/.
10−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
11−-- Stability : experimental
12−-- Portability : non-portable (GHC extensions)
13−
14−module Network.PagerDuty.Internal.IO where
15−
16−import Control.Monad
17−import Control.Monad.IO.Class
18−import Data.Aeson hiding (Error)
19−import qualified Data.ByteString.Lazy as LBS
20−import Data.Monoid
21−import qualified Data.Text as Text
22−import Network.HTTP.Client (Manager, httpLbs)
23−import qualified Network.HTTP.Client as Client
24−import Network.HTTP.Types
25−import Network.PagerDuty.Internal.Types
26−
27−request :: (MonadIO m, ToJSON a, FromJSON b)
28− => Manager
29− -> Logger
30− -> a
31− -> Client.Request
32− -> m (Either Error b)
33−request m l x rq = msg >> liftIO (httpLbs raw m) >>= response l
34− where
35− msg = debug l ("[Raw Request]\n" <> Text.pack (show raw))
36−
37− raw = rq
38− { Client.secure = True
39− , Client.port = 443
40− , Client.requestHeaders = headers
41− , Client.requestBody = Client.RequestBodyLBS (encode x)
42− }
43−
44− headers =
45− [ ("Content-Type", "application/json")
46− , ("Accept", "application/json")
47− ]
48−
49−response :: forall m b. (MonadIO m, FromJSON b)
50− => Logger
51− -> Client.Response LBS.ByteString
52− -> m (Either Error b)
53−response l rs = case statusCode (Client.responseStatus rs) of
54− 200 -> success
55− 201 -> success
56− 400 -> failure
57− 500 -> failure
58− n -> return . Left $ unhandled n
59− where
60− success = maybe (Left unknown) Right `liftM` parse
61− failure = maybe (Left unknown) Left `liftM` parse
62−
63− unhandled n = Internal $
64− "PagerDuty returned unhandled status code: "
65− <> Text.pack (show n)
66−
67− unknown = Internal $
68− "Unable to parse response into a PagerDuty API compatible type: "
69− <> Text.pack (show body)
70−
71− parse :: FromJSON a => m (Maybe a)
72− parse = msg >> return (decode body)
73−
74− msg = debug l ("[Raw Response]\n" <> Text.pack (show rs))
75−
76− body = Client.responseBody rs
src/Network/PagerDuty/Internal/Query.hsdeleted−111
@@ -1,111 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE GADTs #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
7−{-# LANGUAGE TupleSections #-}
8−
9−-- Module : Network.PagerDuty.Internal.Query
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−module Network.PagerDuty.Internal.Query
20− ( QueryValues (..)
21− , gquery
22− , gqueryWith
23− ) where
24−
25−import Data.Aeson.Types
26−import Data.Bifunctor
27−import Data.ByteString (ByteString)
28−import qualified Data.ByteString.Char8 as BS
29−import Data.ByteString.Conversion
30−import Data.Function (on)
31−import Data.List (groupBy)
32−import Data.Monoid ((<>))
33−import Data.Text (Text)
34−import qualified Data.Text.Encoding as Text
35−import Generics.SOP
36−import Network.HTTP.Types
37−import Network.PagerDuty.Internal.Options
38−
39−class QueryValues a where
40− queryValues :: a -> [ByteString]
41−
42− default queryValues :: ToByteString a => a -> [ByteString]
43− queryValues = (:[]) . toByteString'
44−
45−instance QueryValues a => QueryValues (Maybe a) where
46− queryValues (Just x) = queryValues x
47− queryValues Nothing = []
48−
49−instance QueryValues Text where
50− queryValues x = [Text.encodeUtf8 x]
51−
52−gquery :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValues (Code a))
53− => a
54− -> Query
55−gquery = gqueryWith underscored
56−
57−gqueryWith :: forall a. (Generic a, HasDatatypeInfo a, All2 QueryValues (Code a))
58− => Options
59− -> a
60− -> Query
61−gqueryWith o a = case datatypeInfo (Proxy :: Proxy a) of
62− ADT _ _ cs _ -> go cs (from a)
63− Newtype _ _ c -> go (c :* Nil) (from a)
64− where
65− go :: (All2 QueryValues xss, SListI xss)
66− => NP ConstructorInfo xss
67− -> SOP I xss
68− -> Query
69− go cs (SOP sop) =
70− group . hcollapse $ hcliftA2' p (gctor o) cs sop
71−
72− group :: [(ByteString, ByteString)] -> Query
73− group = concatMap f . groupBy ((==) `on` fst)
74− where
75− f [] = []
76− f [(k, v)] = [(k, Just v)]
77− f xs@((k,_):_) = let n = k <> "[]" in map (bimap (const n) Just) xs
78−
79−gctor :: All QueryValues xs
80− => Options
81− -> ConstructorInfo xs
82− -> NP I xs
83− -> K [(ByteString, ByteString)] xs
84−gctor o (Constructor n) args =
85− K . concat . hcollapse $ hcliftA p (K . map (k,) . queryValues . unI) args
86− where
87− k = BS.pack (constructorTagModifier o n)
88−
89−gctor o (Record _ ns) args =
90− K . concat . hcollapse $ hcliftA2 p (gfield o) ns args
91−
92−gctor o (Infix n _ _) (x :* y :* Nil) =
93− K $ map (k,) (queryValues (unI x) ++ queryValues (unI y))
94− where
95− k = BS.pack (constructorTagModifier o n)
96−
97−gctor _ Infix{} _ =
98− error "Network.PagerDuty.Generics.inaccessible"
99−
100−gfield :: QueryValues a
101− => Options
102− -> FieldInfo a
103− -> I a
104− -> K [(ByteString, ByteString)] a
105−gfield o (FieldInfo f) (I a) =
106− K $ map (k,) (queryValues a)
107− where
108− k = BS.pack (fieldLabelModifier o f)
109−
110−p :: Proxy QueryValues
111−p = Proxy
src/Network/PagerDuty/Internal/TH.hsdeleted−96
@@ -1,96 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−-- Module : Network.PagerDuty.Internal.TH
4−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
5−-- License : This Source Code Form is subject to the terms of
6−-- the Mozilla Public License, v. 2.0.
7−-- A copy of the MPL can be found in the LICENSE file or
8−-- you can obtain it at http://mozilla.org/MPL/2.0/.
9−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
10−-- Stability : experimental
11−-- Portability : non-portable (GHC extensions)
12−
13−module Network.PagerDuty.Internal.TH
14− (
15− -- * Requests
16− jsonRequest
17− , queryRequest
18−
19− -- * Compound expressions
20− , deriveNullary
21− , deriveNullaryWith
22− , deriveRecord
23−
24− -- * JSON
25− , deriveJSON
26− , deriveJSONWith
27−
28− -- * Lenses
29− , makeLens
30− , makeFields
31−
32− -- * Re-exported generics
33− , deriveGeneric
34−
35− -- * Re-exported options
36− , dropped
37− , hyphenated
38− , underscored
39− ) where
40−
41−import Control.Applicative
42−import Control.Lens
43−import qualified Data.Aeson.TH as Aeson
44−import Data.Aeson.Types
45−import Data.ByteString (ByteString)
46−import qualified Data.Text.Encoding as Text
47−import Generics.SOP.TH
48−import Language.Haskell.TH
49−import Network.HTTP.Types.QueryLike
50−import Network.PagerDuty.Internal.Options
51−import Network.PagerDuty.Internal.Query
52−
53−jsonRequest :: Name -> Q [Dec]
54−jsonRequest n = concat <$> sequence
55− [ makeLenses n
56− , deriveJSON n
57− , [d|instance QueryLike $(conT n) where toQuery = const []|]
58− ]
59−
60−queryRequest :: Name -> Q [Dec]
61−queryRequest n = concat <$> sequence
62− [ deriveGeneric n
63− , makeLenses n
64− , [d|instance ToJSON $(conT n) where toJSON = const emptyObject|]
65− , [d|instance QueryLike $(conT n) where toQuery = gquery|]
66− ]
67−
68−deriveNullary :: Name -> Q [Dec]
69−deriveNullary = deriveNullaryWith underscored
70−
71−deriveNullaryWith :: Options -> Name -> Q [Dec]
72−deriveNullaryWith o n = concat <$> sequence
73− [ deriveJSONWith o n
74− , [d|instance QueryValues $(conT n) where queryValues = value . toJSON|]
75− ]
76−
77−deriveRecord :: Name -> Q [Dec]
78−deriveRecord n = concat <$> sequence
79− [ deriveJSON n
80− , makeLenses n
81− ]
82−
83−deriveJSON :: Name -> Q [Dec]
84−deriveJSON = deriveJSONWith underscored
85−
86−deriveJSONWith :: Options -> Name -> Q [Dec]
87−deriveJSONWith = Aeson.deriveJSON
88−
89−makeLens :: String -> Name -> Q [Dec]
90−makeLens k = makeLensesWith
91− $ lensRulesFor [(k, drop 1 k)]
92− & simpleLenses .~ True
93−
94−value :: Value -> [ByteString]
95−value (String t) = [Text.encodeUtf8 t]
96−value _ = []
src/Network/PagerDuty/Internal/Types.hsdeleted−497
@@ -1,497 +0,0 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE FunctionalDependencies #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE KindSignatures #-}
8−{-# LANGUAGE MultiParamTypeClasses #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE PatternSynonyms #-}
11−{-# LANGUAGE RankNTypes #-}
12−{-# LANGUAGE StandaloneDeriving #-}
13−{-# LANGUAGE TemplateHaskell #-}
14−{-# LANGUAGE TupleSections #-}
15−{-# LANGUAGE ViewPatterns #-}
16−
17−-- Module : Network.PagerDuty.Internal.Types
18−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
19−-- License : This Source Code Form is subject to the terms of
20−-- the Mozilla Public License, v. 2.0.
21−-- A copy of the MPL can be found in the LICENSE file or
22−-- you can obtain it at http://mozilla.org/MPL/2.0/.
23−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
24−-- Stability : experimental
25−-- Portability : non-portable (GHC extensions)
26−
27−module Network.PagerDuty.Internal.Types where
28−
29−import Control.Applicative
30−import Control.Lens hiding ((.=), Empty)
31−import Control.Monad.IO.Class
32−import Data.Aeson hiding (Error, Key)
33−import qualified Data.Aeson.KeyMap as Map
34−import Data.Aeson.Types (Parser)
35−import Data.ByteString (ByteString)
36−import qualified Data.ByteString.Char8 as BS
37−import Data.ByteString.Conversion hiding (List)
38−import Data.Default.Class
39−import Data.Function (on)
40−import Data.List (deleteBy, intersperse)
41−import Data.Monoid
42−import Data.String
43−import Data.Text (Text)
44−import qualified Data.Text as Text
45−import qualified Data.Text.Encoding as Text
46−import Data.Time (UTCTime, TimeZone, formatTime, utc, timeZoneName)
47−import GHC.TypeLits
48−import Network.HTTP.Client (Manager)
49−import Network.HTTP.Types
50−import Network.HTTP.Types.QueryLike
51−import Network.PagerDuty.Internal.Query
52−import Network.PagerDuty.Internal.TH
53−import Data.Time.Locale.Compat
54−
55−newtype CSV a = CSV [a]
56− deriving (Eq, Show, Semigroup, Monoid)
57−
58−makePrisms ''CSV
59−
60−instance ToByteString a => QueryValues (CSV a)
61−
62−instance ToByteString a => ToByteString (CSV a) where
63− builder (CSV xs) = mconcat . intersperse "," $ map builder xs
64−
65−instance FromJSON a => FromJSON (CSV a) where
66− parseJSON = withText "comma_separated_value" $
67− fmap CSV . traverse (parseJSON . String) . Text.split (== ',')
68−
69−instance ToByteString a => ToJSON (CSV a) where
70− toJSON = String . Text.decodeUtf8 . toByteString'
71−
72−newtype List a = L [a]
73− deriving (Eq, Show, Semigroup, Monoid)
74−
75−deriveJSON ''List
76−makePrisms ''List
77−
78−instance QueryValues a => QueryValues (List a) where
79− queryValues (L xs) = concatMap queryValues xs
80−
81−newtype Bool' = B Bool
82− deriving (Eq, Show)
83−
84−deriveJSON ''Bool'
85−makePrisms ''Bool'
86−
87−instance ToByteString Bool' where
88− builder (B True) = "true"
89− builder (B False) = "false"
90−
91−instance QueryValues Bool'
92−
93−pattern T = B True
94−pattern F = B False
95−
96−newtype Date = D UTCTime
97− deriving (Eq, Ord, Show)
98−
99−makePrisms ''Date
100−
101−instance FromJSON Date where
102− parseJSON = fmap D . parseJSON
103−
104−instance ToJSON Date where
105− toJSON (D d) = toJSON d
106−
107−instance ToByteString Date where
108− builder (D d) = builder
109− (formatTime defaultTimeLocale ("%Y-%m-%dT%XZ") d)
110−
111−instance QueryValues Date
112−
113−newtype TZ = TZ TimeZone
114− deriving (Eq, Show)
115−
116−makePrisms ''TZ
117−
118−instance FromJSON TZ where
119− parseJSON = undefined
120−
121−instance ToJSON TZ where
122− toJSON = toJSON . Text.decodeUtf8 . toByteString'
123−
124−instance ToByteString TZ where
125− builder (TZ tz) = builder (timeZoneName tz)
126−
127−instance QueryValues TZ
128−
129−instance Default TZ where
130− def = TZ utc
131−
132−data Security = Basic | Token
133− deriving (Eq, Show)
134−
135−data Auth (a :: Security) where
136− AuthBasic :: ByteString -> ByteString -> Auth 'Basic
137− AuthToken :: ByteString -> Auth 'Token
138−
139−deriving instance Eq (Auth a)
140−deriving instance Show (Auth a)
141−
142−newtype SubDomain = SubDomain { subDomain :: ByteString }
143− deriving (Eq, Show, IsString, ToByteString)
144−
145−mkSubDomain :: ByteString -> SubDomain
146−mkSubDomain = SubDomain
147−
148−domain :: SubDomain -> ByteString
149−domain (SubDomain s)
150− | base `BS.isSuffixOf` s = s
151− | otherwise = s <> base
152− where
153− base = ".pagerduty.com"
154−
155−-- | The log level and associated logger function.
156−data Logger
157− = None
158− | Debug (Text -> IO ())
159−
160−-- | Log a message using the debug logger, or if none is specified noop.
161−debug :: MonadIO m => Logger -> Text -> m ()
162−debug None = const (return ())
163−debug (Debug f) = liftIO . f
164−
165−-- | The environment containing the parameters required to
166−-- make PagerDuty requests.
167−data Env (s :: Security) = Env
168− { _envDomain :: SubDomain
169− , _envAuth' :: Auth s
170− , _envManager :: Manager
171− , _envLogger :: Logger
172− }
173−
174−makeLenses ''Env
175−
176−envAuth :: forall s s'. Lens (Env s) (Env s') (Auth s) (Auth s')
177−envAuth = lens _envAuth' (\s x -> s { _envAuth' = x })
178−
179−prod :: SubDomain -> Auth s -> Manager -> Env s
180−prod d a m = Env d a m None
181−
182−newtype Code = Code Integer
183− deriving (Eq, Show, Num)
184−
185−deriveJSON ''Code
186−
187−description :: Code -> Text
188−description (Code c) =
189− case c of
190− 2000 -> "Internal Error"
191− 2001 -> "Invalid Input Provided"
192− 2002 -> "Arguments Caused Error"
193− 2003 -> "Missing Arguments"
194− 2004 -> "Invalid 'since' or 'until' Parameter Values"
195− 2005 -> "Invalid Query Date Range"
196− 2006 -> "Authentication Failed"
197− 2007 -> "Account Not Found"
198− 2008 -> "Account Locked"
199− 2009 -> "Only HTTPS Allowed For This Call"
200− 2010 -> "Access Denied"
201− 2011 -> "The action requires a 'requester_id' to be specified"
202− 2012 -> "Your account is expired and cannot use the API"
203− _ -> "Unrecognised error code"
204−
205−class HasMessage s a | s -> a where
206− -- | A short human-readable message describing the error.
207− message :: Lens' s a
208−
209−class HasErrors s a | s -> a where
210− -- | A list of human-readable reasons for the error. These values,
211− -- and even their format, are subject to change.
212− errors :: Lens' s a
213−
214−data IntegrationError = IntegrationError
215− { _ieStatus :: Text
216− , _ieMessage :: Text
217− , _ieErrors :: [Text]
218− } deriving (Eq, Show)
219−
220−deriveRecord ''IntegrationError
221−
222−instance HasMessage IntegrationError Text where message = ieMessage
223−instance HasErrors IntegrationError [Text] where errors = ieErrors
224−
225−status :: Lens' IntegrationError Text
226−status = ieStatus
227−
228−data RESTError = RESTError
229− { _reCode :: Code
230− , _reMessage :: Text
231− , _reErrors :: [Text]
232− } deriving (Eq, Show)
233−
234−deriveRecord ''RESTError
235−
236−instance HasMessage RESTError Text where message = reMessage
237−instance HasErrors RESTError [Text] where errors = reErrors
238−
239−-- | In the case of an error, the PagerDuty error code can give further details
240−-- on the nature of the error.
241−--
242−-- /See:/ 'description'
243−code :: Lens' RESTError Code
244−code = reCode
245−
246−data Error
247− = Internal Text
248− | Integration IntegrationError
249− | REST RESTError
250− deriving (Eq, Show)
251−
252−instance FromJSON Error where
253− parseJSON o = (REST <$> parseJSON o)
254− <|> (Integration <$> parseJSON o)
255−
256−makePrisms ''Error
257−
258−instance HasMessage Error Text where
259− message = lens f g
260− where
261− f (Internal x) = x
262− f (Integration s) = _ieMessage s
263− f (REST s) = _reMessage s
264−
265− g (Internal _) x = Internal x
266− g (Integration s) x = Integration $ s { _ieMessage = x }
267− g (REST s) x = REST $ s { _reMessage = x }
268−
269−data Pager = Pager
270− { _pgOffset :: !Int
271− -- ^ The offset used in the execution of the query.
272− , _pgLimit :: !Int
273− -- ^ The limit used in the execution of the query.
274− , _pgTotal :: !Int
275− -- ^ The total number of records available.
276− , _pgQuery :: Maybe Text
277− -- ^ An optional query= value to be added to the query string.
278− } deriving (Eq, Show)
279−
280−makeLenses ''Pager
281−
282−data Page a = Page
283− { _pgItem :: a
284− , _pgPager :: Maybe Pager
285− }
286−
287−instance FromJSON a => FromJSON (Page a) where
288− parseJSON = withObject "paginated" $ \o -> Page
289− <$> parseJSON (Object o)
290− <*> optional (parse o)
291− where
292− parse o = Pager
293− -- The offset of the first record returned.
294− -- Default is 0.
295− <$> o .: "offset" .!= 0
296− -- The number of records returned.
297− -- Default (and max limit) is 100 for most APIs.
298− <*> o .: "limit" .!= 100
299− <*> o .: "total"
300− <*> o .:? "query"
301−
302−instance ToJSON Pager where
303− toJSON p = object
304− [ "offset" .= _pgOffset p
305− , "limit" .= _pgLimit p
306− ]
307−
308−-- | A path segment.
309−data Path where
310− Path :: Path
311− Seg :: ToByteString a => a -> Path
312−
313−instance Semigroup Path where
314− x <> Path = x
315− Path <> y = y
316− Seg x <> Seg y = Seg (builder x <> "/" <> builder y)
317−
318−instance Monoid Path where
319− mempty = Path
320−
321−instance IsString Path where
322− fromString = Seg
323−
324−instance ToByteString Path where
325− builder Path = mempty
326− builder (Seg x) = builder x
327−
328−(%) :: ToByteString a => Path -> a -> Path
329−a % b = a <> Seg b
330−
331−renderPath :: Path -> ByteString
332−renderPath = toByteString' . mappend v1
333− where
334− v1 :: Path
335− v1 = "/api/v1"
336−
337−data Request a (s :: Security) b where
338− Request :: (QueryLike a, ToJSON a)
339− => { _rqMeth :: !StdMethod
340− , _rqPath :: Path
341− , _rqQuery :: Query
342− , _rqBody :: a
343− , _rqPager :: Maybe Pager
344− , _rqUnwrap :: Value -> Parser Value
345− }
346− -> Request a s b
347−
348−instance ToJSON (Request a s b) where
349− -- Manually unwrapped to ensure GADT constraint holds.
350− toJSON (Request _ _ _ b p _) = Object $
351− let Object x = toJSON b
352− in case toJSON p of
353− (Object y) -> x <> y
354− _ -> x
355−
356−type Unwrap = Getting (First Value) Value Value
357−
358−-- | Create a defaulted request from the payload type.
359−mk :: (QueryLike a, ToJSON a) => a -> Request a s b
360−mk x = Request GET mempty mempty x Nothing pure
361−
362−empty :: Request Empty s r
363−empty = mk Empty
364−
365−-- | Lens into the body of a request.
366−upd :: (QueryLike a, ToJSON a) => Lens' (Request a s b) a
367−upd = lens _rqBody (\(Request m p q _ g u) x -> Request m p q x g u)
368−
369−-- | Drop the security constraint.
370−auth :: Request a s b -> Request a t b
371−auth (Request x m p q g u) = Request x m p q g u
372−
373−meth :: Lens' (Request a s b) StdMethod
374−meth = lens _rqMeth (\r x -> r { _rqMeth = x })
375−
376−path :: Lens' (Request a s b) Path
377−path = lens _rqPath (\r x -> r { _rqPath = x })
378−
379−query :: QueryValueLike v
380− => Lens (Request a s b) (Request a s b) Query [(ByteString, v)]
381−query = lens _rqQuery (\r x -> r { _rqQuery = toQuery x })
382−
383−pager :: Lens' (Request a s b) (Maybe Pager)
384−pager = lens _rqPager (\r x -> r { _rqPager = x })
385−
386−unwrap :: Setter (Request a s b) (Request a s b) (Value -> Parser Value) Unwrap
387−unwrap f r = f (_rqUnwrap r) <&> \k -> r { _rqUnwrap = g k }
388− where
389− g k x = maybe (fail "Failed to extract nested keys.") return (x ^? k)
390−
391−-- | Exists primarily to obtain a constraint for the 'paginate' function.
392−class Paginate a where
393− next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)
394− next rq = maybe Nothing go
395− where
396− go x | x ^. pgTotal == 0 = Nothing
397− | otherwise = Just $
398− rq & pager ?~ (x & pgOffset +~ x ^. pgTotal)
399− & query %~ (add . clear)
400− where
401− add :: Query -> Query
402− add = maybe id ((:) . (k,) . Just . Text.encodeUtf8) (x ^. pgQuery)
403−
404− clear :: Query -> Query
405− clear = deleteBy ((==) `on` fst) (k, Nothing)
406−
407− k :: ByteString
408− k = "query"
409−
410−newtype Key (a :: Symbol) = Key Text
411− deriving (Eq, Show, IsString)
412−
413−mkKey :: Text -> Key a
414−mkKey = Key
415−
416−instance FromJSON (Key a) where
417− parseJSON = withText "key" (return . Key)
418−
419−instance ToJSON (Key a) where
420− toJSON (Key k) = toJSON k
421−
422−instance ToByteString (Key a) where
423− builder (Key k) = builder k
424−
425−instance QueryValues (Key a)
426−
427−instance QueryValueLike (Key a) where
428− toQueryValue = Just . toByteString'
429−
430−type ServiceKey = Key "service"
431−type IncidentKey = Key "incident"
432−
433−newtype Id (a :: Symbol) = Id Text
434− deriving (Eq, Show, IsString)
435−
436−mkId :: Text -> Id a
437−mkId = Id
438−
439−instance FromJSON (Id a) where
440− parseJSON = withText "id" (return . Id)
441−
442−instance ToJSON (Id a) where
443− toJSON (Id i) = toJSON i
444−
445−instance ToByteString (Id a) where
446− builder (Id i) = builder i
447−
448−instance QueryValues (Id a)
449−
450−instance QueryValueLike (Id a) where
451− toQueryValue = Just . toByteString'
452−
453−type AlertId = Id "alert"
454−type ContactId = Id "contact"
455−type EmailFilterId = Id "email-filter"
456−type EscalationPolicyId = Id "escalation-policy"
457−type EscalationRuleId = Id "escalation-rule"
458−type IncidentId = Id "incident"
459−type LogEntryId = Id "log-entry"
460−type NoteId = Id "note"
461−type NotificationRuleId = Id "notification-rule"
462−type OverrideId = Id "schedule-override"
463−type RequesterId = Id "requester"
464−type ScheduleId = Id "schedule"
465−type ServiceId = Id "service"
466−type UserId = Id "user"
467−type VendorId = Id "vendor"
468−type WebhookId = Id "webhook"
469−type WindowId = Id "maintenance-window"
470−
471−data Empty = Empty
472−
473−instance ToJSON Empty where
474− toJSON = const (object [])
475−
476−instance FromJSON Empty where
477− parseJSON = withObject "empty" f
478− where
479− f !o | Map.null o = pure Empty
480− | otherwise = fail "Unexpected non-empty JSON object."
481−
482−instance QueryLike Empty where
483− toQuery = const []
484−
485−newtype Address = Address Text
486− deriving (Eq, Show, IsString)
487−
488−mkAddress :: Text -> Address
489−mkAddress = Address
490−
491−deriveJSON ''Address
492−makePrisms ''Address
493−
494−instance ToByteString Address where
495− builder (Address a) = builder a
496−
497−instance QueryValues Address
src/Network/PagerDuty/REST.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−-- Module : Network.PagerDuty.REST
5−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
6−-- License : This Source Code Form is subject to the terms of
7−-- the Mozilla Public License, v. 2.0.
8−-- A copy of the MPL can be found in the LICENSE file or
9−-- you can obtain it at http://mozilla.org/MPL/2.0/.
10−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
11−-- Stability : experimental
12−-- Portability : non-portable (GHC extensions)
13−
14−module Network.PagerDuty.REST
15− (
16− -- * Sending requests
17− send
18− , sendWith
19− , paginate
20− , paginateWith
21−
22− , module Network.PagerDuty.Types
23− ) where
24−
25−import Control.Applicative
26−import Control.Lens
27−import Control.Monad
28−import Control.Monad.IO.Class
29−import Control.Monad.Trans
30−import Data.Aeson (FromJSON)
31−import Data.Conduit
32−import Data.Monoid
33−import Network.HTTP.Client (Manager)
34−import qualified Network.HTTP.Client as Client
35−import Network.HTTP.Types
36−import Network.PagerDuty.Internal.IO
37−import Network.PagerDuty.Internal.Types
38−import Network.PagerDuty.Types
39−
40−-- FIXME: verify correct actions are all paginated
41−-- FIXME: Ensure RequesterId parameter is always most significant param
42−-- FIXME: add smart constructors for all types, for testing purposes
43−
44−-- | /See:/ 'sendWith'
45−send :: (MonadIO m, FromJSON b)
46− => SubDomain
47− -> Auth s
48− -> Manager
49− -> Request a s b
50− -> m (Either Error b)
51−send d a m = sendWith (prod d a m)
52−
53−sendWith :: (MonadIO m, FromJSON b)
54− => Env s
55− -> Request a s b
56− -> m (Either Error b)
57−sendWith e = liftM (fmap _pgItem) . http e
58−
59−-- | /See:/ 'paginateWith'
60−paginate :: (MonadIO m, Paginate a, FromJSON b)
61− => SubDomain
62− -> Auth s
63− -> Manager
64− -> Request a s b
65− -> Source m (Either Error b)
66−paginate d a m = paginateWith (prod d a m)
67−
68−paginateWith :: (MonadIO m, Paginate a, FromJSON b)
69− => Env s
70− -> Request a s b
71− -> Source m (Either Error b)
72−paginateWith e = go
73− where
74− go rq = do
75− rs <- lift (http e rq)
76− yield (_pgItem <$> rs)
77− either (const (return ()))
78− (maybe (return ()) go . next rq . _pgPager)
79− rs
80−
81−http :: (MonadIO m, FromJSON b)
82− => Env s
83− -> Request a s b
84− -> m (Either Error (Page b))
85−http e rq = request (e ^. envManager) (e ^. envLogger) rq $ raw
86− { Client.host = domain (e ^. envDomain)
87− , Client.path = renderPath (rq ^. path)
88− , Client.queryString = renderQuery False (rq ^. query)
89− }
90− where
91− raw = case e ^. envAuth of
92− AuthBasic u p -> Client.applyBasicAuth u p Client.defaultRequest
93− AuthToken t -> Client.defaultRequest
94− { Client.requestHeaders = [("Authorization", "Token token=" <> t)]
95− }
src/Network/PagerDuty/REST/EscalationPolicies/EscalationRules.hsdeleted−277
@@ -1,277 +0,0 @@
1−{-# LANGUAGE ExtendedDefaultRules #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−
6−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
7−
8−-- Module : Network.PagerDuty.REST.EscalationPolicies.EscalationRules
9−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
10−-- License : This Source Code Form is subject to the terms of
11−-- the Mozilla Public License, v. 2.0.
12−-- A copy of the MPL can be found in the LICENSE file or
13−-- you can obtain it at http://mozilla.org/MPL/2.0/.
14−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
15−-- Stability : experimental
16−-- Portability : non-portable (GHC extensions)
17−
18−-- | This API lets you access and manipulate escalation rules of an existing
19−-- escalation policy.
20−--
21−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules>
22−module Network.PagerDuty.REST.EscalationPolicies.EscalationRules
23− (
24− -- * List Rules
25− listRules
26−
27− -- * Create Rule
28− , CreateRule
29− , createRule
30− , crEscalationDelayInMinutes
31− , crTargets
32−
33− -- * Get Rule
34− , getRule
35−
36− -- * Update Rules
37− , UpdateRules
38− , updateRules
39− , urEscalationRules
40−
41− -- * Update Rule
42− , UpdateRule
43− , updateRule
44− , urEscalationDelayInMinutes
45− , urTargets
46−
47− -- * Delete Rule
48− , deleteRule
49−
50− -- * Types
51− , HasUserInfo (..)
52−
53− , Target (..)
54− , _TSchedule
55− , _TUser
56−
57− , ScheduleTarget
58− , stId
59− , stName
60−
61− , Rule
62− , rId
63− , rEscalationDelayInMinutes
64− , rTargets
65− ) where
66−
67−import Control.Applicative ((<$>))
68−import Control.Lens hiding ((.=))
69−import Data.Aeson
70−import qualified Data.Aeson.KeyMap as Map
71−import Data.Text (Text)
72−import Network.HTTP.Types
73−import Network.PagerDuty.Internal.TH
74−import Network.PagerDuty.Internal.Types
75−import Network.PagerDuty.REST.Users
76−
77−default (Path)
78−
79−-- FIXME: The lenses here need to operate over (Request x s b) using upd
80−
81−rules :: EscalationPolicyId -> Path
82−rules p = "escalation_policies" % p % "escalation_rules"
83−
84−data TargetType
85− = TargetSchedule
86− | TargetUser
87−
88−deriveJSONWith (dropped 6 underscored) ''TargetType
89−
90−data TargetId
91− = ScheduleId ScheduleId
92− | UserId UserId
93− deriving (Eq, Show)
94−
95−instance FromJSON TargetId where
96− parseJSON = withObject "target" $ \o -> do
97− t <- o .: "type"
98− case t of
99− TargetSchedule -> ScheduleId <$> o .: "id"
100− TargetUser -> UserId <$> o .: "id"
101−
102−instance ToJSON TargetId where
103− toJSON (ScheduleId s) = object ["type" .= TargetSchedule, "id" .= s]
104− toJSON (UserId u) = object ["type" .= TargetUser, "id" .= u]
105−
106−data ScheduleTarget = ScheduleTarget
107− { _stId :: ScheduleId
108− , _stName :: Text
109− } deriving (Eq, Show)
110−
111−deriveJSON ''ScheduleTarget
112−
113−-- | The id of the target.
114−makeLens "_stId" ''ScheduleTarget
115−
116−-- | The name of the target.
117−makeLens "_stName" ''ScheduleTarget
118−
119−data Target
120− = TSchedule ScheduleTarget
121− | TUser UserInfo
122− deriving (Eq, Show)
123−
124−makePrisms ''Target
125−
126−instance FromJSON Target where
127− parseJSON = withObject "target" $ \o -> do
128− t <- o .: "type"
129− case t of
130− TargetSchedule -> TSchedule <$> parseJSON (Object o)
131− TargetUser -> TUser <$> parseJSON (Object o)
132−
133−instance ToJSON Target where
134− toJSON t = Object (Map.insert "type" (String k) o)
135− where
136− (k, Object o) = case t of
137− TSchedule s -> ("schedule", toJSON s)
138− TUser u -> ("user", toJSON u)
139−
140−data Rule = Rule
141− { _rId :: EscalationRuleId
142− , _rEscalationDelayInMinutes :: !Int
143− , _rTargets :: [Target]
144− } deriving (Eq, Show)
145−
146−deriveJSON ''Rule
147−
148−-- | The ID of the escalation rule.
149−makeLens "_rId" ''Rule
150−
151−-- | The amount of time before an incident escalates away from this rule.
152−makeLens "_rEscalationDelayInMinutes" ''Rule
153−
154−-- | A list of targets which an incident will be assigned to upon reaching this rule.
155−makeLens "_rTargets" ''Rule
156−
157−-- | List all the escalation rules for an existing escalation policy.
158−--
159−-- @GET \/escalation_policies\/\:escalation_policy_id\/escalation_rules@
160−--
161−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/list>
162−listRules :: EscalationPolicyId -> Request Empty s [Rule]
163−listRules p = empty & path .~ rules p
164−
165−-- | Show the escalation rule for an existing escalation policy.
166−--
167−-- @GET \/escalation_policies\/:escalation_policy_id\/escalation_rules\/\:id@
168−--
169−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/show>
170−getRule :: EscalationPolicyId -> EscalationRuleId -> Request Empty s Rule
171−getRule p r = empty & path .~ rules p % r
172−
173−data CreateRule = CreateRule
174− { _crEscalationDelayInMinutes :: !Int
175− , _crTargets :: [TargetId] -- ^ list1?
176− } deriving (Eq, Show)
177−
178−deriveJSON ''CreateRule
179−
180−instance QueryLike CreateRule where
181− toQuery = const []
182−
183−-- | The escalation timeout in minutes. Must be at least 5 if the rule has
184−-- multiple targets, and at least 1 if not. If an incident is not acknowledged
185−-- within this timeout then it will escalate onto the next escalation rule.
186−makeLens "_crEscalationDelayInMinutes" ''CreateRule
187−
188−-- | The list of the targets an incident should be assigned to upon reaching
189−-- this rule.
190−makeLens "_crTargets" ''CreateRule
191−
192−-- | Creates a new escalation rule for an escalation policy and appends it to
193−-- the end of the existing escalation rules.
194−--
195−-- @POST \/escalation_policies\/\:escalation_policy_id\/escalation_rules@
196−--
197−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/create>
198−createRule :: EscalationPolicyId
199− -> Int -- ^ 'crEscalationDelayInMinutes'
200− -> [TargetId] -- ^ 'crTargets'
201− -> Request CreateRule s Rule
202−createRule p n ts =
203− mk CreateRule
204− { _crEscalationDelayInMinutes = n
205− , _crTargets = ts
206− } & meth .~ POST
207− & path .~ rules p
208−
209−newtype UpdateRules = UpdateRules
210− { _urEscalationRules :: [TargetId] -- ^ list1
211− } deriving (Eq, Show)
212−
213−deriveJSON ''UpdateRules
214−
215−instance QueryLike UpdateRules where
216− toQuery = const []
217−
218−-- | An ordered array of escalation rules.
219−makeLens "_urEscalationRules" ''UpdateRules
220−
221−-- | Updates the entire collection of escalation rules for an existing escalation
222−-- policy. The ordering is determined by the positions of each rule in the
223−-- list. To create a new rule, add it to the list without an id. To remove a
224−-- rule, do not include it in the list.
225−--
226−-- @PUT \/escalation_policies\/\:escalation_policy_id\/escalation_rules@
227−--
228−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/multi_update>
229−updateRules :: EscalationPolicyId
230− -> [TargetId] -- ^ 'urEscalationRules'
231− -> Request UpdateRules s [Rule]
232−updateRules p rs =
233− mk UpdateRules
234− { _urEscalationRules = rs
235− } & meth .~ PUT
236− & path .~ rules p
237−
238−data UpdateRule = UpdateRule
239− { _urEscalationDelayInMinutes :: Maybe Int
240− , _urTargets :: [TargetId]
241− } deriving (Eq, Show)
242−
243−deriveJSON ''UpdateRule
244−
245−instance QueryLike UpdateRule where
246− toQuery = const []
247−
248−-- | The escalation timeout in minutes. Must be at least 5 if the rule has
249−-- multiple targets, and at least 1 if not. If an incident is not acknowledged
250−-- within this timeout then it will escalate onto the next escalation rule.
251−makeLens "_urEscalationDelayInMinutes" ''UpdateRule
252−
253−-- | The list of the targets an incident should be assigned to upon reaching
254−-- this rule.
255−makeLens "_urTargets" ''UpdateRule
256−
257−-- | Updates an escalation rule.
258−--
259−-- @PUT \/escalation_policies\/\:escalation_policy_id\/escalation_rules\/\:id@
260−--
261−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/update>
262−updateRule :: EscalationPolicyId -> EscalationRuleId -> Request UpdateRule s Rule
263−updateRule p r =
264− mk UpdateRule
265− { _urEscalationDelayInMinutes = Nothing
266− , _urTargets = []
267− } & meth .~ PUT
268− & path .~ rules p % r
269−
270−-- | Deletes an existing escalation rule that belongs to an escalation
271−-- policy. There must be a matching rule.
272−--
273−-- @DELETE \/escalation_policies\/\:escalation_policy_id\/escalation_rules\/\:id@
274−--
275−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/escalation_rules/delete>
276−deleteRule :: EscalationPolicyId -> EscalationRuleId -> Request Empty s Empty
277−deleteRule p r = empty & meth .~ DELETE & path .~ rules p % r
src/Network/PagerDuty/REST/Incidents.hsdeleted−651
@@ -1,651 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE LambdaCase #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE TemplateHaskell #-}
8−{-# LANGUAGE TypeFamilies #-}
9−
10−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
11−
12−-- Module : Network.PagerDuty.REST.Incidents
13−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
14−-- License : This Source Code Form is subject to the terms of
15−-- the Mozilla Public License, v. 2.0.
16−-- A copy of the MPL can be found in the LICENSE file or
17−-- you can obtain it at http://mozilla.org/MPL/2.0/.
18−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
19−-- Stability : experimental
20−-- Portability : non-portable (GHC extensions)
21−
22−-- | PagerDuty receives updates (called events) from monitoring systems through
23−-- services (like Nagios, email or generic API calls). Upon receiving an event,
24−-- active services will create a new incident and begin escalating it as
25−-- defined by the service's escalation policy. Events can be de-duplicated into
26−-- existing incidents based on service de-duplication rules to prevent you from
27−-- being overwhelmed by event storms.
28−--
29−-- An incident can be open, acknowledged or resolved. Whenever an incident is
30−-- created, it is assigned to a user (according to the escalation process, as
31−-- described by escalation rules and schedules). The assigned user has a chance
32−-- to either acknowledge that he is working on it, or to resolve it.
33−--
34−-- Resolving an incident closes it, whereas acknowledging it halts the
35−-- escalation process. If the incident is not resolved by the service's
36−-- incident ack timeout it continues up the escalation chain.
37−--
38−-- When an incident is triggered or when it is escalated it creates alerts
39−-- (also known as notifications). Alerts are messages containing the details of
40−-- the incident, and can be sent through SMS, email and phone calls.
41−--
42−-- Incidents and Incident Counts from the last 30 days are returned by
43−-- default. To change this default date range, see the documentation for the
44−-- since, until or dateRange parameters.
45−--
46−-- Note: that to create an incident you need to trigger it through the
47−-- "Network.PagerDuty.Integration" API.
48−--
49−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents>
50−module Network.PagerDuty.REST.Incidents
51− (
52− -- * List Incidents
53− ListIncidents
54− , listIncidents
55− , lsSince
56− , lsUntil
57− , lsDateRange
58− , lsStatus
59− , lsIncidentKey
60− , lsService
61− , lsAssignedToUser
62− , lsTimeZone
63− , lsSortBy
64−
65− -- * Count Incidents
66− , CountIncidents
67− , countIncidents
68− , cSince
69− , cUntil
70− , cDateRange
71− , cStatus
72− , cIncidentKey
73− , cService
74− , cAssignedToUser
75−
76− -- * Get Incident
77− , getIncident
78−
79− -- * Update Incidents
80− , UpdateIncidents
81− , updateIncidents
82− , updateIncidentsBasic
83− , uiIncidents
84−
85− -- * Resolve Incident
86− , resolveIncident
87− , resolveIncidentBasic
88−
89− -- * Acknowledge Incident
90− , acknowledgeIncident
91− , acknowledgeIncidentBasic
92−
93− -- * Reassign Incident
94− , ReassignIncident
95− , reassignIncident
96− , riEscalationPolicy
97− , riEscalationLevel
98− , riAssignedToUser
99−
100− -- * Types
101− , Sort (..)
102− , _Desc
103− , _Asc
104−
105− , Field (..)
106−
107− , IncidentStatus (..)
108− , UpdateStatus (..)
109−
110− , UpdateIncident
111− , iiId
112− , iiStatus
113− , iiEscalationLevel
114− , iiEscalationPolicy
115− , iiAssignedToUser
116−
117− , UpdatedIncidents
118− , uiId
119− , uiStatus
120− , uiIncidentNumber
121− , uiUrl
122− , uiError
123−
124− , Assignee
125− , aAt
126− , aObject
127−
128− , HasIncident (..)
129− , Incident
130− ) where
131−
132−import Control.Applicative hiding (empty)
133−import Control.Lens hiding (Empty)
134−import Data.Aeson
135−import Data.ByteString.Conversion (ToByteString (..),
136− toByteString')
137−import Data.Default.Class
138−import Data.Maybe
139−import Data.Monoid hiding (All)
140−import Data.Text (Text)
141−import qualified Data.Text.Encoding as Text
142−import Data.Time
143−import Network.HTTP.Types
144−import Network.PagerDuty.Internal.Query
145−import Network.PagerDuty.Internal.TH
146−import Network.PagerDuty.Internal.Types
147−
148−default (Path)
149−
150−incidents :: Path
151−incidents = "incidents"
152−
153−data Sort a
154− = Desc a
155− | Asc a
156− deriving (Eq, Show)
157−
158−makePrisms ''Sort
159−
160−data Field
161− = IncidentNumber
162− -- ^ The number of your incident.
163− | CreatedOn
164− -- ^ The date/time the incident was triggered.
165− | ResolvedOn
166− -- ^ The date/time the incident was resolved.
167− deriving (Eq, Show)
168−
169−instance QueryValues (Sort Field) where
170− queryValues s = case s of
171− Desc f -> ["desc:" <> field f]
172− Asc f -> ["asc:" <> field f]
173− where
174− field IncidentNumber = "incidentNumber"
175− field CreatedOn = "createdOn"
176− field ResolvedOn = "resolvedOn"
177−
178−data Range = All
179− deriving (Eq, Show)
180−
181−instance QueryValues Range where
182− queryValues All = ["all"]
183−
184−data IncidentStatus
185− = ITriggered
186− | IAcknowledged
187− | IResolved
188− | IOther Text
189− deriving (Eq, Show)
190−
191−instance ToByteString IncidentStatus where
192− builder = \case
193− ITriggered -> "triggered"
194− IAcknowledged -> "acknowledged"
195− IResolved -> "resolved"
196− IOther t -> builder t
197−
198−instance FromJSON IncidentStatus where
199− parseJSON = withText "status" $ pure . \case
200− "triggered" -> ITriggered
201− "acknowledged" -> IAcknowledged
202− "resolved" -> IResolved
203− t -> IOther t
204−
205−instance ToJSON IncidentStatus where
206− toJSON = String . Text.decodeUtf8 . toByteString'
207−
208−data Assignee = Assignee
209− { _aAt :: Date
210− , _aObject :: Object
211− } deriving (Eq, Show)
212−
213−deriveRecord ''Assignee
214−
215−data Incident = Incident
216− { _iIncidentNumber' :: !Int
217− , _iStatus' :: !IncidentStatus
218− , _iCreatedOn' :: Date
219− , _iHtmlUrl' :: Text
220− , _iIncidentKey' :: Maybe IncidentKey
221− , _iService' :: Object
222− , _iEscalationPolicy' :: Maybe Object
223− , _iAssignedTo' :: [Assignee]
224− , _iAcknowledgers' :: [Assignee]
225− , _iLastStatusChangeBy' :: Maybe Assignee
226− , _iLastStatusChangeOn' :: Maybe Date
227− , _iTriggerSummaryData' :: Object
228− , _iTriggerDetailsHtmlUrl' :: Text
229− } deriving (Eq, Show)
230−
231−deriveRecord ''Incident
232−
233−class HasIncident a where
234− incident :: Lens' a Incident
235−
236− -- | The number of the incident. This is unique across your account.
237− iIncidentNumber :: Lens' a Int
238−
239− -- | The current status of the incident. Valid statuses are:
240− iStatus :: Lens' a IncidentStatus
241−
242− -- | The date/time the incident was triggered.
243− iCreatedOn :: Lens' a UTCTime
244−
245− -- | The PagerDuty website URL where the incident can be viewed and further
246− -- actions taken. This is not the resource URL.
247− iHtmlUrl :: Lens' a Text
248−
249− -- | The incident's de-duplication key. See the PagerDuty Integration API
250− -- docs for further details.
251− iIncidentKey :: Lens' a (Maybe IncidentKey)
252−
253− -- | The PagerDuty service that the incident belongs to. The service will
254− -- contain fields of its own.
255− iService :: Lens' a Object
256−
257− -- | The escalation policy that the incident belongs to. The policy will
258− -- contain fields of its own.
259− iEscalationPolicy :: Lens' a (Maybe Object)
260−
261− -- | The list of assignments of the incident. An assignment is an object
262− -- containing the assigned user as well as the date/time the incident was
263− -- assigned to that user. The user will contain fields of its own.
264− -- This list is empty if the status of the incident is resolved.
265− iAssignedTo :: Lens' a [Assignee]
266−
267− -- | The list of acknowledgements of the incident. An acknowledgement is an
268− -- object containing the acknowleding object (either a user or the
269− -- integration API) as well as the date/time the incident was acknowledged.
270− -- This field is only present if the status of the incident is acknowledged.
271− -- This field is sorted in ascending order by acknowledgement time.
272− iAcknowledgers :: Lens' a [Assignee]
273−
274− -- | The user who is responsible for the incident's last status change. If
275− -- the incident is in the acknowledged or resolved status, this will be the user
276− -- that took the first acknowledged or resolved action. If the incident was
277− -- automatically resolved (say through the Event Integration API), or if the
278− -- incident is in the triggered state, this will be null. User fields are the
279− -- same as in the assignedToUser field above.
280− iLastStatusChangeBy :: Lens' a (Maybe Assignee)
281−
282− -- | The date/time the incident's status last changed.
283− iLastStatusChangeOn :: Lens' a (Maybe UTCTime)
284−
285− -- | Some condensed information regarding the initial event that triggered
286− -- this incident. This data will be a set of key/value pairs that vary depending
287− -- on what sort of event triggered the incident (email, Event API request,
288− -- etc). For instance, if an email triggered the incident, then the
289− -- triggerSummaryData will likely contain a subject. There are no guarantees
290− -- o nthe full presence of this data for every incident.
291− iTriggerSummaryData :: Lens' a Object
292−
293− -- | The PagerDuty website URL where the full details regarding the initial
294− -- event that triggered this incident can be found. (This is not the resource
295− -- URL.)
296− iTriggerDetailsHtmlUrl :: Lens' a Text
297−
298− iIncidentNumber = incident.iIncidentNumber'
299− iStatus = incident.iStatus'
300− iCreatedOn = incident.iCreatedOn'._D
301− iHtmlUrl = incident.iHtmlUrl'
302− iIncidentKey = incident.iIncidentKey'
303− iService = incident.iService'
304− iEscalationPolicy = incident.iEscalationPolicy'
305− iAssignedTo = incident.iAssignedTo'
306− iAcknowledgers = incident.iAcknowledgers'
307− iLastStatusChangeBy = incident.iLastStatusChangeBy'
308− iLastStatusChangeOn = incident.iLastStatusChangeOn'.mapping _D
309− iTriggerSummaryData = incident.iTriggerSummaryData'
310− iTriggerDetailsHtmlUrl = incident.iTriggerDetailsHtmlUrl'
311−
312−instance HasIncident Incident where
313− incident = id
314−
315−data ListIncidents = ListIncidents
316− { _lsSince' :: Maybe Date
317− , _lsUntil' :: Maybe Date
318− , _lsDateRange' :: Maybe Range
319− , _lsStatus' :: Maybe (CSV IncidentStatus)
320− , _lsIncidentKey' :: Maybe IncidentKey
321− , _lsService' :: Maybe (CSV ServiceId)
322− , _lsAssignedToUser' :: Maybe (CSV UserId)
323− , _lsTimeZone' :: !TZ
324− , _lsSortBy' :: Maybe (Sort Field)
325− } deriving (Eq, Show)
326−
327−queryRequest ''ListIncidents
328−
329−instance Paginate ListIncidents
330−
331−-- | The start of the date range over which you want to search.
332−lsSince :: Lens' (Request ListIncidents s b) (Maybe UTCTime)
333−lsSince = upd.lsSince'.mapping _D
334−
335−-- | The end of the date range over which you want to search.
336−--
337−-- /Note: If you leave off either since or until, a 30 day default range is
338−-- applied to your open ended range. Not including the since parameter will set
339−-- the date range to until - 30 days. Likewise, if you leave off until,
340−-- it is set to since + 30 days.
341−--
342−-- Defaults to the last 30 days if you leave off both. The size of the date
343−-- range must be less than 180 days.
344−lsUntil :: Lens' (Request ListIncidents s b) (Maybe UTCTime)
345−lsUntil = upd.lsUntil'.mapping _D
346−
347−-- | When set, the since and until parameters and defaults are
348−-- ignored. Use this to get all incidents since the account was created.
349−lsDateRange :: Lens' (Request ListIncidents s b) Bool
350−lsDateRange = upd.lens get_ (flip set_)
351− where
352− get_ = (Just All ==) . view lsDateRange'
353− set_ x = lsDateRange' .~ listToMaybe [All | x]
354−
355−-- | Returns only the incidents currently in the passed status(es).
356−lsStatus :: Lens' (Request ListIncidents s b) (Maybe [IncidentStatus])
357−lsStatus = upd.lsStatus'.mapping _CSV
358−
359−-- | Returns only the incidents with the passed de-duplication key.
360−--
361−-- /See:/ "Network.PagerDuty.Integration"
362−lsIncidentKey :: Lens' (Request ListIncidents s b) (Maybe IncidentKey)
363−lsIncidentKey = upd.lsIncidentKey'
364−
365−-- | Returns only the incidents associated with the passed service(s). This
366−-- expects one or more service IDs.
367−lsService :: Lens' (Request ListIncidents s b) (Maybe [ServiceId])
368−lsService = upd.lsService'.mapping _CSV
369−
370−-- | Returns only the incidents currently assigned to the passed user(s). This
371−-- expects one or more user IDs.
372−--
373−-- /Note:/ When using the assignedToUser filter, you will only receive
374−-- incidents with statuses of triggered or acknowledged. This is because resolved
375−-- incidents are not assigned to any user.
376−lsAssignedToUser :: Lens' (Request ListIncidents s b) (Maybe [UserId])
377−lsAssignedToUser = upd.lsAssignedToUser'.mapping _CSV
378−
379−-- | Time zone in which dates in the result will be rendered.
380−--
381−-- /Default:/ 'UTC'.
382−lsTimeZone :: Lens' (Request ListIncidents s b) TimeZone
383−lsTimeZone = upd.lsTimeZone'._TZ
384−
385−-- | Used to specify both the field you wish to sort the results on, as well as
386−-- the direction (ascending/descending) of the results.
387−lsSortBy :: Lens' (Request ListIncidents s b) (Maybe (Sort Field))
388−lsSortBy = upd.lsSortBy'
389−
390−-- | The PagerDuty incidents query API can be used to query current and
391−-- historical PagerDuty incidents over a date range, letting you build custom
392−-- dashboards or incident reports. The API allows for searching for incidents
393−-- with multiple filters or query parameters, various sorts, and also supports
394−-- the pagination of results.
395−--
396−-- @GET \/incidents@
397−--
398−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/list>
399−listIncidents :: Request ListIncidents s [Incident]
400−listIncidents =
401− mk ListIncidents
402− { _lsSince' = Nothing
403− , _lsUntil' = Nothing
404− , _lsDateRange' = Nothing
405− , _lsStatus' = Nothing
406− , _lsIncidentKey' = Nothing
407− , _lsService' = Nothing
408− , _lsAssignedToUser' = Nothing
409− , _lsTimeZone' = def
410− , _lsSortBy' = Nothing
411− } & path .~ incidents
412−
413−-- | Get detailed information about an incident. Accepts either an incident id,
414−-- or an incident number.
415−--
416−-- @GET \/incidents\/\:id@
417−--
418−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/show>
419−getIncident :: IncidentId -> Request Empty s Incident
420−getIncident i = empty & path .~ incidents % i
421−
422−data CountIncidents = CountIncidents
423− { _cSince' :: Maybe Date
424− , _cUntil' :: Maybe Date
425− , _cDateRange' :: Maybe Range
426− , _cStatus' :: Maybe (CSV IncidentStatus)
427− , _cIncidentKey' :: Maybe IncidentKey
428− , _cService' :: Maybe (CSV ServiceId)
429− , _cAssignedToUser' :: Maybe (CSV UserId)
430− } deriving (Eq, Show)
431−
432−queryRequest ''CountIncidents
433−
434−-- | The start of the date range over which you want to search.
435−cSince :: Lens' (Request CountIncidents s b) (Maybe UTCTime)
436−cSince = upd.cSince'.mapping _D
437−
438−-- | The end of the date range over which you want to search.
439−--
440−-- /Note:/ If you leave off either since or until, a 30 day default range is
441−-- applied to your open ended range. Not including the since parameter will set
442−-- the date range to until @-30@ days. Likewise, if you leave off until,
443−-- it is set to since @+30@ days.
444−--
445−-- /Default:/ The last 30 days if you leave off both. The size of the date
446−-- range must be less than 180 days.
447−cUntil :: Lens' (Request CountIncidents s b) (Maybe UTCTime)
448−cUntil = upd.cUntil'.mapping _D
449−
450−-- | When set, the since and until parameters and defaults are
451−-- ignored. Use this to get all counts since the account was created.
452−cDateRange :: Lens' (Request CountIncidents s b) Bool
453−cDateRange = upd.lens get_ (flip set_)
454− where
455− get_ = (Just All ==) . view cDateRange'
456− set_ x = cDateRange' .~ listToMaybe [All | x]
457−
458−-- | Only counts the incidents currently in the passed status(es).
459−cStatus :: Lens' (Request CountIncidents s b) (Maybe [IncidentStatus])
460−cStatus = upd.cStatus'.mapping _CSV
461−
462−-- | Returns only the incidents with the passed de-duplication key.
463−--
464−-- /See:/ "Network.PagerDuty.Integration"
465−cIncidentKey :: Lens' (Request CountIncidents s b) (Maybe IncidentKey)
466−cIncidentKey = upd.cIncidentKey'
467−
468−-- | Only counts the incidents associated with the passed service(s).
469−-- This is expecting one or more service IDs.
470−cService :: Lens' (Request CountIncidents s b) (Maybe [ServiceId]) -- list1
471−cService = upd.cService'.mapping _CSV
472−
473−-- | Only counts the incidents currently assigned to the passed user(s).
474−-- This is expecting one or more user IDs.
475−--
476−-- /Note:/ When using the assigned_to_user filter, you will only count
477−-- incidents with statuses of triggered or acknowledged. This is because resolved
478−-- incidents are not assigned to any user.
479−cAssignedToUser :: Lens' (Request CountIncidents s b) (Maybe [UserId]) -- list1
480−cAssignedToUser = upd.cAssignedToUser'.mapping _CSV
481−
482−newtype Count = Count Int
483− deriving (Eq, Ord, Show, Bounded, Enum, Num, Integral, Real)
484−
485−instance FromJSON Count where
486− parseJSON = withObject "count" $ \o -> Count <$> o .: "total"
487−
488−-- | Use this query if you are simply looking for the count of incidents that
489−-- match a given query. This should be used if you don't need access to the
490−-- actual incident details.
491−--
492−-- @GET \/incidents\/count@
493−--
494−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/count>
495−countIncidents :: Request CountIncidents s Count
496−countIncidents =
497− mk CountIncidents
498− { _cSince' = Nothing
499− , _cUntil' = Nothing
500− , _cDateRange' = Nothing
501− , _cStatus' = Nothing
502− , _cIncidentKey' = Nothing
503− , _cService' = Nothing
504− , _cAssignedToUser' = Nothing
505− } & path .~ incidents % "count"
506−
507−
508−data UpdateStatus
509− = UAcknowledged
510− | UResolved
511− deriving (Eq, Show)
512−
513−deriveNullary ''UpdateStatus
514−
515−data UpdateIncident = UpdateIncident
516− { _iiId :: IncidentId
517− , _iiStatus :: Maybe UpdateStatus
518− , _iiEscalationLevel :: Maybe Int
519− , _iiEscalationPolicy :: Maybe EscalationPolicyId
520− , _iiAssignedToUser :: Maybe (CSV UserId)
521− } deriving (Eq, Show)
522−
523−deriveJSON ''UpdateIncident
524−
525−-- | The id of the incident to update.
526−makeLens "_iiId" ''UpdateIncident
527−
528−-- | The new status of the incident.
529−makeLens "_iiStatus" ''UpdateIncident
530−
531−-- | Escalate incident to this level in the escalation policy.
532−makeLens "_iiEscalationLevel" ''UpdateIncident
533−
534−-- | Delegate this incident to the specified escalation policy id.
535−-- This restarts the incident's escalation following the new policy.
536−makeLens "_iiEscalationPolicy" ''UpdateIncident
537−
538−-- | List of user IDs to assign this incident to.
539−makeLens "_iiAssignedToUser" ''UpdateIncident
540−
541−data UpdatedIncidents = UpdatedIncidents
542− { _uiId :: IncidentId
543− , _uiStatus :: IncidentStatus
544− , _uiIncidentNumber :: !Int
545− , _uiUrl :: Text
546− , _uiError :: Maybe Object
547− } deriving (Eq, Show)
548−
549−deriveRecord ''UpdatedIncidents
550−
551−data UpdateIncidents = UpdateIncidents
552− { _uiIncidents' :: [UpdateIncident]
553− } deriving (Eq, Show)
554−
555−jsonRequest ''UpdateIncidents
556−
557−uiIncidents :: Lens' (Request UpdateIncidents s b) [UpdateIncident]
558−uiIncidents = upd.uiIncidents'
559−
560−-- | Acknowledge, resolve, escalate or reassign one or more incidents.
561−--
562−-- @PUT \/incidents@
563−--
564−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/update>
565−updateIncidents :: RequesterId -> Request UpdateIncidents s [UpdatedIncidents]
566−updateIncidents r = auth updateIncidentsBasic & query .~ [("requester_id", r)]
567−
568−-- | A version of 'updateIncidents' which uses HTTP Basic authentication and
569−-- doesn't require a 'RequesterId'.
570−updateIncidentsBasic :: Request UpdateIncidents 'Basic [UpdatedIncidents]
571−updateIncidentsBasic =
572− mk UpdateIncidents
573− { _uiIncidents' = []
574− } & meth .~ PUT
575− & path .~ incidents
576−
577−-- | Resolve an incident.
578−--
579−-- @PUT \/incidents\/\:id\/resolve@
580−--
581−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/resolve>
582−resolveIncident :: IncidentId
583− -> RequesterId
584− -> Request Empty s Empty
585−resolveIncident i r =
586− auth (resolveIncidentBasic i) & query .~ [("requester_id", r)]
587−
588−-- | A version of 'resolveIncident' which uses HTTP Basic authentication and
589−-- doesn't require a 'RequesterId'.
590−resolveIncidentBasic :: IncidentId -> Request Empty s Empty
591−resolveIncidentBasic i = empty & meth .~ PUT & path .~ incidents % i % "resolve"
592−
593−-- | Acknowledge an incident.
594−--
595−-- @PUT \/incidents\/\:id\/acknowledge@
596−--
597−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/acknowledge>
598−acknowledgeIncident :: IncidentId
599− -> RequesterId
600− -> Request Empty s Empty
601−acknowledgeIncident i r =
602− auth (acknowledgeIncidentBasic i) & query .~ [("requester_id", r)]
603−
604−-- | A version of 'acknowledgeIncident' which uses HTTP Basic authentication and
605−-- doesn't require a 'RequesterId'.
606−acknowledgeIncidentBasic :: IncidentId -> Request Empty s Empty
607−acknowledgeIncidentBasic i =
608− empty & meth .~ PUT & path .~ incidents % i % "acknowledge"
609−
610−data ReassignIncident = ReassignIncident
611− { _riEscalationPolicy' :: Maybe EscalationPolicyId
612− , _riEscalationLevel' :: Maybe Int
613− , _riAssignedToUser' :: Maybe (CSV UserId)
614− } deriving (Eq, Show)
615−
616−jsonRequest ''ReassignIncident
617−
618−-- | The ID of an escalation policy. Delegate the incident to this escalation
619−-- policy.
620−riEscalationPolicy :: Lens' (Request ReassignIncident s b) (Maybe EscalationPolicyId)
621−riEscalationPolicy = upd.riEscalationPolicy'
622−
623−-- | Escalate incident to this level in the escalation policy.
624−riEscalationLevel :: Lens' (Request ReassignIncident s b) (Maybe Int)
625−riEscalationLevel = upd.riEscalationLevel'
626−
627−-- | Comma separated list of user IDs to assign this incident to.
628−riAssignedToUser :: Lens' (Request ReassignIncident s b) (Maybe [UserId])
629−riAssignedToUser = upd.riAssignedToUser'.mapping _CSV
630−
631−-- | Reassign an incident.
632−--
633−-- @PUT \/incidents\/\:id\/reassign@
634−--
635−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/reassign>
636−reassignIncident :: IncidentId
637− -> RequesterId
638− -> Request ReassignIncident s Empty
639−reassignIncident i r =
640− auth (reassignIncidentBasic i) & query .~ [("requester_id", r)]
641−
642−-- | A version of 'reassignIncident' which uses HTTP Basic authentication and
643−-- doesn't require a 'RequesterId'.
644−reassignIncidentBasic :: IncidentId -> Request ReassignIncident s Empty
645−reassignIncidentBasic i =
646− mk ReassignIncident
647− { _riEscalationPolicy' = Nothing
648− , _riEscalationLevel' = Nothing
649− , _riAssignedToUser' = Nothing
650− } & meth .~ PUT
651− & path .~ incidents % i % "reassign"
src/Network/PagerDuty/REST/Incidents/Notes.hsdeleted−108
@@ -1,108 +0,0 @@
1−{-# LANGUAGE ExtendedDefaultRules #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
6−
7−-- Module : Network.PagerDuty.REST.Incidents.Notes
8−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9−-- License : This Source Code Form is subject to the terms of
10−-- the Mozilla Public License, v. 2.0.
11−-- A copy of the MPL can be found in the LICENSE file or
12−-- you can obtain it at http://mozilla.org/MPL/2.0/.
13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
14−-- Stability : experimental
15−-- Portability : non-portable (GHC extensions)
16−
17−-- | The Incident Notes API allows you to add notes to a specified incident.
18−--
19−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes>
20−module Network.PagerDuty.REST.Incidents.Notes
21− (
22− -- * List Notes
23− listNotes
24−
25− -- * Create Note
26− , CreateNote
27− , createNote
28− , createNoteBasic
29− , cnContent
30−
31− -- * Types
32− , Note
33− , nId
34− , nCreatedAt
35− , nUser
36− , nContent
37− ) where
38−
39−import Control.Lens hiding ((.=))
40−import Data.Aeson
41−import Data.Text (Text)
42−import Data.Time
43−import Network.HTTP.Types
44−import Network.PagerDuty.Internal.TH
45−import Network.PagerDuty.Internal.Types
46−import Network.PagerDuty.REST.Users
47−
48−default (Path)
49−
50−notes :: IncidentId -> Path
51−notes i = "incidents" % i % "notes"
52−
53−data Note = Note
54− { _nId :: NoteId
55− , _nCreatedAt :: Date
56− , _nUser :: User
57− , _nContent :: Text
58− } deriving (Eq, Show)
59−
60−deriveJSON ''Note
61−
62−makeLens "_nId" ''Note
63−makeLens "_nUser" ''Note
64−makeLens "_nContent" ''Note
65−
66−nCreatedAt :: Lens' Note UTCTime
67−nCreatedAt = lens _nCreatedAt (\n x -> n { _nCreatedAt = x }) . _D
68−
69−-- | List existing notes for the specified incident.
70−--
71−-- @GET \/incidents\/\:incident_id\/notes@
72−--
73−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes/create>
74−listNotes :: IncidentId -> Request Empty s [Note]
75−listNotes i = empty & path .~ notes i
76−
77−newtype CreateNote = CreateNote
78− { _cnContent' :: Maybe Text
79− } deriving (Eq, Show)
80−
81−makeLenses ''CreateNote
82−
83−instance ToJSON CreateNote where
84− toJSON cn = object ["note" .= object ["content" .= _cnContent' cn]]
85−
86−instance QueryLike CreateNote where
87− toQuery = const []
88−
89−-- | The note content.
90−cnContent :: Lens' (Request CreateNote s b) (Maybe Text)
91−cnContent = upd.cnContent'
92−
93−-- | Create a new note for the specified incident.
94−--
95−-- @POST \/incidents\/\:incident_id\/notes@
96−--
97−-- /See:/ <http://developer.pagerduty.com/documentation/rest/incidents/notes/create>
98−createNote :: IncidentId -> RequesterId -> Request CreateNote s Note
99−createNote i r = auth (createNoteBasic i) & query .~ [("requester_id", r)]
100−
101−-- | A version of 'createNote' which uses HTTP Basic authentication and
102−-- doesn't require a 'RequesterId'.
103−createNoteBasic :: IncidentId -> Request CreateNote s Note
104−createNoteBasic i =
105− mk CreateNote
106− { _cnContent' = Nothing
107− } & meth .~ POST
108− & path .~ notes i
src/Network/PagerDuty/REST/LogEntries.hsdeleted−513
@@ -1,513 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE StandaloneDeriving #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−-- Module : Network.PagerDuty.REST.LogEntries
8−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9−-- License : This Source Code Form is subject to the terms of
10−-- the Mozilla Public License, v. 2.0.
11−-- A copy of the MPL can be found in the LICENSE file or
12−-- you can obtain it at http://mozilla.org/MPL/2.0/.
13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
14−-- Stability : experimental
15−-- Portability : non-portable (GHC extensions)
16−
17−-- | PagerDuty keeps a log of all the events that happen to an incident. The
18−-- following APIs provide fine-grained access to this incident log entry data to
19−-- give you more insight into how your team or organization is handling your
20−-- incidents. Log entry data includes details about the event(s) that triggered
21−-- the incident, who was notified and when, how they were notified, and who
22−-- acknowledged or resolved it, amongst a few other things.
23−--
24−-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries>
25−module Network.PagerDuty.REST.LogEntries
26− (
27− -- * List Logs
28− ListLogs
29− , listLogs
30− , listUserLogs
31− , listIncidentLogs
32− , llTimeZone
33− , llSince
34− , llUntil
35− , llIsOverview
36−
37− -- * Get Log
38− , GetLog
39− , getLog
40− , glTimeZone
41−
42− -- * Types
43− -- ** Channels
44− , Channel (..)
45− , _ChanNagios
46− , _ChanAPI
47− , _ChanEmail
48− , _ChanUserEmail
49− , _ChanWebTrigger
50− , _ChanSMS
51− , _ChanWeb
52− , _ChanNote
53− , _ChanAuto
54− , _ChanTimeout
55−
56− , NagiosChannel
57− , ncSummary
58− , ncHost
59− , ncService
60− , ncState
61− , ncDetails
62−
63− , APIChannel
64− , acSummary
65− , acServiceKey
66− , acDescription
67− , acIncidentKey
68− , acDetails
69−
70− , EmailType (..)
71− , EmailChannel
72− , ecSummary
73− , ecTo
74− , ecFrom
75− , ecSubject
76− , ecBody
77− , ecBodyContentType
78− , ecRawUrl
79− , ecHtmlUrl
80−
81− , WebTriggerChannel
82− , wcSummary
83− , wcSubject
84− , wcDetails
85−
86− -- ** Entries
87− , Entry (..)
88− , _LogEntry
89− , _NotifyEntry
90−
91− , LogEntryType (..)
92− , LogEntry
93− , leId
94− , leType
95− , leCreatedAt
96− , leNote
97− , leAssignedUser
98− , leChannel
99−
100− , NotifyEntry
101− , neCreatedAt
102− , neUser
103− , neNotification
104−
105− , NotificationType (..)
106− , NotificationStatus (..)
107−
108− , Notification
109− , nType
110− , nStatus
111− , nAddress
112− ) where
113−
114−import Control.Lens hiding (Empty)
115−import Data.Aeson
116−import Data.Aeson.Lens
117−import qualified Data.Aeson.KeyMap as Map
118−import Data.Default.Class
119−import Data.Text (Text)
120−import qualified Data.Text as Text
121−import Data.Time
122−import Network.HTTP.Types
123−import Network.PagerDuty.Internal.TH
124−import Network.PagerDuty.Internal.Types
125−import Network.PagerDuty.REST.Users (User)
126−
127−logs :: Path
128−logs = "log_entries"
129−
130−includes :: Query
131−includes =
132− [ ("include[]", Just "channel")
133− , ("include[]", Just "incident")
134− , ("include[]", Just "service")
135− ]
136−
137−data NagiosChannel = NagiosChannel
138− { _ncSummary :: Text
139− , _ncHost :: Text
140− , _ncService :: Maybe Text
141− , _ncState :: Text
142− , _ncDetails :: Object
143− } deriving (Eq, Show)
144−
145−deriveJSON ''NagiosChannel
146−
147−-- | Same as host.
148−makeLens "_ncSummary" ''NagiosChannel
149−
150−-- | Nagios host.
151−makeLens "_ncHost" ''NagiosChannel
152−
153−-- | Nagios service that created the event, if applicable.
154−makeLens "_ncService" ''NagiosChannel
155−
156−-- | State the caused the event.
157−makeLens "_ncState" ''NagiosChannel
158−
159−-- | Additional details of the incident.
160−makeLens "_ncDetails" ''NagiosChannel
161−
162−data APIChannel = APIChannel
163− { _acSummary :: Text
164− , _acServiceKey :: ServiceKey
165− , _acDescription :: Text
166− , _acIncidentKey :: IncidentKey
167− , _acDetails :: Object
168− } deriving (Eq, Show)
169−
170−deriveJSON ''APIChannel
171−
172−-- | Same as description.
173−makeLens "_acSummary" ''APIChannel
174−
175−-- | API service key.
176−makeLens "_acServiceKey" ''APIChannel
177−
178−-- | Description of the event.
179−makeLens "_acDescription" ''APIChannel
180−
181−-- | Incident deduping string.
182−makeLens "_acIncidentKey" ''APIChannel
183−
184−-- | Additional details of the incident, if any.
185−makeLens "_acDetails" ''APIChannel
186−
187−data EmailType
188− = Plain
189− | HTML
190− deriving (Eq, Show)
191−
192−deriveNullary ''EmailType
193−
194−data EmailChannel = EmailChannel
195− { _ecSummary :: Text
196− , _ecTo :: Text
197− , _ecFrom :: Text
198− , _ecSubject :: Text
199− , _ecBody :: Text
200− , _ecBodyContentType :: EmailType
201− , _ecRawUrl :: Text
202− , _ecHtmlUrl :: Maybe Text
203− } deriving (Eq, Show)
204−
205−deriveJSON ''EmailChannel
206−
207−-- | Same as subject.
208−makeLens "_ecSummary" ''EmailChannel
209−
210−-- | To address of the email.
211−makeLens "_ecTo" ''EmailChannel
212−
213−-- | From address of the email.
214−makeLens "_ecFrom" ''EmailChannel
215−
216−-- | Subject of the email.
217−makeLens "_ecSubject" ''EmailChannel
218−
219−-- | Body of the email.
220−makeLens "_ecBody" ''EmailChannel
221−
222−-- | Content type of the email body.
223−makeLens "_ecBodyContentType" ''EmailChannel
224−
225−-- | URL for raw text of email.
226−makeLens "_ecRawUrl" ''EmailChannel
227−
228−-- | URL for html rendered version of the email.
229−--
230−-- Only present if content_type is 'HTML'.
231−makeLens "_ecHtmlUrl" ''EmailChannel
232−
233−data WebTriggerChannel = WebTriggerChannel
234− { _wcSummary :: Text
235− , _wcSubject :: Text
236− , _wcDetails :: Maybe Text
237− } deriving (Eq, Show)
238−
239−deriveJSON ''WebTriggerChannel
240−
241−-- | Same as subject.
242−makeLens "_wcSummary" ''WebTriggerChannel
243−
244−-- | Subject of the web trigger.
245−makeLens "_wcSubject" ''WebTriggerChannel
246−
247−-- | Details about the web trigger.
248−makeLens "_wcDetails" ''WebTriggerChannel
249−
250−-- | Representation of the means by which the action was channeled.
251−data Channel
252− = ChanNagios NagiosChannel
253− | ChanAPI APIChannel
254− | ChanEmail EmailChannel
255− | ChanUserEmail User EmailChannel
256− | ChanWebTrigger User WebTriggerChannel
257− | ChanSMS User
258− | ChanWeb User
259− | ChanNote User
260− | ChanAuto
261− | ChanTimeout
262− deriving (Eq, Show)
263−
264−makePrisms ''Channel
265−
266−instance FromJSON Channel where
267− parseJSON = withObject "agent+channel" $ \o -> do
268− t <- o .: "channel" >>= (.: "type")
269− let u = Map.member "user" o
270− case t of
271− -- service
272− "email" | not u -> ChanEmail <$> o .: "channel"
273− "nagios" -> ChanNagios <$> o .: "channel"
274− "api" -> ChanAPI <$> o .: "channel"
275− -- user
276− "email" | u -> ChanUserEmail <$> o .: "user" <*> o .: "channel"
277− "web_trigger" -> ChanWebTrigger <$> o .: "user" <*> o .: "channel"
278− "sms" -> ChanSMS <$> o .: "user"
279− "web" -> ChanWeb <$> o .: "user"
280− "note" -> ChanNote <$> o .: "user"
281− -- empty
282− "auto" -> pure ChanAuto
283− "timeout" -> pure ChanTimeout
284− _ -> fail $
285− "unrecognised service channel type: " ++ Text.unpack t
286−
287−data LogEntryType
288− = Trigger
289− -- ^ The incident was triggered.
290− | Acknowledge
291− -- ^ The incident was acknowledged.
292− | Unacknowledge
293− -- ^ The incident was unacknowledged.
294− | Resolve
295− -- ^ The incident was resolved.
296− | Escalate
297− -- ^ The incident was escalated.
298− | Assign
299− -- ^ The incident was assigned to a user.
300− | Annotate
301− -- ^ A note was added to the incident.
302− | ReachTriggerLimit
303− -- ^ The incident has reached the log entry trigger limit and
304− -- will not create any more.
305− | RepeatEscalationPath
306− -- ^ The incident has reached the end of its escalation policy
307− -- and will restart.
308− | ExhaustEscalationPath
309− -- ^ The incident has cycled through its escalation policy the
310− -- max allowed number of times.
311− | Notify
312− -- ^ A user was notified.
313− deriving (Eq, Show)
314−
315−deriveNullary ''LogEntryType
316−
317−-- | The raw log event.
318−data LogEntry = LogEntry'
319− { _leId :: LogEntryId
320− , _leType :: LogEntryType
321− , _leCreatedAt :: Date
322− , _leNote :: Maybe Text
323− , _leAssignedUser :: Maybe User
324− , _leChannel :: Channel
325− } deriving (Eq, Show)
326−
327−instance FromJSON LogEntry where
328− parseJSON = withObject "log_entry" $ \o ->
329− LogEntry' <$> o .: "id"
330− <*> o .: "type"
331− <*> o .: "created_at"
332− <*> o .:? "note"
333− <*> o .:? "assigned_user"
334− <*> parseJSON (Object o)
335−
336−-- | Id of the log entry.
337−makeLens "_leId" ''LogEntry
338−
339−-- | Time at which the log entry was created.
340−makeLens "_leCreatedAt" ''LogEntry
341−
342−-- | The type of the log entry.
343−makeLens "_leType" ''LogEntry
344−
345−-- | Optional field containing an action note, if one was included
346−-- with the action.
347−makeLens "_leNote" ''LogEntry
348−
349−-- | Only for assign, escalate log entries. The user to which the incident is
350−-- assigned.
351−makeLens "_leAssignedUser" ''LogEntry
352−
353−-- | Representation of the means by which the action was channeled and the
354−-- possible perfomer of this action.
355−makeLens "_leChannel" ''LogEntry
356−
357−data NotificationType
358− = SMS
359− | Email
360− | Phone
361− | IosPushNotification
362− deriving (Eq, Show)
363−
364−deriveNullary ''NotificationType
365−
366−data NotificationStatus
367− = Success
368− | Blocked
369− | Busy
370− | Failed
371− | NoAnswer
372− | BadAddress
373− deriving (Eq, Show)
374−
375−deriveNullary ''NotificationStatus
376−
377−data Notification = Notification
378− { _nType :: !NotificationType
379− , _nStatus :: !NotificationStatus
380− , _nAddress :: Address
381− } deriving (Eq, Show)
382−
383−deriveJSON ''Notification
384−
385−-- | Type of notification.
386−makeLens "_nType" ''Notification
387−
388−-- | The current status of the notification.
389−makeLens "_nStatus" ''Notification
390−
391−-- | The address to which the notification was sent. I.e., an email address,
392−-- phone number, or iPhone name.
393−makeLens "_nAddress" ''Notification
394−
395−-- | Notify log entries correspond to notifications sent to users. They have a
396−-- distinct format from action log entries.
397−data NotifyEntry = NotifyEntry'
398− { _neCreatedAt' :: Date
399− , _neUser' :: User
400− , _neNotification' :: Notification
401− } deriving (Eq, Show)
402−
403−deriveRecord ''NotifyEntry
404−
405−-- | Time at which the log entry was created
406−neCreatedAt :: Lens' NotifyEntry UTCTime
407−neCreatedAt = neCreatedAt'._D
408−
409−-- | User who was notified
410−neUser :: Lens' NotifyEntry User
411−neUser = neUser'
412−
413−-- | Object representing the notification itself
414−neNotification :: Lens' NotifyEntry Notification
415−neNotification = neNotification'
416−
417−data Entry
418− = LogEntry LogEntry
419− -- ^ Log entries come in a wide variety of types. Most types use this format,
420− -- the exception being the 'NotifyEntry' type.
421− | NotifyEntry NotifyEntry
422− -- ^ A user was notified.
423− deriving (Eq, Show)
424−
425−makePrisms ''Entry
426−
427−data ListLogs = ListLogs
428− { _llTimeZone' :: TZ
429− , _llSince' :: Maybe Date
430− , _llUntil' :: Maybe Date
431− , _llIsOverview' :: Bool'
432− } deriving (Eq, Show)
433−
434−instance Paginate ListLogs
435−
436−queryRequest ''ListLogs
437−
438−-- | Time zone in which dates in the result will be rendered.
439−--
440−-- /Default:/ UTC.
441−llTimeZone :: Lens' (Request ListLogs s b) TimeZone
442−llTimeZone = upd.llTimeZone'._TZ
443−
444−-- | The start of the date range over which you want to search.
445−llSince :: Lens' (Request ListLogs s b) (Maybe UTCTime)
446−llSince = upd.llSince'.mapping _D
447−
448−-- | The end of the date range over which you want to search.
449−llUntil :: Lens' (Request ListLogs s b) (Maybe UTCTime)
450−llUntil = upd.llUntil'.mapping _D
451−
452−-- | If true, will only return log entries of type trigger, acknowlldge, or resolve.
453−--
454−-- /Default:/ false.
455−llIsOverview :: Lens' (Request ListLogs s b) Bool
456−llIsOverview = upd.llIsOverview'._B
457−
458−-- | List all incident log entries across the entire account.
459−--
460−-- @GET \/log_entries@
461−--
462−-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/list>
463−listLogs :: Request ListLogs s [LogEntry]
464−listLogs =
465− mk ListLogs
466− { _llTimeZone' = def
467− , _llSince' = Nothing
468− , _llUntil' = Nothing
469− , _llIsOverview' = F
470− } & path .~ logs
471− & query .~ includes
472− & unwrap .~ key "log_entries"
473−
474−-- | List all incident log entries that describe interactions with a specific user.
475−--
476−-- @GET \/users\/\:user_id\/log_entries@
477−--
478−-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/user_log_entries>
479−listUserLogs :: UserId -> Request ListLogs s [LogEntry]
480−listUserLogs u = listLogs & path .~ "users" % u % logs
481−
482−-- | List all incident log entries for a specific incident.
483−--
484−-- @GET \/incidents\/\:incident_id\/log_entries@
485−--
486−-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/incident_log_entries>
487−listIncidentLogs :: IncidentKey -> Request ListLogs s [LogEntry]
488−listIncidentLogs i = listLogs & path .~ "incidents" % i % logs
489−
490−newtype GetLog = GetLog
491− { _glTimeZone' :: TZ
492− } deriving (Eq, Show)
493−
494−queryRequest ''GetLog
495−
496−-- | Time zone in which dates in the result will be rendered.
497−--
498−-- /Default:/ UTC.
499−glTimeZone :: Lens' (Request GetLog s b) TimeZone
500−glTimeZone = upd.glTimeZone'._TZ
501−
502−-- | Get details for a specific incident log entry. This method provides additional
503−-- information you can use to get at raw event data.
504−--
505−-- @GET \/log_entries\/\:id@
506−--
507−-- /See:/ <http://developer.pagerduty.com/documentation/rest/log_entries/show>
508−getLog :: LogEntryId -> Request GetLog s LogEntry
509−getLog l =
510− mk GetLog
511− { _glTimeZone' = def
512− } & path .~ logs % l
513− & query .~ includes
src/Network/PagerDuty/REST/MaintenanceWindows.hsdeleted−289
@@ -1,289 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−{-# LANGUAGE TypeFamilies #-}
5−
6−-- Module : Network.PagerDuty.REST.MaintenanceWindows
7−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
8−-- License : This Source Code Form is subject to the terms of
9−-- the Mozilla Public License, v. 2.0.
10−-- A copy of the MPL can be found in the LICENSE file or
11−-- you can obtain it at http://mozilla.org/MPL/2.0/.
12−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
13−-- Stability : experimental
14−-- Portability : non-portable (GHC extensions)
15−
16−-- | Maintenance windows allow you to schedule service maintenance periods,
17−-- during which no incidents will be created.
18−--
19−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows>
20−module Network.PagerDuty.REST.MaintenanceWindows
21− (
22− -- * List Windows
23− ListWindows
24− , listWindows
25− , lwQuery
26− , lwServiceIds
27− , lwFilter
28−
29− , ListWindowsResponse
30− , lwMaintenanceWindows
31− , lwCounts
32−
33− -- * Create Window
34− , CreateWindow
35− , createWindow
36− , createWindowBasic
37− , cwStartTime
38− , cwEndTime
39− , cwDescription
40− , cwServiceIds
41−
42− -- * Get Window
43− , getWindow
44−
45− -- * Update Window
46− , UpdateWindow
47− , updateWindow
48− , uwStartTime
49− , uwEndTime
50− , uwDescription
51− , uwServiceIds
52−
53− -- * Delete Window
54− , deleteWindow
55−
56− -- * Types
57− , ServiceInfo
58− , siId
59− , siName
60− , siUrl
61−
62− , Counts
63− , cOngoing
64− , cFuture
65− , cPast
66− , cAll
67−
68− , MaintenanceWindow
69− , mwSequenceNumber
70− , mwStartTime
71− , mwEndTime
72− , mwDescription
73− , mwCreatedBy
74− , mwServices
75− ) where
76−
77−import Control.Lens hiding (Empty)
78−import Data.Monoid
79−import Data.Text (Text)
80−import Data.Time
81−import Network.HTTP.Types
82−import Network.PagerDuty.Internal.TH
83−import Network.PagerDuty.Internal.Types
84−import Network.PagerDuty.REST.Users (User)
85−
86−windows :: Path
87−windows = "maintenance_windows"
88−
89−data ServiceInfo = ServiceInfo
90− { _siId :: ServiceId
91− , _siName :: Text
92− , _siUrl :: Text
93− } deriving (Eq, Show)
94−
95−deriveRecord ''ServiceInfo
96−
97−data MaintenanceWindow = MaintenanceWindow
98− { _mwSequenceNumber :: !Int
99− , _mwStartTime :: Date
100− , _mwEndTime :: Date
101− , _mwDescription :: Maybe Text
102− , _mwCreatedBy :: User
103− , _mwServices :: [ServiceInfo]
104− } deriving (Eq, Show)
105−
106−deriveRecord ''MaintenanceWindow
107−
108−data ListWindows = ListWindows
109− { _lwQuery' :: Maybe Text
110− , _lwServiceIds' :: List ServiceId
111− , _lwFilter' :: Maybe Text
112− }
113−
114−queryRequest ''ListWindows
115−
116−-- | Filters the results, showing only the maintenance windows whose
117−-- descriptions contain the query.
118−lwQuery :: Lens' (Request ListWindows s b) (Maybe Text)
119−lwQuery = upd.lwQuery'
120−
121−-- | An list of service IDs, specifying services whose maintenance
122−-- windows shall be returned.
123−lwServiceIds :: Lens' (Request ListWindows s b) [ServiceId]
124−lwServiceIds = upd.lwServiceIds'._L
125−
126−-- | Only return maintenance windows that are of this type. Possible values
127−-- are past, future, ongoing. If this parameter is omitted, all maintenance
128−-- windows will be returned.
129−lwFilter :: Lens' (Request ListWindows s b) (Maybe Text)
130−lwFilter = upd.lwFilter'
131−
132−data Counts = Counts
133− { _cOngoing :: !Int
134− , _cFuture :: !Int
135− , _cPast :: !Int
136− , _cAll :: !Int
137− } deriving (Eq, Show)
138−
139−deriveRecord ''Counts
140−
141−data ListWindowsResponse = ListWindowsResponse
142− { _lwMaintenanceWindows :: [MaintenanceWindow]
143− , _lwCounts :: Counts
144− } deriving (Eq, Show)
145−
146−deriveRecord ''ListWindowsResponse
147−
148−-- | List existing maintenance windows, optionally filtered by service,
149−-- or whether they are from the past, present or future.
150−--
151−-- @GET \/maintenance_windows@
152−--
153−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/list>
154−listWindows :: Request ListWindows s ListWindowsResponse
155−listWindows =
156− mk ListWindows
157− { _lwQuery' = Nothing
158− , _lwServiceIds' = mempty
159− , _lwFilter' = Nothing
160− } & path .~ windows
161−
162−data CreateWindow' = CreateWindow'
163− { _cwStartTime' :: Date
164− , _cwEndTime' :: Date
165− , _cwDescription' :: Maybe Text
166− , _cwServiceIds' :: [ServiceId] -- ^ List1
167− } deriving (Eq, Show)
168−
169−deriveRecord ''CreateWindow'
170−
171−data CreateWindow = CreateWindow
172− { _cwRequesterId' :: Maybe RequesterId
173− , _cwMaintenanceWindow' :: CreateWindow'
174− } deriving (Eq, Show)
175−
176−jsonRequest ''CreateWindow
177−
178−-- | This maintenance window's start time. This is when the services will stop
179−-- creating incidents. If this date is in the past, it will be updated to be the
180−-- current time.
181−cwStartTime :: Lens' (Request CreateWindow s b) UTCTime
182−cwStartTime = upd.cwMaintenanceWindow'.cwStartTime'._D
183−
184−-- | This maintenance window's end time. This is when the services will start
185−-- creating incidents again. This date must be in the future and after the
186−-- start_time.
187−cwEndTime :: Lens' (Request CreateWindow s b) UTCTime
188−cwEndTime = upd.cwMaintenanceWindow'.cwEndTime'._D
189−
190−-- | A description for this maintenance window.
191−cwDescription :: Lens' (Request CreateWindow s b) (Maybe Text)
192−cwDescription = upd.cwMaintenanceWindow'.cwDescription'
193−
194−-- | The ids of the services that are affected by this maintenance window.
195−cwServiceIds :: Lens' (Request CreateWindow s b) [ServiceId]
196−cwServiceIds = upd.cwMaintenanceWindow'.cwServiceIds'
197−
198−-- | Create a new maintenance window for the specified services. No new
199−-- incidents will be created for a service that is currently in maintenance.
200−--
201−-- @POST \/maintenance_windows@
202−--
203−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/create>
204−createWindow :: RequesterId
205− -> UTCTime -- ^ 'cwStartTime'
206− -> UTCTime -- ^ 'cwEndTime'
207− -> [ServiceId] -- ^ 'cwServiceIds'
208− -> Request CreateWindow s MaintenanceWindow
209−createWindow r s e xs =
210− auth (createWindowBasic s e xs) & upd.cwRequesterId' ?~ r
211−
212−-- | A version of 'createWindow' which uses HTTP Basic authentication and
213−-- doesn't require a 'RequesterId'.
214−createWindowBasic :: UTCTime -- ^ 'cwStartTime'
215− -> UTCTime -- ^ 'cwEndTime'
216− -> [ServiceId] -- ^ 'cwServiceIds'
217− -> Request CreateWindow 'Basic MaintenanceWindow
218−createWindowBasic s e xs =
219− mk CreateWindow
220− { _cwRequesterId' = Nothing
221− , _cwMaintenanceWindow' = CreateWindow'
222− { _cwStartTime' = D s
223− , _cwEndTime' = D e
224− , _cwDescription' = Nothing
225− , _cwServiceIds' = xs
226− }
227− } & meth .~ POST
228− & path .~ windows
229−
230−-- | Get details about an existing maintenance window.
231−--
232−-- @GET \/maintenance_windows\/\:id@
233−--
234−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/show>
235−getWindow :: WindowId -> Request Empty s MaintenanceWindow
236−getWindow w = empty & path .~ windows % w
237−
238−data UpdateWindow = UpdateWindow
239− { _uwStartTime' :: Maybe Date
240− , _uwEndTime' :: Maybe Date
241− , _uwDescription' :: Maybe Text
242− , _uwServiceIds' :: Maybe [ServiceId]
243− } deriving (Eq, Show)
244−
245−jsonRequest ''UpdateWindow
246−
247−-- | The maintenance window's start time. Can only be updated on future
248−-- maintenance windows. If the start_time is set to a date in the past, it will be
249−-- updated to the current date.
250−uwStartTime :: Lens' (Request UpdateWindow s b) (Maybe Date)
251−uwStartTime = upd.uwStartTime'
252−
253−-- | The maintenance window's end time. Can only be updated on ongoing and
254−-- future maintenance windows, and cannot be set to a value before start_time.
255−uwEndTime :: Lens' (Request UpdateWindow s b) (Maybe Date)
256−uwEndTime = upd.uwEndTime'
257−
258−-- | Description for this maintenance window. Can only be updated on ongoing
259−-- and future maintenance windows.
260−uwDescription :: Lens' (Request UpdateWindow s b) (Maybe Text)
261−uwDescription = upd.uwDescription'
262−
263−-- | Services that are affected by this maintenance window. Can only be updated
264−-- on future maintenance windows.
265−uwServiceIds :: Lens' (Request UpdateWindow s b) (Maybe [ServiceId])
266−uwServiceIds = upd.uwServiceIds'
267−
268−-- | Update an existing maintenance window.
269−--
270−-- @PUT \/maintenance_windows\/\:id@
271−--
272−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/update>
273−updateWindow :: WindowId -> Request UpdateWindow s MaintenanceWindow
274−updateWindow w =
275− mk UpdateWindow
276− { _uwStartTime' = Nothing
277− , _uwEndTime' = Nothing
278− , _uwDescription' = Nothing
279− , _uwServiceIds' = Nothing
280− } & meth .~ PUT
281− & path .~ windows % w
282−
283−-- | Cancel or delete an existing maintenance window.
284−--
285−-- @DELETE \/maintenance_windows\/\:id@
286−--
287−-- /See:/ <http://developer.pagerduty.com/documentation/rest/maintenance_windows/delete>
288−deleteWindow :: WindowId -> Request Empty s Empty
289−deleteWindow w = empty & meth .~ DELETE & path .~ windows % w
src/Network/PagerDuty/REST/Reports.hsdeleted−188
@@ -1,188 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8−
9−-- Module : Network.PagerDuty.REST.Reports
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−-- | Access high level reports about alerts and incidents.
20−-- Useful for creating graphs.
21−--
22−-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports>
23−module Network.PagerDuty.REST.Reports
24− (
25− -- * Alerts Per Time
26− alertsPerTime
27−
28− -- * Incidents Per Time
29− , incidentsPerTime
30−
31− -- * Types
32− , Report
33− , rSince
34− , rUntil
35− , rRollup
36−
37− , Rollup (..)
38−
39− , AlertReport
40− , arStart
41− , arEnd
42− , arNumberOfAlerts
43− , arNumberOfPhoneAlerts
44− , arNumberOfSmsAlerts
45− , arNumberOfEmailAlerts
46−
47− , AlertTotals
48− , atAlerts
49− , atTotalNumberOfAlerts
50− , atTotalNumberOfPhoneAlerts
51− , atTotalNumberOfSmsAlerts
52− , atTotalNumberOfEmailAlerts
53− , atTotalNumberOfBillableAlerts
54−
55− , IncidentReport
56− , irStart
57− , irEnd
58− , irNumberOfIncidents
59− ) where
60−
61−import Control.Lens hiding (Empty)
62−import Data.Aeson.Lens
63−import Data.Time
64−import Network.PagerDuty.Internal.TH
65−import Network.PagerDuty.Internal.Types
66−
67−default (Path)
68−
69−reports :: Path
70−reports = "reports"
71−
72−data Rollup
73− = Daily
74− | Weekly
75− | Monthly
76− deriving (Eq, Show)
77−
78−deriveNullary ''Rollup
79−
80−data Report = Report
81− { _rSince' :: Date
82− , _rUntil' :: Date
83− , _rRollup' :: !Rollup
84− } deriving (Eq, Show)
85−
86−queryRequest ''Report
87−
88−-- | Start of the date range over which you want to search. The time element
89−-- is optional.
90−rSince :: Lens' (Request Report s b) UTCTime
91−rSince = upd.rSince'._D
92−
93−-- | The end of the date range over which you want to search. This should be
94−-- in the same format as since.
95−rUntil :: Lens' (Request Report s b) UTCTime
96−rUntil = upd.rUntil'._D
97−
98−-- | Specifies the bucket duration for each summation.
99−--
100−-- /Default:/ monthly.
101−--
102−-- Example: A time window of two years (based on since and until) with a
103−-- rollup of monthly will result in 24 sets of data points being returned
104−-- (one for each month in the span).
105−rRollup :: Lens' (Request Report s b) Rollup
106−rRollup = upd.rRollup'
107−
108−data AlertReport = AlertReport
109− { _arStart :: Date
110− , _arEnd :: Date
111− , _arNumberOfAlerts :: !Int
112− , _arNumberOfPhoneAlerts :: !Int
113− , _arNumberOfSmsAlerts :: !Int
114− , _arNumberOfEmailAlerts :: !Int
115− } deriving (Eq, Show)
116−
117−deriveJSON ''AlertReport
118−
119−arStart :: Lens' AlertReport UTCTime
120−arStart = lens _arStart (\r x -> r { _arStart = x }) ._D
121−
122−arEnd :: Lens' AlertReport UTCTime
123−arEnd = lens _arEnd (\r x -> r { _arEnd = x }) ._D
124−
125−makeLens "_arNumberOfAlerts" ''AlertReport
126−makeLens "_arNumberOfPhoneAlerts" ''AlertReport
127−makeLens "_arNumberOfSmsAlerts" ''AlertReport
128−makeLens "_arNumberOfEmailAlerts" ''AlertReport
129−
130−data AlertTotals = AlertTotals
131− { _atAlerts :: [AlertReport]
132− , _atTotalNumberOfAlerts :: !Int
133− , _atTotalNumberOfPhoneAlerts :: !Int
134− , _atTotalNumberOfSmsAlerts :: !Int
135− , _atTotalNumberOfEmailAlerts :: !Int
136− , _atTotalNumberOfBillableAlerts :: !Int
137− } deriving (Eq, Show)
138−
139−deriveRecord ''AlertTotals
140−
141−-- | Get high level statistics about the number of alerts (SMSes, phone calls and
142−-- emails) sent for the desired time period, summed daily, weekly or monthly.
143−--
144−-- @GET \/reports\/alerts_per_time@
145−--
146−-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports/alerts_per_time>
147−alertsPerTime :: UTCTime -- ^ 'rSince'
148− -> UTCTime -- ^ 'rUntil'
149− -> Request Report s AlertTotals
150−alertsPerTime s u =
151− mk Report
152− { _rSince' = D s
153− , _rUntil' = D u
154− , _rRollup' = Monthly
155− } & path .~ reports % "alerts_per_time"
156−
157−data IncidentReport = IncidentReport
158− { _irStart :: Date
159− , _irEnd :: Date
160− , _irNumberOfIncidents :: !Int
161− } deriving (Eq, Show)
162−
163−deriveJSON ''IncidentReport
164−
165−irStart :: Lens' IncidentReport UTCTime
166−irStart = lens _irStart (\r x -> r { _irStart = x }) . _D
167−
168−irEnd :: Lens' IncidentReport UTCTime
169−irEnd = lens _irEnd (\r x -> r { _irEnd = x }) . _D
170−
171−makeLens "_irNumberOfIncidents" ''IncidentReport
172−
173−-- | Get high level statistics about the number of incidents created for the
174−-- desired time period, summed daily, weekly or monthly.
175−--
176−-- @GET \/reports\/incidents_per_time@
177−--
178−-- /See:/ <http://developer.pagerduty.com/documentation/rest/reports/incidents_per_time>
179−incidentsPerTime :: UTCTime -- ^ 'rSince'
180− -> UTCTime -- ^ 'rUntil'
181− -> Request Report s [IncidentReport]
182−incidentsPerTime s u =
183− mk Report
184− { _rSince' = D s
185− , _rUntil' = D u
186− , _rRollup' = Monthly
187− } & path .~ reports % "incidents_per_time"
188− & unwrap .~ key "incidents"
src/Network/PagerDuty/REST/Schedules.hsdeleted−638
@@ -1,638 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8−
9−-- Module : Network.PagerDuty.REST.Schedules
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−-- | On call schedules determine the time periods that users are on-call. Only when
20−-- a user is on-call he is eligible to receive alerts from incidents.
21−--
22−-- This API allows users to manipulate on-call schedules.
23−--
24−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides>
25−module Network.PagerDuty.REST.Schedules
26− (
27− -- * List Schedules
28− ListSchedules
29− , listSchedules
30− , lsQuery
31−
32− -- * Get Schedule
33− , GetSchedule
34− , getSchedule
35− , gsSince
36− , gsUntil
37− , gsTimeZone
38−
39− -- * Get Schedule Users
40− , GetScheduleUsers
41− , getScheduleUsers
42− , gsuSince
43− , gsuUntil
44−
45− -- * Get Schedule Entries
46− , GetScheduleEntries
47− , getScheduleEntries
48− , gseSince
49− , gseUntil
50− , gseOverflow
51− , gseTimeZone
52− , gseUserId
53−
54− -- * Create Schedule
55− , CreateSchedule
56− , createSchedule
57− , csName
58− , csOverflow
59− , csTimeZone
60− , csScheduleLayers
61−
62− -- * Update Schedule
63− , UpdateSchedule
64− , updateSchedule
65− , usOverflow
66− , usTimeZone
67− , usScheduleLayers
68−
69− -- * Preview Schedule
70− , PreviewSchedule
71− , previewSchedule
72− , psSince
73− , psUntil
74− , psOverflow
75− , psName
76− , psTimeZone
77− , psScheduleLayers
78−
79− -- * Delete Schedule
80− , deleteSchedule
81−
82− -- * Types
83− , RestrictionType (..)
84− , Restriction
85− , rStartTimeOfDay
86− , rDurationSeconds
87−
88− , Rotation
89− , rMemberOrder
90− , rUser
91−
92− , ScheduleLayer
93− , slName
94− , slRenderedScheduleEntries
95− , slRestrictionType
96− , slRestrictions
97− , slPriority
98− , slStart
99− , slEnd
100− , slRenderedCoveragePercentage
101− , slRotationTurnLengthSeconds
102− , slRotationVirtualStart
103− , slUsers
104−
105− , HasScheduleInfo (..)
106− , ScheduleInfo
107− , Schedule
108− , sScheduleLayers
109− , sOverridesSubschedule
110− , sFinalSchedule
111− ) where
112−
113−import Control.Lens hiding (Empty, (.=))
114−import Data.Aeson
115−import Data.Text (Text)
116−import Data.Time
117−import Network.HTTP.Types
118−import Network.PagerDuty.Internal.TH
119−import Network.PagerDuty.Internal.Types
120−import Network.PagerDuty.REST.Users (User)
121−
122−default (Path)
123−
124−schedules :: Path
125−schedules = "schedules"
126−
127−data RestrictionType
128− = Daily
129− | Weekly
130− deriving (Eq, Show)
131−
132−deriveNullary ''RestrictionType
133−
134−data Restriction = Restriction
135− { _rStartTimeOfDay :: Date
136− , _rDurationSeconds :: !Int
137− } deriving (Eq, Show)
138−
139−deriveJSON ''Restriction
140−
141−rStartTimeOfDay :: Lens' Restriction UTCTime
142−rStartTimeOfDay =
143− lens _rStartTimeOfDay (\r x -> r { _rStartTimeOfDay = x }) . _D
144−
145−makeLens "_rDurationSeconds" ''Restriction
146−
147−data Rotation = Rotation
148− { _rMemberOrder :: !Int
149− , _rUser :: User
150− } deriving (Eq, Show)
151−
152−deriveRecord ''Rotation
153−
154−-- | A schedule is composed of multiple schedule layers.
155−--
156−-- A layer is composed of a group of people who will rotate through the same
157−-- shift. In a basic weekly schedule, you create a single layer where each member
158−-- is on-call for one week, with a set day and time for transferring on-call duty.
159−--
160−-- When a schedule has multiple layers, the layer can be ordered using the
161−-- priority field. The layer with the highest priority has precedence over the
162−-- layers with lower priority. You can use restrictions to control how layers
163−-- overlap.
164−--
165−-- The override layer is a special layer where all the override entries are
166−-- stored.
167−--
168−-- The final layer is a special layer that contains the result of all the previous
169−-- layers put together. This layer cannot be edited.
170−data ScheduleLayer = ScheduleLayer
171− { _slName :: Text
172− , _slRenderedScheduleEntries :: [ScheduleId] -- FIXME: what is this a list of?
173− , _slRestrictionType :: !RestrictionType
174− , _slRestrictions :: [Restriction]
175− , _slPriority :: !Int
176− , _slStart :: Date
177− , _slEnd :: Date
178− , _slRenderedCoveragePercentage :: !Double
179− , _slRotationTurnLengthSeconds :: !Int
180− , _slRotationVirtualStart :: Date
181− , _slUsers :: [Rotation]
182− } deriving (Eq, Show)
183−
184−-- FIXME: most of these fields are maybes
185−
186−deriveJSON ''ScheduleLayer
187−
188−makeLens "_slName" ''ScheduleLayer
189−
190−-- | This is a list of entries to be rendered for the current time range.
191−makeLens "_slRenderedScheduleEntries" ''ScheduleLayer
192−
193−-- | This specifies the type of restrictions present on this layer.
194−makeLens "_slRestrictionType" ''ScheduleLayer
195−
196−-- | A list of time restrictions for this layer.
197−makeLens "_slRestrictions" ''ScheduleLayer
198−
199−-- | The priority of the layer. Layers with higher priority will override
200−-- layers with a lower priority.
201−makeLens "_slPriority" ''ScheduleLayer
202−
203−-- | The effective start date of the layer
204−makeLens "_slStart" ''ScheduleLayer
205−
206−-- | The effective end date of the layer. If 'Nothing', the layer has no end date.
207−makeLens "_slEnd" ''ScheduleLayer
208−
209−-- | The percentage of the time range covered by this layer.
210−makeLens "_slRenderedCoveragePercentage" ''ScheduleLayer
211−
212−-- | The duration of each on-call shift in seconds.
213−makeLens "_slRotationTurnLengthSeconds" ''ScheduleLayer
214−
215−-- | The effective start time of the layer. This can be before the start
216−-- time of the schedule.
217−makeLens "_slRotationVirtualStart" ''ScheduleLayer
218−
219−-- | An ordered list of users in this layer. The member_order field controls
220−-- the order in which the users apear in the rotation.
221−makeLens "_slUsers" ''ScheduleLayer
222−
223−data ScheduleInfo = ScheduleInfo
224− { _siId' :: ScheduleId
225− , _siName' :: Text
226− , _siTimeZone' :: TZ
227− , _siToday' :: Date
228− , _siEscalationPolicies' :: [EscalationPolicyId]
229− } deriving (Eq, Show)
230−
231−deriveRecord ''ScheduleInfo
232−
233−class HasScheduleInfo a where
234− scheduleInfo :: Lens' a ScheduleInfo
235−
236− -- | The unique identifier of the schedule.
237− sId :: Lens' a ScheduleId
238− -- | The name of the schedule.
239− sName :: Lens' a Text
240− -- | The time zone of the schedule.
241− sTimeZone :: Lens' a TimeZone
242− -- | The current day in the schedule's time zone.
243− sToday :: Lens' a UTCTime
244− -- | An list of all the escalation policies that uses this schedule.
245− sEscalationPolicies :: Lens' a [EscalationPolicyId]
246−
247− sId = scheduleInfo.siId'
248− sName = scheduleInfo.siName'
249− sTimeZone = scheduleInfo.siTimeZone'._TZ
250− sToday = scheduleInfo.siToday'._D
251− sEscalationPolicies = scheduleInfo.siEscalationPolicies'
252−
253−instance HasScheduleInfo ScheduleInfo where
254− scheduleInfo = id
255−
256−data Schedule = Schedule
257− { _sInfo :: ScheduleInfo
258− , _sScheduleLayers :: [ScheduleLayer]
259− , _sOverridesSubschedule :: ScheduleLayer
260− , _sFinalSchedule :: ScheduleLayer
261− } deriving (Eq, Show)
262−
263−deriveJSON ''Schedule
264−
265−instance HasScheduleInfo Schedule where
266− scheduleInfo = lens _sInfo (\s x -> s { _sInfo = x })
267−
268−-- | A list of schedule layers. See the schedule layers parameters for details.
269−makeLens "_sScheduleLayers" ''Schedule
270−
271−-- | The schedule layer object where all the overrides are stored.
272−makeLens "_sOverridesSubschedule" ''Schedule
273−
274−-- | The final schedule layer object.
275−makeLens "_sFinalSchedule" ''Schedule
276−
277−newtype ListSchedules = ListSchedules
278− { _lsQuery' :: Maybe Text
279− } deriving (Eq, Show)
280−
281−queryRequest ''ListSchedules
282−
283−-- | Filters the result, showing only the schedules whose name matches the query.
284−lsQuery :: Lens' (Request ListSchedules s b) (Maybe Text)
285−lsQuery = upd.lsQuery'
286−
287−instance Paginate ListSchedules
288−
289−-- | List existing on-call schedules.
290−--
291−-- @GET \/schedules@
292−--
293−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/list>
294−listSchedules :: RequesterId -> Request ListSchedules s [ScheduleInfo]
295−listSchedules r = auth listSchedulesBasic & query .~ [("requester_id", r)]
296−
297−-- | A version of 'listSchedules' which uses HTTP Basic authentication and
298−-- doesn't require a 'RequesterId'.
299−listSchedulesBasic :: Request ListSchedules s [ScheduleInfo]
300−listSchedulesBasic =
301− mk ListSchedules
302− { _lsQuery' = Nothing
303− } & path .~ schedules
304−
305−data GetSchedule = GetSchedule
306− { _gsSince' :: Maybe Date
307− , _gsUntil' :: Maybe Date
308− , _gsTimeZone' :: Maybe TZ
309− } deriving (Eq, Show)
310−
311−queryRequest ''GetSchedule
312−
313−-- | The start of the date range over which you want to return on-call schedule
314−-- entries and on-call schedule layers.
315−gsSince :: Lens' (Request GetSchedule s b) (Maybe UTCTime)
316−gsSince = upd.gsSince'.mapping _D
317−
318−-- | The end of the date range over which you want to return schedule entries
319−-- and on-call schedule layers.
320−gsUntil :: Lens' (Request GetSchedule s b) (Maybe UTCTime)
321−gsUntil = upd.gsUntil'.mapping _D
322−
323−-- | Time zone in which dates in the result will be rendered.
324−--
325−-- /Default:/ account time zone.
326−gsTimeZone :: Lens' (Request GetSchedule s b) (Maybe TimeZone)
327−gsTimeZone = upd.gsTimeZone'.mapping _TZ
328−
329−-- | Show detailed information about a schedule, including entries for each
330−-- layer and sub-schedule.
331−--
332−-- @GET \/schedules\/\:id@
333−--
334−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/show>
335−getSchedule :: Request GetSchedule s Schedule
336−getSchedule =
337− mk GetSchedule
338− { _gsSince' = Nothing
339− , _gsUntil' = Nothing
340− , _gsTimeZone' = Nothing
341− } & path .~ schedules
342−
343−
344−data GetScheduleUsers = GetScheduleUsers
345− { _gsuSince' :: Maybe Date
346− , _gsuUntil' :: Maybe Date
347− } deriving (Eq, Show)
348−
349−queryRequest ''GetScheduleUsers
350−
351−-- | The start of the date range over which you want to return on-call users.
352−gsuSince :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)
353−gsuSince = upd.gsuSince'.mapping _D
354−
355−-- | The end time of the date range over which you want to return on-call users.
356−gsuUntil :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)
357−gsuUntil = upd.gsuUntil'.mapping _D
358−
359−-- | List all the users on-call in a given schedule for a given time range.
360−--
361−-- @GET \/schedules\/\:id\/users@
362−--
363−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/users>
364−getScheduleUsers :: UserId -> Request GetScheduleUsers s [User]
365−getScheduleUsers u =
366− mk GetScheduleUsers
367− { _gsuSince' = Nothing
368− , _gsuUntil' = Nothing
369− } & path .~ schedules % u % "users"
370−
371−data GetScheduleEntries = GetScheduleEntries
372− { _gseSince' :: Date
373− , _gseUntil' :: Date
374− , _gseOverflow' :: !Bool'
375− , _gseTimeZone' :: Maybe TZ
376− , _gseUserId' :: Maybe UserId
377− } deriving (Eq, Show)
378−
379−queryRequest ''GetScheduleEntries
380−
381−-- | The start of the date range over which you want to return on-call
382−-- schedule entries.
383−-- The maximum range queryable at once is three months.
384−gseSince :: Lens' (Request GetScheduleEntries s b) UTCTime
385−gseSince = upd.gseSince'._D
386−
387−-- | The end of the date range over which you want to return schedule entries.
388−gseUntil :: Lens' (Request GetScheduleEntries s b) UTCTime
389−gseUntil = upd.gseUntil'._D
390−
391−-- | Any on-call schedule entries that pass the date range bounds will be
392−-- truncated at the bounds, unless the parameter overflow=true is passed.
393−--
394−-- Default: false.
395−--
396−-- Example: if your schedule is a rotation that changes daily at midnight UTC,
397−-- and your date range is from 2011-06-01T10:00:00Z to 2011-06-01T14:00:00Z: If
398−-- you don't pass the overflow=true parameter, you will get one schedule entry
399−-- returned with a start of 2011-06-01T10:00:00Z and end of 2011-06-01T14:00:00Z.
400−-- If you do pass the overflow=true parameter, you will get one schedule entry
401−-- returned with a start of 2011-06-01T00:00:00Z and end of 2011-06-02T00:00:00Z.
402−gseOverflow :: Lens' (Request GetScheduleEntries s b) Bool
403−gseOverflow = upd.gseOverflow'._B
404−
405−-- | Time zone in which dates in the result will be rendered.
406−--
407−-- Default: account time zone.
408−gseTimeZone :: Lens' (Request GetScheduleEntries s b) (Maybe TimeZone)
409−gseTimeZone = upd.gseTimeZone'.mapping _TZ
410−
411−-- | To filter the returned on-call schedule entries by a specific user, you
412−-- can optionally add the user_id parameter to the query.
413−gseUserId :: Lens' (Request GetScheduleEntries s b) (Maybe UserId)
414−gseUserId = upd.gseUserId'
415−
416−-- | List schedule entries that are active for a given time range for a
417−-- specified on-call schedule.
418−--
419−-- @GET \/schedules\/\:id\/entries@
420−--
421−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/entries>
422−getScheduleEntries :: UserId
423− -> Date -- ^ 'gseSince'
424− -> Date -- ^ 'gseUntil'
425− -> Request GetScheduleEntries s b
426−getScheduleEntries i s u =
427− mk GetScheduleEntries
428− { _gseSince' = s
429− , _gseUntil' = u
430− , _gseOverflow' = F
431− , _gseTimeZone' = Nothing
432− , _gseUserId' = Nothing
433− } & path .~ schedules % i
434−
435−data CreateSchedule = CreateSchedule
436− { _csName' :: Text
437− , _csOverflow' :: !Bool'
438− , _csTimeZone' :: TZ
439− , _csScheduleLayers' :: [ScheduleLayer]
440− } deriving (Eq, Show)
441−
442−makeLenses ''CreateSchedule
443−
444−instance ToJSON CreateSchedule where
445− toJSON cs = object
446− [ "name" .= _csName' cs
447− , "overflow" .= _csOverflow' cs
448− , "schedule" .= object
449− [ "time_zone" .= _csTimeZone' cs
450− , "schedule_layers" .= _csScheduleLayers' cs
451− ]
452− ]
453−
454−instance QueryLike CreateSchedule where
455− toQuery = const []
456−
457−-- | Any on-call schedule entries that pass the date range bounds will be
458−-- truncated at the bounds, unless 'csOverflow' is set to 'True'.
459−--
460−-- Default: 'False'.
461−csOverflow :: Lens' (Request CreateSchedule s b) Bool
462−csOverflow = upd.csOverflow'._B
463−
464−-- | The name of the schedule.
465−csName :: Lens' (Request CreateSchedule s b) Text
466−csName = upd.csName'
467−
468−-- | The time zone of the schedule.
469−--
470−-- Default: 'UTC'.
471−csTimeZone :: Lens' (Request CreateSchedule s b) TimeZone
472−csTimeZone = upd.csTimeZone'._TZ
473−
474−-- | A list of schedule layers.
475−csScheduleLayers :: Lens' (Request CreateSchedule s b) [ScheduleLayer]
476−csScheduleLayers = upd.csScheduleLayers'
477−
478−-- | Create a new on-call schedule.
479−--
480−-- @POST \/schedules@
481−--
482−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/create>
483−createSchedule :: Text -- ^ 'csName'
484− -> TimeZone -- ^ 'csTimeZone'
485− -> [ScheduleLayer] -- ^ 'csScheduleLayers'
486− -> Request CreateSchedule s Schedule
487−createSchedule n z ls =
488− mk CreateSchedule
489− { _csName' = n
490− , _csOverflow' = F
491− , _csTimeZone' = TZ z
492− , _csScheduleLayers' = ls
493− } & meth .~ POST
494− & path .~ schedules
495−
496−data UpdateSchedule = UpdateSchedule
497− { _usOverflow' :: !Bool'
498− , _usTimeZone' :: TZ
499− , _usScheduleLayers' :: [ScheduleLayer]
500− } deriving (Eq, Show)
501−
502−makeLenses ''UpdateSchedule
503−
504−instance ToJSON UpdateSchedule where
505− toJSON us = object
506− [ "overflow" .= _usOverflow' us
507− , "schedule" .= object
508− [ "time_zone" .= _usTimeZone' us
509− , "schedule_layers" .= _usScheduleLayers' us
510− ]
511− ]
512−
513−instance QueryLike UpdateSchedule where
514− toQuery = const []
515−
516−-- | Any on-call schedule entries that pass the date range bounds will be
517−-- truncated at the bounds, unless 'usOverflow' is set to 'True'.
518−--
519−-- Default: 'False'.
520−usOverflow :: Lens' (Request UpdateSchedule s b) Bool
521−usOverflow = upd.usOverflow'._B
522−
523−-- | The time zone of the schedule.
524−usTimeZone :: Lens' (Request UpdateSchedule s b) TimeZone
525−usTimeZone = upd.usTimeZone'._TZ
526−
527−-- | A list of schedule layers.
528−usScheduleLayers :: Lens' (Request UpdateSchedule s b) [ScheduleLayer]
529−usScheduleLayers = upd.usScheduleLayers'
530−
531−-- | Update an existing on-call schedule.
532−--
533−-- /Note:/ You cannot delete schedule layers. You must include all layers in
534−-- your update request. To delete a layer, set the end parameter to schedule its
535−-- termination.
536−--
537−-- @PUT \/schedules\/\:id@
538−--
539−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/update>
540−updateSchedule :: ScheduleId
541− -> TimeZone -- ^ 'usTimeZone'
542− -> [ScheduleLayer] -- ^ 'usScheduleLayers'
543− -> Request UpdateSchedule s Schedule
544−updateSchedule s z ls =
545− mk UpdateSchedule
546− { _usOverflow' = F
547− , _usTimeZone' = TZ z
548− , _usScheduleLayers' = ls
549− } & meth .~ PUT
550− & path .~ schedules % s
551−
552−data PreviewSchedule = PreviewSchedule
553− { _psSince' :: Maybe Date
554− , _psUntil' :: Maybe Date
555− , _psName' :: Text
556− , _psOverflow' :: !Bool'
557− , _psTimeZone' :: TZ
558− , _psScheduleLayers' :: [ScheduleLayer]
559− } deriving (Eq, Show)
560−
561−makeLenses ''PreviewSchedule
562−
563−instance ToJSON PreviewSchedule where
564− toJSON ps = object
565− [ "since" .= _psSince' ps
566− , "until" .= _psUntil' ps
567− , "name" .= _psName' ps
568− , "overflow" .= _psOverflow' ps
569− , "schedule" .= object
570− [ "time_zone" .= _psTimeZone' ps
571− , "schedule_layers" .= _psScheduleLayers' ps
572− ]
573− ]
574−
575−instance QueryLike PreviewSchedule where
576− toQuery = const []
577−
578−-- | The start of the date range over which you want to return on-call schedule
579−-- entries and on-call schedule layers.
580−psSince :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)
581−psSince = upd.psSince'.mapping _D
582−
583−-- | The end of the date range over which you want to return schedule entries
584−-- and on-call schedule layers.
585−psUntil :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)
586−psUntil = upd.psUntil'.mapping _D
587−
588−-- | Any on-call schedule entries that pass the date range bounds will be
589−-- truncated at the bounds, unless 'psOverflow' is set to 'True'.
590−--
591−-- Default: 'False'.
592−psOverflow :: Lens' (Request PreviewSchedule s b) Bool
593−psOverflow = upd.psOverflow'._B
594−
595−-- | The name of the schedule.
596−psName :: Lens' (Request PreviewSchedule s b) Text
597−psName = upd.psName'
598−
599−-- | The time zone of the schedule.
600−--
601−-- Default: 'UTC'.
602−psTimeZone :: Lens' (Request PreviewSchedule s b) TimeZone
603−psTimeZone = upd.psTimeZone'._TZ
604−
605−-- | A list of schedule layers.
606−psScheduleLayers :: Lens' (Request PreviewSchedule s b) [ScheduleLayer]
607−psScheduleLayers = upd.psScheduleLayers'
608−
609−-- | Preview what a schedule would look like without saving it. This work the
610−-- same as the update or create actions, except that the result is not
611−-- persisted. Preview optionally takes two additional arguments, since and until,
612−-- deliminating the span of the preview.
613−--
614−-- @POST \/schedules\/preview@
615−--
616−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/preview>
617−previewSchedule :: Text -- ^ 'psName'
618− -> TimeZone -- ^ 'psTimeZone'
619− -> [ScheduleLayer] -- ^ 'psScheduleLayers'
620− -> Request PreviewSchedule s Schedule
621−previewSchedule n z ls =
622− mk PreviewSchedule
623− { _psSince' = Nothing
624− , _psUntil' = Nothing
625− , _psName' = n
626− , _psOverflow' = F
627− , _psTimeZone' = TZ z
628− , _psScheduleLayers' = ls
629− } & meth .~ POST
630− & path .~ schedules % "preview"
631−
632−-- | Delete an on-call schedule.
633−--
634−-- @DELETE \/schedules\/\:id@
635−--
636−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/delete>
637−deleteSchedule :: ScheduleId -> Request Empty s Empty
638−deleteSchedule s = empty & meth .~ DELETE & path .~ schedules % s
src/Network/PagerDuty/REST/Schedules/Overrides.hsdeleted−188
@@ -1,188 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8−
9−-- Module : Network.PagerDuty.REST.Schedules
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−-- | Schedule overrides are custom, non-recurring exceptions to your regular
20−-- on-call schedules. Use them when your team members go on vacation, swap shifts,
21−-- or when you simply cannot achieve your normal scheduling with recurring layers.
22−--
23−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules>
24−module Network.PagerDuty.REST.Schedules.Overrides
25− (
26− -- * List Overrides
27− ListOverrides
28− , listOverrides
29− , lsSince
30− , lsUntil
31− , lsEditable
32− , lsOverflow
33−
34− -- * Create Override
35− , CreateOverride
36− , createOverride
37− , coUserId
38− , coStart
39− , coEnd
40−
41− -- * Delete Override
42− , deleteOverride
43−
44− -- * Types
45− , HasUserInfo (..)
46− , Override
47− , oId
48− , oStart
49− , oEnd
50− , oUser
51− ) where
52−
53−import Control.Lens
54−import Data.Time
55−import Network.HTTP.Types
56−import Network.PagerDuty.Internal.TH
57−import Network.PagerDuty.Internal.Types
58−import Network.PagerDuty.REST.Users
59−
60−overrides :: ScheduleId -> Path
61−overrides i = "schedules" % i % "overrides"
62−
63−data Override = Override
64− { _oId :: Maybe OverrideId
65− , _oStart :: Date
66− , _oEnd :: Date
67− , _oUser :: UserInfo
68− } deriving (Eq, Show)
69−
70−deriveRecord ''Override
71−
72−instance HasUserInfo Override where
73− userInfo = oUser
74−
75−data ListOverrides = ListOverrides
76− { _lsSince' :: Date
77− , _lsUntil' :: Date
78− , _lsEditable' :: Bool'
79− , _lsOverflow' :: Bool'
80− } deriving (Eq, Show)
81−
82−queryRequest ''ListOverrides
83−
84−-- | The start time of the date range you want to retrieve override for.
85−--
86−-- The maximum date range queryable is 3 months.
87−lsSince :: Lens' (Request ListOverrides s b) UTCTime
88−lsSince = upd.lsSince'._D
89−
90−-- | The end time of the date range you want to retrieve override for.
91−lsUntil :: Lens' (Request ListOverrides s b) UTCTime
92−lsUntil = upd.lsUntil'._D
93−
94−-- | When 'True', only editable overrides will be returned.
95−--
96−-- The result will onlyinclude the id the override if this parameter is present.
97−-- Only future overrides are editable.
98−--
99−-- /Default:/ 'False.'
100−lsEditable :: Lens' (Request ListOverrides s b) Bool
101−lsEditable = upd.lsEditable'._B
102−
103−-- | Any on-call schedule entries that pass the date range bounds will be
104−-- truncated at the bounds, unless @lsEditable .~ True@ is specified.
105−--
106−-- /Default:/ 'False.'
107−lsOverflow :: Lens' (Request ListOverrides s b) Bool
108−lsOverflow = upd.lsOverflow'._B
109−
110−-- | List overrides for a given time range.
111−--
112−-- @GET \/schedules\/\:schedule_id\/overrides@
113−--
114−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/list>
115−listOverrides :: ScheduleId
116− -> Date -- ^ 'lsSince'
117− -> Date -- ^ 'lsUntil'
118− -> Request ListOverrides s [Override]
119−listOverrides i s u =
120− mk ListOverrides
121− { _lsSince' = s
122− , _lsUntil' = u
123− , _lsEditable' = F
124− , _lsOverflow' = F
125− } & path .~ overrides i
126−
127−data CreateOverride = CreateOverride
128− { _coStart' :: Date
129− , _coEnd' :: Date
130− , _coUserId' :: UserId
131− } deriving (Eq, Show)
132−
133−jsonRequest ''CreateOverride
134−
135−-- | The start date and time for the override.
136−coStart :: Lens' (Request CreateOverride s b) UTCTime
137−coStart = upd.coStart'._D
138−
139−-- | The end date and time for the override.
140−coEnd :: Lens' (Request CreateOverride s b) UTCTime
141−coEnd = upd.coEnd'._D
142−
143−-- | The ID of the user who will be on call for the duration of the override.
144−coUserId :: Lens' (Request CreateOverride s b) UserId
145−coUserId = upd.coUserId'
146−
147−-- | Create an override for a specific user covering the specified time range. If
148−-- you create an override on top of an existing one, the last created override
149−-- will have priority.
150−--
151−-- If no time zone information is present in the since and until parameters, the
152−-- schedule's time zone will be used.
153−--
154−-- /Note:/ You cannot create overrides in the past.
155−--
156−-- @POST \/schedules\/\:schedule_id\/overrides@
157−--
158−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/create>
159−createOverride :: ScheduleId
160− -> UserId -- ^ 'coUserId'
161− -> Date -- ^ 'coStart'
162− -> Date -- ^ 'coEnd'
163− -> Request CreateOverride s Override
164−createOverride i u s e =
165− mk CreateOverride
166− { _coUserId' = u
167− , _coStart' = s
168− , _coEnd' = e
169− } & meth .~ POST
170− & path .~ overrides i
171−
172−-- | Remove an override.
173−--
174−-- You cannot remove a past override. If the override start
175−-- time is before the current time, but the end time is after the current time,
176−-- the override will be truncated to the current time. If the override is
177−-- truncated, the status code will be 200 OK, as opposed to a 204 No Content for a
178−-- successful delete.
179−--
180−-- @DELETE \/schedules\/\:schedule_id\/overrides\/\:id@
181−--
182−-- /See:/ <http://developer.pagerduty.com/documentation/rest/schedules/overrides/delete>
183−
184−-- FIXME: How to parse whether truncated or deleted?
185−deleteOverride :: ScheduleId -> OverrideId -> Request Empty s Empty
186−deleteOverride i o = empty
187− & meth .~ DELETE
188− & path .~ overrides i % o
src/Network/PagerDuty/REST/Services/EmailFilters.hsdeleted−180
@@ -1,180 +0,0 @@
1−{-# LANGUAGE ExtendedDefaultRules #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
6−
7−-- Module : Network.PagerDuty.REST.Services.EmailFilters
8−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9−-- License : This Source Code Form is subject to the terms of
10−-- the Mozilla Public License, v. 2.0.
11−-- A copy of the MPL can be found in the LICENSE file or
12−-- you can obtain it at http://mozilla.org/MPL/2.0/.
13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
14−-- Stability : experimental
15−-- Portability : non-portable (GHC extensions)
16−
17−-- | Email Filters are a set of rules that are applied to triggering email's body,
18−-- subject and from address. It only applies to generic_email kind of
19−-- Services. The way multiple filters are combined depends on the
20−-- email_filter_mode attribute of the service.
21−--
22−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters>
23−module Network.PagerDuty.REST.Services.EmailFilters
24− (
25− -- * Create Email Filter
26− createEmailFilter
27−
28− -- * Update Email Filter
29− , updateEmailFilter
30−
31− -- * Delete Email Filter
32− , deleteEmailFilter
33−
34− -- * Types
35− , MatchMode (..)
36− , HasEmailFilterInfo (..)
37− , EmailFilterInfo
38− , EmailFilter
39− , efId
40− ) where
41−
42−import Control.Applicative hiding (empty)
43−import Control.Lens hiding ((.=))
44−import Data.Aeson
45−import Data.Default.Class
46−import Data.Monoid
47−import Data.Text (Text)
48−import Network.HTTP.Types
49−import Network.PagerDuty.Internal.TH
50−import Network.PagerDuty.Internal.Types
51−
52−default (Path)
53−
54−filters :: ServiceId -> Path
55−filters s = "services" % s % "email_filters"
56−
57−data MatchMode
58− = Always
59− | Match
60− | NoMatch
61− deriving (Eq, Show)
62−
63−deriveNullaryWith hyphenated ''MatchMode
64−
65−-- FIXME: Tighten up this type! Make the regex required for match/no-match and
66−-- encode the conditional invariants.
67−data EmailFilterInfo = EmailFilterInfo
68− { _efSubjectMode' :: Maybe MatchMode
69− , _efSubjectRegex' :: Maybe Text
70− , _efBodyMode' :: Maybe MatchMode
71− , _efBodyRegex' :: Maybe Text
72− , _efFromEmailMode' :: Maybe MatchMode
73− , _efFromEmailRegex' :: Maybe Text
74− } deriving (Eq, Show)
75−
76−deriveRecord ''EmailFilterInfo
77−
78−instance Default EmailFilterInfo where
79− def = EmailFilterInfo Nothing Nothing Nothing Nothing Nothing Nothing
80−
81−instance QueryLike EmailFilterInfo where
82− toQuery = const []
83−
84−class HasEmailFilterInfo a where
85− emailFilterInfo :: Lens' a EmailFilterInfo
86−
87− -- | One of always, match, no-match, which, respectively, means to not
88− -- filter the email trigger by subject, filter it if the email subject
89− -- matches the given regex, or filter if it doesn't match the given regex.
90− --
91− -- /Default:/ always.
92− efSubjectMode :: Lens' a (Maybe MatchMode)
93−
94− -- | The regex to be used when subject_mode is match or no-match.
95− -- It is a required parameter on such cases.
96− efSubjectRegex :: Lens' a (Maybe Text)
97−
98− -- | One of always, match, no-match, which, respectively, means to not filter
99− -- the email trigger by body, filter it if the body email matches the given
100− -- regex, or filter if it doesn't match the given regex.
101− --
102− -- /Default:/ always.
103− efBodyMode :: Lens' a (Maybe MatchMode)
104−
105− -- | The regex to be used when body_mode is match or no-match.
106− -- It is a required parameter on such cases.
107− efBodyRegex :: Lens' a (Maybe Text)
108−
109− -- | One of always, match, no-match, which, respectively, means to not filter
110− -- the email trigger by its from address, filter it if the email from address
111− -- matches the given regex, or filter if it doesn't match the given regex.
112− --
113− -- /Default:/ always.
114− efFromEmailMode :: Lens' a (Maybe MatchMode)
115−
116− -- | The regex to be used when from_email_mode is match or no-match.
117− -- It is a required parameter on such cases.
118− efFromEmailRegex :: Lens' a (Maybe Text)
119−
120− efSubjectMode = emailFilterInfo.efSubjectMode'
121− efSubjectRegex = emailFilterInfo.efSubjectRegex'
122− efBodyMode = emailFilterInfo.efBodyMode'
123− efBodyRegex = emailFilterInfo.efBodyRegex'
124− efFromEmailMode = emailFilterInfo.efFromEmailMode'
125− efFromEmailRegex = emailFilterInfo.efFromEmailRegex'
126−
127−instance (QueryLike a, ToJSON a, HasEmailFilterInfo a)
128− => HasEmailFilterInfo (Request a s b) where
129− emailFilterInfo = upd.emailFilterInfo
130−
131−instance HasEmailFilterInfo EmailFilterInfo where
132− emailFilterInfo = id
133−
134−data EmailFilter = EmailFilter
135− { _efId :: EmailFilterId
136− , _efInfo :: EmailFilterInfo
137− } deriving (Eq, Show)
138−
139−instance FromJSON EmailFilter where
140− parseJSON = withObject "email_filter" $ \o ->
141− EmailFilter <$> parseJSON (Object o)
142− <*> o .: "id"
143−
144−instance ToJSON EmailFilter where
145− toJSON e = Object (x <> y)
146− where
147− Object x = toJSON (_efInfo e)
148− Object y = object ["id" .= _efId e]
149−
150−instance HasEmailFilterInfo EmailFilter where
151− emailFilterInfo = lens _efInfo (\e x -> e { _efInfo = x })
152−
153−-- | The email filter ID.
154−makeLens "_efId" ''EmailFilter
155−
156−-- | Create a new Email Filter for the specified service.
157−--
158−-- @POST \/services\/\:service_id\/email_filters@
159−--
160−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/create>
161−createEmailFilter :: ServiceId -> Request EmailFilterInfo s EmailFilter
162−createEmailFilter s = mk def & meth .~ POST & path .~ filters s
163−
164−-- | Update an existing Email Filter.
165−--
166−-- @PUT \/services\/\:service_id\/email_filters\/\:id@
167−--
168−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/update>
169−updateEmailFilter :: ServiceId
170− -> EmailFilterId
171− -> Request EmailFilterInfo s Empty
172−updateEmailFilter s e = mk def & meth .~ PUT & path .~ filters s % e
173−
174−-- | Delete an existing Email Filter.
175−--
176−-- @DELETE \/services\/\:service_id\/email_filters\/\:id@
177−--
178−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/email_filters/delete>
179−deleteEmailFilter :: ServiceId -> EmailFilterId -> Request Empty s Empty
180−deleteEmailFilter s e = empty & meth .~ DELETE & path .~ filters s % e
src/Network/PagerDuty/REST/Users.hsdeleted−384
@@ -1,384 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6−
7−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8−
9−-- Module : Network.PagerDuty.REST.Users
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
11−-- License : This Source Code Form is subject to the terms of
12−-- the Mozilla Public License, v. 2.0.
13−-- A copy of the MPL can be found in the LICENSE file or
14−-- you can obtain it at http://mozilla.org/MPL/2.0/.
15−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
16−-- Stability : experimental
17−-- Portability : non-portable (GHC extensions)
18−
19−-- | Access and manipulate user data for your PagerDuty account. When a user is
20−-- shown inlined in other resources, a deleted user will have its @html_url@ attribute
21−-- set to null.
22−--
23−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users>
24−module Network.PagerDuty.REST.Users
25− (
26− -- * List Users
27− ListUsers
28− , listUsers
29− , luQuery
30−
31− -- * List On Call Users
32− , listOnCallUsers
33−
34− -- * Create User
35− , CreateUser
36− , createUser
37− , cuName
38− , cuEmail
39− , cuRole
40− , cuJobTitle
41− , cuTimeZone
42−
43− -- * Get User
44− , getUser
45−
46− -- * Get User On Call
47− , getUserOnCall
48−
49− -- * Update User
50− , UpdateUser
51− , updateUser
52− , uuName
53− , uuEmail
54− , uuRole
55− , uuJobTitle
56− , uuTimeZone
57−
58− -- * Delete User
59− , deleteUser
60−
61− -- * Types
62− , PolicyInfo
63− , piId
64− , piName
65−
66− , OnCall
67− , ocLevel
68− , ocStart
69− , ocEnd
70− , ocEscalationPolicy
71−
72− , Role (..)
73−
74− , HasUserInfo (..)
75− , UserInfo
76− , User
77− , uRole
78− , uAvatarUrl
79− , uUserUrl
80− , uInvitationSent
81− , uJobTitle
82− ) where
83−
84−import Control.Applicative hiding (empty)
85−import Control.Lens hiding (Empty, (.=))
86−import Data.Aeson
87−import Data.Default.Class
88−import Data.Monoid
89−import Data.Text (Text)
90−import Data.Time
91−import Network.HTTP.Types
92−import Network.PagerDuty.Internal.TH
93−import Network.PagerDuty.Internal.Types
94−
95−default (Path)
96−
97−users :: Path
98−users = "users"
99−
100−includes :: Query
101−includes =
102− [ ("include[]", Just "contact_methods")
103− , ("include[]", Just "notification_rules")
104− ]
105−
106−data UserInfo = UserInfo
107− { _uId' :: UserId
108− , _uName' :: Text
109− , _uEmail' :: Address
110− , _uColor' :: Text
111− , _uTimeZone' :: TZ
112− } deriving (Eq, Show)
113−
114−deriveRecord ''UserInfo
115−
116−class HasUserInfo a where
117− userInfo :: Lens' a UserInfo
118−
119− -- | The id of the user.
120− uId :: Lens' a UserId
121−
122− -- | The name of the user.
123− uName :: Lens' a Text
124−
125− -- | The user's email address.
126− uEmail :: Lens' a Address
127−
128− -- | The color used to represent the user in schedules.
129− uColor :: Lens' a Text
130−
131− -- | The user's personal time zone.
132− uTimeZone :: Lens' a TimeZone
133−
134− uId = userInfo.uId'
135− uName = userInfo.uName'
136− uEmail = userInfo.uEmail'
137− uColor = userInfo.uColor'
138− uTimeZone = userInfo.uTimeZone'._TZ
139−
140−instance (QueryLike a, ToJSON a, HasUserInfo a)
141− => HasUserInfo (Request a s b) where
142− userInfo = upd.userInfo
143−
144−instance HasUserInfo UserInfo where
145− userInfo = id
146−
147−data PolicyInfo = PolicyInfo
148− { _piId :: EscalationPolicyId
149− , _piName :: Text
150− } deriving (Eq, Show)
151−
152−deriveRecord ''PolicyInfo
153−
154−data OnCall = OnCall
155− { _ocLevel :: !Int
156− , _ocStart :: Maybe Date
157− , _ocEnd :: Maybe Date
158− , _ocEscalationPolicy :: PolicyInfo
159− } deriving (Eq, Show)
160−
161−deriveRecord ''OnCall
162−
163−data Role
164− = RoleAdmin
165− | RoleUser
166− | RoleLimitedUser
167− deriving (Eq, Show)
168−
169−deriveNullaryWith (dropped 4 underscored) ''Role
170−
171−instance Default Role where
172− def = RoleUser
173−
174−data User = User
175− { _uInfo :: UserInfo
176− , _uRole :: !Role
177− , _uAvatarUrl :: Text
178− , _uUserUrl :: Text
179− , _uInvitationSent' :: !Bool'
180− , _uJobTitle :: Maybe Text
181− } deriving (Eq, Show)
182−
183− -- FIXME: add notification_rules, contact_methods, on_call
184−
185−makeLenses ''User
186−
187−instance FromJSON User where
188− parseJSON = withObject "user" $ \o ->
189− User <$> parseJSON (Object o)
190− <*> o .: "role"
191− <*> o .: "avatar_url"
192− <*> o .: "user_url"
193− <*> o .: "invitation_sent"
194− <*> o .:? "job_title"
195−
196−instance ToJSON User where
197− toJSON u = Object (x <> y)
198− where
199− Object x = toJSON (_uInfo u)
200− Object y = object
201− [ "role" .= _uRole u
202− , "avatar_url" .= _uAvatarUrl u
203− , "user_url" .= _uUserUrl u
204− , "invitation_sent" .= _uInvitationSent' u
205− , "job_title" .= _uJobTitle u
206− ]
207−
208−instance HasUserInfo User where
209− userInfo = uInfo
210−
211−uInvitationSent :: Lens' User Bool
212−uInvitationSent = uInvitationSent'._B
213−
214−newtype ListUsers = ListUsers
215− { _luQuery' :: Maybe Text
216− }
217−
218−queryRequest ''ListUsers
219−
220−instance Paginate ListUsers
221−
222−-- | Filters the result, showing only the users whose names or email addresses
223−-- match the query.
224−luQuery :: Lens' (Request ListUsers s b) (Maybe Text)
225−luQuery = upd.luQuery'
226−
227−-- | List users of your PagerDuty account, optionally filtered by a search query.
228−--
229−-- @GET \/users@
230−--
231−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/list>
232−listUsers :: Request ListUsers s [User]
233−listUsers =
234− mk ListUsers
235− { _luQuery' = Nothing
236− } & path .~ users
237− & query .~ includes
238−
239−-- | List all the existing escalation policies with currently on-call users.
240−--
241−-- If the start and end of an on-call object are null, then the user is always
242−-- on-call for an escalation policy level.
243−--
244−-- @GET \/escalation_policies\/on_call@
245−--
246−-- /See:/ <http://developer.pagerduty.com/documentation/rest/escalation_policies/on_call>
247−listOnCallUsers :: Request ListUsers s [User]
248−listOnCallUsers = listUsers & path .~ users % "on_call"
249−
250−-- | Get information about an existing user.
251−--
252−-- @GET \/users\/\:id@
253−--
254−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/show>
255−getUser :: UserId -> Request Empty s User
256−getUser u = empty & path .~ users % u & query .~ includes
257−
258−-- | Get a user object with that user's current on-call status. If the on-call
259−-- object is an empty list, the user is never on-call.
260−--
261−-- If the start and end of an on-call object are null, then the user is always
262−-- on-call for an escalation policy level.
263−--
264−-- @GET \/users\/\:id\/on_call@
265−--
266−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/show_on_call>
267−getUserOnCall :: UserId -> Request Empty s User
268−getUserOnCall u = empty & path .~ users % u % "on_call" & query .~ includes
269−
270−data CreateUser = CreateUser
271− { _cuName' :: Text
272− , _cuEmail' :: Address
273− , _cuRole' :: Maybe Role
274− , _cuJobTitle' :: Maybe Text
275− , _cuTimeZone' :: Maybe TZ
276− } deriving (Eq, Show)
277−
278−jsonRequest ''CreateUser
279−
280−-- | The name of the user.
281−cuName :: Lens' (Request CreateUser s b) Text
282−cuName = upd.cuName'
283−
284−-- | The email of the user. The newly created user will receive an email asking
285−-- to confirm the subscription.
286−cuEmail :: Lens' (Request CreateUser s b) Address
287−cuEmail = upd.cuEmail'
288−
289−-- | The user's role.
290−cuRole :: Lens' (Request CreateUser s b) (Maybe Role)
291−cuRole = upd.cuRole'
292−
293−-- | The job title of the user.
294−cuJobTitle :: Lens' (Request CreateUser s b) (Maybe Text)
295−cuJobTitle = upd.cuJobTitle'
296−
297−-- | The time zone the user is in. If not specified, the time zone of the
298−-- account making the API call will be used.
299−cuTimeZone :: Lens' (Request CreateUser s b) (Maybe TimeZone)
300−cuTimeZone = upd.cuTimeZone'.mapping _TZ
301−
302−-- | Create a new user for your account. An invite email will be sent asking
303−-- the user to choose a password.
304−--
305−-- @POST \/users@
306−--
307−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/create>
308−createUser :: RequesterId
309− -> Text -- ^ 'cuName'
310− -> Address -- ^ 'cuEmail'
311− -> Request CreateUser s User
312−createUser r n e = auth (createUserBasic n e) & query .~ [("requester_id", r)]
313−
314−-- | A version of 'disableService' which uses HTTP Basic authentication and
315−-- doesn't require a 'RequesterId'.
316−createUserBasic :: Text -- ^ 'cuName'
317− -> Address -- ^ 'cuEmail'
318− -> Request CreateUser 'Basic User
319−createUserBasic n e =
320− mk CreateUser
321− { _cuName' = n
322− , _cuEmail' = e
323− , _cuRole' = Nothing
324− , _cuJobTitle' = Nothing
325− , _cuTimeZone' = Nothing
326− } & meth .~ POST
327− & path .~ users
328−
329−data UpdateUser = UpdateUser
330− { _uuName' :: Maybe Text
331− , _uuEmail' :: Maybe Address
332− , _uuRole' :: Maybe Role
333− , _uuJobTitle' :: Maybe Text
334− , _uuTimeZone' :: Maybe TZ
335− } deriving (Eq, Show)
336−
337−jsonRequest ''UpdateUser
338−
339−-- | The name of the user.
340−uuName :: Lens' (Request UpdateUser s b) (Maybe Text)
341−uuName = upd.uuName'
342−
343−-- | The email of the user. The newly created user will receive an email asking
344−-- to confirm the subscription.
345−uuEmail :: Lens' (Request UpdateUser s b) (Maybe Address)
346−uuEmail = upd.uuEmail'
347−
348−-- | The user's role.
349−uuRole :: Lens' (Request UpdateUser s b) (Maybe Role)
350−uuRole = upd.uuRole'
351−
352−-- | The job title of the user.
353−uuJobTitle :: Lens' (Request UpdateUser s b) (Maybe Text)
354−uuJobTitle = upd.uuJobTitle'
355−
356−-- | The time zone the user is in. If not specified, the time zone of the
357−-- account making the API call will be used.
358−uuTimeZone :: Lens' (Request UpdateUser s b) (Maybe TimeZone)
359−uuTimeZone = upd.uuTimeZone'.mapping _TZ
360−
361−-- | Update an existing user.
362−--
363−-- @PUT \/users\/\:id@
364−--
365−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/update>
366−updateUser :: UserId -> Request UpdateUser s User
367−updateUser u =
368− mk UpdateUser
369− { _uuName' = Nothing
370− , _uuEmail' = Nothing
371− , _uuRole' = Nothing
372− , _uuJobTitle' = Nothing
373− , _uuTimeZone' = Nothing
374− } & meth .~ PUT
375− & path .~ users % u
376−
377−-- | Remove an existing user.
378−--
379−-- @DELETE \/users\/\:id@
380−--
381−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/delete>
382−deleteUser :: UserId -> Request Empty s Empty
383−deleteUser u = empty & meth .~ DELETE & path .~ users % u
384−-- FIXME: deal with conflict errors
src/Network/PagerDuty/REST/Users/ContactMethods.hsdeleted−236
@@ -1,236 +0,0 @@
1−{-# LANGUAGE ExtendedDefaultRules #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
6−
7−-- Module : Network.PagerDuty.REST.Users.ContactMethods
8−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9−-- License : This Source Code Form is subject to the terms of
10−-- the Mozilla Public License, v. 2.0.
11−-- A copy of the MPL can be found in the LICENSE file or
12−-- you can obtain it at http://mozilla.org/MPL/2.0/.
13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
14−-- Stability : experimental
15−-- Portability : non-portable (GHC extensions)
16−
17−-- | Contact methods describe the various channels (phone numbers, SMS numbers
18−-- and email addresses) used to contact a user when an incident is assigned to
19−-- the user.
20−--
21−-- Access and manipulate the contact methods for a user.
22−--
23−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods>
24−module Network.PagerDuty.REST.Users.ContactMethods
25− (
26− -- * List Contacts
27− listContacts
28−
29− -- * Create Contact
30− , CreateContact
31− , createContact
32− , ccType
33− , ccAddress
34− , ccCountryCode
35− , ccLabel
36− , ccSendShortEmail
37−
38− -- * Get Contact
39− , getContact
40−
41− -- * Update Contact
42− , UpdateContact
43− , updateContact
44− , ucAddress
45− , ucCountryCode
46− , ucLabel
47− , ucSendShortEmail
48−
49− -- * Delete Contact
50− , deleteContact
51−
52− -- * Types
53− , ContactType (..)
54−
55− , HasContact (..)
56− , Contact
57− ) where
58−
59−import Control.Lens
60−import Data.Aeson.Lens
61−import Data.Text (Text)
62−import Network.HTTP.Types
63−import Network.PagerDuty.Internal.TH
64−import Network.PagerDuty.Internal.Types
65−
66−default (Path)
67−
68−contacts :: UserId -> Path
69−contacts u = "users" % u % "contact_methods"
70−
71−data ContactType
72− = SMS
73− | Phone
74− | Email
75− deriving (Eq, Show)
76−
77−deriveNullary ''ContactType
78−
79−data Contact = Contact
80− { _cId :: ContactId
81− , _cUserId :: UserId
82− , _cLabel :: Text
83− , _cAddress :: Address
84− , _cType :: !ContactType
85− , _cCountryCode :: Maybe Int
86− , _cSendShortEmail :: Maybe Bool'
87− , _cBlacklisted :: Maybe Bool'
88− } deriving (Eq, Show)
89−
90−deriveJSON ''Contact
91−makeClassy ''Contact
92−
93−-- | List existing contact methods for the specified user.
94−--
95−-- @GET \/users\/\:user_id\/contact_methods@
96−--
97−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/list>
98−listContacts :: UserId -> Request Empty s [Contact]
99−listContacts u = empty & path .~ contacts u
100−
101−-- | Get details for a contact method.
102−--
103−-- @GET \/users\/\:user_id\/contact_methods\/\:id@
104−--
105−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/show>
106−getContact :: UserId -> ContactId -> Request Empty s Contact
107−getContact u c = empty & path .~ contacts u % c
108−
109−data CreateContact = CreateContact
110− { _ccType' :: !ContactType
111− , _ccAddress' :: Address
112− , _ccCountryCode' :: Maybe Int
113− , _ccLabel' :: Maybe Text
114− , _ccSendShortEmail' :: Maybe Bool'
115− } deriving (Eq, Show)
116−
117−jsonRequest ''CreateContact
118−
119−-- | The type of the contact method.
120−ccType :: Lens' (Request CreateContact s b) ContactType
121−ccType = upd.ccType'
122−
123−-- | The id of the contact method. For 'SMS' and 'Phone' it is the number, and for
124−-- 'Email' it is the email address.
125−ccAddress :: Lens' (Request CreateContact s b) Address
126−ccAddress = upd.ccAddress'
127−
128−-- | The number code for your country. Not used for 'Email'.
129−--
130−-- /Default:/ 1
131−ccCountryCode :: Lens' (Request CreateContact s b) (Maybe Int)
132−ccCountryCode = upd.ccCountryCode'
133−
134−-- | A human friendly label for the contact method.
135−--
136−-- /Example:/ "Home Phone", "Work Email", etc.
137−--
138−-- /Default:/ The type of the contact method and the address (with country code
139−-- for phone numbers).
140−ccLabel :: Lens' (Request CreateContact s b) (Maybe Text)
141−ccLabel = upd.ccLabel'
142−
143−-- | Send an abbreviated email message instead of the standard email
144−-- output. Useful for email-to-SMS gateways and email based pagers. Only valid for
145−-- 'Email' contact methods.
146−--
147−-- /Default:/ false.
148−ccSendShortEmail :: Lens' (Request CreateContact s b) (Maybe Bool)
149−ccSendShortEmail = upd.ccSendShortEmail'.mapping _B
150−
151−-- | Create a new contact method for a given user. A contact method can be one
152−-- of the following types: SMS, email, and phone. push_notification contact
153−-- methods cannot be created using this API, they are added automatically during
154−-- device registration.
155−--
156−-- @POST \/users\/\:user_id\/contact_methods@
157−--
158−-- /Note:/ The contact info must be unique.
159−--
160−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/create>
161−createContact :: UserId
162− -> ContactType
163− -> Address
164− -> Request CreateContact s Contact
165−createContact u t a =
166− mk CreateContact
167− { _ccType' = t
168− , _ccAddress' = a
169− , _ccCountryCode' = Nothing
170− , _ccLabel' = Nothing
171− , _ccSendShortEmail' = Nothing
172− } & meth .~ POST
173− & path .~ contacts u
174− & unwrap .~ key "contact_method"
175−
176−data UpdateContact = UpdateContact
177− { _ucAddress' :: Maybe Address
178− , _ucCountryCode' :: Maybe Int
179− , _ucLabel' :: Maybe Text
180− , _ucSendShortEmail' :: Maybe Bool'
181− } deriving (Eq, Show)
182−
183−jsonRequest ''UpdateContact
184−
185−-- | The id of the contact method. For 'SMS' and 'Phone' it is the number, and for
186−-- 'Email' it is the email address.
187−ucAddress :: Lens' (Request UpdateContact s b) (Maybe Address)
188−ucAddress = upd.ucAddress'
189−
190−-- | The number code for your country. Not used for 'Email'.
191−--
192−-- /Default:/ 1
193−ucCountryCode :: Lens' (Request UpdateContact s b) (Maybe Int)
194−ucCountryCode = upd.ucCountryCode'
195−
196−-- | A human friendly label for the contact method.
197−--
198−-- /Example:/ "Home Phone", "Work Email", etc.
199−--
200−-- /Default:/ The type of the contact method and the address (with country code
201−-- for phone numbers).
202−ucLabel :: Lens' (Request UpdateContact s b) (Maybe Text)
203−ucLabel = upd.ucLabel'
204−
205−-- | Send an abbreviated email message instead of the standard email
206−-- output. Useful for email-to-SMS gateways and email based pagers. Only valid for
207−-- 'Email' contact methods.
208−--
209−-- /Default:/ false.
210−ucSendShortEmail :: Lens' (Request UpdateContact s b) (Maybe Bool)
211−ucSendShortEmail = upd.ucSendShortEmail'.mapping _B
212−
213−-- | Update an existing contact method of a given user. Note that you cannot
214−-- change the type of an existing method.
215−--
216−-- @PUT \/users\/\:user_id\/contact_methods\/\:id@
217−--
218−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/update>
219−updateContact :: UserId -> ContactId -> Request UpdateContact s Contact
220−updateContact u c =
221− mk UpdateContact
222− { _ucAddress' = Nothing
223− , _ucCountryCode' = Nothing
224− , _ucLabel' = Nothing
225− , _ucSendShortEmail' = Nothing
226− } & meth .~ PUT
227− & path .~ contacts u % c
228− & unwrap .~ key "contact_method"
229−
230−-- | Remove a contact method and any corresponding notification rules.
231−--
232−-- @DELETE \/users\/\:user_id\/contact_methods\/\:id@
233−--
234−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/contact_methods/delete>
235−deleteContact :: UserId -> ContactId -> Request Empty s Empty
236−deleteContact u c = empty & meth .~ DELETE & path .~ contacts u % c
src/Network/PagerDuty/REST/Users/NotificationRules.hsdeleted−164
@@ -1,164 +0,0 @@
1−{-# LANGUAGE ExtendedDefaultRules #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−{-# OPTIONS_GHC -fno-warn-type-defaults #-}
6−
7−-- Module : Network.PagerDuty.REST.Users.NotificationRules
8−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9−-- License : This Source Code Form is subject to the terms of
10−-- the Mozilla Public License, v. 2.0.
11−-- A copy of the MPL can be found in the LICENSE file or
12−-- you can obtain it at http://mozilla.org/MPL/2.0/.
13−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
14−-- Stability : experimental
15−-- Portability : non-portable (GHC extensions)
16−
17−-- | When a user is assigned an incident, the user's notification rules are
18−-- used to determine which contact method will be used to alert the user and how
19−-- long after the incident to do so.
20−--
21−-- Access and manipulate the notification rules for a user.
22−--
23−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules>
24−module Network.PagerDuty.REST.Users.NotificationRules
25− (
26− -- * List Rules
27− listRules
28−
29− -- * Create Rule
30− , CreateRule
31− , createRule
32− , crStartDelayInMinutes
33− , crContactMethodId
34−
35− -- * Get Rule
36− , getRule
37−
38− -- * Update Rule
39− , UpdateRule
40− , updateRule
41− , urStartDelayInMinutes
42− , urContactMethodId
43−
44− -- * Delete Rule
45− , deleteRule
46−
47− -- * Types
48− , Rule
49− , rId
50− , rStartDelayInMinutes
51− , rContactMethod
52− ) where
53−
54−import Control.Lens
55−import Data.Aeson.Lens
56−import Network.HTTP.Types
57−import Network.PagerDuty.Internal.TH
58−import Network.PagerDuty.Internal.Types
59−import Network.PagerDuty.REST.Users.ContactMethods
60−
61−default (Path)
62−
63−rules :: UserId -> Path
64−rules u = "users" % u % "notification_rules"
65−
66−data Rule = Rule
67− { _rId :: NotificationRuleId
68− , _rStartDelayInMinutes :: !Int
69− , _rContactMethod :: Contact
70− } deriving (Eq, Show)
71−
72−deriveJSON ''Rule
73−makeLenses ''Rule
74−
75−instance HasContact Rule where
76− contact = rContactMethod
77−
78−-- | List existing notification rules for the specified user.
79−--
80−-- @GET \/users\/\:user_id\/notification_rules@
81−--
82−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/list>
83−listRules :: UserId -> Request Empty s Rule
84−listRules u = empty & path .~ rules u
85−
86−-- | Get details for a notification rule.
87−--
88−-- @GET \/users\/\:user_id\/notification_rules\/\:id@
89−--
90−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/show>
91−getRule :: UserId -> NotificationRuleId -> Request Empty s Rule
92−getRule u n = empty & path .~ rules u % n
93−
94−data CreateRule = CreateRule
95− { _crStartDelayInMinutes' :: !Int
96− , _crContactMethodId' :: ContactId
97− } deriving (Eq, Show)
98−
99−jsonRequest ''CreateRule
100−
101−-- | Number of minutes it will take for the notification rule to be activated
102−-- (from the time the incident is assigned to the owning user) and an alert be
103−-- fired.
104−crStartDelayInMinutes :: Lens' (Request CreateRule s b) Int
105−crStartDelayInMinutes = upd.crStartDelayInMinutes'
106−
107−-- | The id of the contact method.
108−crContactMethodId :: Lens' (Request CreateRule s b) ContactId
109−crContactMethodId = upd.crContactMethodId'
110−
111−-- | Create a new notification rule for the specified user.
112−--
113−-- @POST \/users\/\:user_id\/notification_rules@
114−--
115−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/create>
116−createRule :: UserId -> ContactId -> Int -> Request CreateRule s Rule
117−createRule u c n =
118− mk CreateRule
119− { _crStartDelayInMinutes' = n
120− , _crContactMethodId' = c
121− } & meth .~ POST
122− & path .~ rules u
123− & unwrap .~ key "notification_rule"
124−
125−data UpdateRule = UpdateRule
126− { _urStartDelayInMinutes' :: Maybe Int
127− , _urContactMethodId' :: Maybe ContactId
128− } deriving (Eq, Show)
129−
130−jsonRequest ''UpdateRule
131−
132−-- | Number of minutes it will take for the notification rule to be activated
133−-- (from the time the incident is assigned to the owning user) and an alert be
134−-- fired.
135−urStartDelayInMinutes :: Lens' (Request UpdateRule s b) (Maybe Int)
136−urStartDelayInMinutes = upd.urStartDelayInMinutes'
137−
138−-- | The id of the contact method.
139−urContactMethodId :: Lens' (Request UpdateRule s b) (Maybe ContactId)
140−urContactMethodId = upd.urContactMethodId'
141−
142−-- | Update an existing notification rule.
143−--
144−-- @PUT \/users\/\:user_id\/notification_rules\/\:id@
145−--
146−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/update>
147−updateRule :: UserId -> NotificationRuleId -> Request UpdateRule s Rule
148−updateRule u r =
149− mk UpdateRule
150− { _urStartDelayInMinutes' = Nothing
151− , _urContactMethodId' = Nothing
152− } & meth .~ PUT
153− & path .~ rules u % r
154− & unwrap .~ key "notification_rule"
155−
156−-- | Remove a notification rule.
157−--
158−-- @DELETE \/users\/\:user_id\/notification_rules\/\:id@
159−--
160−-- /See:/ <http://developer.pagerduty.com/documentation/rest/users/notification_rules/delete>
161−deleteRule :: UserId
162− -> NotificationRuleId
163− -> Request Empty s Empty
164−deleteRule u n = empty & meth .~ DELETE & path .~ rules u % n
src/Network/PagerDuty/REST/Webhooks.hsdeleted−116
@@ -1,116 +0,0 @@
1−{-# LANGUAGE LambdaCase #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−-- Module : Network.PagerDuty.REST.Webhooks
6−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
7−-- License : This Source Code Form is subject to the terms of
8−-- the Mozilla Public License, v. 2.0.
9−-- A copy of the MPL can be found in the LICENSE file or
10−-- you can obtain it at http://mozilla.org/MPL/2.0/.
11−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12−-- Stability : experimental
13−-- Portability : non-portable (GHC extensions)
14−
15−-- | Webhooks let you recieve HTTP callbacks when interesting events happen within
16−-- your PagerDuty account. Details surrounding the interesting event will be sent
17−-- via HTTP to a URL that you specify.
18−--
19−-- PagerDuty currently supports incident-based webhooks. After adding a webhook
20−-- URL to a PagerDuty service, the triggering of new incidents on that service
21−-- will cause outgoing webhook messages to be sent to that URL. In addition,
22−-- certain interesting changes to an incident's state will cause other types of
23−-- incident webhook messages to be sent: Generally, any change to the @status@ or
24−-- @assigned_to_user@ of an incident will cause an outgoing message to be sent.
25−--
26−-- /See:/ <http://developer.pagerduty.com/documentation/rest/webhooks>
27−module Network.PagerDuty.REST.Webhooks
28− ( WebhookType (..)
29− , Webhook
30− , wId
31− , wType
32− , wCreatedOn
33− ) where
34−
35−import Control.Applicative hiding (empty)
36−import Control.Lens
37−import Data.Aeson
38−import Data.ByteString.Conversion (ToByteString (..),
39− toByteString')
40−import Data.Text (Text)
41−import qualified Data.Text.Encoding as Text
42−import Data.Time
43−import Network.PagerDuty.Internal.TH
44−import Network.PagerDuty.Internal.Types
45−import Network.PagerDuty.REST.Incidents
46−
47−data WebhookType
48− = WTrigger
49− -- ^ Sent when an incident is newly created/triggered.
50− | WAcknowledge
51− -- ^ Sent when an incident has had its status changed from triggered to
52− -- acknowledged.
53− | WUnacknowledge
54− -- ^ Sent when an incident is unacknowledged due to timeout.
55− | WResolve
56− -- ^ Sent when an incident has been resolved.
57− | WAssign
58− -- ^ Sent when an incident has been manually reassigned to another user
59− -- in a different escalation chain.
60− | WEscalate
61− -- ^ Sent when an incident has been escalated to another user in the
62− -- same escalation chain.
63− | WDelegate
64− -- ^ Sent when an incident has been reassigned to another escalation chain.
65− | WOther Text
66− -- ^ /Note:/ As new types of incident actions are supported,
67− -- new incident webhook message types will be added.
68− deriving (Eq, Show)
69−
70−instance ToByteString WebhookType where
71− builder = \case
72− WTrigger -> "incident.trigger"
73− WAcknowledge -> "incident.acknowledge"
74− WUnacknowledge -> "incident.unacknowledge"
75− WResolve -> "incident.resolve"
76− WAssign -> "incident.assign"
77− WEscalate -> "incident.escalate"
78− WDelegate -> "incident.delegate"
79− WOther t -> builder t
80−
81−instance FromJSON WebhookType where
82− parseJSON = withText "status" $ pure . \case
83− "incident.trigger" -> WTrigger
84− "incident.acknowledge" -> WAcknowledge
85− "incident.unacknowledge" -> WUnacknowledge
86− "incident.resolve" -> WResolve
87− "incident.assign" -> WAssign
88− "incident.escalate" -> WEscalate
89− "incident.delegate" -> WDelegate
90− t -> (WOther t)
91−
92−instance ToJSON WebhookType where
93− toJSON = String . Text.decodeUtf8 . toByteString'
94−
95−data Webhook = Webhook
96− { _wId :: WebhookId
97− , _wType :: !WebhookType
98− , _wCreatedOn :: !Date
99− , _wData :: Incident
100− } deriving (Eq, Show)
101−
102−deriveJSON ''Webhook
103−
104−instance HasIncident Webhook where
105− incident = lens _wData (\s x -> s { _wData = x })
106−
107−-- | Uniquely identifies this outgoing webhook message; can be used for
108−-- idempotency when processing the messages.
109−makeLens "_wId" ''Webhook
110−
111−-- | The webhook message type.
112−makeLens "_wType" ''Webhook
113−
114−-- | The date/time when the incident changed state.
115−wCreatedOn :: Lens' Webhook UTCTime
116−wCreatedOn = lens _wCreatedOn (\i x -> i { _wCreatedOn = x }) . _D
src/Network/PagerDuty/REST/Services.hs → src/Network/PagerDuty/Services.hsrenamed+100−260
@@ -1,13 +1,12 @@
1−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE ExtendedDefaultRules #-}
2+{-# LANGUAGE ExtendedDefaultRules #-}
3−{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TemplateHaskell #-}
4+{-# LANGUAGE TemplateHaskell #-}
5−{-# LANGUAGE TypeFamilies #-}
6
5
7{-# OPTIONS_GHC -fno-warn-type-defaults #-}
6{-# OPTIONS_GHC -fno-warn-type-defaults #-}
8
7
9−-- Module : Network.PagerDuty.REST.Services
8+-- Module : Network.PagerDuty.Services
10−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
9+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
11-- License : This Source Code Form is subject to the terms of
10-- License : This Source Code Form is subject to the terms of
12-- the Mozilla Public License, v. 2.0.
11-- the Mozilla Public License, v. 2.0.
13-- A copy of the MPL can be found in the LICENSE file or
12-- A copy of the MPL can be found in the LICENSE file or
@@ -24,16 +23,14 @@
24-- When a service is shown inlined in other resources, a deleted service will
23-- When a service is shown inlined in other resources, a deleted service will
25-- have its @html_url@ attribute set to 'Nothing'.
24-- have its @html_url@ attribute set to 'Nothing'.
26--
25--
27−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services>
26+-- See: <http://developer.pagerduty.com/documentation/rest/services>
28−module Network.PagerDuty.REST.Services
27+module Network.PagerDuty.Services
29 (
28 (
30 -- * List Services
29 -- * List Services
31− ListServices
32− , listServices
30+ listServices
33 , lsTimeZone
31 , lsTimeZone
34
32
35 -- * Create Service
33 -- * Create Service
36− , CreateService
37 , createService
34 , createService
38 , csName
35 , csName
39 , csDescription
36 , csDescription
@@ -48,7 +45,6 @@ module Network.PagerDuty.REST.Services
48 , getService
45 , getService
49
46
50 -- * Update Service
47 -- * Update Service
51− , UpdateService
52 , updateService
48 , updateService
53 , usName
49 , usName
54 , usEscalationPolicyId
50 , usEscalationPolicyId
@@ -72,6 +68,7 @@ module Network.PagerDuty.REST.Services
72 -- * Types
68 -- * Types
73 , EmailFilterMode (..)
69 , EmailFilterMode (..)
74 , EmailIncidentCreation (..)
70 , EmailIncidentCreation (..)
71+ , MatchMode (..)
75 , ServiceStatus (..)
72 , ServiceStatus (..)
76 , ServiceType (..)
73 , ServiceType (..)
77 , SeverityFilter (..)
74 , SeverityFilter (..)
@@ -82,6 +79,15 @@ module Network.PagerDuty.REST.Services
82 , cntResolved
79 , cntResolved
83 , cntTotal
80 , cntTotal
84
81
82+ , EmailFilters (..)
83+ , efsId
84+ , efsSubjectMode
85+ , efsSubjectRegex
86+ , efsBodyMode
87+ , efsBodyRegex
88+ , efsFromEmailMode
89+ , efsFromEmailRegex
90+
85 , PolicyInfo
91 , PolicyInfo
86 , pinfoId
92 , pinfoId
87 , pinfoName
93 , pinfoName
@@ -106,16 +112,16 @@ module Network.PagerDuty.REST.Services
106 , svcSeverityFilter
112 , svcSeverityFilter
107 ) where
113 ) where
108
114
109−import Control.Lens hiding (Empty)
115+import Control.Lens
110−import Data.Aeson.Lens
116+import Data.Aeson.Lens
111−import Data.Text (Text)
117+import Data.ByteString.Builder (Builder)
112−import Data.Time
118+import Data.Text (Text)
113−import Network.HTTP.Types
119+import Network.HTTP.Types
114−import Network.PagerDuty.Internal.TH
120+import Network.PagerDuty.Services.Types
121+import Network.PagerDuty.TH
115−import Network.PagerDuty.Internal.Types
122+import Network.PagerDuty.Types
116−import Network.PagerDuty.REST.Services.EmailFilters
117
123
118−default (Path)
124+default (Builder)
119
125
120services :: Path
126services :: Path
121services = "services"
127services = "services"
@@ -126,203 +132,37 @@ includes =
126 , ("include[]", Just "email_filters")
132 , ("include[]", Just "email_filters")
127 ]
133 ]
128
134
129−data IncidentCounts = IncidentCounts
130− { _cntTriggered :: !Int
131− , _cntAcknowledged :: !Int
132− , _cntResolved :: !Int
133− , _cntTotal :: !Int
134− } deriving (Eq, Show)
135−
136−deriveRecord ''IncidentCounts
137−
138−data EmailIncidentCreation
139− = OnNewEmail
140− -- ^ Open a new incident for each trigger email.
141− | OnNewEmailSubject
142− -- ^ Open a new incident for each new trigger email subject.
143− | OnlyIfNoOpenIncidents
144− -- ^ Open a new incident only if an open incident does not already exist.
145− deriving (Eq, Show)
146−
147−deriveNullary ''EmailIncidentCreation
148−
149−data EmailFilterMode
150− = AllEmail
151− -- ^ Accept all incoming email
152− | OrRulesEmail
153− -- ^ Accept email only if it matches ONE OR MORE rules below
154− | AndRulesEmail
155− -- ^ Accept email only if it matches ALL of the rules below
156− deriving (Eq, Show)
157−
158−deriveNullaryWith hyphenated ''EmailFilterMode
159−
160−data ServiceStatus
161− = Active
162− -- ^ The service is enabled and has no open incidents.
163− | Warning
164− -- ^ The service is enabled and has one or more acknowledged incidents.
165− | Critical
166− -- ^ The service is enabled and has one or more triggered incidents.
167− | Maintenance
168− -- ^ The service is under maintenance, no new incidents will be
169− -- triggered during maintenance mode.
170− | Disabled
171− -- ^ The service is disabled and will not have any new triggered incidents.
172− deriving (Eq, Show)
173−
174−deriveNullary ''ServiceStatus
175−
176−data ServiceType
177− = CloudKick
178− | GenericEmail
179− | GenericEventsApi
180− | Keynote
181− | Nagios
182− | Pingdom
183− | ServerDensity
184− | SqlMonitor
185− deriving (Eq, Show)
186−
187−deriveNullary ''ServiceType
188−
189−data PolicyInfo = PolicyInfo
190− { _pinfoId :: EscalationPolicyId
191− , _pinfoName :: Text
192− } deriving (Eq, Show)
193−
194−deriveRecord ''PolicyInfo
195−
196−data SeverityFilter
197− = SevCritical
198− -- ^ Incidents are created when an alarm enters the Critical state.
199− | SevCriticalOrWarning
200− -- ^ Incidents are created when an alarm enters the Critical OR Warning states
201− | SevOnAny
202− -- ^ SQL Monitor: Incidents are created for alerts of any severity.
203− | SevOnHigh
204− -- ^ SQL Monitor: Incidents are created for alerts with high severity.
205− | SevOnMediumHigh
206− -- ^ SQL Monitor: Incidents are created for with high or medium severity
207− deriving (Eq, Show)
208−
209−deriveNullaryWith (dropped 3 underscored) ''SeverityFilter
210−
211−data Service = Service
212− { _svcId :: ServiceId
213− , _svcName :: Text
214− , _svcDescription :: Text
215− , _svcServiceUrl :: Text
216− , _svcServiceKey :: ServiceKey
217− , _svcAutoResolveTimeout :: Maybe Int
218− , _svcAcknowledgementTimeout :: Maybe Int
219− , _svcCreatedAt :: Date
220− , _svcStatus :: ServiceStatus
221− , _svcLastIncidentTimestamp :: Maybe Date
222− , _svcEmailIncidentCreation :: Maybe EmailIncidentCreation
223− , _svcIncidentCounts :: IncidentCounts
224− , _svcEmailFilterMode :: EmailFilterMode
225− , _svcType :: ServiceType
226− , _svcEscalationPolicy :: Maybe PolicyInfo -- FIXME: extract from inline.
227− , _svcEmailFilters :: Maybe [EmailFilterInfo] -- FIXME: extract from inline.
228− , _svcSeverityFilter :: Maybe SeverityFilter
229− } deriving (Eq, Show)
230−
231−deriveJSON ''Service
232−
233−-- | A unique identifier for this service.
234−makeLens "_svcId" ''Service
235−
236−-- | The name of the service.
237−makeLens "_svcName" ''Service
238−
239−-- | The description of the service
240−makeLens "_svcDescription" ''Service
241−
242−-- | Relative URL that corresponds to this service.
243−makeLens "_svcServiceUrl" ''Service
244−
245−-- | For Email services, the serviceKey is the associated email address
246−-- for the service.
247−-- For all other service types, this is the unique key used for API calls.
248−makeLens "_svcServiceKey" ''Service
249−
250−-- | Time in seconds that an incident changes to the Triggered State after
251−-- being Acknowledged. Value is 'Nothing' if the feature is disabled.
252−makeLens "_svcAutoResolveTimeout" ''Service
253−
254−-- | Time in seconds that an incident is automatically resolved if left open for
255−-- that long. Value is 'Nothing' is the feature is disabled.
256−makeLens "_svcAcknowledgementTimeout" ''Service
257−
258−-- | The date/time when this service was created.
259−svcCreatedAt :: Lens' Service UTCTime
260−svcCreatedAt = lens _svcCreatedAt (\s x -> s { _svcCreatedAt = x }) . _D
261−
262−-- | The current state of the Service.
263−makeLens "_svcStatus" ''Service
264−
265−-- | The date/time when the most recent incident was created for this service.
266−svcLastIncidentTimestamp :: Lens' Service (Maybe UTCTime)
267−svcLastIncidentTimestamp =
268− lens _svcLastIncidentTimestamp
269− (\s x -> s { _svcLastIncidentTimestamp = x }) . mapping _D
270−
271−-- | If the service is a Generic Email service, this describes what kind of
272−-- emails create an incident.
273−makeLens "_svcEmailIncidentCreation" ''Service
274−
275−-- | An object with the number of incidents corresponding to these states.
276−makeLens "_svcIncidentCounts" ''Service
277−
278−-- | If the service is a Generic Email service, this describes which types of
279−-- email will generate an incident.
280−makeLens "_svcEmailFilterMode" ''Service
281−
282−-- | The service type.
283−makeLens "_svcType" ''Service
284−
285−-- | An object containing the ID and name of the escalation policy used by this
286−-- service.
287−makeLens "_svcEscalationPolicy" ''Service
288−
289−-- | An object containing inline Email Filters.
290−-- Note that only genericEmail services have filters.
291−makeLens "_svcEmailFilters" ''Service
292−
293−-- | Specifies what severity levels will create a new open incident.
294−makeLens "_svcSeverityFilter" ''Service
295−
296newtype ListServices = ListServices
135newtype ListServices = ListServices
297− { _lsTimeZone' :: Maybe TZ
136+ { _lsTimeZone' :: Maybe TimeZone
298 } deriving (Eq, Show)
137 } deriving (Eq, Show)
299
138
300instance Paginate ListServices
139instance Paginate ListServices
301
140
302−queryRequest ''ListServices
141+deriveJSON ''ListServices
303−
142+makeLenses ''ListServices
304−-- | Time zone in which dates in the result will be rendered.
305−--
306−-- /Default:/ account default time zone.
307−lsTimeZone :: Lens' (Request ListServices s r) (Maybe TimeZone)
308−lsTimeZone = upd.lsTimeZone'.mapping _TZ
309
143
310-- | List existing services.
144-- | List existing services.
311--
145--
312-- @GET \/services@
146-- @GET \/services@
313--
147--
314−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/list>
148+-- See: <http://developer.pagerduty.com/documentation/rest/services/list>
315listServices :: Request ListServices s [Service]
149listServices :: Request ListServices s [Service]
316listServices =
150listServices =
317 mk ListServices
151 mk ListServices
318 { _lsTimeZone' = Nothing
152 { _lsTimeZone' = Nothing
319 } & path .~ services
153 } & path .~ services
320− & query .~ includes
154+ & query <>~ includes
321 & unwrap .~ key "escalation_policies"
155 & unwrap .~ key "escalation_policies"
322
156
157+-- | Time zone in which dates in the result will be rendered.
158+--
159+-- Defaults to account default time zone.
160+lsTimeZone :: Lens' (Request ListServices s r) (Maybe TimeZone)
161+lsTimeZone = upd.lsTimeZone'
162+
323data CreateService = CreateService
163data CreateService = CreateService
324 { _csName' :: Text
164 { _csName' :: Text
325− , _csEscalationPolicyId' :: EscalationPolicyId
165+ , _csEscalationPolicyId' :: PolicyId
326 , _csType' :: !ServiceType
166 , _csType' :: !ServiceType
327 , _csVendorId' :: Maybe VendorId
167 , _csVendorId' :: Maybe VendorId
328 , _csDescription' :: Maybe Text
168 , _csDescription' :: Maybe Text
@@ -331,7 +171,30 @@ data CreateService = CreateService
331 , _csSeverityFilter' :: Maybe SeverityFilter
171 , _csSeverityFilter' :: Maybe SeverityFilter
332 } deriving (Eq, Show)
172 } deriving (Eq, Show)
333
173
334−jsonRequest ''CreateService
174+deriveJSON ''CreateService
175+makeLenses ''CreateService
176+
177+-- | Creates a new service.
178+--
179+-- @POST \/services@
180+--
181+-- See: <http://developer.pagerduty.com/documentation/rest/services/create>
182+createService :: Text
183+ -> PolicyId
184+ -> ServiceType
185+ -> Request CreateService s Service
186+createService n p t =
187+ mk CreateService
188+ { _csName' = n
189+ , _csEscalationPolicyId' = p
190+ , _csType' = t
191+ , _csVendorId' = Nothing
192+ , _csDescription' = Nothing
193+ , _csAcknowledgementTimeout' = Nothing
194+ , _csAutoResolveTimeout' = Nothing
195+ , _csSeverityFilter' = Nothing
196+ } & path .~ services
197+ & unwrap .~ key "service"
335
198
336-- | The name of the service.
199-- | The name of the service.
337csName :: Lens' (Request CreateService s r) Text
200csName :: Lens' (Request CreateService s r) Text
@@ -351,19 +214,19 @@ csVendorId :: Lens' (Request CreateService s r) (Maybe VendorId)
351csVendorId = upd.csVendorId'
214csVendorId = upd.csVendorId'
352
215
353-- | The id of the escalation policy to be used by this service.
216-- | The id of the escalation policy to be used by this service.
354−csEscalationPolicyId :: Lens' (Request CreateService s r) EscalationPolicyId
217+csEscalationPolicyId :: Lens' (Request CreateService s r) PolicyId
355csEscalationPolicyId = upd.csEscalationPolicyId'
218csEscalationPolicyId = upd.csEscalationPolicyId'
356
219
357-- | The duration in seconds before an incidents acknowledged in this service
220-- | The duration in seconds before an incidents acknowledged in this service
358-- become triggered again.
221-- become triggered again.
359--
222--
360−-- /Default:/ 30 minutes.
223+-- Defaults to 30 minutes.
361csAcknowledgementTimeout :: Lens' (Request CreateService s r) (Maybe Int)
224csAcknowledgementTimeout :: Lens' (Request CreateService s r) (Maybe Int)
362csAcknowledgementTimeout = upd.csAcknowledgementTimeout'
225csAcknowledgementTimeout = upd.csAcknowledgementTimeout'
363
226
364-- | The duration in seconds before a triggered incident auto-resolves itself.
227-- | The duration in seconds before a triggered incident auto-resolves itself.
365--
228--
366−-- /Default:/ 4 hours.
229+-- Defaults to 4 hours.
367csAutoResolveTimeout :: Lens' (Request CreateService s r) (Maybe Int)
230csAutoResolveTimeout :: Lens' (Request CreateService s r) (Maybe Int)
368csAutoResolveTimeout = upd.csAutoResolveTimeout'
231csAutoResolveTimeout = upd.csAutoResolveTimeout'
369
232
@@ -371,33 +234,11 @@ csAutoResolveTimeout = upd.csAutoResolveTimeout'
371csSeverityFilter :: Lens' (Request CreateService s r) (Maybe SeverityFilter)
234csSeverityFilter :: Lens' (Request CreateService s r) (Maybe SeverityFilter)
372csSeverityFilter = upd.csSeverityFilter'
235csSeverityFilter = upd.csSeverityFilter'
373
236
374−-- | Creates a new service.
375−--
376−-- @POST \/services@
377−--
378−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/create>
379−createService :: Text
380− -> EscalationPolicyId
381− -> ServiceType
382− -> Request CreateService s Service
383−createService n p t =
384− mk CreateService
385− { _csName' = n
386− , _csEscalationPolicyId' = p
387− , _csType' = t
388− , _csVendorId' = Nothing
389− , _csDescription' = Nothing
390− , _csAcknowledgementTimeout' = Nothing
391− , _csAutoResolveTimeout' = Nothing
392− , _csSeverityFilter' = Nothing
393− } & path .~ services
394− & unwrap .~ key "service"
395−
396-- | Get details about an existing service.
237-- | Get details about an existing service.
397--
238--
398-- @GET services\/\:id@
239-- @GET services\/\:id@
399--
240--
400−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/show>
241+-- See: <http://developer.pagerduty.com/documentation/rest/services/show>
401getService :: ServiceId -> Request Empty s Service
242getService :: ServiceId -> Request Empty s Service
402getService i = empty
243getService i = empty
403 & path .~ services % i
244 & path .~ services % i
@@ -407,13 +248,32 @@ getService i = empty
407data UpdateService = UpdateService
248data UpdateService = UpdateService
408 { _usName' :: Maybe Text
249 { _usName' :: Maybe Text
409 , _usDescription' :: Maybe Text
250 , _usDescription' :: Maybe Text
410− , _usEscalationPolicyId' :: Maybe EscalationPolicyId
251+ , _usEscalationPolicyId' :: Maybe PolicyId
411 , _usAcknowledgementTimeout' :: Maybe Int
252 , _usAcknowledgementTimeout' :: Maybe Int
412 , _usAutoResolveTimeout' :: Maybe Int
253 , _usAutoResolveTimeout' :: Maybe Int
413 , _usSeverityFilter' :: Maybe SeverityFilter
254 , _usSeverityFilter' :: Maybe SeverityFilter
414 } deriving (Eq, Show)
255 } deriving (Eq, Show)
415
256
257+deriveJSON ''UpdateService
416−jsonRequest ''UpdateService
258+makeLenses ''UpdateService
259+
260+-- | Update an existing service.
261+--
262+-- @PUT services\/\:id@
263+--
264+-- See: <http://developer.pagerduty.com/documentation/rest/services/update>
265+updateService :: ServiceId -> Request UpdateService s Service
266+updateService i =
267+ mk UpdateService
268+ { _usName' = Nothing
269+ , _usEscalationPolicyId' = Nothing
270+ , _usDescription' = Nothing
271+ , _usAcknowledgementTimeout' = Nothing
272+ , _usAutoResolveTimeout' = Nothing
273+ , _usSeverityFilter' = Nothing
274+ } & meth .~ PUT
275+ & path .~ services % i
276+ & unwrap .~ key "service"
417
277
418-- | The name of the service.
278-- | The name of the service.
419usName :: Lens' (Request UpdateService s r) (Maybe Text)
279usName :: Lens' (Request UpdateService s r) (Maybe Text)
@@ -424,19 +284,19 @@ usDescription :: Lens' (Request UpdateService s r) (Maybe Text)
424usDescription = upd.usDescription'
284usDescription = upd.usDescription'
425
285
426-- | The id of the escalation policy to be used by this service.
286-- | The id of the escalation policy to be used by this service.
427−usEscalationPolicyId :: Lens' (Request UpdateService s r) (Maybe EscalationPolicyId)
287+usEscalationPolicyId :: Lens' (Request UpdateService s r) (Maybe PolicyId)
428usEscalationPolicyId = upd.usEscalationPolicyId'
288usEscalationPolicyId = upd.usEscalationPolicyId'
429
289
430-- | The duration in seconds before an incidents acknowledged in this service
290-- | The duration in seconds before an incidents acknowledged in this service
431-- become triggered again.
291-- become triggered again.
432--
292--
433−-- /Default:/ 30 minutes.
293+-- Defaults to 30 minutes.
434usAcknowledgementTimeout :: Lens' (Request UpdateService s r) (Maybe Int)
294usAcknowledgementTimeout :: Lens' (Request UpdateService s r) (Maybe Int)
435usAcknowledgementTimeout = upd.usAcknowledgementTimeout'
295usAcknowledgementTimeout = upd.usAcknowledgementTimeout'
436
296
437-- | The duration in seconds before a triggered incident auto-resolves itself.
297-- | The duration in seconds before a triggered incident auto-resolves itself.
438--
298--
439−-- /Default:/ 4 hours.
299+-- Defaults to 4 hours.
440usAutoResolveTimeout :: Lens' (Request UpdateService s r) (Maybe Int)
300usAutoResolveTimeout :: Lens' (Request UpdateService s r) (Maybe Int)
441usAutoResolveTimeout = upd.usAutoResolveTimeout'
301usAutoResolveTimeout = upd.usAutoResolveTimeout'
442
302
@@ -444,31 +304,13 @@ usAutoResolveTimeout = upd.usAutoResolveTimeout'
444usSeverityFilter :: Lens' (Request UpdateService s r) (Maybe SeverityFilter)
304usSeverityFilter :: Lens' (Request UpdateService s r) (Maybe SeverityFilter)
445usSeverityFilter = upd.usSeverityFilter'
305usSeverityFilter = upd.usSeverityFilter'
446
306
447−-- | Update an existing service.
448−--
449−-- @PUT services\/\:id@
450−--
451−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/update>
452−updateService :: ServiceId -> Request UpdateService s Service
453−updateService i =
454− mk UpdateService
455− { _usName' = Nothing
456− , _usEscalationPolicyId' = Nothing
457− , _usDescription' = Nothing
458− , _usAcknowledgementTimeout' = Nothing
459− , _usAutoResolveTimeout' = Nothing
460− , _usSeverityFilter' = Nothing
461− } & meth .~ PUT
462− & path .~ services % i
463− & unwrap .~ key "service"
464−
465-- | Delete an existing service. Once the service is deleted, it will not be
307-- | Delete an existing service. Once the service is deleted, it will not be
466-- accessible from the web UI and new incidents won't be able to be created
308-- accessible from the web UI and new incidents won't be able to be created
467-- for this service.
309-- for this service.
468--
310--
469-- @DELETE \/services/:id@
311-- @DELETE \/services/:id@
470--
312--
471−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/delete>
313+-- See: <http://developer.pagerduty.com/documentation/rest/services/delete>
472deleteService :: ServiceId -> Request Empty s Empty
314deleteService :: ServiceId -> Request Empty s Empty
473deleteService i = empty & meth .~ DELETE & path .~ services % i
315deleteService i = empty & meth .~ DELETE & path .~ services % i
474
316
@@ -476,14 +318,13 @@ deleteService i = empty & meth .~ DELETE & path .~ services % i
476--
318--
477-- @PUT services\/\:id\/enable@
319-- @PUT services\/\:id\/enable@
478--
320--
479−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/enable>
321+-- See: <http://developer.pagerduty.com/documentation/rest/services/enable>
480enableService :: RequesterId -> ServiceId -> Request Empty s Empty
322enableService :: RequesterId -> ServiceId -> Request Empty s Empty
481−enableService r i =
482− auth (enableServiceBasic i) & query .~ [("requester_id", r)]
323+enableService r i = auth (enableServiceBasic i) & query .~ [("requester_id", r)]
483
324
484-- | A version of 'enableService' which uses HTTP Basic authentication and
325-- | A version of 'enableService' which uses HTTP Basic authentication and
485-- doesn't require a 'RequesterId'.
326-- doesn't require a 'RequesterId'.
486−enableServiceBasic :: ServiceId -> Request Empty 'Basic Empty
327+enableServiceBasic :: ServiceId -> Request Empty Basic Empty
487enableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "enable"
328enableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "enable"
488
329
489-- | Disable a service. Once a service is disabled, it will not be able to
330-- | Disable a service. Once a service is disabled, it will not be able to
@@ -491,14 +332,13 @@ enableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "enable"
491--
332--
492-- @PUT services\/\:id\/disable@
333-- @PUT services\/\:id\/disable@
493--
334--
494−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/disable>
335+-- See: <http://developer.pagerduty.com/documentation/rest/services/disable>
495disableService :: RequesterId -> ServiceId -> Request Empty s Empty
336disableService :: RequesterId -> ServiceId -> Request Empty s Empty
496−disableService r i =
497− auth (disableServiceBasic i) & query .~ [("requester_id", r)]
337+disableService r i = auth (disableServiceBasic i) & query .~ [("requester_id", r)]
498
338
499-- | A version of 'disableService' which uses HTTP Basic authentication and
339-- | A version of 'disableService' which uses HTTP Basic authentication and
500-- doesn't require a 'RequesterId'.
340-- doesn't require a 'RequesterId'.
501−disableServiceBasic :: ServiceId -> Request Empty 'Basic Empty
341+disableServiceBasic :: ServiceId -> Request Empty Basic Empty
502disableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "disable"
342disableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "disable"
503
343
504-- | Regenerate a new service key for an existing service.
344-- | Regenerate a new service key for an existing service.
@@ -508,6 +348,6 @@ disableServiceBasic i = empty & meth .~ PUT & path .~ services % i % "disable"
508--
348--
509-- @POST services\/\:id\/regenerate_key@
349-- @POST services\/\:id\/regenerate_key@
510--
350--
511−-- /See:/ <http://developer.pagerduty.com/documentation/rest/services/regenerate_key>
351+-- See: <http://developer.pagerduty.com/documentation/rest/services/regenerate_key>
512regenerateKey :: ServiceId -> Request Empty s Service
352regenerateKey :: ServiceId -> Request Empty s Service
513regenerateKey i = empty & meth .~ POST & path .~ services % i % "regenerate_key"
353regenerateKey i = empty & meth .~ POST & path .~ services % i % "regenerate_key"
src/Network/PagerDuty/Services/Types.hsnew file+242
@@ -0,0 +1,242 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
4+
5+-- Module : Network.PagerDuty.Services.Types
6+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
7+-- License : This Source Code Form is subject to the terms of
8+-- the Mozilla Public License, v. 2.0.
9+-- A copy of the MPL can be found in the LICENSE file or
10+-- you can obtain it at http://mozilla.org/MPL/2.0/.
11+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12+-- Stability : experimental
13+-- Portability : non-portable (GHC extensions)
14+
15+module Network.PagerDuty.Services.Types where
16+
17+import Control.Lens
18+import Data.Text (Text)
19+import Network.PagerDuty.TH
20+import Network.PagerDuty.Types
21+
22+data IncidentCounts = IncidentCounts
23+ { _cntTriggered :: !Int
24+ , _cntAcknowledged :: !Int
25+ , _cntResolved :: !Int
26+ , _cntTotal :: !Int
27+ } deriving (Eq, Show)
28+
29+deriveJSON ''IncidentCounts
30+makeLenses ''IncidentCounts
31+
32+data EmailIncidentCreation
33+ = OnNewEmail
34+ -- ^ Open a new incident for each trigger email.
35+ | OnNewEmailSubject
36+ -- ^ Open a new incident for each new trigger email subject.
37+ | OnlyIfNoOpenIncidents
38+ -- ^ Open a new incident only if an open incident does not already exist.
39+ deriving (Eq, Show)
40+
41+deriveJSON ''EmailIncidentCreation
42+
43+data EmailFilterMode
44+ = AllEmail
45+ -- ^ Accept all incoming email
46+ | OrRulesEmail
47+ -- ^ Accept email only if it matches ONE OR MORE rules below
48+ | AndRulesEmail
49+ -- ^ Accept email only if it matches ALL of the rules below
50+ deriving (Eq, Show)
51+
52+deriveJSONWith hyphenated ''EmailFilterMode
53+
54+data ServiceStatus
55+ = Active
56+ -- ^ The service is enabled and has no open incidents.
57+ | Warning
58+ -- ^ The service is enabled and has one or more acknowledged incidents.
59+ | Critical
60+ -- ^ The service is enabled and has one or more triggered incidents.
61+ | Maintenance
62+ -- ^ The service is under maintenance, no new incidents will be
63+ -- triggered during maintenance mode.
64+ | Disabled
65+ -- ^ The service is disabled and will not have any new triggered incidents.
66+ deriving (Eq, Show)
67+
68+deriveJSON ''ServiceStatus
69+
70+data ServiceType
71+ = CloudKick
72+ | GenericEmail
73+ | GenericEventsApi
74+ | Keynote
75+ | Nagios
76+ | Pingdom
77+ | ServerDensity
78+ | SqlMonitor
79+ deriving (Eq, Show)
80+
81+deriveJSON ''ServiceType
82+
83+data PolicyInfo = PolicyInfo
84+ { _pinfoId :: PolicyId
85+ , _pinfoName :: Text
86+ } deriving (Eq, Show)
87+
88+makeLenses ''PolicyInfo
89+deriveJSON ''PolicyInfo
90+
91+data MatchMode
92+ = Always
93+ | Match
94+ | NoMatch
95+ deriving (Eq, Show)
96+
97+deriveJSONWith hyphenated ''MatchMode
98+
99+-- FIXME: Tighten up this type! Make the regex required for match/no-match.
100+data EmailFilters = EmailFilters
101+ { _efsId :: EmailFilterId
102+ , _efsSubjectMode :: Maybe MatchMode
103+ , _efsSubjectRegex :: Maybe Text
104+ , _efsBodyMode :: Maybe MatchMode
105+ , _efsBodyRegex :: Maybe Text
106+ , _efsFromEmailMode :: Maybe MatchMode
107+ , _efsFromEmailRegex :: Maybe Text
108+ } deriving (Eq, Show)
109+
110+deriveJSON ''EmailFilters
111+
112+-- | The email filter ID.
113+makeLens "_efsId" ''EmailFilters
114+
115+-- | One of always, match, no-match, which, respectively, means to not filter
116+-- the email trigger by subject, filter it if the email subject matches the
117+-- given regex, or filter if it doesn't match the given regex.
118+--
119+-- Defaults to always.
120+makeLens "_efsSubjectMode" ''EmailFilters
121+
122+-- | The regex to be used when subject_mode is match or no-match.
123+-- It is a required parameter on such cases.
124+makeLens "_efsSubjectRegex" ''EmailFilters
125+
126+-- | One of always, match, no-match, which, respectively, means to not filter
127+-- the email trigger by body, filter it if the body email matches the given regex,
128+-- or filter if it doesn't match the given regex.
129+--
130+-- Defaults to always.
131+makeLens "_efsBodyMode" ''EmailFilters
132+
133+-- | The regex to be used when body_mode is match or no-match.
134+-- It is a required parameter on such cases.
135+makeLens "_efsBodyRegex" ''EmailFilters
136+
137+-- | One of always, match, no-match, which, respectively, means to not filter
138+-- the email trigger by its from address, filter it if the email from address
139+-- matches the given regex, or filter if it doesn't match the given regex.
140+--
141+-- Defaults to always.
142+makeLens "_efsFromEmailMode" ''EmailFilters
143+
144+-- | The regex to be used when from_email_mode is match or no-match.
145+-- It is a required parameter on such cases.
146+makeLens "_efsFromEmailRegex" ''EmailFilters
147+
148+data SeverityFilter
149+ = SevCritical
150+ -- ^ Incidents are created when an alarm enters the Critical state.
151+ | SevCriticalOrWarning
152+ -- ^ Incidents are created when an alarm enters the Critical OR Warning states
153+ | SevOnAny
154+ -- ^ SQL Monitor: Incidents are created for alerts of any severity.
155+ | SevOnHigh
156+ -- ^ SQL Monitor: Incidents are created for alerts with high severity.
157+ | SevOnMediumHigh
158+ -- ^ SQL Monitor: Incidents are created for with high or medium severity
159+ deriving (Eq, Show)
160+
161+deriveJSONWith (dropped 3 underscored) ''SeverityFilter
162+
163+data Service = Service
164+ { _svcId :: ServiceId
165+ , _svcName :: Text
166+ , _svcDescription :: Text
167+ , _svcServiceUrl :: Text
168+ , _svcServiceKey :: ServiceKey
169+ , _svcAutoResolveTimeout :: Maybe Int
170+ , _svcAcknowledgementTimeout :: Maybe Int
171+ , _svcCreatedAt :: Date
172+ , _svcStatus :: ServiceStatus
173+ , _svcLastIncidentTimestamp :: Maybe Date
174+ , _svcEmailIncidentCreation :: Maybe EmailIncidentCreation
175+ , _svcIncidentCounts :: IncidentCounts
176+ , _svcEmailFilterMode :: EmailFilterMode
177+ , _svcType :: ServiceType
178+ , _svcEscalationPolicy :: Maybe PolicyInfo -- FIXME: extract from inline.
179+ , _svcEmailFilters :: Maybe EmailFilters -- FIXME: extract from inline.
180+ , _svcSeverityFilter :: Maybe SeverityFilter
181+ } deriving (Eq, Show)
182+
183+deriveJSON ''Service
184+
185+-- | A unique identifier for this service.
186+makeLens "_svcId" ''Service
187+
188+-- | The name of the service.
189+makeLens "_svcName" ''Service
190+
191+-- | The description of the service
192+makeLens "_svcDescription" ''Service
193+
194+-- | Relative URL that corresponds to this service.
195+makeLens "_svcServiceUrl" ''Service
196+
197+-- | For Email services, the serviceKey is the associated email address
198+-- for the service.
199+-- For all other service types, this is the unique key used for API calls.
200+makeLens "_svcServiceKey" ''Service
201+
202+-- | Time in seconds that an incident changes to the Triggered State after
203+-- being Acknowledged. Value is 'Nothing' if the feature is disabled.
204+makeLens "_svcAutoResolveTimeout" ''Service
205+
206+-- | Time in seconds that an incident is automatically resolved if left open for
207+-- that long. Value is 'Nothing' is the feature is disabled.
208+makeLens "_svcAcknowledgementTimeout" ''Service
209+
210+-- | The date/time when this service was created.
211+makeLens "_svcCreatedAt" ''Service
212+
213+-- | The current state of the Service.
214+makeLens "_svcStatus" ''Service
215+
216+-- | The date/time when the most recent incident was created for this service.
217+makeLens "_svcLastIncidentTimestamp" ''Service
218+
219+-- | If the service is a Generic Email service, this describes what kind of
220+-- emails create an incident.
221+makeLens "_svcEmailIncidentCreation" ''Service
222+
223+-- | An object with the number of incidents corresponding to these states.
224+makeLens "_svcIncidentCounts" ''Service
225+
226+-- | If the service is a Generic Email service, this describes which types of
227+-- email will generate an incident.
228+makeLens "_svcEmailFilterMode" ''Service
229+
230+-- | The service type.
231+makeLens "_svcType" ''Service
232+
233+-- | An object containing the ID and name of the escalation policy used by this
234+-- service.
235+makeLens "_svcEscalationPolicy" ''Service
236+
237+-- | An object containing inline Email Filters.
238+-- Note that only genericEmail services have filters.
239+makeLens "_svcEmailFilters" ''Service
240+
241+-- | Specifies what severity levels will create a new open incident.
242+makeLens "_svcSeverityFilter" ''Service
src/Network/PagerDuty/Internal/Options.hs → src/Network/PagerDuty/TH.hsrenamed+23−4
@@ -1,5 +1,7 @@
1+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2+
1−-- Module : Network.PagerDuty.Internal.Options
3+-- Module : Network.PagerDuty.TH
2−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
4+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
3-- License : This Source Code Form is subject to the terms of
5-- License : This Source Code Form is subject to the terms of
4-- the Mozilla Public License, v. 2.0.
6-- the Mozilla Public License, v. 2.0.
5-- A copy of the MPL can be found in the LICENSE file or
7-- A copy of the MPL can be found in the LICENSE file or
@@ -8,16 +10,33 @@
8-- Stability : experimental
10-- Stability : experimental
9-- Portability : non-portable (GHC extensions)
11-- Portability : non-portable (GHC extensions)
10
12
11−module Network.PagerDuty.Internal.Options
13+module Network.PagerDuty.TH
14+ (
15+ -- * Lenses
16+ makeLens
17+ -- * JSON
18+ , deriveJSON
19+ , deriveJSONWith
20+ -- ** Options
12− ( dropped
21+ , dropped
13 , hyphenated
22 , hyphenated
14 , underscored
23 , underscored
15 ) where
24 ) where
16
25
26+import Control.Lens
27+import qualified Data.Aeson.TH as Aeson
17import Data.Aeson.Types
28import Data.Aeson.Types
18import Data.Char
29import Data.Char
19import Data.List
30import Data.List
20
31
32+makeLens k = makeLensesWith
33+ $ lensRulesFor [(k, drop 1 k)]
34+ & simpleLenses .~ True
35+
36+deriveJSON = deriveJSONWith underscored
37+
38+deriveJSONWith = Aeson.deriveJSON
39+
21dropped :: Int -> Options -> Options
40dropped :: Int -> Options -> Options
22dropped n o = o
41dropped n o = o
23 { constructorTagModifier = constructorTagModifier o . drop n
42 { constructorTagModifier = constructorTagModifier o . drop n
src/Network/PagerDuty/Types.hs+366−84
@@ -1,5 +1,17 @@
1+{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE GADTs #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+{-# LANGUAGE KindSignatures #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE RankNTypes #-}
9+{-# LANGUAGE StandaloneDeriving #-}
10+{-# LANGUAGE TemplateHaskell #-}
11+{-# LANGUAGE ViewPatterns #-}
12+
1-- Module : Network.PagerDuty.Types
13-- Module : Network.PagerDuty.Types
2−-- Copyright : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
14+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>
3-- License : This Source Code Form is subject to the terms of
15-- License : This Source Code Form is subject to the terms of
4-- the Mozilla Public License, v. 2.0.
16-- the Mozilla Public License, v. 2.0.
5-- A copy of the MPL can be found in the LICENSE file or
17-- A copy of the MPL can be found in the LICENSE file or
@@ -8,86 +20,356 @@
8-- Stability : experimental
20-- Stability : experimental
9-- Portability : non-portable (GHC extensions)
21-- Portability : non-portable (GHC extensions)
10
22
11−module Network.PagerDuty.Types
23+module Network.PagerDuty.Types where
12− (
24+ -- (
13− -- * Configuration
14− -- ** Environment
15− Env
16− , envDomain
17− , envAuth
18− , envManager
19− , envLogger
20−
21− -- ** Logging
22− , Logger (..)
23− , debug
24−
25− -- * Types
26− -- ** Requests
25+ -- -- * Requests
27− , Paginate
26+ -- Auth (..)
27+ -- , Cred (..)
28+ -- , Domain (..)
29+
30+ -- , Request (..)
28− , Request
31+ -- , Request'
29−
32+
33+ -- , Paginate (..)
34+
30− -- ** Errors
35+ -- -- * Errors
31− , Error
36+ -- , Code (..)
32− , _Internal
37+ -- , message
33− , _Integration
38+ -- , RestError (..)
34− , _REST
39+ -- , Error (..)
35− -- *** Messages
40+
36− , HasMessage (..)
41+ -- -- * Primitives
37− -- *** Fields
42+ -- , Key (..)
38− , HasErrors (..)
43+ -- , ServiceKey
39− -- *** Integration
44+ -- , IncidentKey
40− , IntegrationError
45+
41− , status
46+ -- , Id (..)
42− -- *** REST
47+ -- , ServiceId
43− , RESTError
48+ -- , RequesterId
44− , Code
49+
45− , code
50+ -- , Empty (..)
46− , description
51+ -- ) where
47−
52+
48− -- ** Authentication
53+import Control.Applicative
49− , Security (..)
54+import Control.Lens hiding ((.=))
50− , Auth (..)
55+import Data.Aeson hiding (Error)
51−
56+import Data.Aeson.Types (Parser)
52− -- ** Keys
57+import Data.ByteString (ByteString)
53− , Key
58+import qualified Data.ByteString.Char8 as BS
54− , mkKey
59+import Data.ByteString.Conversion
55− -- *** Aliases
60+import Data.Function
56− , ServiceKey
61+import qualified Data.HashMap.Strict as Map
57− , IncidentKey
62+import Data.Monoid
58−
63+import Data.String
59− -- ** Identifiers
64+import Data.Text (Text)
60− , Id
65+import qualified Data.Time as Time
61− , mkId
66+import Data.Time hiding (TimeZone)
62− -- *** Aliases
67+import GHC.TypeLits
68+import Network.HTTP.Types
69+import Network.HTTP.Types.QueryLike
70+import Network.PagerDuty.TH
71+
72+-- FIXME: Query String parameters vs JSON bodies for GET
73+
74+newtype Date = Date { unDate :: ZonedTime }
75+ deriving (Show)
76+
77+instance Eq Date where
78+ (Date a) == (Date b) =
79+ on (==) zonedTimeToLocalTime a b
80+ || on (==) zonedTimeZone a b
81+
82+instance FromJSON Date where
83+ parseJSON = fmap Date . parseJSON
84+
85+instance ToJSON Date where
86+ toJSON = toJSON . unDate
87+
88+newtype TimeZone = TimeZone { unTZ :: Time.TimeZone }
89+ deriving (Eq, Ord, Show)
90+
91+instance FromJSON TimeZone where
92+ parseJSON = undefined
93+
94+instance ToJSON TimeZone where
95+ toJSON = undefined
96+
97+data Security = Basic | Token -- None
98+ deriving (Eq, Show)
99+
100+data Auth (a :: Security) where
101+ AuthBasic :: ByteString -> ByteString -> Auth Basic
102+ AuthToken :: ByteString -> Auth Token
103+-- AuthNone :: Auth None
104+
105+deriving instance Eq (Auth a)
106+deriving instance Show (Auth a)
107+
108+newtype SubDomain = SubDomain ByteString
109+ deriving (Eq, Show, IsString)
110+
111+domain :: SubDomain -> ByteString
112+domain (SubDomain s)
113+ | base `BS.isSuffixOf` s = s
114+ | otherwise = s <> base
115+ where
116+ base = ".pagerduty.com"
117+
118+newtype Code = Code Integer
119+ deriving (Eq, Show)
120+
121+deriveJSON ''Code
122+
123+description :: Code -> Text
124+description (Code c) =
125+ case c of
126+ 2000 -> "Internal Error"
127+ 2001 -> "Invalid Input Provided"
128+ 2002 -> "Arguments Caused Error"
129+ 2003 -> "Missing Arguments"
130+ 2004 -> "Invalid 'since' or 'until' Parameter Values"
131+ 2005 -> "Invalid Query Date Range"
132+ 2006 -> "Authentication Failed"
133+ 2007 -> "Account Not Found"
134+ 2008 -> "Account Locked"
135+ 2009 -> "Only HTTPS Allowed For This Call"
136+ 2010 -> "Access Denied"
137+ 2011 -> "The action requires a 'requester_id' to be specified"
138+ 2012 -> "Your account is expired and cannot use the API"
139+ _ -> "Unrecognised error code"
140+
141+data RestError = RestError
142+ { _reCode :: Code
143+ , _reMessage :: Text
144+ , _reErrors :: [Text]
145+ } deriving (Eq, Show)
146+
147+deriveJSON ''RestError
148+makeLenses ''RestError
149+
150+data Error
151+ = Internal String
152+ | Error RestError
153+ deriving (Eq, Show)
154+
155+instance FromJSON Error where
156+ parseJSON = fmap Error . parseJSON
157+
158+makePrisms ''Error
159+
160+data Pager = Pager
161+ { _pgOffset :: !Int
162+ -- ^ The offset used in the execution of the query.
163+ , _pgLimit :: !Int
164+ -- ^ The limit used in the execution of the query.
165+ , _pgTotal :: !Int
166+ -- ^ The total number of records available.
167+ } deriving (Eq, Show)
168+
169+makeLenses ''Pager
170+
171+instance FromJSON a => FromJSON (a, Maybe Pager) where
172+ parseJSON = withObject "paginated" $ \o -> (,)
173+ <$> parseJSON (Object o)
174+ <*> optional (parse o)
175+ where
176+ parse o = Pager
177+ -- The offset of the first record returned.
178+ -- Default is 0.
179+ <$> o .: "offset" .!= 0
180+ -- The number of records returned.
181+ -- Default (and max limit) is 100 for most APIs.
182+ <*> o .: "limit" .!= 100
183+ <*> o .: "total"
184+
185+instance ToJSON Pager where
186+ toJSON p = object
187+ [ "offset" .= _pgOffset p
188+ , "limit" .= _pgLimit p
189+ ]
190+
191+-- | A path segment.
192+data Path where
193+ Path :: Path
194+ Seg :: ToByteString a => a -> Path
195+
196+instance Monoid Path where
197+ mempty = Path
198+ mappend x Path = x
199+ mappend Path y = y
200+ mappend (Seg x) (Seg y) = Seg (builder x <> "/" <> builder y)
201+
202+instance IsString Path where
203+ fromString = Seg
204+
205+instance ToByteString Path where
206+ builder Path = mempty
207+ builder (Seg x) = builder x
208+
209+(%) :: ToByteString a => Path -> a -> Path
210+a % b = a <> Seg b
211+
212+renderPath :: Path -> ByteString
213+renderPath = toByteString' . mappend v1
214+ where
215+ v1 :: Path
216+ v1 = "/api/v1"
217+
218+data Request a (s :: Security) b where
219+ Request :: ToJSON a
220+ => { _rqPayload :: a
221+ , _rqMethod :: !StdMethod
222+ , _rqPath :: Path
223+ , _rqQuery :: Query
224+ , _rqPager :: Maybe Pager
225+ , _rqUnwrap :: Value -> Parser Value
226+ }
227+ -> Request a s b
228+
229+instance ToJSON (Request a s b) where
230+ -- Manually unwrapped to ensure GADT constraint holds.
231+ toJSON (Request p _ _ _ q _) = Object $
232+ let Object x = toJSON p
233+ in case toJSON q of
234+ (Object y) -> x <> y
235+ _ -> x
236+
237+type Unwrap = Getting (First Value) Value Value
238+
239+-- | Create a defaulted request from the payload type.
240+mk :: ToJSON a => a -> Request a s b
241+mk x = Request x GET mempty mempty Nothing pure
242+
243+empty :: Request Empty s r
244+empty = mk Empty
245+
246+-- | Modify the request state.
247+upd :: ToJSON a => Lens' (Request a s b) a
248+upd = lens _rqPayload (\(Request _ m p q g u) x -> Request x m p q g u)
249+
250+-- | Drop the security constraint.
251+auth :: Request a s b -> Request a t b
252+auth (Request x m p q g u) = Request x m p q g u
253+
254+meth :: Lens' (Request a s b) StdMethod
255+meth = lens _rqMethod (\r x -> r { _rqMethod = x })
256+
257+path :: Lens' (Request a s b) Path
258+path = lens _rqPath (\r x -> r { _rqPath = x })
259+
260+query :: QueryValueLike v
261+ => Lens (Request a s b) (Request a s b) Query [(ByteString, v)]
262+query = lens _rqQuery (\r x -> r { _rqQuery = toQuery x })
263+
264+pager :: Lens' (Request a s b) (Maybe Pager)
265+pager = lens _rqPager (\r x -> r { _rqPager = x })
266+
267+unwrap :: Setter (Request a s b) (Request a s b) (Value -> Parser Value) Unwrap
268+unwrap f r = f (_rqUnwrap r) <&> \k -> r { _rqUnwrap = g k }
269+ where
270+ g k x = maybe (fail "Failed to extract nested keys.") return (x ^? k)
271+
272+-- | Primarily to obtain a constraint for the pagination function, as well as
273+-- the overrideable flexibility.
274+class Paginate a where
275+ next :: Request a s b -> Maybe Pager -> Maybe (Request a s b)
276+ next _ Nothing = Nothing
277+ next rq (Just x)
278+ | x^.pgTotal == 0 = Nothing
279+ | otherwise = Just (rq & pager ?~ (x & pgOffset +~ x^.pgTotal))
280+
281+newtype Key (a :: Symbol) = Key Text
282+ deriving (Eq, Show, IsString)
283+
284+instance ToByteString (Key a) where
285+ builder (Key k) = builder k
286+
287+instance FromJSON (Key a) where
288+ parseJSON = withText "key" (return . Key)
289+
290+instance ToJSON (Key a) where
291+ toJSON (Key k) = toJSON k
292+
293+instance QueryValueLike (Key a) where
294+ toQueryValue = Just . toByteString'
295+
296+type ServiceKey = Key "service"
297+type IncidentKey = Key "incident"
298+
299+newtype Id (a :: Symbol) = Id Text
300+ deriving (Eq, Show, IsString)
301+
302+instance ToByteString (Id a) where
303+ builder (Id i) = builder i
304+
305+instance FromJSON (Id a) where
306+ parseJSON = withText "id" (return . Id)
307+
308+instance ToJSON (Id a) where
309+ toJSON (Id i) = toJSON i
310+
311+instance QueryValueLike (Id a) where
312+ toQueryValue = Just . toByteString'
313+
63− , AlertId
314+type AlertId = Id "alert"
64− , ContactId
315+type PolicyId = Id "policy"
65− , EmailFilterId
316+type RequesterId = Id "requester"
66− , EscalationPolicyId
317+type RuleId = Id "rule"
67− , EscalationRuleId
68− , IncidentId
69− , LogEntryId
70− , NoteId
71− , NotificationRuleId
72− , OverrideId
73− , RequesterId
74− , ScheduleId
318+type ScheduleId = Id "schedule"
75− , ServiceId
319+type ServiceId = Id "service"
320+type TargetId = Id "target"
76− , UserId
321+type UserId = Id "user"
322+type EmailFilterId = Id "email-filter"
77− , VendorId
323+type VendorId = Id "vendor"
78− , WebhookId
324+
79− , WindowId
325+data Empty = Empty
80−
326+
81− -- ** SubDomain
327+instance ToJSON Empty where
82− , SubDomain
328+ toJSON = const (object [])
83− , mkSubDomain
329+
84−
330+instance FromJSON Empty where
331+ parseJSON = withObject "empty" f
332+ where
333+ f !o | Map.null o = pure Empty
334+ | otherwise = fail "Unexpected non-empty JSON object."
335+
336+newtype Email = Email Text
337+ deriving (Eq, Show, IsString)
338+
339+deriveJSON ''Email
340+
341+newtype Phone = Phone Text
342+ deriving (Eq, Show, IsString)
343+
344+deriveJSON ''Phone
345+
346+data Address
347+ = AddrEmail Email
348+ | AddrPhone Phone
349+ deriving (Eq, Show)
350+
351+instance FromJSON Address where
352+ parseJSON o =
353+ AddrEmail <$> parseJSON o
354+ <|> AddrPhone <$> parseJSON o
355+
356+instance ToJSON Address where
357+ toJSON (AddrEmail e) = toJSON e
358+ toJSON (AddrPhone p) = toJSON p
359+
85− -- ** Address
360+makePrisms ''Address
86− , Address
361+
87− , mkAddress
362+data User = User
88−
363+ { _userId :: UserId
89− -- ** Miscellaneous
364+ , _userName :: Text
90− , Empty (..)
365+ , _userEmail :: Email
91− ) where
366+ , _userTimeZone :: TimeZone
92−
367+ , _userColor :: Text
93−import Network.PagerDuty.Internal.Types
368+ , _userRole :: Text
369+ , _userAvatarUrl :: Text
370+ , _userUrl :: Text
371+ , _userInvitationSent :: Bool
372+ } deriving (Eq, Show)
373+
374+deriveJSON ''User
375+makeLenses ''User
stack.yamldeleted−7
@@ -1,7 +0,0 @@
1−resolver: lts-19.23
2−
3−packages:
4−- .
5−
6−nix:
7− packages: [zlib]