module Network.PagerDuty.Integration
(
submit
, submitWith
, Trigger
, trigger
, client
, clientUrl
, Acknowledge
, acknowledge
, Resolve
, resolve
, HasServiceKey (..)
, HasIncidentKey (..)
, HasDescription (..)
, HasDetails (..)
, Event (..)
, _Trigger
, _Acknowledge
, _Resolve
, Response
, rsStatus
, rsMessage
, rsIncidentKey
, Generic
, module Network.PagerDuty.Types
) where
import Control.Lens
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.HashMap.Strict as Map
import Data.Text (Text)
import Network.HTTP.Client (Manager)
import qualified Network.HTTP.Client as Client
import Network.PagerDuty.Internal.IO
import Network.PagerDuty.Internal.TH
import Network.PagerDuty.Internal.Types
import Network.PagerDuty.Types hiding (description, message)
data Response = Response
{ _rsStatus :: Text
, _rsMessage :: Text
, _rsIncidentKey :: IncidentKey
} deriving (Eq, Show)
deriveJSON ''Response
makeLens "_rsStatus" ''Response
makeLens "_rsMessage" ''Response
makeLens "_rsIncidentKey" ''Response
class HasServiceKey s a | s -> a where
serviceKey :: Lens' s a
class HasIncidentKey s a | s -> a where
incidentKey :: Lens' s a
class HasDescription s a | s -> a where
description :: Lens' s a
class HasDetails s a | s -> a where
details :: Lens' s a
data Trigger = Trigger'
{ _tServiceKey' :: ServiceKey
, _tIncidentKey' :: IncidentKey
, _tDescription' :: Text
, _tDetails' :: Maybe Object
, _tClient' :: Maybe Text
, _tClientUrl' :: Maybe Text
} deriving (Eq, Show)
deriveRecord ''Trigger
instance HasServiceKey Trigger ServiceKey where serviceKey = tServiceKey'
instance HasIncidentKey Trigger IncidentKey where incidentKey = tIncidentKey'
instance HasDescription Trigger Text where description = tDescription'
instance HasDetails Trigger (Maybe Object) where details = tDetails'
client :: Lens' Trigger (Maybe Text)
client = tClient'
clientUrl :: Lens' Trigger (Maybe Text)
clientUrl = tClientUrl'
data Generic = Generic'
{ _gServiceKey' :: ServiceKey
, _gIncidentKey' :: IncidentKey
, _gDescription' :: Maybe Text
, _gDetails' :: Maybe Object
} deriving (Eq, Show)
deriveRecord ''Generic
instance HasServiceKey Generic ServiceKey where serviceKey = gServiceKey'
instance HasIncidentKey Generic IncidentKey where incidentKey = gIncidentKey'
instance HasDescription Generic (Maybe Text) where description = gDescription'
instance HasDetails Generic (Maybe Object) where details = gDetails'
type Resolve = Generic
type Acknowledge = Generic
data Event
= Trigger Trigger
| Acknowledge Generic
| Resolve Generic
deriving (Eq, Show)
makePrisms ''Event
instance HasServiceKey Event ServiceKey where
serviceKey = lens f g
where
f (Trigger s) = _tServiceKey' s
f (Acknowledge s) = _gServiceKey' s
f (Resolve s) = _gServiceKey' s
g (Trigger s) x = Trigger $ s { _tServiceKey' = x }
g (Acknowledge s) x = Acknowledge $ s { _gServiceKey' = x }
g (Resolve s) x = Resolve $ s { _gServiceKey' = x }
instance HasIncidentKey Event IncidentKey where
incidentKey = lens f g
where
f (Trigger s) = _tIncidentKey' s
f (Acknowledge s) = _gIncidentKey' s
f (Resolve s) = _gIncidentKey' s
g (Trigger s) x = Trigger $ s { _tIncidentKey' = x }
g (Acknowledge s) x = Acknowledge $ s { _gIncidentKey' = x }
g (Resolve s) x = Resolve $ s { _gIncidentKey' = x }
instance HasDetails Event (Maybe Object) where
details = lens f g
where
f (Trigger s) = _tDetails' s
f (Acknowledge s) = _gDetails' s
f (Resolve s) = _gDetails' s
g (Trigger s) x = Trigger $ s { _tDetails' = x }
g (Acknowledge s) x = Acknowledge $ s { _gDetails' = x }
g (Resolve s) x = Resolve $ s { _gDetails' = x }
instance ToJSON Event where
toJSON = \case
Trigger x -> event "trigger" x
Acknowledge x -> event "acknowledge" x
Resolve x -> event "resolve" x
where
event k x =
case toJSON x of
Object o -> Object (Map.insert "event_type" (String k) o)
v -> v
trigger :: ServiceKey
-> IncidentKey
-> Text
-> Event
trigger k i d =
Trigger Trigger'
{ _tServiceKey' = k
, _tDescription' = d
, _tIncidentKey' = i
, _tClient' = Nothing
, _tClientUrl' = Nothing
, _tDetails' = Nothing
}
acknowledge :: ServiceKey
-> IncidentKey
-> Event
acknowledge k i =
Acknowledge Generic'
{ _gServiceKey' = k
, _gIncidentKey' = i
, _gDescription' = Nothing
, _gDetails' = Nothing
}
resolve :: ServiceKey
-> IncidentKey
-> Event
resolve k i =
Resolve Generic'
{ _gServiceKey' = k
, _gIncidentKey' = i
, _gDescription' = Nothing
, _gDetails' = Nothing
}
submit :: MonadIO m => Manager -> Event -> m (Either Error Response)
submit m = submitWith m None
submitWith :: MonadIO m
=> Manager
-> Logger
-> Event
-> m (Either Error Response)
submitWith m l e = request m l e $
Client.defaultRequest
{ Client.host = "events.pagerduty.com"
, Client.path = "/generic/2010-04-15/create_event.json"
, Client.method = "POST"
}