{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-- | Jenkins REST API interface
--
-- This module is intended to be imported qualified.
module Jenkins.Rest
  ( -- * Query Jenkins
    run
  , JenkinsT
  , Jenkins
  , Master(..)
    -- ** Combinators
  , get
  , stream
  , post
  , post_
  , orElse
  , orElse_
  , locally
    -- ** Method
  , module Jenkins.Rest.Method
    -- ** Concurrency
  , concurrently
  , Jenkins.Rest.traverse
  , Jenkins.Rest.traverse_
    -- ** Convenience
  , postXml
  , groovy
  , reload
  , restart
  , forceRestart
  , JenkinsException(..)
    -- * Reexports
  , liftIO
  , Http.Request
  ) where

import qualified Control.Exception as Unlifted
import           Control.Monad (void)
import           Control.Monad.Trans (MonadIO(..))
import           Control.Monad.Trans.Control (MonadBaseControl(..))
import           Control.Monad.Trans.Resource (MonadResource)
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString as Strict
import           Data.Data (Data, Typeable)
import qualified Data.Foldable as F
import           Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Text.Lazy
import           Data.Traversable (sequence)
import qualified Network.HTTP.Conduit as Http
import qualified Network.HTTP.Types as Http
import           Prelude hiding (sequence)

import           Jenkins.Rest.Internal
import           Jenkins.Rest.Method
import           Jenkins.Rest.Method.Internal


-- | Run a 'JenkinsT' action
--
-- If a 'JenkinsException' is thrown by performing a request to Jenkins,
-- 'runJenkins' will catch and wrap it in @'Exception'@. Other exceptions
-- will propagate further untouched.
run :: (MonadIO m, MonadBaseControl IO m) => Master -> JenkinsT m a -> m (Either JenkinsException a)
run :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Master -> JenkinsT m a -> m (Either JenkinsException a)
run Master
m JenkinsT m a
jenk = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either JenkinsException a)
try (forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
String -> Text -> Text -> JenkinsT m a -> m a
runInternal (Master -> String
url Master
m) (Master -> Text
user Master
m) (Master -> Text
apiToken Master
m) JenkinsT m a
jenk)

try :: MonadBaseControl IO m => m a -> m (Either JenkinsException a)
try :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either JenkinsException a)
try m a
m = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
magic -> forall e a. Exception e => IO a -> IO (Either e a)
Unlifted.try (RunInBase m IO
magic m a
m))
{-# INLINABLE try #-}

-- | A handy type synonym for the kind of 'JenkinsT' actions that's used the most
type Jenkins = JenkinsT IO

-- | Jenkins master node connection settings token
data Master = Master
  { Master -> String
url      :: String -- ^ Jenkins URL
  , Master -> Text
user     :: Text   -- ^ Jenkins user
  , Master -> Text
apiToken :: Text   -- ^ Jenkins user API token or password
  } deriving (Int -> Master -> ShowS
[Master] -> ShowS
Master -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Master] -> ShowS
$cshowList :: [Master] -> ShowS
show :: Master -> String
$cshow :: Master -> String
showsPrec :: Int -> Master -> ShowS
$cshowsPrec :: Int -> Master -> ShowS
Show, Master -> Master -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Master -> Master -> Bool
$c/= :: Master -> Master -> Bool
== :: Master -> Master -> Bool
$c== :: Master -> Master -> Bool
Eq, Typeable, Typeable Master
Master -> DataType
Master -> Constr
(forall b. Data b => b -> b) -> Master -> Master
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Master -> u
forall u. (forall d. Data d => d -> u) -> Master -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Master -> m Master
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Master -> m Master
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Master
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Master -> c Master
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Master)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Master)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Master -> m Master
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Master -> m Master
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Master -> m Master
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Master -> m Master
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Master -> m Master
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Master -> m Master
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Master -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Master -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Master -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Master -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Master -> r
gmapT :: (forall b. Data b => b -> b) -> Master -> Master
$cgmapT :: (forall b. Data b => b -> b) -> Master -> Master
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Master)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Master)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Master)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Master)
dataTypeOf :: Master -> DataType
$cdataTypeOf :: Master -> DataType
toConstr :: Master -> Constr
$ctoConstr :: Master -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Master
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Master
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Master -> c Master
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Master -> c Master
Data)


