module Jenkins.REST
(
Jenkins, Disconnect(..)
, Settings(..), Host(..), Port(..), User(..), APIToken(..), Password
, Request
, get, post, post_, concurrently, io, disconnect, with
, module Jenkins.REST.Method
, concurrentlys, concurrentlys_, postXML, reload, restart
, runJenkins, runJenkinsP
, jenkins_host, jenkins_port, jenkins_user, jenkins_api_token, jenkins_password
, _Host, _Port, _User, _APIToken, _Password
, module Jenkins.REST.Lens
) where
import Control.Applicative ((<$))
import Control.Exception (handle)
import Control.Lens
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data, Typeable)
import Data.Default (Default(..))
import Data.Monoid (mempty)
import Data.String (IsString)
import GHC.Generics (Generic)
import Network.HTTP.Conduit (Request, HttpException, withManager, applyBasicAuth, parseUrl)
import Text.XML (Document, renderLBS)
import Jenkins.REST.Internal
import qualified Jenkins.REST.Lens
import Jenkins.REST.Lens as L
import Jenkins.REST.Method
get :: Method Complete f -> Jenkins BL.ByteString
get m = liftJ $ Get m id
post :: (forall f. Method Complete f) -> BL.ByteString -> Jenkins ()
post m body = liftJ $ Post m body (\_ -> ())
post_ :: (forall f. Method Complete f) -> Jenkins ()
post_ m = post m mempty
concurrently :: Jenkins a -> Jenkins b -> Jenkins (a, b)
concurrently ja jb = liftJ $ Conc ja jb (,)
io :: IO a -> Jenkins a
io = liftIO
disconnect :: Jenkins a
disconnect = liftJ Dcon
with :: (forall m. Request m -> Request m) -> Jenkins a -> Jenkins a
with f j = liftJ $ With f j id
postXML :: (forall f. Method Complete f) -> Document -> Jenkins ()
postXML m =
with (requestHeaders <>~ [("Content-Type", "text/xml")]) . post m . renderLBS def
concurrentlys :: [Jenkins a] -> Jenkins [a]
concurrentlys = foldr go (return [])
where
go x xs = do
(y, ys) <- concurrently x xs
return (y : ys)
concurrentlys_ :: [Jenkins a] -> Jenkins ()
concurrentlys_ = foldr (\x xs -> () <$ concurrently x xs) (return ())
reload :: Jenkins a
reload = do
post_ "reload"
disconnect
restart :: Jenkins a
restart = do
post_ "restart"
disconnect
data Settings = Settings
{ _jenkins_host :: Host
, _jenkins_port :: Port
, _jenkins_user :: User
, _jenkins_api_token :: APIToken
} deriving (Show, Eq, Typeable, Data, Generic)
instance Default Settings where
def = Settings
{ _jenkins_host = "http://example.com"
, _jenkins_port = 80
, _jenkins_user = "anonymous"
, _jenkins_api_token = "secret"
}
newtype Host = Host { unHost :: String }
deriving (Show, Eq, Typeable, Data, Generic, IsString)
newtype Port = Port { unPort :: Int }
deriving (Show, Eq, Typeable, Data, Generic, Num)
newtype User = User { unUser :: B.ByteString }
deriving (Show, Eq, Typeable, Data, Generic, IsString)
newtype APIToken = APIToken { unAPIToken :: B.ByteString }
deriving (Show, Eq, Typeable, Data, Generic, IsString)
type Password = APIToken
makeLenses ''Settings
jenkins_password :: Lens' Settings Password
jenkins_password = jenkins_api_token
makePrisms ''Host
makePrisms ''Port
makePrisms ''User
makePrisms ''APIToken
_Password :: Prism' Password B.ByteString
_Password = _APIToken
data Disconnect =
Disconnect
| JenkinsException HttpException
deriving (Show, Typeable, Generic)
runJenkins :: Settings -> Jenkins a -> IO (Either Disconnect a)
runJenkins (Settings (Host h) (Port p) (User u) (APIToken t)) jenk =
handle (return . Left . JenkinsException) $
withManager $ \manager -> do
req <- liftIO $ parseUrl h
let req' = req
& L.port .~ p
& L.responseTimeout .~ Just (20 * 1000000)
res <- runReaderT (runMaybeT (runJenkinsIO manager jenk)) (applyBasicAuth u t req')
return $ maybe (Left Disconnect) Right res