{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- Module : Network.PagerDuty.REST.Users -- Copyright : (c) 2013-2015 Brendan Hay -- License : This Source Code Form is subject to the terms of -- the Mozilla Public License, v. 2.0. -- A copy of the MPL can be found in the LICENSE file or -- you can obtain it at http://mozilla.org/MPL/2.0/. -- Maintainer : Brendan Hay -- Stability : experimental -- Portability : non-portable (GHC extensions) -- | Access and manipulate user data for your PagerDuty account. When a user is -- shown inlined in other resources, a deleted user will have its @html_url@ attribute -- set to null. -- -- /See:/ module Network.PagerDuty.REST.Users ( -- * List Users ListUsers , listUsers , luQuery -- * List On Call Users , listOnCallUsers -- * Create User , CreateUser , createUser , cuName , cuEmail , cuRole , cuJobTitle , cuTimeZone -- * Get User , getUser -- * Get User On Call , getUserOnCall -- * Update User , UpdateUser , updateUser , uuName , uuEmail , uuRole , uuJobTitle , uuTimeZone -- * Delete User , deleteUser -- * Types , PolicyInfo , piId , piName , OnCall , ocLevel , ocStart , ocEnd , ocEscalationPolicy , Role (..) , HasUserInfo (..) , UserInfo , User , uRole , uAvatarUrl , uUserUrl , uInvitationSent , uJobTitle ) where import Control.Applicative hiding (empty) import Control.Lens hiding (Empty, (.=)) import Data.Aeson import Data.Default.Class import Data.Monoid import Data.Text (Text) import Data.Time import Network.HTTP.Types import Network.PagerDuty.Internal.TH import Network.PagerDuty.Internal.Types default (Path) users :: Path users = "users" includes :: Query includes = [ ("include[]", Just "contact_methods") , ("include[]", Just "notification_rules") ] data UserInfo = UserInfo { _uId' :: UserId , _uName' :: Text , _uEmail' :: Address , _uColor' :: Text , _uTimeZone' :: TZ } deriving (Eq, Show) deriveRecord ''UserInfo class HasUserInfo a where userInfo :: Lens' a UserInfo -- | The id of the user. uId :: Lens' a UserId -- | The name of the user. uName :: Lens' a Text -- | The user's email address. uEmail :: Lens' a Address -- | The color used to represent the user in schedules. uColor :: Lens' a Text -- | The user's personal time zone. uTimeZone :: Lens' a TimeZone uId = userInfo.uId' uName = userInfo.uName' uEmail = userInfo.uEmail' uColor = userInfo.uColor' uTimeZone = userInfo.uTimeZone'._TZ instance (QueryLike a, ToJSON a, HasUserInfo a) => HasUserInfo (Request a s b) where userInfo = upd.userInfo instance HasUserInfo UserInfo where userInfo = id data PolicyInfo = PolicyInfo { _piId :: EscalationPolicyId , _piName :: Text } deriving (Eq, Show) deriveRecord ''PolicyInfo data OnCall = OnCall { _ocLevel :: !Int , _ocStart :: Maybe Date , _ocEnd :: Maybe Date , _ocEscalationPolicy :: PolicyInfo } deriving (Eq, Show) deriveRecord ''OnCall data Role = RoleAdmin | RoleUser | RoleLimitedUser deriving (Eq, Show) deriveNullaryWith (dropped 4 underscored) ''Role instance Default Role where def = RoleUser data User = User { _uInfo :: UserInfo , _uRole :: !Role , _uAvatarUrl :: Text , _uUserUrl :: Text , _uInvitationSent' :: !Bool' , _uJobTitle :: Maybe Text } deriving (Eq, Show) -- FIXME: add notification_rules, contact_methods, on_call makeLenses ''User instance FromJSON User where parseJSON = withObject "user" $ \o -> User <$> parseJSON (Object o) <*> o .: "role" <*> o .: "avatar_url" <*> o .: "user_url" <*> o .: "invitation_sent" <*> o .:? "job_title" instance ToJSON User where toJSON u = Object (x <> y) where Object x = toJSON (_uInfo u) Object y = object [ "role" .= _uRole u , "avatar_url" .= _uAvatarUrl u , "user_url" .= _uUserUrl u , "invitation_sent" .= _uInvitationSent' u , "job_title" .= _uJobTitle u ] instance HasUserInfo User where userInfo = uInfo uInvitationSent :: Lens' User Bool uInvitationSent = uInvitationSent'._B newtype ListUsers = ListUsers { _luQuery' :: Maybe Text } queryRequest ''ListUsers instance Paginate ListUsers -- | Filters the result, showing only the users whose names or email addresses -- match the query. luQuery :: Lens' (Request ListUsers s b) (Maybe Text) luQuery = upd.luQuery' -- | List users of your PagerDuty account, optionally filtered by a search query. -- -- @GET \/users@ -- -- /See:/ listUsers :: Request ListUsers s [User] listUsers = mk ListUsers { _luQuery' = Nothing } & path .~ users & query .~ includes -- | List all the existing escalation policies with currently on-call users. -- -- If the start and end of an on-call object are null, then the user is always -- on-call for an escalation policy level. -- -- @GET \/escalation_policies\/on_call@ -- -- /See:/ listOnCallUsers :: Request ListUsers s [User] listOnCallUsers = listUsers & path .~ users % "on_call" -- | Get information about an existing user. -- -- @GET \/users\/\:id@ -- -- /See:/ getUser :: UserId -> Request Empty s User getUser u = empty & path .~ users % u & query .~ includes -- | Get a user object with that user's current on-call status. If the on-call -- object is an empty list, the user is never on-call. -- -- If the start and end of an on-call object are null, then the user is always -- on-call for an escalation policy level. -- -- @GET \/users\/\:id\/on_call@ -- -- /See:/ getUserOnCall :: UserId -> Request Empty s User getUserOnCall u = empty & path .~ users % u % "on_call" & query .~ includes data CreateUser = CreateUser { _cuName' :: Text , _cuEmail' :: Address , _cuRole' :: Maybe Role , _cuJobTitle' :: Maybe Text , _cuTimeZone' :: Maybe TZ } deriving (Eq, Show) jsonRequest ''CreateUser -- | The name of the user. cuName :: Lens' (Request CreateUser s b) Text cuName = upd.cuName' -- | The email of the user. The newly created user will receive an email asking -- to confirm the subscription. cuEmail :: Lens' (Request CreateUser s b) Address cuEmail = upd.cuEmail' -- | The user's role. cuRole :: Lens' (Request CreateUser s b) (Maybe Role) cuRole = upd.cuRole' -- | The job title of the user. cuJobTitle :: Lens' (Request CreateUser s b) (Maybe Text) cuJobTitle = upd.cuJobTitle' -- | The time zone the user is in. If not specified, the time zone of the -- account making the API call will be used. cuTimeZone :: Lens' (Request CreateUser s b) (Maybe TimeZone) cuTimeZone = upd.cuTimeZone'.mapping _TZ -- | Create a new user for your account. An invite email will be sent asking -- the user to choose a password. -- -- @POST \/users@ -- -- /See:/ createUser :: RequesterId -> Text -- ^ 'cuName' -> Address -- ^ 'cuEmail' -> Request CreateUser s User createUser r n e = auth (createUserBasic n e) & query .~ [("requester_id", r)] -- | A version of 'disableService' which uses HTTP Basic authentication and -- doesn't require a 'RequesterId'. createUserBasic :: Text -- ^ 'cuName' -> Address -- ^ 'cuEmail' -> Request CreateUser 'Basic User createUserBasic n e = mk CreateUser { _cuName' = n , _cuEmail' = e , _cuRole' = Nothing , _cuJobTitle' = Nothing , _cuTimeZone' = Nothing } & meth .~ POST & path .~ users data UpdateUser = UpdateUser { _uuName' :: Maybe Text , _uuEmail' :: Maybe Address , _uuRole' :: Maybe Role , _uuJobTitle' :: Maybe Text , _uuTimeZone' :: Maybe TZ } deriving (Eq, Show) jsonRequest ''UpdateUser -- | The name of the user. uuName :: Lens' (Request UpdateUser s b) (Maybe Text) uuName = upd.uuName' -- | The email of the user. The newly created user will receive an email asking -- to confirm the subscription. uuEmail :: Lens' (Request UpdateUser s b) (Maybe Address) uuEmail = upd.uuEmail' -- | The user's role. uuRole :: Lens' (Request UpdateUser s b) (Maybe Role) uuRole = upd.uuRole' -- | The job title of the user. uuJobTitle :: Lens' (Request UpdateUser s b) (Maybe Text) uuJobTitle = upd.uuJobTitle' -- | The time zone the user is in. If not specified, the time zone of the -- account making the API call will be used. uuTimeZone :: Lens' (Request UpdateUser s b) (Maybe TimeZone) uuTimeZone = upd.uuTimeZone'.mapping _TZ -- | Update an existing user. -- -- @PUT \/users\/\:id@ -- -- /See:/ updateUser :: UserId -> Request UpdateUser s User updateUser u = mk UpdateUser { _uuName' = Nothing , _uuEmail' = Nothing , _uuRole' = Nothing , _uuJobTitle' = Nothing , _uuTimeZone' = Nothing } & meth .~ PUT & path .~ users % u -- | Remove an existing user. -- -- @DELETE \/users\/\:id@ -- -- /See:/ deleteUser :: UserId -> Request Empty s Empty deleteUser u = empty & meth .~ DELETE & path .~ users % u -- FIXME: deal with conflict errors