{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK hide #-}
-- | Jenkins REST API interface internals
module Jenkins.Rest.Internal
  ( JenkinsT(..)
  , liftJ
  , runInternal
  , JF(..)
  , JenkinsException(..)
  , iter
  , ResumableSource
  ) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative
#endif
import           Control.Concurrent.Async (Async)
import qualified Control.Concurrent.Async as Unlifted
import           Control.Exception (Exception(..), SomeException, throwIO)
import qualified Control.Exception as Unlifted
import           Control.Monad
import           Control.Monad.Free.Church (liftF)
import           Control.Monad.Except (MonadError(..))
import           Control.Monad.Reader (MonadReader(..))
import           Control.Monad.State (MonadState(..))
import           Control.Monad.Trans (MonadIO(..), MonadTrans(..))
import           Control.Monad.Trans.Control (MonadBaseControl(..), control, liftBaseOp_)
import           Control.Monad.Trans.Free.Church (FT, iterTM)
import           Control.Monad.Trans.Resource (MonadResource)
import           Control.Monad.Writer (MonadWriter(..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as ByteString.Lazy
import           Data.Conduit (ConduitM)
import qualified Data.Kind as Ghc (Type)
import           Data.Text (Text)
import qualified Data.Text.Encoding as Text
import           Data.Typeable (Typeable)
import           Network.HTTP.Conduit (Request, HttpException)
import qualified Network.HTTP.Conduit as Http
import qualified Network.HTTP.Client as Http (brReadSome)
import qualified Network.HTTP.Client.Internal as Http (throwHttp)
import           Network.HTTP.Types (Status(..))

import           Jenkins.Rest.Method.Internal (Method, Type(..), render, slash)

{-# ANN module ("HLint: ignore Use join" :: String) #-}


-- | The value of this type describes Jenkins REST API requests sequence
newtype JenkinsT m a = JenkinsT { forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT :: FT (JF m) m a }
  deriving (forall a b. a -> JenkinsT m b -> JenkinsT m a
forall a b. (a -> b) -> JenkinsT m a -> JenkinsT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> JenkinsT m b -> JenkinsT m a
forall (m :: * -> *) a b. (a -> b) -> JenkinsT m a -> JenkinsT m b
<$ :: forall a b. a -> JenkinsT m b -> JenkinsT m a
$c<$ :: forall (m :: * -> *) a b. a -> JenkinsT m b -> JenkinsT m a
fmap :: forall a b. (a -> b) -> JenkinsT m a -> JenkinsT m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> JenkinsT m a -> JenkinsT m b
Functor)

instance MonadIO m => MonadIO (JenkinsT m) where
  liftIO :: forall a. IO a -> JenkinsT m a
liftIO = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadTrans JenkinsT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> JenkinsT m a
lift = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance Applicative (JenkinsT m) where
  pure :: forall a. a -> JenkinsT m a
pure = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  JenkinsT FT (JF m) m (a -> b)
f <*> :: forall a b. JenkinsT m (a -> b) -> JenkinsT m a -> JenkinsT m b
<*> JenkinsT FT (JF m) m a
x = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT (FT (JF m) m (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FT (JF m) m a
x)

instance Monad (JenkinsT m) where
  return :: forall a. a -> JenkinsT m a
return = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
  JenkinsT FT (JF m) m a
m >>= :: forall a b. JenkinsT m a -> (a -> JenkinsT m b) -> JenkinsT m b
>>= a -> JenkinsT m b
k = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT (FT (JF m) m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> JenkinsT m b
k)

instance MonadReader r m => MonadReader r (JenkinsT m) where
  ask :: JenkinsT m r
ask = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> JenkinsT m a -> JenkinsT m a
local r -> r
f = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT

instance MonadWriter w m => MonadWriter w (JenkinsT m) where
  tell :: w -> JenkinsT m ()
tell = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. JenkinsT m a -> JenkinsT m (a, w)
listen = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT
  pass :: forall a. JenkinsT m (a, w -> w) -> JenkinsT m a
pass = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT
  writer :: forall a. (a, w) -> JenkinsT m a
writer = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer

instance MonadState s m => MonadState s (JenkinsT m) where
  get :: JenkinsT m s
get = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> JenkinsT m ()
put = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> JenkinsT m a
state = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadError e m => MonadError e (JenkinsT m) where
  throwError :: forall a. e -> JenkinsT m a
throwError = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  JenkinsT m a
m catchError :: forall a. JenkinsT m a -> (e -> JenkinsT m a) -> JenkinsT m a
`catchError` e -> JenkinsT m a
f = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT (forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT JenkinsT m a
m forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> JenkinsT m a
f))

type ResumableSource m o = ConduitM () o m ()

data JF :: (Ghc.Type -> Ghc.Type) -> Ghc.Type -> Ghc.Type where
  Get    :: Method 'Complete f -> (Lazy.ByteString -> a) -> JF m a
  Stream :: MonadResource m => Method 'Complete f -> (ResumableSource m ByteString -> a) -> JF m a
  Post   :: (forall f. Method 'Complete f) -> Lazy.ByteString -> (Lazy.ByteString -> a) -> JF m a
  Conc   :: JenkinsT m a -> JenkinsT m b -> (a -> b -> c) -> JF m c
  Or     :: JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JF m a
  With   :: (Request -> Request) -> JenkinsT m b -> (b -> a) -> JF m a

instance Functor (JF m) where
  fmap :: forall a b. (a -> b) -> JF m a -> JF m b
fmap a -> b
f (Get Method 'Complete f
m ByteString -> a
g)       = forall (b :: Format) a (m :: * -> *).
Method 'Complete b -> (ByteString -> a) -> JF m a
Get Method 'Complete f
m (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
g)
  fmap a -> b
f (Stream Method 'Complete f
m ResumableSource m ByteString -> a
g)    = forall (m :: * -> *) (b :: Format) a.
MonadResource m =>
Method 'Complete b -> (ResumableSource m ByteString -> a) -> JF m a
Stream Method 'Complete f
m (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResumableSource m ByteString -> a
g)
  fmap a -> b
f (Post forall (f :: Format). Method 'Complete f
m ByteString
body ByteString -> a
g) = forall a (m :: * -> *).
(forall (f :: Format). Method 'Complete f)
-> ByteString -> (ByteString -> a) -> JF m a
Post forall (f :: Format). Method 'Complete f
m ByteString
body (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
g)
  fmap a -> b
f (Conc JenkinsT m a
m JenkinsT m b
n a -> b -> a
g)    = forall (m :: * -> *) b b c.
JenkinsT m b -> JenkinsT m b -> (b -> b -> c) -> JF m c
Conc JenkinsT m a
m JenkinsT m b
n (\a
a b
b -> a -> b
f (a -> b -> a
g a
a b
b))
  fmap a -> b
f (Or JenkinsT m a
a JenkinsException -> JenkinsT m a
b)        = forall (m :: * -> *) a.
JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JF m a
Or (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f JenkinsT m a
a) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. JenkinsException -> JenkinsT m a
b)
  fmap a -> b
f (With Request -> Request
h JenkinsT m b
j b -> a
g)    = forall (m :: * -> *) b a.
(Request -> Request) -> JenkinsT m b -> (b -> a) -> JF m a
With Request -> Request
h JenkinsT m b
j (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)

-- | Lift 'JF' to 'JenkinsT'
liftJ :: JF m a -> JenkinsT m a
liftJ :: forall (m :: * -> *) a. JF m a -> JenkinsT m a
liftJ = forall (m :: * -> *) a. FT (JF m) m a -> JenkinsT m a
JenkinsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF


-- | The kind of exceptions that can be thrown by performing requests
-- to the Jenkins REST API
newtype JenkinsException
  = JenkinsHttpException HttpException
    deriving (Int -> JenkinsException -> ShowS
[JenkinsException] -> ShowS
JenkinsException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JenkinsException] -> ShowS
$cshowList :: [JenkinsException] -> ShowS
show :: JenkinsException -> String
$cshow :: JenkinsException -> String
showsPrec :: Int -> JenkinsException -> ShowS
$cshowsPrec :: Int -> JenkinsException -> ShowS
Show, Typeable)

instance Exception JenkinsException


runInternal
  :: (MonadIO m, MonadBaseControl IO m)
  => String -> Text -> Text -> JenkinsT m a -> m a
runInternal :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
String -> Text -> Text -> JenkinsT m a -> m a
runInternal String
h Text
user Text
token JenkinsT m a
jenk = do
  Request
url <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
wrapException (forall (m :: * -> *). MonadThrow m => String -> m Request
Http.parseUrlThrow String
h))
  Manager
man <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
Http.newManager ManagerSettings
Http.tlsManagerSettings)
  forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JenkinsT m a -> InterpT m a
iterInterpT Manager
man JenkinsT m a
jenk)
             (ByteString -> ByteString -> Request -> Request
Http.applyBasicAuth (Text -> ByteString
Text.encodeUtf8 Text
user) (Text -> ByteString
Text.encodeUtf8 Text
token) Request
url)

newtype InterpT m a = InterpT
  { forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT :: Request -> m a
  } deriving (forall a b. a -> InterpT m b -> InterpT m a
forall a b. (a -> b) -> InterpT m a -> InterpT m b
forall (m :: * -> *) a b.
Functor m =>
a -> InterpT m b -> InterpT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpT m a -> InterpT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InterpT m b -> InterpT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> InterpT m b -> InterpT m a
fmap :: forall a b. (a -> b) -> InterpT m a -> InterpT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpT m a -> InterpT m b
Functor)

instance (Functor m, Monad m) => Applicative (InterpT m) where
  pure :: forall a. a -> InterpT m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b. InterpT m (a -> b) -> InterpT m a -> InterpT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (InterpT m) where
  return :: forall a. a -> InterpT m a
return = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
  InterpT Request -> m a
m >>= :: forall a b. InterpT m a -> (a -> InterpT m b) -> InterpT m b
>>= a -> InterpT m b
k = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT (\Request
req -> Request -> m a
m Request
req forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (a -> InterpT m b
k a
a) Request
req)

instance MonadTrans InterpT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> InterpT m a
lift = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | Interpret the 'JF' AST in 'InterpT'
iterInterpT :: (MonadIO m, MonadBaseControl IO m) => Http.Manager -> JenkinsT m a -> InterpT m a
iterInterpT :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JenkinsT m a -> InterpT m a
iterInterpT Manager
manager = forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, Monad (t m), MonadTrans t) =>
(JF m (t m a) -> t m a) -> JenkinsT m a -> t m a
iter (forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JF m (InterpT m a) -> InterpT m a
interpreter Manager
manager)

