{-# 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 #-}
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) #-}
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)
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
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
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)
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
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 #-}