module Network.PagerDuty.REST.Users
(
ListUsers
, listUsers
, luQuery
, listOnCallUsers
, CreateUser
, createUser
, cuName
, cuEmail
, cuRole
, cuJobTitle
, cuTimeZone
, getUser
, getUserOnCall
, UpdateUser
, updateUser
, uuName
, uuEmail
, uuRole
, uuJobTitle
, uuTimeZone
, deleteUser
, PolicyInfo
, piId
, piName
, OnCall
, ocLevel
, ocStart
, ocEnd
, ocEscalationPolicy
, Role (..)
, HasUserInfo (..)
, UserInfo
, User
, uRole
, uAvatarUrl
, uUserUrl
, uInvitationSent
, uJobTitle
) where
import Control.Applicative hiding (empty)
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Default.Class
import Data.Monoid
import Data.Text (Text)
import Data.Time
import Network.HTTP.Types
import Network.PagerDuty.Internal.TH
import Network.PagerDuty.Internal.Types
default (Path)
users :: Path
users = "users"
includes :: Query
includes =
[ ("include[]", Just "contact_methods")
, ("include[]", Just "notification_rules")
]
data UserInfo = UserInfo
{ _uId' :: UserId
, _uName' :: Text
, _uEmail' :: Address
, _uColor' :: Text
, _uTimeZone' :: TZ
} deriving (Eq, Show)
deriveRecord ''UserInfo
class HasUserInfo a where
userInfo :: Lens' a UserInfo
uId :: Lens' a UserId
uName :: Lens' a Text
uEmail :: Lens' a Address
uColor :: Lens' a Text
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)
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
luQuery :: Lens' (Request ListUsers s b) (Maybe Text)
luQuery = upd.luQuery'
listUsers :: Request ListUsers s [User]
listUsers =
mk ListUsers
{ _luQuery' = Nothing
} & path .~ users
& query .~ includes
listOnCallUsers :: Request ListUsers s [User]
listOnCallUsers = listUsers & path .~ users % "on_call"
getUser :: UserId -> Request Empty s User
getUser u = empty & path .~ users % u & query .~ includes
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
cuName :: Lens' (Request CreateUser s b) Text
cuName = upd.cuName'
cuEmail :: Lens' (Request CreateUser s b) Address
cuEmail = upd.cuEmail'
cuRole :: Lens' (Request CreateUser s b) (Maybe Role)
cuRole = upd.cuRole'
cuJobTitle :: Lens' (Request CreateUser s b) (Maybe Text)
cuJobTitle = upd.cuJobTitle'
cuTimeZone :: Lens' (Request CreateUser s b) (Maybe TimeZone)
cuTimeZone = upd.cuTimeZone'.mapping _TZ
createUser :: RequesterId
-> Text
-> Address
-> Request CreateUser s User
createUser r n e = auth (createUserBasic n e) & query .~ [("requester_id", r)]
createUserBasic :: Text
-> Address
-> 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
uuName :: Lens' (Request UpdateUser s b) (Maybe Text)
uuName = upd.uuName'
uuEmail :: Lens' (Request UpdateUser s b) (Maybe Address)
uuEmail = upd.uuEmail'
uuRole :: Lens' (Request UpdateUser s b) (Maybe Role)
uuRole = upd.uuRole'
uuJobTitle :: Lens' (Request UpdateUser s b) (Maybe Text)
uuJobTitle = upd.uuJobTitle'
uuTimeZone :: Lens' (Request UpdateUser s b) (Maybe TimeZone)
uuTimeZone = upd.uuTimeZone'.mapping _TZ
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
deleteUser :: UserId -> Request Empty s Empty
deleteUser u = empty & meth .~ DELETE & path .~ users % u