-- | Tear down the 'JF' AST with a 'JF'-algebra
iter
  :: (Monad m, Monad (t m), MonadTrans t)
  => (JF m (t m a) -> t m a) -> JenkinsT m a -> t m a
iter :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, Monad (t m), MonadTrans t) =>
(JF m (t m a) -> t m a) -> JenkinsT m a -> t m a
iter JF m (t m a) -> t m a
go = forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Functor f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FT f m a -> t m a
iterTM JF m (t m a) -> t m a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. JenkinsT m a -> FT (JF m) m a
unJenkinsT

-- | 'JF' AST interpreter
interpreter
  :: forall m a. (MonadIO m, MonadBaseControl IO m)
  => Http.Manager
  -> JF m (InterpT m a) -> InterpT m a
interpreter :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JF m (InterpT m a) -> InterpT m a
interpreter Manager
man = JF m (InterpT m a) -> InterpT m a
go where
  go :: JF m (InterpT m a) -> InterpT m a
  go :: JF m (InterpT m a) -> InterpT m a
go (Get Method 'Complete f
m ByteString -> InterpT m a
next) = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall a b. (a -> b) -> a -> b
$ \Request
req -> do
    ByteString
res <- forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m ByteString
oneshotReq (forall (f :: Format). Method 'Complete f -> Request -> Request
prepareGet Method 'Complete f
m Request
req) Manager
man
    forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (ByteString -> InterpT m a
next ByteString
res) Request
req
  go (Stream Method 'Complete f
m ResumableSource m ByteString -> InterpT m a
next) = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall a b. (a -> b) -> a -> b
$ \Request
req -> do
    ResumableSource m ByteString
