circlehs (empty) → 0.0.3
raw patch · 15 files changed
+1497/−0 lines, 15 filesdep +aesondep +basedep +http-clientsetup-changed
Dependencies added: aeson, base, http-client, http-client-tls, mtl, servant, servant-client, text, time, transformers, unordered-containers
Files
- CHANGELOG.md +4/−0
- LICENSE +21/−0
- README.md +26/−0
- Setup.hs +2/−0
- circlehs.cabal +68/−0
- src/Network/CircleCI.hs +39/−0
- src/Network/CircleCI/Cache.hs +123/−0
- src/Network/CircleCI/CheckoutKey.hs +323/−0
- src/Network/CircleCI/Common/HTTPS.hs +22/−0
- src/Network/CircleCI/Common/Run.hs +21/−0
- src/Network/CircleCI/Common/Types.hs +63/−0
- src/Network/CircleCI/Common/URL.hs +25/−0
- src/Network/CircleCI/Environment.hs +315/−0
- src/Network/CircleCI/Project.hs +233/−0
- src/Network/CircleCI/User.hs +212/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+0.0.3+------+* The first version for Hackage's main index.+
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Denis Shevchenko++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,26 @@+[](https://circleci.com/gh/denisshevchenko/circlehs) [](https://codeclimate.com/github/denisshevchenko/circlehs) [](http://hackage.haskell.org/package/circlehs)++# CircleHs++The [CircleCI](https://circleci.com/) REST API implementation in Haskell. For more info please see [official API reference](https://circleci.com/docs/api/).++Work in progress.++## Hello, CircleCI!++Let's obtain information about the user:++```haskell+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++import Network.CircleCI++main :: IO ()+main = runCircleCI getUserInfo+ (AccountAPIToken "e64c67410f96ba2whatever")+ >>= \case+ Left problem -> print problem+ Right info -> print info+```+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ circlehs.cabal view
@@ -0,0 +1,68 @@+name: circlehs+version: 0.0.3++synopsis: The CircleCI REST API for Haskell+description:+ The CircleCI REST API implementation in Haskell. For more info please see <https://circleci.com/docs/api/ official API reference>.+ .+ Built with <http://hackage.haskell.org/package/servant Servant>.+ .+ /Please note that implementation is incomplete yet./++homepage: https://github.com/denisshevchenko/circlehs+bug-reports: https://github.com/denisshevchenko/circlehs/issues++stability: alpha++license: MIT+license-file: LICENSE++author: Denis Shevchenko+maintainer: me@dshevchenko.biz+copyright: 2016 Denis Shevchenko++category: API, Web+build-type: Simple++extra-source-files: CHANGELOG.md+ , README.md++cabal-version: >=1.10++tested-with: GHC == 7.10.2, GHC == 7.10.3++library+ hs-source-dirs: src++ exposed-modules: Network.CircleCI+ -- API+ , Network.CircleCI.User+ , Network.CircleCI.Project+ , Network.CircleCI.CheckoutKey+ , Network.CircleCI.Environment+ , Network.CircleCI.Cache+ -- Commonly used stuff.+ , Network.CircleCI.Common.Types+ , Network.CircleCI.Common.Run++ other-modules: Network.CircleCI.Common.HTTPS+ , Network.CircleCI.Common.URL++ build-depends: base >= 4.7 && < 5+ , text >= 1.2.2.1 && < 2+ , aeson >= 0.9.0.1 && < 0.12+ , unordered-containers >= 0.2.5.1 && < 0.3+ , servant >= 0.7 && < 0.9+ , servant-client >= 0.7 && < 0.9+ , time >= 1.4.1.1 && < 1.7+ , mtl >= 2.2.1 && < 2.3+ , transformers >= 0.4.2.0 && < 0.6+ , http-client >= 0.4.24 && < 0.5+ , http-client-tls >= 0.2.2 && < 0.5++ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-binds++source-repository head+ type: git+ location: https://github.com/denisshevchenko/circlehs.git
+ src/Network/CircleCI.hs view
@@ -0,0 +1,39 @@+{-|+Module : Network.CircleCI+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++Top module for re-exporting everything.+-}++module Network.CircleCI (+ -- * Work with User info+ module Network.CircleCI.User+ -- * Work with Projects info+ , module Network.CircleCI.Project+ -- * Work with GitHub Checkout Keys+ , module Network.CircleCI.CheckoutKey+ -- * Work with Environment Variables for project build+ , module Network.CircleCI.Environment+ -- * Work with project's build cache+ , module Network.CircleCI.Cache+ -- * Commonly used types and functions+ , module Network.CircleCI.Common.Run+ , module Network.CircleCI.Common.URL+ , module Network.CircleCI.Common.Types+ , module Network.CircleCI.Common.HTTPS+) where++import Network.CircleCI.User+import Network.CircleCI.Project+import Network.CircleCI.CheckoutKey+import Network.CircleCI.Environment+import Network.CircleCI.Cache++import Network.CircleCI.Common.Run+import Network.CircleCI.Common.URL+import Network.CircleCI.Common.Types+import Network.CircleCI.Common.HTTPS+
+ src/Network/CircleCI/Cache.hs view
@@ -0,0 +1,123 @@+{-|+Module : Network.CircleCI.Cache+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++API call for work with project build's cache.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiWayIf #-}++module Network.CircleCI.Cache (+ -- * API call+ clearCache+ -- * Type for response+ , CacheCleared (..)+ , 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 qualified Data.Proxy as P+import Data.Text ( Text )+import Network.HTTP.Client ( Manager )++import Servant.API+import Servant.Client++-- | Clears build cache. Based on https://circleci.com/docs/api/#clear-cache.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (clearCache $ ProjectPoint "denisshevchenko" "circlehs")+-- (AccountAPIToken "e64c674195bbc0dbe3f9676c6ba2whatever")+-- >>= \\case+-- Left problem -> print problem+-- Right isCleared -> print isCleared+-- @+clearCache :: ProjectPoint -- ^ Names of GitHub user/project.+ -> CircleCIResponse CacheCleared -- ^ Info about clearing.+clearCache project = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantClearCache (userName project)+ (projectName project)+ (Just token)+ manager+ apiBaseUrl++-- | Cache clearing status.+data CacheCleared = CacheSuccessfullyCleared+ | UnableToClearCache ErrorMessage+ deriving (Show)++-- How to make CacheCleared from JSON.+instance FromJSON CacheCleared where+ parseJSON (Object o) =+ o .: "status" >>= toCacheCleared+ parseJSON _ = mzero++toCacheCleared :: Text -> Parser CacheCleared+toCacheCleared rawStatus = return $+ if | rawStatus `elem` okMessages -> CacheSuccessfullyCleared+ | otherwise -> UnableToClearCache rawStatus+ where+ okMessages = [ "build dependency caches deleted"+ , "build caches deleted"+ ]++-------------------------------------------------------------------------------+-- API types for Servant ------------------------------------------------------+-------------------------------------------------------------------------------++-- Complete API for work with build cache.+type CacheAPI = ClearCacheCall++-- Clears build cache.+type ClearCacheCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "build-cache"+ :> QueryParam "circle-token" Token+ :> Delete '[JSON] CacheCleared+ -- DELETE: /project/:username/:project/build-cache?circle-token=:token++-------------------------------------------------------------------------------+-- API client calls for Servant -----------------------------------------------+-------------------------------------------------------------------------------++servantClearCache :: UserName+ -> ProjectName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM CacheCleared+servantClearCache = client cacheAPI++cacheAPI :: P.Proxy CacheAPI+cacheAPI = P.Proxy+
+ src/Network/CircleCI/CheckoutKey.hs view
@@ -0,0 +1,323 @@+{-|+Module : Network.CircleCI.CheckoutKey+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++API calls for work with Checkout Keys. CircleCI uses Checkout Keys to check out your GitHub project, submodules, and private dependencies.++For more info please see "Checkout SSH keys" section in your CircleCI project's Settings.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiWayIf #-}++module Network.CircleCI.CheckoutKey (+ -- * API calls+ getCheckoutKeys+ , getCheckoutKey+ , createCheckoutKey+ , deleteCheckoutKey+ -- * Types for calls and responses+ , Fingerprint (..)+ , CheckoutKeyInfo (..)+ , CheckoutKeyType (..)+ , CheckoutKeyDeleted (..)+ , 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 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++-- | Shows list of checkout keys. Based on https://circleci.com/docs/api/#list-checkout-keys.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (getCheckoutKeys $ ProjectPoint "denisshevchenko" "circlehs")+-- (AccountAPIToken "e64c674195bbc0d0be3ef9679b6c6ba2whatever")+-- >>= \\case+-- Left problem -> print problem+-- Right keys -> print keys+-- @+getCheckoutKeys :: ProjectPoint -- ^ Names of GitHub user/project.+ -> CircleCIResponse [CheckoutKeyInfo] -- ^ List of checkout keys.+getCheckoutKeys project = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantGetCheckoutKeys (userName project)+ (projectName project)+ (Just token)+ manager+ apiBaseUrl++-- | Shows single checkout key. Based on https://circleci.com/docs/api/#get-checkout-key.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (getCheckoutKey project fingerprint) apiToken+-- >>= \\case+-- Left problem -> print problem+-- Right key -> print key+-- where+-- project = ProjectPoint "denisshevchenko" "circlehs"+-- fingerprint = Fingerprint "79:23:05:6a:6d:4c:3c:5c:0e:64:79:49:f0:e9:8d:a0"+-- apiToken = AccountAPIToken "e64c674195bbc0d0be3ef9679b6c6ba2whatever"+-- @+getCheckoutKey :: ProjectPoint -- ^ Names of GitHub user/project.+ -> Fingerprint -- ^ Key fingerprint.+ -> CircleCIResponse CheckoutKeyInfo -- ^ Checkout key info.+getCheckoutKey project (Fingerprint aFingerprint) = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantGetCheckoutKey (userName project)+ (projectName project)+ aFingerprint+ (Just token)+ manager+ apiBaseUrl++-- | Creates checkout key. Based on https://circleci.com/docs/api/#new-checkout-key.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (createCheckoutKey $ ProjectPoint "denisshevchenko" "circlehs")+-- (AccountAPIToken "e64c674195bbc0d0be3ef9679b6c6ba2whatever")+-- >>= \\case+-- Left problem -> print problem+-- Right newKey -> print newKey+-- @+createCheckoutKey :: ProjectPoint -- ^ Names of GitHub user/project.+ -> CircleCIResponse CheckoutKeyInfo -- ^ New checkout key info.+createCheckoutKey project = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantCreateCheckoutKey (userName project)+ (projectName project)+ (Just token)+ manager+ apiBaseUrl++-- | Deletes single checkout key. Based on https://circleci.com/docs/api/#delete-checkout-key.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (deleteCheckoutKey project fingerprint) apiToken+-- >>= \\case+-- Left problem -> print problem+-- Right isDeleted -> print isDeleted+-- where+-- project = ProjectPoint "denisshevchenko" "circlehs"+-- fingerprint = Fingerprint "79:23:05:6a:6d:4c:3c:5c:0e:64:79:49:f0:e9:8d:a0"+-- apiToken = AccountAPIToken "e64c674195bbc0d0be3ef9679b6c6ba2whatever"+-- @+deleteCheckoutKey :: ProjectPoint -- ^ Names of GitHub user/project.+ -> Fingerprint -- ^ Key fingerprint.+ -> CircleCIResponse CheckoutKeyDeleted -- ^ Status of checkout key deletion.+deleteCheckoutKey project (Fingerprint aFingerprint) = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantDeleteCheckoutKey (userName project)+ (projectName project)+ aFingerprint+ (Just token)+ manager+ apiBaseUrl++-- | Checkout key fingerprint. For example, @"79:23:05:6a:6d:4c:3c:5c:0e:64:79:49:f0:e9:8d:a0"@.+newtype Fingerprint = Fingerprint Text+ deriving (Eq, Show)++-- | Type of checkout key.+data CheckoutKeyType = GitHubDeployKey -- ^ Repo-specific SSH key.+ | GitHubUserKey -- ^ User-specific SSH key.+ deriving (Eq, Show)++-- | Info about checkout key.+data CheckoutKeyInfo = CheckoutKeyInfo {+ publicKey :: Text -- ^ Public SSH key.+ , keyType :: CheckoutKeyType -- ^ Key type.+ , fingerprint :: Fingerprint -- ^ Key fingerprint.+ , preferred :: Bool -- ^ Preferred key or not.+ , issueDate :: UTCTime -- ^ Date when this key was issued.+ } deriving (Eq, Show)++-- How to create CheckoutKeyInfo from JSON.+instance FromJSON CheckoutKeyInfo where+ parseJSON (Object o) = CheckoutKeyInfo+ <$> o .: "public_key"+ <*> (o .: "type" >>= toCheckoutKeyType)+ <*> (o .: "fingerprint" >>= toFingerprint)+ <*> o .: "preferred"+ <*> o .: "time"+ parseJSON _ = mzero++toCheckoutKeyType :: Text -> Parser CheckoutKeyType+toCheckoutKeyType "deploy-key" = return GitHubDeployKey+toCheckoutKeyType "github-user-key" = return GitHubUserKey+toCheckoutKeyType _ = return GitHubDeployKey++toFingerprint :: Text -> Parser Fingerprint+toFingerprint = return . Fingerprint++-- | Checkout key deleting status.+data CheckoutKeyDeleted = KeySuccessfullyDeleted+ | UnableToDeleteKey ErrorMessage+ deriving (Show)++-- How to create CheckoutKeyDeleted from JSON.+instance FromJSON CheckoutKeyDeleted where+ parseJSON (Object o) =+ o .: "message" >>= toCheckoutKeyDeleted+ parseJSON _ = mzero++toCheckoutKeyDeleted :: Text -> Parser CheckoutKeyDeleted+toCheckoutKeyDeleted "ok" = return KeySuccessfullyDeleted+toCheckoutKeyDeleted rawMessage = return $ UnableToDeleteKey rawMessage++-------------------------------------------------------------------------------+-- API types for Servant ------------------------------------------------------+-------------------------------------------------------------------------------++-- Complete API for work with checkout keys.+type CheckoutKeyAPI =+ GetCheckoutKeysCall+ :<|> GetCheckoutKeyCall+ :<|> CreateCheckoutKeyCall+ :<|> DeleteCheckoutKeyCall++-- Lists checkout keys.+type GetCheckoutKeysCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "checkout-key"+ :> QueryParam "circle-token" Token+ :> Get '[JSON] [CheckoutKeyInfo]+ -- GET: /project/:username/:project/checkout-key?circle-token=:token++-- Get a checkout key.+type GetCheckoutKeyCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "checkout-key"+ :> Capture "fingerprint" Text+ :> QueryParam "circle-token" Token+ :> Get '[JSON] CheckoutKeyInfo+ -- GET: /project/:username/:project/checkout-key/:fingerprint?circle-token=:token++-- Create checkout key.+type CreateCheckoutKeyCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "checkout-key"+ :> QueryParam "circle-token" Token+ :> Post '[JSON] CheckoutKeyInfo+ -- POST: /project/:username/:project/checkout-key?circle-token=:token++-- Delete a checkout key.+type DeleteCheckoutKeyCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "checkout-key"+ :> Capture "fingerprint" Text+ :> QueryParam "circle-token" Token+ :> Delete '[JSON] CheckoutKeyDeleted+ -- DELETE: /project/:username/:project/checkout-key/:fingerprint?circle-token=:token++-------------------------------------------------------------------------------+-- API client calls for Servant -----------------------------------------------+-------------------------------------------------------------------------------++servantGetCheckoutKeys :: UserName+ -> ProjectName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM [CheckoutKeyInfo]++servantGetCheckoutKey :: UserName+ -> ProjectName+ -> Text+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM CheckoutKeyInfo++servantCreateCheckoutKey :: UserName+ -> ProjectName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM CheckoutKeyInfo++servantDeleteCheckoutKey :: UserName+ -> ProjectName+ -> Text+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM CheckoutKeyDeleted++servantGetCheckoutKeys+ :<|> servantGetCheckoutKey+ :<|> servantCreateCheckoutKey+ :<|> servantDeleteCheckoutKey = client checkoutKeyAPI++checkoutKeyAPI :: P.Proxy CheckoutKeyAPI+checkoutKeyAPI = P.Proxy+
+ src/Network/CircleCI/Common/HTTPS.hs view
@@ -0,0 +1,22 @@+{-|+Module : Network.CircleCI.Common.HTTPS+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++Connection manager for @https@-requests. CircleCI uses TLS.+-}++module Network.CircleCI.Common.HTTPS (+ httpsManager+) where++import Control.Monad.IO.Class+import Network.HTTP.Client+import Network.HTTP.Client.TLS++-- | Connection manager with TLS support.+httpsManager :: MonadIO m => m Manager+httpsManager = liftIO $ newManager tlsManagerSettings+
+ src/Network/CircleCI/Common/Run.hs view
@@ -0,0 +1,21 @@+{-|+Module : Network.CircleCI.Common.Run+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++Run 'CircleCIResponse' monad.+-}++module Network.CircleCI.Common.Run (+ runCircleCI+) where++import Control.Monad.Reader++-- | All API calls require account API token, so move it into 'ReaderT' monad+-- instead of passing it as an explicit argument.+runCircleCI :: ReaderT t IO a -> t -> IO a+runCircleCI = runReaderT+
+ src/Network/CircleCI/Common/Types.hs view
@@ -0,0 +1,63 @@+{-|+Module : Network.CircleCI.Common.Types+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++Common types for work with CircleCI API.+-}++module Network.CircleCI.Common.Types (+ AccountAPIToken (..)+ , Token+ , UserName+ , ProjectName+ , BranchName+ , BuildNumber (..)+ , Email+ , CircleCIResponse+ , ProjectPoint (..)+ , ErrorMessage+) where++import Servant.Client+import Data.Text ( Text )+import Control.Monad.Reader++-- import CircleCI.Common.Run++-- | CircleCI account API token. List of account API tokens can be found at https://circleci.com/account/api.+newtype AccountAPIToken = AccountAPIToken Token++-- | API token as text, for Servant.+type Token = Text++-- | GitHub user name.+type UserName = Text++-- | GitHub project name.+type ProjectName = Text++-- | GitHub branch name.+type BranchName = Text++-- | Number of project's build on CircleCI.+newtype BuildNumber = BuildNumber Int+ deriving (Eq, Show)++-- | User email address.+type Email = Text++-- | Monad for response from CircleCI.+type CircleCIResponse a = ReaderT AccountAPIToken IO (Either ServantError a)++-- | GitHub project identifier, composed from user name and project name.+data ProjectPoint = ProjectPoint+ { userName :: UserName -- ^ GitHub user name.+ , projectName :: ProjectName -- ^ GitHub project name.+ }++-- | Message about some problem.+type ErrorMessage = Text+
+ src/Network/CircleCI/Common/URL.hs view
@@ -0,0 +1,25 @@+{-|+Module : Network.CircleCI.Common.URL+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++Base URL for all CircleCI API calls. Based on https://circleci.com/docs/api/#calling.+-}++module Network.CircleCI.Common.URL (+ apiBaseUrl+) where++import Servant.Common.BaseUrl++-- | Base URL for all API calls. For API v1 it's @https://circleci.com/api/v1/@.+apiBaseUrl :: BaseUrl+apiBaseUrl = BaseUrl {+ baseUrlScheme = Https+ , baseUrlHost = "circleci.com"+ , baseUrlPort = 443+ , baseUrlPath = "/api/v1"+ }+
+ src/Network/CircleCI/Environment.hs view
@@ -0,0 +1,315 @@+{-|+Module : Network.CircleCI.Environment+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++API calls for work with Environment Variables used in project build.++For more info please see "Environment variables" section in your CircleCI project's Settings.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiWayIf #-}++module Network.CircleCI.Environment (+ -- * API calls+ getEnvVars+ , getEnvVar+ , addEnvVar+ , deleteEnvVar+ -- * Types for calls and responses+ , EnvVar (..)+ , EnvVarDeleted (..)+ , EnvVarName+ , 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 qualified Data.Proxy as P+import Data.Text ( Text )+import Network.HTTP.Client ( Manager )++import Servant.API+import Servant.Client++-- | Name of environment variable.+type EnvVarName = Text++-- | Shows list of environment variables for the single project. Based on https://circleci.com/docs/api/#list-environment-variables.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (getEnvVars $ ProjectPoint "denisshevchenko" "circlehs")+-- (AccountAPIToken "e64c674195b87d76e988e9fbcba2whatever")+-- >>= \\case+-- Left problem -> print problem+-- Right envVars -> print envVars+-- @+getEnvVars :: ProjectPoint -- ^ Names of GitHub user/project.+ -> CircleCIResponse [EnvVar] -- ^ List of environment variables.+getEnvVars project = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantGetEnvVars (userName project)+ (projectName project)+ (Just token)+ manager+ apiBaseUrl++-- | Shows single environment variable. Based on https://circleci.com/docs/api/#get-environment-variable.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (getEnvVar project \"GCC\") token+-- >>= \\case+-- Left problem -> print problem+-- Right envVar -> print envVar+-- where+-- project = ProjectPoint "denisshevchenko" "circlehs"+-- token = AccountAPIToken "e64c674195b87d76e988e9fbcba2whatever"+-- @+getEnvVar :: ProjectPoint -- ^ Names of GitHub user/project.+ -> EnvVarName -- ^ Environment variable name.+ -> CircleCIResponse EnvVar -- ^ Environment variable.+getEnvVar project envVarName = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantGetEnvVar (userName project)+ (projectName project)+ envVarName+ (Just token)+ manager+ apiBaseUrl++-- | Adds environment variable. Based on https://circleci.com/docs/api/#add-environment-variable.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (addEnvVar project envVar) token+-- >>= \\case+-- Left problem -> print problem+-- Right newEnvVar -> print newEnvVar+-- where+-- project = ProjectPoint "denisshevchenko" "circlehs"+-- envVar = EnvVar \"GCC\" "\/usr\/local\/bin\/gcc-4.8"+-- token = AccountAPIToken "e64c674195b87d76e988e9fbcba2whatever"+-- @+addEnvVar :: ProjectPoint -- ^ Names of GitHub user/project.+ -> EnvVar -- ^ Environment variable.+ -> CircleCIResponse EnvVar -- ^ Added environment variable.+addEnvVar project envVar = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantAddEnvVar (userName project)+ (projectName project)+ (Just token)+ envVar+ manager+ apiBaseUrl++-- | Deletes single environment variable. Based on https://circleci.com/docs/api/#delete-environment-variable.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI (deleteEnvVar project \"GCC\") token+-- >>= \\case+-- Left problem -> print problem+-- Right isDeleted -> print isDeleted+-- where+-- project = ProjectPoint "denisshevchenko" "circlehs"+-- token = AccountAPIToken "e64c674195b87d76e988e9fbcba2whatever"+-- @+deleteEnvVar :: ProjectPoint -- ^ Names of GitHub user/project.+ -> EnvVarName -- ^ Environment variable name.+ -> CircleCIResponse EnvVarDeleted -- ^ Info about environment variable deleting.+deleteEnvVar project envVarName = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantDeleteEnvVar (userName project)+ (projectName project)+ envVarName+ (Just token)+ manager+ apiBaseUrl++-- | Environment variable, name/value.+data EnvVar = EnvVar {+ name :: Text+ , value :: Text+ } deriving (Eq, Show)++-- How to make EnvVar from JSON, for POST call.+instance FromJSON EnvVar where+ parseJSON (Object o) = EnvVar+ <$> o .: "name"+ <*> o .: "value"+ parseJSON _ = mzero++-- How to serialize EnvVar to JSON.+instance ToJSON EnvVar where+ toJSON (EnvVar aName aValue) =+ object [ "name" .= aName+ , "value" .= aValue+ ]++-- | Environment variable deleting status.+data EnvVarDeleted = EnvVarSuccessfullyDeleted+ | UnableToDeleteEnvVar ErrorMessage+ deriving (Show)++-- How to create EnvVarDeleted from JSON.+instance FromJSON EnvVarDeleted where+ parseJSON (Object o) =+ o .: "message" >>= toEnvVarDeleted+ parseJSON _ = mzero++toEnvVarDeleted :: Text -> Parser EnvVarDeleted+toEnvVarDeleted rawMessage = return $+ if | rawMessage == "ok" -> EnvVarSuccessfullyDeleted+ | otherwise -> UnableToDeleteEnvVar rawMessage++-------------------------------------------------------------------------------+-- API types for Servant ------------------------------------------------------+-------------------------------------------------------------------------------++-- Complete API for work with environment variables.+type EnvVarAPI =+ GetEnvVarsCall+ :<|> GetEnvVarCall+ :<|> AddEnvVarCall+ :<|> DeleteEnvVarCall++-- Lists environment variables for project.+type GetEnvVarsCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "envvar"+ :> QueryParam "circle-token" Token+ :> Get '[JSON] [EnvVar]+ -- GET: /project/:username/:project/envvar?circle-token=:token++-- Get single environment variable.+type GetEnvVarCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "envvar"+ :> Capture "name" EnvVarName+ :> QueryParam "circle-token" Token+ :> Get '[JSON] EnvVar+ -- GET: /project/:username/:project/envvar/:name?circle-token=:token++-- Add environment variable.+type AddEnvVarCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "envvar"+ :> QueryParam "circle-token" Token+ :> ReqBody '[JSON] EnvVar+ :> Post '[JSON] EnvVar+ -- POST: /project/:username/:project/envvar?circle-token=:token+ -- --header "Content-Type: application/json" -d '{"name":"foo", "value":"bar"}'++-- Delete environment variable.+type DeleteEnvVarCall =+ "project"+ :> Capture "username" UserName+ :> Capture "project" ProjectName+ :> "envvar"+ :> Capture "name" EnvVarName+ :> QueryParam "circle-token" Token+ :> Delete '[JSON] EnvVarDeleted+ -- DELETE: /project/:username/:project/envvar/:name?circle-token=:token++-------------------------------------------------------------------------------+-- API client calls for Servant -----------------------------------------------+-------------------------------------------------------------------------------++servantGetEnvVars :: UserName+ -> ProjectName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM [EnvVar]++servantGetEnvVar :: UserName+ -> ProjectName+ -> EnvVarName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM EnvVar++servantAddEnvVar :: UserName+ -> ProjectName+ -> Maybe Token+ -> EnvVar+ -> Manager+ -> BaseUrl+ -> ClientM EnvVar++servantDeleteEnvVar :: UserName+ -> ProjectName+ -> EnvVarName+ -> Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM EnvVarDeleted++servantGetEnvVars+ :<|> servantGetEnvVar+ :<|> servantAddEnvVar+ :<|> servantDeleteEnvVar = client envVarAPI++envVarAPI :: P.Proxy EnvVarAPI+envVarAPI = P.Proxy+
+ src/Network/CircleCI/Project.hs view
@@ -0,0 +1,233 @@+{-|+Module : Network.CircleCI.Project+Copyright : (c) Denis Shevchenko, 2016+License : MIT+Maintainer : me@dshevchenko.biz+Stability : alpha++API calls for work with info about projects.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiWayIf #-}++module Network.CircleCI.Project (+ -- * API call+ getProjectsInfo+ -- * Types for calls and response+ , ProjectInfo (..)+ , BranchBuildInfo (..)+ , BuildInfo (..)+ , BuildStatus (..)+ , 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 all projects user is following. Based on https://circleci.com/docs/api/#projects.+--+-- Usage example:+--+-- @+-- {-\# LANGUAGE OverloadedStrings \#-}+-- {-\# LANGUAGE LambdaCase \#-}+--+-- import Network.CircleCI+--+-- main :: IO ()+-- main = runCircleCI getProjectsInfo+-- (AccountAPIToken "e64c674195bbc0d0be3efa2whatever")+-- >>= \\case+-- Left problem -> print problem+-- Right info -> print info+-- @+getProjectsInfo :: CircleCIResponse [ProjectInfo] -- ^ Info about projects.+getProjectsInfo = do+ AccountAPIToken token <- ask+ liftIO . runExceptT $ do+ manager <- httpsManager+ servantGetProjectsInfo (Just token)+ manager+ apiBaseUrl++-- | Info about single project.+data ProjectInfo = ProjectInfo {+ language :: Text -- ^ Programming language using in project.+ , repositoryName :: Text -- ^+ , repositoryUrl :: Text -- ^ Repository URL.+ , branches :: [BranchBuildInfo] -- ^ Info about recent builds in branches.+ , defaultBranch :: Text -- ^ Name of default branch.+ , isOpenSource :: Bool -- ^ If 'True' - project is open.+ , followed :: Bool -- ^ If 'True' - project is followed by some user.+ , gitHubUserName :: Text -- ^ GitHub user name.+ -- Slack+ , slackChannel :: Maybe Text -- ^ Slack channel name.+ , slackWebhookUrl :: Maybe Text -- ^ Slack webhook URL.+ , slackNotifyPreferenses :: Maybe Text -- ^ Slack notify preferences.+ , slackSubdomain :: Maybe Text -- ^ Slack subdomain.+ , slackAPIToken :: Maybe Text -- ^ Slack API token.+ -- HipChat+ , hipchatNotifyPreferenses :: Maybe Text -- ^ HipChat notify preferences.+ , hipchatNotify :: Maybe Text -- ^ HipChat notify.+ , hipchatAPIToken :: Maybe Text -- ^ HipChat API token.+ , hipchatRoom :: Maybe Text -- ^ HipChat room name.+ -- IRC+ , ircServer :: Maybe Text -- ^ IRC server.+ , ircKeyword :: Maybe Text -- ^ IRC keyword.+ , ircChannel :: Maybe Text -- ^ IRC channel name.+ , ircUsername :: Maybe Text -- ^ IRC user name.+ , ircPassword :: Maybe Text -- ^ IRC password.+ , ircNotifyPreferenses :: Maybe Text -- ^ IRC notify preferences.+ } deriving (Show)++-- How to create ProjectInfo from JSON.+instance FromJSON ProjectInfo where+ parseJSON (Object o) = ProjectInfo+ <$> o .: "language"+ <*> o .: "reponame"+ <*> o .: "vcs_url"+ <*> (o .: "branches" >>= toBranchesBuildInfo)+ <*> o .: "default_branch"+ <*> o .: "oss"+ <*> o .: "followed"+ <*> o .: "username"+ <*> o .:? "slack_channel"+ <*> o .:? "slack_webhook_url"+ <*> o .:? "slack_notify_prefs"+ <*> o .:? "slack_subdomain"+ <*> o .:? "slack_api_token"+ <*> o .:? "hipchat_notify_prefs"+ <*> o .:? "hipchat_notify"+ <*> o .:? "hipchat_api_token"+ <*> o .:? "hipchat_room"+ <*> o .:? "irc_server"+ <*> o .:? "irc_keyword"+ <*> o .:? "irc_channel"+ <*> o .:? "irc_username"+ <*> o .:? "irc_password"+ <*> o .:? "irc_notify_prefs"+ parseJSON _ = mzero++toBranchesBuildInfo :: HashMap Text RawBranchBuildInfo -> Parser [BranchBuildInfo]+toBranchesBuildInfo rawBranchesBuildInfo = return+ [BranchBuildInfo { branchName = aBranchName+ , lastSuccessBuild = rawLastSuccessBuild rawBranchesBuild+ , lastFailedBuild = rawLastFailedBuild rawBranchesBuild+ , pusherLogins = rawPusherLogins rawBranchesBuild+ , recentBuilds = rawRecentBuilds rawBranchesBuild+ , runningBuilds = rawRunningBuilds rawBranchesBuild+ }+ | (aBranchName, rawBranchesBuild) <- toList rawBranchesBuildInfo]++-- Raw build info for a single branch, for HashMap.+data RawBranchBuildInfo = RawBranchBuildInfo {+ rawLastSuccessBuild :: Maybe BuildInfo+ , rawLastFailedBuild :: Maybe BuildInfo+ , rawPusherLogins :: [Text]+ , rawRecentBuilds :: Maybe [BuildInfo]+ , rawRunningBuilds :: Maybe [BuildInfo]+ } deriving (Eq, Show)++-- How we create RawBranchBuildInfo from JSON.+instance FromJSON RawBranchBuildInfo where+ parseJSON (Object o) = RawBranchBuildInfo+ <$> o .:? "last_success"+ <*> o .:? "last_non_success"+ <*> o .: "pusher_logins"+ <*> o .:? "recent_builds"+ <*> o .:? "running_builds"+ parseJSON _ = mzero++-- | Build info for a single branch.+data BranchBuildInfo = BranchBuildInfo {+ branchName :: Text+ , lastSuccessBuild :: Maybe BuildInfo+ , lastFailedBuild :: Maybe BuildInfo+ , pusherLogins :: [Text]+ , recentBuilds :: Maybe [BuildInfo]+ , runningBuilds :: Maybe [BuildInfo]+ } deriving (Eq, Show)++-- | Info about single build.+data BuildInfo = BuildInfo {+ status :: BuildStatus+ , number :: Int+ , commit :: Text+ , pushDate :: UTCTime+ , addingDate :: UTCTime+ } deriving (Eq, Show)++-- How we create BuildInfo from JSON.+instance FromJSON BuildInfo where+ parseJSON (Object o) = BuildInfo+ <$> (o .: "status" >>= toBuildStatus)+ <*> o .: "build_num"+ <*> o .: "vcs_revision"+ <*> o .: "pushed_at"+ <*> o .: "added_at"+ parseJSON _ = mzero++toBuildStatus :: Text -> Parser BuildStatus+toBuildStatus "running" = return BuildRunning+toBuildStatus "success" = return BuildSuccess+toBuildStatus "failed" = return BuildFailed+toBuildStatus "canceled" = return BuildCanceled+toBuildStatus "no_tests" = return NoTests+toBuildStatus _ = return BuildSuccess++-- | Build status.+data BuildStatus = BuildRunning+ | BuildSuccess+ | BuildFailed+ | BuildCanceled+ | NoTests+ deriving (Eq, Show)++-------------------------------------------------------------------------------+-- API types for Servant ------------------------------------------------------+-------------------------------------------------------------------------------++-- Complete API for work with projects.+type ProjectsInfoAPI = GetProjectsInfoCall++-- Obtain info about Projects.+type GetProjectsInfoCall =+ "projects"+ :> QueryParam "circle-token" Token+ :> Get '[JSON] [ProjectInfo]+ -- GET: /projects?circle-token=:token++-------------------------------------------------------------------------------+-- API client calls for Servant -----------------------------------------------+-------------------------------------------------------------------------------++servantGetProjectsInfo :: Maybe Token+ -> Manager+ -> BaseUrl+ -> ClientM [ProjectInfo]+servantGetProjectsInfo = client projectsInfoAPI++projectsInfoAPI :: P.Proxy ProjectsInfoAPI+projectsInfoAPI = P.Proxy+
+ src/Network/CircleCI/User.hs view
@@ -0,0 +1,212 @@+{-|+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+