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
, groovy
, reload
, restart
, forceRestart
, _Exception
, _Disconnect
, _Ok
, JenkinsException(..)
, liftIO
, Http.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 qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Text.Lazy
import qualified Network.HTTP.Client as Http
import qualified Network.HTTP.Types as Http
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 Lazy.ByteString
post m body = liftJ (Post m body id)
post_ :: (forall f. Method Complete f) -> JenkinsT m Lazy.ByteString
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 :: (Http.Request -> Http.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 Lazy.ByteString
postXml m = locally (\r -> r { Http.requestHeaders = xmlHeader : Http.requestHeaders r }) . post m
where
xmlHeader = ("Content-Type", "text/xml")
groovy
:: Text.Lazy.Text
-> JenkinsT m Text.Lazy.Text
groovy script = locally (\r -> r { Http.requestHeaders = ascii : Http.requestHeaders r }) $
liftJ (Post "scriptText" body Text.Lazy.decodeUtf8)
where
body = Lazy.fromChunks
[Http.renderSimpleQuery False [("script", Lazy.toStrict (Text.Lazy.encodeUtf8 script))]]
ascii = ("Content-Type", "application/x-www-form-urlencoded")
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