res <- forall (m :: * -> *).
(MonadBaseControl IO m, MonadResource m) =>
Request -> Manager -> m (ResumableSource m ByteString)
streamReq (forall (f :: Format). Method 'Complete f -> Request -> Request
prepareGet Method 'Complete f
m Request
req) Manager
man
    forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (ResumableSource m ByteString -> InterpT m a
next ResumableSource m ByteString
res) Request
req
  go (Post forall (f :: Format). Method 'Complete f
m ByteString
body ByteString -> InterpT m a
next) = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall a b. (a -> b) -> a -> b
$ \Request
req -> do
    ByteString
res <- forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m ByteString
oneshotReq (forall (f :: Format).
Method 'Complete f -> ByteString -> Request -> Request
preparePost forall (f :: Format). Method 'Complete f
m ByteString
body Request
req) Manager
man
    forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (ByteString -> InterpT m a
next ByteString
res) Request
req
  go (Conc JenkinsT m a
ja JenkinsT m b
jb a -> b -> InterpT m a
next) = do
    (a
a, b
b) <- forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> ((forall b. JenkinsT m b -> m b) -> m a) -> InterpT m a
intoM Manager
man forall a b. (a -> b) -> a -> b
$ \forall b. JenkinsT m b -> m b
run -> forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m b -> m (a, b)
concurrently (forall b. JenkinsT m b -> m b
run JenkinsT m a
ja) (forall b. JenkinsT m b -> m b
run JenkinsT m b
jb)
    a -> b -> InterpT m a
