module Jenkins.Rest
(
run
, JenkinsT
, Jenkins
, Result(..)
, HasMaster(..)
, Master
, defaultMaster
, get
, post
, post_
, orElse
, orElse_
, locally
, disconnect
, module Jenkins.Rest.Method
, concurrently
, Jenkins.Rest.traverse
, Jenkins.Rest.traverse_
, postXml
, reload
, restart
, forceRestart
, _Exception
, _Disconnect
, _Ok
, JenkinsException(..)
, liftIO
, Request
) where
import Control.Applicative ((<$))
import Control.Exception.Lifted (try)
import Control.Monad
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Control (MonadBaseControl(..))
import qualified Data.ByteString.Lazy as Lazy
import Data.Data (Data, Typeable)
import qualified Data.Foldable as F
import Data.Monoid (mempty)
import Data.Text (Text)
import Network.HTTP.Client (Request, requestHeaders)
import Jenkins.Rest.Internal
import Jenkins.Rest.Method
import Jenkins.Rest.Method.Internal
import Network.HTTP.Client.Lens.Internal
run
:: (MonadIO m, MonadBaseControl IO m, HasMaster t)
=> t -> JenkinsT m a -> m (Result a)
run c jenk =
either Exception (maybe Disconnect Ok)
`liftM`
try (runInternal (c^.url) (c^.user) (c^.apiToken) jenk)
type Jenkins = JenkinsT IO
data Result v =
Exception JenkinsException
| Disconnect
| Ok v
deriving (Show, Typeable)
_Exception :: Prism (Result a) (Result a) JenkinsException JenkinsException
_Exception = prism' Exception $ \case
Exception e -> Just e
_ -> Nothing
_Disconnect :: Prism' (Result a) ()
_Disconnect = prism' (\_ -> Disconnect) $ \case
Disconnect -> Just ()
_ -> Nothing
_Ok :: Prism (Result a) (Result b) a b
_Ok = prism Ok $ \case
Exception e -> Left (Exception e)
Disconnect -> Left Disconnect
Ok a -> Right a
class HasMaster t where
master :: Lens' t Master
url :: HasMaster t => Lens' t String
url = master . \f x -> f (_url x) <&> \p -> x { _url = p }
user :: HasMaster t => Lens' t Text
user = master . \f x -> f (_user x) <&> \p -> x { _user = p }
apiToken :: HasMaster t => Lens' t Text
apiToken = master . \f x -> f (_apiToken x) <&> \p -> x { _apiToken = p }
data Master = Master
{ _url :: String
, _user :: Text
, _apiToken :: Text
} deriving (Show, Eq, Typeable, Data)
instance HasMaster Master where
master = id
defaultMaster :: Master
defaultMaster = Master
{ _url = "http://example.com/jenkins"
, _user = "jenkins"
, _apiToken = "secret"
}
get :: Formatter f -> (forall g. Method Complete g) -> JenkinsT m Lazy.ByteString
get (Formatter f) m = liftJ (Get (f m) id)
post :: (forall f. Method Complete f) -> Lazy.ByteString -> JenkinsT m ()
post m body = liftJ (Post m body ())
post_ :: (forall f. Method Complete f) -> JenkinsT m ()
post_ m = post m mempty
orElse :: JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JenkinsT m a
orElse a b = liftJ (Or a b)
orElse_ :: JenkinsT m a -> JenkinsT m a -> JenkinsT m a
orElse_ a b = orElse a (\_ -> b)
locally :: (Request -> Request) -> JenkinsT m a -> JenkinsT m a
locally f j = liftJ (With f j id)
disconnect :: JenkinsT m a
disconnect = liftJ Dcon
concurrently :: JenkinsT m a -> JenkinsT m b -> JenkinsT m (a, b)
concurrently ja jb = liftJ (Conc ja jb (,))
traverse :: (a -> JenkinsT m b) -> [a] -> JenkinsT m [b]
traverse f = foldr go (return [])
where
go x xs = do (y, ys) <- concurrently (f x) xs; return (y : ys)
traverse_ :: F.Foldable f => (a -> JenkinsT m b) -> f a -> JenkinsT m ()
traverse_ f = F.foldr (\x xs -> () <$ concurrently (f x) xs) (return ())
postXml :: (forall f. Method Complete f) -> Lazy.ByteString -> JenkinsT m ()
postXml m = locally (\r -> r { requestHeaders = xmlHeader : requestHeaders r }) . post m
where
xmlHeader = ("Content-Type", "text/xml")
reload :: JenkinsT m a
reload = do post_ "reload"; disconnect
restart :: JenkinsT m a
restart = do post_ "safeRestart"; disconnect
forceRestart :: JenkinsT m a
forceRestart = do post_ "restart"; disconnect