@@ -27,15 +27,15 @@ import Control.Lens
2727import Control.Monad
2828import Control.Monad.IO.Class
2929import Control.Monad.Trans
30−import Data.Aeson hiding (Error)
31−import qualified Data.ByteString.Lazy as LBS
30+import Data.Aeson hiding (Error)
31+import qualified Data.ByteString.Lazy as LBS
3232import Data.Conduit
3333import Data.Default
3434import Data.Monoid
35−import Network.HTTP.Client (Manager, httpLbs)
36−import qualified Network.HTTP.Client as Client
37−import qualified Network.HTTP.Client.Lens as Lens
35+import Network.HTTP.Client (Manager, applyBasicAuth)
36+import qualified Network.HTTP.Client.Lens as Lens
3837import Network.HTTP.Types
38+import Network.PagerDuty.HTTP
3939import Network.PagerDuty.Types
4040
4141-- data Env (s :: Security) = Env
@@ -73,49 +73,12 @@ http :: (MonadIO m, FromJSON b)
7373 -> Manager
7474 -> Request a s b
7575 -> m (Either Error (b, Maybe Pager))
76−http a (SubDomain h) m rq = liftIO (httpLbs raw m) >>= response rq
76+http a (SubDomain h) m rq = request m rq $ raw
77+ & Lens.host .~ h
78+ & Lens.path .~ renderPath (rq ^. path)
79+ & Lens.queryString .~ renderQuery False (rq ^. query)
7780 where
78− raw = authorise
79− & Lens.secure .~ True
80− & Lens.port .~ 443
81− & Lens.path .~ renderPath (rq ^. path)
82− & Lens.queryString .~ renderQuery False (rq ^. query)
83− & Lens.requestHeaders <>~ headers
84− & Lens.requestBody .~ Client.RequestBodyLBS (encode rq)
85−
86− authorise = case a of
87− AuthBasic u p -> Client.applyBasicAuth u p def & Lens.host .~ h
88− AuthToken t -> def & Lens.host .~ h & Lens.requestHeaders <>~ [token t]
89−
90− token t = ("Authorization", "Token token=" <> t)
91−
92− headers =
93− [ ("Content-Type", "application/json")
94− , ("Accept", "application/json")
95− ]
96−
97−response :: (MonadIO m, FromJSON b)
98− => Request a s b
99− -> Client.Response LBS.ByteString
100− -> m (Either Error (b, Maybe Pager))
101−response _ x = case statusCode (Client.responseStatus x) of
102− 200 -> success
103− 201 -> success
104− 400 -> failure
105− 500 -> failure
106− n -> return . Left $ unhandled n
107− where
108− success = maybe (Left unknown) Right `liftM` parse
109− failure = maybe (Left unknown) Left `liftM` parse
110−
111− unhandled n = Internal
112− $ "PagerDuty returned unhandled status code: " ++ show n
113−
114− unknown = Internal
115− $ "Unable to parse response into a PagerDuty API compatible type: "
116− ++ show body
117−
118− parse :: (Monad m, FromJSON a) => m (Maybe a)
119− parse = return (decode body)
120−
121− body = Client.responseBody x
81+ raw = case a of
82+ AuthBasic u p -> applyBasicAuth u p def
83+ AuthToken t -> def & Lens.requestHeaders <>~
84+ [("Authorization", "Token token=" <> t)]