module CircleCI.User (
getUserInfo
, UserInfo (..)
, ProjectShortInfo (..)
, EmailNotification (..)
, Plan (..)
, GitHubOAuth (..)
, AnalyticsId
, module CircleCI.Common.Types
, module CircleCI.Common.Run
) where
import CircleCI.Common.URL
import CircleCI.Common.Types
import CircleCI.Common.HTTPS
import 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
getUserInfo :: CircleCIResponse UserInfo
getUserInfo = do
AccountAPIToken token <- ask
liftIO . runExceptT $ do
manager <- httpsManager
servantGetUserInfo (Just token)
manager
apiBaseUrl
type AnalyticsId = Text
data UserInfo = UserInfo {
inBetaProgram :: Bool
, fullName :: Text
, allEmails :: [Text]
, defaultEmail :: Text
, basicEmailPreference :: EmailNotification
, gitHubAvatarUrl :: Text
, gitHubId :: Integer
, gitHubLogin :: Text
, gitHubOAuthScopes :: [GitHubOAuth]
, accountCreatedAt :: UTCTime
, trialEndDate :: UTCTime
, plan :: Plan
, parallelism :: Int
, containtersNumber :: Int
, projects :: [ProjectShortInfo]
, analyticsId :: AnalyticsId
, pusherId :: Text
, herokuAPIKey :: Maybe Text
} deriving (Show)
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
data ProjectShortInfo = ProjectShortInfo {
gitHubURL :: Text
, onDashboard :: Bool
, emailNotification :: EmailNotification
} 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
data Plan = Hobbyist
| Plan Text
deriving (Show)
toPlan :: Text -> Parser Plan
toPlan "" = return Hobbyist
toPlan key = return $ Plan key
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
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
type UserAPI = GetUserInfoCall
type GetUserInfoCall =
"me"
:> QueryParam "circle-token" Token
:> Get '[JSON] UserInfo
servantGetUserInfo :: Maybe Token
-> Manager
-> BaseUrl
-> ClientM UserInfo
servantGetUserInfo = client userAPI
userAPI :: P.Proxy UserAPI
userAPI = P.Proxy