-- | Perform a @GET@ request
--
-- While the return type is /lazy/ @Bytestring@, the entire response
-- sits in memory anyway: lazy I/O is not used at the least
get :: Formatter f -> (forall g. Method 'Complete g) -> JenkinsT m Lazy.ByteString
get :: forall (f :: Format) (m :: * -> *).
Formatter f
-> (forall (g :: Format). Method 'Complete g)
-> JenkinsT m ByteString
get (Formatter (forall (g :: Format). Method 'Complete g) -> Method 'Complete f
f) forall (g :: Format). Method 'Complete g
m = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall (a :: Format) a (m :: * -> *).
Method 'Complete a -> (ByteString -> a) -> JF m a
Get ((forall (g :: Format). Method 'Complete g) -> Method 'Complete f
f forall (g :: Format). Method 'Complete g
m) forall a. a -> a
id)

-- | Perform a streaming @GET@ request
--
-- 'stream', unlike 'get', is constant-space
stream
  :: MonadResource m
  => Formatter f -> (forall g. Method 'Complete g) -> JenkinsT m (ResumableSource m Strict.ByteString)
stream :: forall (m :: * -> *) (f :: Format).
MonadResource m =>
Formatter f
-> (forall (g :: Format). Method 'Complete g)
-> JenkinsT m (ResumableSource m ByteString)
stream (Formatter (forall (g :: Format). Method 'Complete g) -> Method 'Complete f
f) forall (g :: Format). Method 'Complete g
m = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall (m :: * -> *) (a :: Format) a.
MonadResource m =>
Method 'Complete a -> (ResumableSource m ByteString -> a) -> JF m a
Stream ((forall (g :: Format). Method 'Complete g) -> Method 'Complete f
f forall (g :: Format). Method 'Complete g
m) forall a. a -> a
id)

-- | Perform a @POST@ request
post :: (forall f. Method 'Complete f) -> Lazy.ByteString -> JenkinsT m Lazy.ByteString
post :: forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> JenkinsT m ByteString
post forall (g :: Format). Method 'Complete g
m ByteString
body = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall a (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> (ByteString -> a) -> JF m a
Post forall (g :: Format). Method 'Complete g
m ByteString
body forall a. a -> a
id)

-- | Perform a @POST@ request without a payload
post_ :: (forall f. Method 'Complete f) -> JenkinsT m Lazy.ByteString
post_ :: forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g) -> JenkinsT m ByteString
post_ forall (g :: Format). Method 'Complete g
m = forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> JenkinsT m ByteString
post forall (g :: Format). Method 'Complete g
m ByteString
Lazy.empty

-- | A simple exception handler. If an exception is raised while the action is
-- executed the handler is executed with it as an argument
orElse :: JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JenkinsT m a
orElse :: forall (m :: * -> *) a.
JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JenkinsT m a
orElse JenkinsT m a
a JenkinsException -> JenkinsT m a
b = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall (m :: * -> *) a.
JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JF m a
Or JenkinsT m a
a JenkinsException -> JenkinsT m a
b)

-- | A simpler exception handler
--
-- @
-- orElse_ a b = 'orElse' a (\\_ -> b)
-- @
orElse_ :: JenkinsT m a -> JenkinsT m a -> JenkinsT m a
orElse_ :: forall (m :: * -> *) a.
JenkinsT m a -> JenkinsT m a -> JenkinsT m a
orElse_ JenkinsT m a
a JenkinsT m a
b = forall (m :: * -> *) a.
JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JenkinsT m a
orElse JenkinsT m a
a (\JenkinsException
_ -> JenkinsT m a
b)
{-# ANN orElse_ ("HLint: ignore Use const" :: String) #-}

-- | @locally f x@ modifies the base 'Request' with @f@ for the execution of @x@
-- (think 'Control.Monad.Trans.Reader.local')
--
-- This is useful for setting the appropriate headers, response timeouts and the like
locally :: (Http.Request -> Http.Request) -> JenkinsT m a -> JenkinsT m a
locally :: forall (m :: * -> *) a.
(Request -> Request) -> JenkinsT m a -> JenkinsT m a
locally Request -> Request
f JenkinsT m a
j = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall (m :: * -> *) a a.
(Request -> Request) -> JenkinsT m a -> (a -> a) -> JF m a
With Request -> Request
f JenkinsT m a
j forall a. a -> a
id)


-- | Run two actions concurrently
concurrently :: JenkinsT m a -> JenkinsT m b -> JenkinsT m (a, b)
concurrently :: forall (m :: * -> *) a b.
JenkinsT m a -> JenkinsT m b -> JenkinsT m (a, b)
concurrently JenkinsT m a
ja JenkinsT m b
jb = forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall (m :: * -> *) a b c.
JenkinsT m a -> JenkinsT m b -> (a -> b -> c) -> JF m c
Conc JenkinsT m a
ja JenkinsT m b
jb (,))

-- | Map every list element to an action, run them concurrently and collect the results
--
-- @'traverse' : 'Data.Traversable.traverse' :: 'concurrently' : 'Control.Applicative.liftA2' (,)@
traverse :: (a -> JenkinsT m b) -> [a] -> JenkinsT m [b]
traverse :: forall a (m :: * -> *) b.
(a -> JenkinsT m b) -> [a] -> JenkinsT m [b]
traverse a -> JenkinsT m b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> JenkinsT m [b] -> JenkinsT m [b]
go (forall (m :: * -> *) a. Monad m => a -> m a
return [])
 where
  go :: a -> JenkinsT m [b] -> JenkinsT m [b]
go a
x JenkinsT m [b]
xs = do (b
y, [b]
ys) <- forall (m :: * -> *) a b.
JenkinsT m a -> JenkinsT m b -> JenkinsT m (a, b)
concurrently (a -> JenkinsT m b
f a
x) JenkinsT m [b]
xs; forall (m :: * -> *) a. Monad m => a -> m a
return (b
y forall a. a -> [a] -> [a]
: [b]
ys)

-- | Map every list element to an action and run them concurrently ignoring the results
--
-- @'traverse_' : 'Data.Foldable.traverse_' :: 'concurrently' : 'Control.Applicative.liftA2' (,)@
traverse_ :: F.Foldable f => (a -> JenkinsT m b) -> f a -> JenkinsT m ()
traverse_ :: forall (f :: * -> *) a (m :: * -> *) b.
Foldable f =>
(a -> JenkinsT m b) -> f a -> JenkinsT m ()
traverse_ a -> JenkinsT m b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
x -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
JenkinsT m a -> JenkinsT m b -> JenkinsT m (a, b)
concurrently (a -> JenkinsT m b
f a
x)) (forall (m :: * -> *) a. Monad m => a -> m a
return ())


-- | Perform a @POST@ request to Jenkins with the XML document
--
-- Sets up the correct @Content-Type@ header. Mostly useful for updating @config.xml@
-- files for jobs, views, etc
postXml :: (forall f. Method 'Complete f) -> Lazy.ByteString -> JenkinsT m Lazy.ByteString
postXml :: forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> JenkinsT m ByteString
postXml forall (g :: Format). Method 'Complete g
m = forall (m :: * -> *) a.
(Request -> Request) -> JenkinsT m a -> JenkinsT m a
locally (\Request
r -> Request
r { requestHeaders :: RequestHeaders
Http.requestHeaders = (HeaderName, ByteString)
xmlHeader forall a. a -> [a] -> [a]
: Request -> RequestHeaders
Http.requestHeaders Request
r }) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> JenkinsT m ByteString
post forall (g :: Format). Method 'Complete g
m
 where
  xmlHeader :: (HeaderName, ByteString)
xmlHeader = (HeaderName
"Content-Type", ByteString
"text/xml")

-- | Perform a @POST@ request to @/scriptText@
groovy
  :: Text.Lazy.Text            -- ^ Groovy source code
  -> JenkinsT m Text.Lazy.Text
groovy :: forall (m :: * -> *). Text -> JenkinsT m Text
groovy Text
script = forall (m :: * -> *) a.
(Request -> Request) -> JenkinsT m a -> JenkinsT m a
locally (\Request
r -> Request
r { requestHeaders :: RequestHeaders
Http.requestHeaders = (HeaderName, ByteString)
ascii forall a. a -> [a] -> [a]
: Request -> RequestHeaders
Http.requestHeaders Request
r }) forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ (forall a (m :: * -> *).
(forall (g :: Format). Method 'Complete g)
-> ByteString -> (ByteString -> a) -> JF m a
Post Method 'Complete f
"scriptText" ByteString
body ByteString -> Text
Text.Lazy.decodeUtf8)
 where
  body :: ByteString
body  = [ByteString] -> ByteString
Lazy.fromChunks
    [Bool -> SimpleQuery -> ByteString
Http.renderSimpleQuery Bool
False [(ByteString
"script", ByteString -> ByteString
Lazy.toStrict (Text -> ByteString
Text.Lazy.encodeUtf8 Text
script))]]
  ascii :: (HeaderName, ByteString)
ascii = (HeaderName
"Content-Type", ByteString
"application/x-www-form-urlencoded")

-- | Reload jenkins configuration from disk
--
-- Performs @/reload@
reload :: JenkinsT m ()
reload :: forall (m :: * -> *). JenkinsT m ()
reload = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g) -> JenkinsT m ByteString
post_ Method 'Complete f
"reload")

-- | Restart jenkins safely
--
-- Performs @/safeRestart@
--
-- @/safeRestart@ allows all running jobs to complete
restart :: JenkinsT m ()
restart :: forall (m :: * -> *). JenkinsT m ()
restart = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g) -> JenkinsT m ByteString
post_ Method 'Complete f
"safeRestart")

-- | Restart jenkins
--
-- Performs @/restart@
--
-- @/restart@ restart Jenkins immediately, without waiting for the completion of
-- the building and/or waiting jobs
forceRestart :: JenkinsT m ()
forceRestart :: forall (m :: * -> *). JenkinsT m ()
forceRestart = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *).
(forall (g :: Format). Method 'Complete g) -> JenkinsT m ByteString
post_ Method 'Complete f
"restart")