src/Network/CircleCI/User.hs
{-|
Module : Network.CircleCI.User
Copyright : (c) Denis Shevchenko, 2016
License : MIT
Maintainer : me@dshevchenko.biz
Stability : alpha
API calls for work with User info.
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
module Network.CircleCI.User (
-- * API call
getUserInfo
-- * Types for calls and response
, UserInfo (..)
, ProjectShortInfo (..)
, EmailNotification (..)
, Plan (..)
, GitHubOAuth (..)
, AnalyticsId
, module Network.CircleCI.Common.Types
, module Network.CircleCI.Common.Run
) where
import Network.CircleCI.Common.URL
import Network.CircleCI.Common.Types
import Network.CircleCI.Common.HTTPS
import Network.CircleCI.Common.Run
import Control.Monad ( mzero )
import Control.Monad.Except ( runExceptT )
import Control.Monad.Reader ( ask )
import Control.Monad.IO.Class ( liftIO )
import Data.Aeson
import Data.Aeson.Types
import Data.HashMap.Strict
import qualified Data.Proxy as P
import Data.Text ( Text )
import Data.Time.Clock ( UTCTime )
import Network.HTTP.Client ( Manager )
import Servant.API
import Servant.Client
-- | Show info about user. Based on https://circleci.com/docs/api/#user.
--
-- Usage example:
--
-- @
-- {-\# LANGUAGE OverloadedStrings \#-}
-- {-\# LANGUAGE LambdaCase \#-}
--
-- import Network.CircleCI
--
-- main :: IO ()
-- main = runCircleCI getUserInfo
-- (AccountAPIToken "e64c674195bbc0d0be3efa2whatever")
-- >>= \\case
-- Left problem -> print problem
-- Right info -> print info
-- @
getUserInfo :: CircleCIResponse UserInfo -- ^ Info about the signed in user.
getUserInfo = do
AccountAPIToken token <- ask
liftIO . runExceptT $ do
manager <- httpsManager
servantGetUserInfo (Just token)
manager
apiBaseUrl
-- | User's analytics id. For example, @"6fc20e13-008e-4dc9-b158-ababd33a099d"@.
type AnalyticsId = Text
-- | Info about user.
data UserInfo = UserInfo {
inBetaProgram :: Bool -- ^ Does user in the CircleCI Beta Program?
, fullName :: Text -- ^ User's full name.
, allEmails :: [Text] -- ^ All email addresses in user's account.
, defaultEmail :: Text -- ^ Default email for notifications.
, basicEmailPreference :: EmailNotification -- ^ User email notifications.
, gitHubAvatarUrl :: Text -- ^ GitHub avatar URL.
, gitHubId :: Integer -- ^ GitHub ID.
, gitHubLogin :: Text -- ^ User's GitHub login.
, gitHubOAuthScopes :: [GitHubOAuth] -- ^ GitHub OAuth scopes.
, accountCreatedAt :: UTCTime -- ^ Date when CircleCI-account was created.
, trialEndDate :: UTCTime -- ^ Trial period end date.
, plan :: Plan -- ^ User's plan pricing.
, parallelism :: Int -- ^ Parallelism for tests.
, containtersNumber :: Int -- ^ Number of user's build containers.
, projects :: [ProjectShortInfo] -- ^ User's projects, short info.
, analyticsId :: AnalyticsId -- ^ Analytics ID.
, pusherId :: Text -- ^ Pusher ID.
, herokuAPIKey :: Maybe Text -- ^ Heroku API key.
} deriving (Show)
-- How to create UserInfo from JSON.
instance FromJSON UserInfo where
parseJSON (Object o) = UserInfo
<$> o .: "in_beta_program"
<*> o .: "name"
<*> o .: "all_emails"
<*> o .: "selected_email"
<*> (o .: "basic_email_prefs" >>= toEmailPreference)
<*> o .: "avatar_url"
<*> o .: "github_id"
<*> o .: "login"
<*> (o .: "github_oauth_scopes" >>= toGitHubOAuth)
<*> o .: "created_at"
<*> o .: "trial_end"
<*> (o .:? "plan" .!= "" >>= toPlan)
<*> o .: "parallelism"
<*> o .: "containers"
<*> (o .: "projects" >>= toProjectsShortInfo)
<*> o .: "analytics_id"
<*> o .: "pusher_id"
<*> o .:? "heroku_api_key"
parseJSON _ = mzero
-- | Short info about the project.
data ProjectShortInfo = ProjectShortInfo {
gitHubURL :: Text -- ^ Project's GitHUb URL.
, onDashboard :: Bool -- ^ Does this project on CircleCI Dashboard?
, emailNotification :: EmailNotification -- ^ Email notifications for this project.
} deriving (Show)
toProjectsShortInfo :: HashMap Text RawProject -> Parser [ProjectShortInfo]
toProjectsShortInfo rawProjects = return
[ProjectShortInfo { gitHubURL = githubUrl
, onDashboard = rawOnDashboard rawProject
, emailNotification = rawEmailNotification rawProject
}
| (githubUrl, rawProject) <- toList rawProjects]
data RawProject = RawProject {
rawOnDashboard :: Bool
, rawEmailNotification :: EmailNotification
} deriving (Show)
instance FromJSON RawProject where
parseJSON (Object o) = RawProject
<$> o .: "on_dashboard"
<*> (o .: "emails" >>= toEmailPreference)
parseJSON _ = mzero
-- | CircleCI plan. For more info please see https://circleci.com/pricing/.
data Plan = Hobbyist -- ^ Hobbyist is a free plan for Linux.
| Plan Text -- ^ Commercial plan.
deriving (Show)
toPlan :: Text -> Parser Plan
toPlan "" = return Hobbyist
toPlan key = return $ Plan key
-- | Email notification preference.
data EmailNotification = DefaultNotification
| AllBuildsNotification
| BranchesIHavePushedTo
| WithoutNotification
deriving (Show)
toEmailPreference :: Text -> Parser EmailNotification
toEmailPreference "default" = return DefaultNotification
toEmailPreference "all" = return AllBuildsNotification
toEmailPreference "smart" = return BranchesIHavePushedTo
toEmailPreference "none" = return WithoutNotification
toEmailPreference _ = return DefaultNotification
-- | GitHub OAuth mode.
data GitHubOAuth = UserEmailOAuth
| RepoOAuth
deriving (Show)
toGitHubOAuth :: [Text] -> Parser [GitHubOAuth]
toGitHubOAuth raw = return $ Prelude.map convert raw
where
convert :: Text -> GitHubOAuth
convert "user:email" = UserEmailOAuth
convert "repo" = RepoOAuth
convert _ = RepoOAuth
-------------------------------------------------------------------------------
-- API types for Servant ------------------------------------------------------
-------------------------------------------------------------------------------
-- Complete API for work with user info.
type UserAPI = GetUserInfoCall
-- Clears build cache.
type GetUserInfoCall =
"me"
:> QueryParam "circle-token" Token
:> Get '[JSON] UserInfo
-- GET: /me?circle-token=:token
-------------------------------------------------------------------------------
-- API client calls for Servant -----------------------------------------------
-------------------------------------------------------------------------------
servantGetUserInfo :: Maybe Token
-> Manager
-> BaseUrl
-> ClientM UserInfo
servantGetUserInfo = client userAPI
userAPI :: P.Proxy UserAPI
userAPI = P.Proxy