module Network.PagerDuty.REST.Schedules
(
ListSchedules
, listSchedules
, lsQuery
, GetSchedule
, getSchedule
, gsSince
, gsUntil
, gsTimeZone
, GetScheduleUsers
, getScheduleUsers
, gsuSince
, gsuUntil
, GetScheduleEntries
, getScheduleEntries
, gseSince
, gseUntil
, gseOverflow
, gseTimeZone
, gseUserId
, CreateSchedule
, createSchedule
, csName
, csOverflow
, csTimeZone
, csScheduleLayers
, UpdateSchedule
, updateSchedule
, usOverflow
, usTimeZone
, usScheduleLayers
, PreviewSchedule
, previewSchedule
, psSince
, psUntil
, psOverflow
, psName
, psTimeZone
, psScheduleLayers
, deleteSchedule
, RestrictionType (..)
, Restriction
, rStartTimeOfDay
, rDurationSeconds
, Rotation
, rMemberOrder
, rUser
, ScheduleLayer
, slName
, slRenderedScheduleEntries
, slRestrictionType
, slRestrictions
, slPriority
, slStart
, slEnd
, slRenderedCoveragePercentage
, slRotationTurnLengthSeconds
, slRotationVirtualStart
, slUsers
, HasScheduleInfo (..)
, ScheduleInfo
, Schedule
, sScheduleLayers
, sOverridesSubschedule
, sFinalSchedule
) where
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Text (Text)
import Data.Time
import Network.HTTP.Types
import Network.PagerDuty.REST.Users (User)
import Network.PagerDuty.Internal.TH
import Network.PagerDuty.Internal.Types
default (Path)
schedules :: Path
schedules = "schedules"
data RestrictionType
= Daily
| Weekly
deriving (Eq, Show)
deriveNullary ''RestrictionType
data Restriction = Restriction
{ _rStartTimeOfDay :: Date
, _rDurationSeconds :: !Int
} deriving (Eq, Show)
deriveJSON ''Restriction
rStartTimeOfDay :: Lens' Restriction UTCTime
rStartTimeOfDay =
lens _rStartTimeOfDay (\r x -> r { _rStartTimeOfDay = x }) . _D
makeLens "_rDurationSeconds" ''Restriction
data Rotation = Rotation
{ _rMemberOrder :: !Int
, _rUser :: User
} deriving (Eq, Show)
deriveRecord ''Rotation
data ScheduleLayer = ScheduleLayer
{ _slName :: Text
, _slRenderedScheduleEntries :: [ScheduleId]
, _slRestrictionType :: !RestrictionType
, _slRestrictions :: [Restriction]
, _slPriority :: !Int
, _slStart :: Date
, _slEnd :: Date
, _slRenderedCoveragePercentage :: !Double
, _slRotationTurnLengthSeconds :: !Int
, _slRotationVirtualStart :: Date
, _slUsers :: [Rotation]
} deriving (Eq, Show)
deriveJSON ''ScheduleLayer
makeLens "_slName" ''ScheduleLayer
makeLens "_slRenderedScheduleEntries" ''ScheduleLayer
makeLens "_slRestrictionType" ''ScheduleLayer
makeLens "_slRestrictions" ''ScheduleLayer
makeLens "_slPriority" ''ScheduleLayer
makeLens "_slStart" ''ScheduleLayer
makeLens "_slEnd" ''ScheduleLayer
makeLens "_slRenderedCoveragePercentage" ''ScheduleLayer
makeLens "_slRotationTurnLengthSeconds" ''ScheduleLayer
makeLens "_slRotationVirtualStart" ''ScheduleLayer
makeLens "_slUsers" ''ScheduleLayer
data ScheduleInfo = ScheduleInfo
{ _siId' :: ScheduleId
, _siName' :: Text
, _siTimeZone' :: TZ
, _siToday' :: Date
, _siEscalationPolicies' :: [EscalationPolicyId]
} deriving (Eq, Show)
deriveRecord ''ScheduleInfo
class HasScheduleInfo a where
scheduleInfo :: Lens' a ScheduleInfo
sId :: Lens' a ScheduleId
sName :: Lens' a Text
sTimeZone :: Lens' a TimeZone
sToday :: Lens' a UTCTime
sEscalationPolicies :: Lens' a [EscalationPolicyId]
sId = scheduleInfo.siId'
sName = scheduleInfo.siName'
sTimeZone = scheduleInfo.siTimeZone'._TZ
sToday = scheduleInfo.siToday'._D
sEscalationPolicies = scheduleInfo.siEscalationPolicies'
instance HasScheduleInfo ScheduleInfo where
scheduleInfo = id
data Schedule = Schedule
{ _sInfo :: ScheduleInfo
, _sScheduleLayers :: [ScheduleLayer]
, _sOverridesSubschedule :: ScheduleLayer
, _sFinalSchedule :: ScheduleLayer
} deriving (Eq, Show)
deriveJSON ''Schedule
instance HasScheduleInfo Schedule where
scheduleInfo = lens _sInfo (\s x -> s { _sInfo = x })
makeLens "_sScheduleLayers" ''Schedule
makeLens "_sOverridesSubschedule" ''Schedule
makeLens "_sFinalSchedule" ''Schedule
newtype ListSchedules = ListSchedules
{ _lsQuery' :: Maybe Text
} deriving (Eq, Show)
queryRequest ''ListSchedules
lsQuery :: Lens' (Request ListSchedules s b) (Maybe Text)
lsQuery = upd.lsQuery'
instance Paginate ListSchedules
listSchedules :: RequesterId -> Request ListSchedules s [ScheduleInfo]
listSchedules r = auth listSchedulesBasic & query .~ [("requester_id", r)]
listSchedulesBasic :: Request ListSchedules s [ScheduleInfo]
listSchedulesBasic =
mk ListSchedules
{ _lsQuery' = Nothing
} & path .~ schedules
data GetSchedule = GetSchedule
{ _gsSince' :: Maybe Date
, _gsUntil' :: Maybe Date
, _gsTimeZone' :: Maybe TZ
} deriving (Eq, Show)
queryRequest ''GetSchedule
gsSince :: Lens' (Request GetSchedule s b) (Maybe UTCTime)
gsSince = upd.gsSince'.mapping _D
gsUntil :: Lens' (Request GetSchedule s b) (Maybe UTCTime)
gsUntil = upd.gsUntil'.mapping _D
gsTimeZone :: Lens' (Request GetSchedule s b) (Maybe TimeZone)
gsTimeZone = upd.gsTimeZone'.mapping _TZ
getSchedule :: Request GetSchedule s Schedule
getSchedule =
mk GetSchedule
{ _gsSince' = Nothing
, _gsUntil' = Nothing
, _gsTimeZone' = Nothing
} & path .~ schedules
data GetScheduleUsers = GetScheduleUsers
{ _gsuSince' :: Maybe Date
, _gsuUntil' :: Maybe Date
} deriving (Eq, Show)
queryRequest ''GetScheduleUsers
gsuSince :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)
gsuSince = upd.gsuSince'.mapping _D
gsuUntil :: Lens' (Request GetScheduleUsers s b) (Maybe UTCTime)
gsuUntil = upd.gsuUntil'.mapping _D
getScheduleUsers :: UserId -> Request GetScheduleUsers s [User]
getScheduleUsers u =
mk GetScheduleUsers
{ _gsuSince' = Nothing
, _gsuUntil' = Nothing
} & path .~ schedules % u % "users"
data GetScheduleEntries = GetScheduleEntries
{ _gseSince' :: Date
, _gseUntil' :: Date
, _gseOverflow' :: !Bool'
, _gseTimeZone' :: Maybe TZ
, _gseUserId' :: Maybe UserId
} deriving (Eq, Show)
queryRequest ''GetScheduleEntries
gseSince :: Lens' (Request GetScheduleEntries s b) UTCTime
gseSince = upd.gseSince'._D
gseUntil :: Lens' (Request GetScheduleEntries s b) UTCTime
gseUntil = upd.gseUntil'._D
gseOverflow :: Lens' (Request GetScheduleEntries s b) Bool
gseOverflow = upd.gseOverflow'._B
gseTimeZone :: Lens' (Request GetScheduleEntries s b) (Maybe TimeZone)
gseTimeZone = upd.gseTimeZone'.mapping _TZ
gseUserId :: Lens' (Request GetScheduleEntries s b) (Maybe UserId)
gseUserId = upd.gseUserId'
getScheduleEntries :: UserId
-> Date
-> Date
-> Request GetScheduleEntries s b
getScheduleEntries i s u =
mk GetScheduleEntries
{ _gseSince' = s
, _gseUntil' = u
, _gseOverflow' = F
, _gseTimeZone' = Nothing
, _gseUserId' = Nothing
} & path .~ schedules % i
data CreateSchedule = CreateSchedule
{ _csName' :: Text
, _csOverflow' :: !Bool'
, _csTimeZone' :: TZ
, _csScheduleLayers' :: [ScheduleLayer]
} deriving (Eq, Show)
makeLenses ''CreateSchedule
instance ToJSON CreateSchedule where
toJSON cs = object
[ "name" .= _csName' cs
, "overflow" .= _csOverflow' cs
, "schedule" .= object
[ "time_zone" .= _csTimeZone' cs
, "schedule_layers" .= _csScheduleLayers' cs
]
]
instance QueryLike CreateSchedule where
toQuery = const []
csOverflow :: Lens' (Request CreateSchedule s b) Bool
csOverflow = upd.csOverflow'._B
csName :: Lens' (Request CreateSchedule s b) Text
csName = upd.csName'
csTimeZone :: Lens' (Request CreateSchedule s b) TimeZone
csTimeZone = upd.csTimeZone'._TZ
csScheduleLayers :: Lens' (Request CreateSchedule s b) [ScheduleLayer]
csScheduleLayers = upd.csScheduleLayers'
createSchedule :: Text
-> TimeZone
-> [ScheduleLayer]
-> Request CreateSchedule s Schedule
createSchedule n z ls =
mk CreateSchedule
{ _csName' = n
, _csOverflow' = F
, _csTimeZone' = TZ z
, _csScheduleLayers' = ls
} & meth .~ POST
& path .~ schedules
data UpdateSchedule = UpdateSchedule
{ _usOverflow' :: !Bool'
, _usTimeZone' :: TZ
, _usScheduleLayers' :: [ScheduleLayer]
} deriving (Eq, Show)
makeLenses ''UpdateSchedule
instance ToJSON UpdateSchedule where
toJSON us = object
[ "overflow" .= _usOverflow' us
, "schedule" .= object
[ "time_zone" .= _usTimeZone' us
, "schedule_layers" .= _usScheduleLayers' us
]
]
instance QueryLike UpdateSchedule where
toQuery = const []
usOverflow :: Lens' (Request UpdateSchedule s b) Bool
usOverflow = upd.usOverflow'._B
usTimeZone :: Lens' (Request UpdateSchedule s b) TimeZone
usTimeZone = upd.usTimeZone'._TZ
usScheduleLayers :: Lens' (Request UpdateSchedule s b) [ScheduleLayer]
usScheduleLayers = upd.usScheduleLayers'
updateSchedule :: ScheduleId
-> TimeZone
-> [ScheduleLayer]
-> Request UpdateSchedule s Schedule
updateSchedule s z ls =
mk UpdateSchedule
{ _usOverflow' = F
, _usTimeZone' = TZ z
, _usScheduleLayers' = ls
} & meth .~ PUT
& path .~ schedules % s
data PreviewSchedule = PreviewSchedule
{ _psSince' :: Maybe Date
, _psUntil' :: Maybe Date
, _psName' :: Text
, _psOverflow' :: !Bool'
, _psTimeZone' :: TZ
, _psScheduleLayers' :: [ScheduleLayer]
} deriving (Eq, Show)
makeLenses ''PreviewSchedule
instance ToJSON PreviewSchedule where
toJSON ps = object
[ "since" .= _psSince' ps
, "until" .= _psUntil' ps
, "name" .= _psName' ps
, "overflow" .= _psOverflow' ps
, "schedule" .= object
[ "time_zone" .= _psTimeZone' ps
, "schedule_layers" .= _psScheduleLayers' ps
]
]
instance QueryLike PreviewSchedule where
toQuery = const []
psSince :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)
psSince = upd.psSince'.mapping _D
psUntil :: Lens' (Request PreviewSchedule s b) (Maybe UTCTime)
psUntil = upd.psUntil'.mapping _D
psOverflow :: Lens' (Request PreviewSchedule s b) Bool
psOverflow = upd.psOverflow'._B
psName :: Lens' (Request PreviewSchedule s b) Text
psName = upd.psName'
psTimeZone :: Lens' (Request PreviewSchedule s b) TimeZone
psTimeZone = upd.psTimeZone'._TZ
psScheduleLayers :: Lens' (Request PreviewSchedule s b) [ScheduleLayer]
psScheduleLayers = upd.psScheduleLayers'
previewSchedule :: Text
-> TimeZone
-> [ScheduleLayer]
-> Request PreviewSchedule s Schedule
previewSchedule n z ls =
mk PreviewSchedule
{ _psSince' = Nothing
, _psUntil' = Nothing
, _psName' = n
, _psOverflow' = F
, _psTimeZone' = TZ z
, _psScheduleLayers' = ls
} & meth .~ POST
& path .~ schedules % "preview"
deleteSchedule :: ScheduleId -> Request Empty s Empty
deleteSchedule s = empty & meth .~ DELETE & path .~ schedules % s