module Network.PagerDuty.REST
(
send
, sendWith
, paginate
, paginateWith
, module Network.PagerDuty.Types
) where
import Control.Applicative
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Data.Aeson (FromJSON)
import Data.Conduit
import Data.Default.Class
import Data.Monoid
import Network.HTTP.Client (Manager)
import qualified Network.HTTP.Client as Client
import Network.HTTP.Types
import Network.PagerDuty.Internal.IO
import Network.PagerDuty.Internal.Types
import Network.PagerDuty.Types
send :: (MonadIO m, FromJSON b)
=> SubDomain
-> Auth s
-> Manager
-> Request a s b
-> m (Either Error b)
send d a m = sendWith (prod d a m)
sendWith :: (MonadIO m, FromJSON b)
=> Env s
-> Request a s b
-> m (Either Error b)
sendWith e = liftM (fmap fst) . http e
paginate :: (MonadIO m, Paginate a, FromJSON b)
=> SubDomain
-> Auth s
-> Manager
-> Request a s b
-> Source m (Either Error b)
paginate d a m = paginateWith (prod d a m)
paginateWith :: (MonadIO m, Paginate a, FromJSON b)
=> Env s
-> Request a s b
-> Source m (Either Error b)
paginateWith e = go
where
go rq = do
rs <- lift (http e rq)
yield (fst <$> rs)
either (const (return ()))
(maybe (return ()) go . next rq . snd)
rs
http :: (MonadIO m, FromJSON b)
=> Env s
-> Request a s b
-> m (Either Error (b, Maybe Pager))
http e rq = request (e ^. envManager) (e ^. envLogger) rq $ raw
{ Client.host = domain (e ^. envDomain)
, Client.path = renderPath (rq ^. path)
, Client.queryString = renderQuery False (rq ^. query)
}
where
raw = case e ^. envAuth of
AuthBasic u p -> Client.applyBasicAuth u p def
AuthToken t -> def
{ Client.requestHeaders = [("Authorization", "Token token=" <> t)]
}