next a
a b
b
  go (Or JenkinsT m (InterpT m a)
ja JenkinsException -> JenkinsT m (InterpT m a)
jb) = do
    InterpT m a
res <- forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> ((forall b. JenkinsT m b -> m b) -> m a) -> InterpT m a
intoM Manager
man forall a b. (a -> b) -> a -> b
$ \forall b. JenkinsT m b -> m b
run -> forall b. JenkinsT m b -> m b
run JenkinsT m (InterpT m a)
ja forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall b. JenkinsT m b -> m b
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. JenkinsException -> JenkinsT m (InterpT m a)
jb)
    InterpT m a
res
  go (With Request -> Request
f JenkinsT m b
jenk b -> InterpT m a
next) = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall a b. (a -> b) -> a -> b
$ \Request
req -> do
    b
res <- forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JenkinsT m a -> InterpT m a
iterInterpT Manager
man JenkinsT m b
jenk) (Request -> Request
f Request
req)
    forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (b -> InterpT m a
next b
res) Request
req

oneshotReq :: MonadIO m => Request -> Http.Manager -> m Lazy.ByteString
oneshotReq :: forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m ByteString
oneshotReq Request
req =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
wrapException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall body. Response body -> body
Http.responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
Http.httpLbs Request
req

streamReq
  :: (MonadBaseControl IO m, MonadResource m)
  => Request -> Http.Manager -> m (ResumableSource m ByteString)
streamReq :: forall (m :: * -> *).
(MonadBaseControl IO m, MonadResource m) =>
Request -> Manager -> m (ResumableSource m ByteString)
streamReq Request
req =
  forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
wrapException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall body. Response body -> body
Http.responseBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
Http.http Request
req

intoM
  :: forall m a. (MonadIO m, MonadBaseControl IO m)
  => Http.Manager
  -> ((forall b. JenkinsT m b -> m b) -> m a)
  -> InterpT m a
intoM :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> ((forall b. JenkinsT m b -> m b) -> m a) -> InterpT m a
intoM Manager
m (forall b. JenkinsT m b -> m b) -> m a
f = forall (m :: * -> *) a. (Request -> m a) -> InterpT m a
InterpT forall a b. (a -> b) -> a -> b
$ \Request
req -> (forall b. JenkinsT m b -> m b) -> m a
f (\JenkinsT m b
x -> forall (m :: * -> *) a. InterpT m a -> Request -> m a
runInterpT (forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
Manager -> JenkinsT m a -> InterpT m a
iterInterpT Manager
m JenkinsT m b
x) Request
req)

prepareGet :: Method 'Complete f -> Request -> Request
prepareGet :: forall (f :: Format). Method 'Complete f -> Request -> Request
prepareGet Method 'Complete f
m Request
r = Request
r
  { method :: ByteString
Http.method = ByteString
"GET"
  , path :: ByteString
Http.path   = Request -> ByteString
Http.path Request
r forall m. (IsString m, Monoid m, Eq m) => m -> m -> m
`slash` forall (f :: Format). Method 'Complete f -> ByteString
render Method 'Complete f
m
  }

preparePost :: Method 'Complete f -> Lazy.ByteString -> Request -> Request
preparePost :: forall (f :: Format).
Method 'Complete f -> ByteString -> Request -> Request
preparePost Method 'Complete f
m ByteString
body Request
r = Request
r
  { checkResponse :: Request -> Response BodyReader -> IO ()
Http.checkResponse = forall {p}. p -> Response BodyReader -> IO ()
statusCheck
  , redirectCount :: Int
Http.redirectCount = Int
0
  , requestBody :: RequestBody
Http.requestBody   = ByteString -> RequestBody
Http.RequestBodyLBS ByteString
body
  , method :: ByteString
Http.method        = ByteString
"POST"
  , path :: ByteString
Http.path          = Request -> ByteString
Http.path Request
r forall m. (IsString m, Monoid m, Eq m) => m -> m -> m
`slash` forall (f :: Format). Method 'Complete f -> ByteString
render Method 'Complete f
m
  }
 where
  statusCheck :: p -> Response BodyReader -> IO ()
statusCheck p
_req Response BodyReader
res =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
200 forall a. Ord a => a -> a -> Bool
<= Int
st Bool -> Bool -> Bool
&& Int
st forall a. Ord a => a -> a -> Bool
< Int
400) forall a b. (a -> b) -> a -> b
$ do
      ByteString
chunk <- BodyReader -> Int -> IO ByteString
Http.brReadSome (forall body. Response body -> body
Http.responseBody Response BodyReader
res) Int
1024
      forall a. HttpExceptionContent -> IO a
Http.throwHttp (Response () -> ByteString -> HttpExceptionContent
Http.StatusCodeException (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Response BodyReader
res) (ByteString -> ByteString
ByteString.Lazy.toStrict ByteString
chunk))
   where
    Status Int
st ByteString
_ = forall body. Response body -> Status
Http.responseStatus Response BodyReader
res

wrapException :: (MonadBaseControl IO m, MonadIO m) => m a -> m a
wrapException :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
wrapException m a
m = m a
m forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
.  HttpException -> JenkinsException
JenkinsHttpException)

concurrently :: (MonadBaseControl IO m, MonadIO m) => m a -> m b -> m (a, b)
concurrently :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m b -> m (a, b)
concurrently m a
ma m b
mb =
  forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
ma forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
mb forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
Async (StM m a) -> Async (StM m b) -> m (a, b)
waitBoth Async (StM m a)
a Async (StM m b)
b
{-# INLINABLE concurrently #-}

withAsync :: (MonadBaseControl IO m, MonadIO m) => m a -> (Async (StM m a) -> m b) -> m b
withAsync :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
action Async (StM m a) -> m b
inner = forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
  Async (StM m a)
a <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
magic -> forall a. IO a -> IO (Async a)
Unlifted.async (RunInBase m IO
magic (forall a. m a -> m a
restore m a
action)))
  b
r <- forall a. m a -> m a
restore (Async (StM m a) -> m b
inner Async (StM m a)
a) forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do forall a. Async a -> IO ()
Unlifted.cancel Async (StM m a)
a; forall e a. Exception e => e -> IO a
throwIO (SomeException
e :: SomeException))
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Async a -> IO ()
Unlifted.cancel Async (StM m a)
a)
  forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# INLINABLE withAsync #-}

waitBoth :: (MonadBaseControl IO m, MonadIO m) => Async (StM m a) -> Async (StM m b) -> m (a, b)
waitBoth :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, MonadIO m) =>
Async (StM m a) -> Async (StM m b) -> m (a, b)
waitBoth Async (StM m a)
aa Async (StM m b)
ab = do
  (StM m a
ma, StM m b
mb) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO (a, b)
Unlifted.waitBoth Async (StM m a)
aa Async (StM m b)
ab)
  a
a <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
ma
  b
b <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m b
mb
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)
{-# INLINABLE waitBoth #-}

mask :: MonadBaseControl IO m => ((forall a. m a -> m a) -> m b) -> m b
mask :: forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
mask (forall a. m a -> m a) -> m b
f = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
magic -> forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Unlifted.mask (\forall a. IO a -> IO a
g -> RunInBase m IO
magic ((forall a. m a -> m a) -> m b
f (forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
g)))
{-# INLINABLE mask #-}

catch :: (MonadBaseControl IO m, Exception e) => m a -> (e -> m a) -> m a
catch :: forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
m e -> m a
h = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control (\RunInBase m IO
magic -> forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Unlifted.catch (RunInBase m IO
magic m a
m) (RunInBase m IO
magic forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
h))
{-# INLINABLE catch #-}