http-conduit 2.0 support

authenticate-oauth/Web/Authenticate/OAuth.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving, FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
 module Web.Authenticate.OAuth
     ( -- * Data types
@@ -48,6 +49,7 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Control
 import Control.Monad.Trans.Resource
 import Data.Default
+import qualified Data.IORef as I
 
 -- | Data type for OAuth client (consumer).
 -- 
@@ -156,7 +158,11 @@ getTemporaryCredentialWithScope :: (MonadResource m, MonadBaseControl IO m)
                                 -> m Credential -- ^ Temporay Credential (Request Token & Secret).
 getTemporaryCredentialWithScope bs = getTemporaryCredential' (addScope bs)
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+addScope :: BS.ByteString -> Request -> Request
+#else
 addScope :: (MonadIO m) => BS.ByteString -> Request m -> Request m
+#endif
 addScope scope req | BS.null scope = req
                    | otherwise     = urlEncodedBody [("scope", scope)] req
 
@@ -169,7 +175,11 @@ getTemporaryCredentialProxy :: (MonadResource m, MonadBaseControl IO m)
 getTemporaryCredentialProxy p oa m = getTemporaryCredential' (addMaybeProxy p) oa m
 
 getTemporaryCredential' :: (MonadResource m, MonadBaseControl IO m)
+#if MIN_VERSION_http_conduit(2, 0, 0)
+                        => (Request -> Request)       -- ^ Request Hook
+#else
                         => (Request m -> Request m)   -- ^ Request Hook
+#endif
                         -> OAuth                      -- ^ OAuth Application
                         -> Manager
                         -> m Credential    -- ^ Temporary Credential (Request Token & Secret).
@@ -225,7 +235,11 @@ getAccessTokenProxy, getTokenCredentialProxy
 getAccessTokenProxy p = getAccessToken' $ addMaybeProxy p
 
 getAccessToken' :: (MonadResource m, MonadBaseControl IO m)
+#if MIN_VERSION_http_conduit(2, 0, 0)
+                => (Request -> Request)       -- ^ Request Hook
+#else
                 => (Request m -> Request m)   -- ^ Request Hook
+#endif
                 -> OAuth                      -- ^ OAuth Application
                 -> Credential                 -- ^ Temporary Credential (with oauth_verifier if >= 1.0a)
                 -> Manager
@@ -272,8 +286,13 @@ injectVerifier = insert "oauth_verifier"
 signOAuth :: (MonadUnsafeIO m)
           => OAuth              -- ^ OAuth Application
           -> Credential         -- ^ Credential
+#if MIN_VERSION_http_conduit(2, 0, 0)
+          -> Request            -- ^ Original Request
+          -> m Request          -- ^ Signed OAuth Request
+#else
           -> Request m          -- ^ Original Request
           -> m (Request m)    -- ^ Signed OAuth Request
+#endif
 signOAuth oa crd req = do
   crd' <- addTimeStamp =<< addNonce crd
   let tok = injectOAuthToCred oa crd'
@@ -311,7 +330,11 @@ injectOAuthToCred oa cred =
             , ("oauth_version", "1.0")
             ] cred
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+genSign :: MonadUnsafeIO m => OAuth -> Credential -> Request -> m BS.ByteString
+#else
 genSign :: MonadUnsafeIO m => OAuth -> Credential -> Request m -> m BS.ByteString
+#endif
 genSign oa tok req =
   case oauthSignatureMethod oa of
     HMACSHA1 -> do
@@ -323,7 +346,11 @@ genSign oa tok req =
     RSASHA1 pr ->
       liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign ha_SHA1 pr) (getBaseString tok req)
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+addAuthHeader :: BS.ByteString -> Credential -> Request -> Request
+#else
 addAuthHeader :: BS.ByteString -> Credential -> Request a -> Request a
+#endif
 addAuthHeader prefix (Credential cred) req =
   req { requestHeaders = insertMap "Authorization" (renderAuthHeader prefix cred) $ requestHeaders req }
 
@@ -339,7 +366,11 @@ paramEncode = BS.concatMap escape
                                oct = '%' : replicate (2 - length num) '0' ++ num
                            in BS.pack oct
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+getBaseString :: MonadUnsafeIO m => Credential -> Request -> m BSL.ByteString
+#else
 getBaseString :: MonadUnsafeIO m => Credential -> Request m -> m BSL.ByteString
+#endif
 getBaseString tok req = do
   let bsMtd  = BS.map toUpper $ method req
       isHttps = secure req
@@ -359,6 +390,34 @@ getBaseString tok req = do
   -- So this is OK.
   return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams]
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+toLBS :: MonadUnsafeIO m => RequestBody -> m BS.ByteString
+toLBS (RequestBodyLBS l) = return $ toStrict l
+toLBS (RequestBodyBS s) = return s
+toLBS (RequestBodyBuilder _ b) = return $ toByteString b
+toLBS (RequestBodyStream _ givesPopper) = toLBS' givesPopper
+toLBS (RequestBodyStreamChunked givesPopper) = toLBS' givesPopper
+
+type Popper = IO BS.ByteString
+type NeedsPopper a = Popper -> IO a
+type GivesPopper a = NeedsPopper a -> IO a
+
+toLBS' :: MonadUnsafeIO m => GivesPopper () -> m BS.ByteString
+-- FIXME probably shouldn't be using MonadUnsafeIO
+toLBS' gp = unsafeLiftIO $ do
+    ref <- I.newIORef BS.empty
+    gp (go ref)
+    I.readIORef ref
+  where
+    go ref popper =
+        loop id
+      where
+        loop front = do
+            bs <- popper
+            if BS.null bs
+                then I.writeIORef ref $ BS.concat $ front []
+                else loop (front . (bs:))
+#else
 toLBS :: MonadUnsafeIO m => RequestBody m -> m BS.ByteString
 toLBS (RequestBodyLBS l) = return $ toStrict l
 toLBS (RequestBodyBS s) = return s
@@ -368,6 +427,7 @@ toLBS (RequestBodySourceChunked src) = toLBS' src
 
 toLBS' :: MonadUnsafeIO m => Source m Builder -> m BS.ByteString
 toLBS' src = liftM BS.concat $ src $= builderToByteString $$ CL.consume
+#endif
 
 isBodyFormEncoded :: [Header] -> Bool
 isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type"
@@ -379,5 +439,9 @@ compareTuple (a,b) (c,d) =
     EQ -> compare b d
     GT -> GT
 
+#if MIN_VERSION_http_conduit(2, 0, 0)
+addMaybeProxy :: Maybe Proxy -> Request -> Request
+#else
 addMaybeProxy :: Maybe Proxy -> Request m -> Request m
+#endif
 addMaybeProxy p req = req { proxy = p }

authenticate-oauth/Web/Authenticate/OAuth/IO.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
 -- | This Module provides interface for the instance of 'MonadIO' instead of 'MonadIO'.
 -- What this module do is just adding 'withManager' or 'runResourceT'.
@@ -51,7 +52,11 @@ getTemporaryCredentialProxy :: MonadIO m
 getTemporaryCredentialProxy p oa = liftIO $ withManager $ OA.getTemporaryCredential' (addMaybeProxy p) oa
 
 getTemporaryCredential' :: MonadIO m
+#if MIN_VERSION_http_conduit(2, 0, 0)
+                        => (Request -> Request)                                 -- ^ Request Hook
+#else
                         => (Request (ResourceT IO) -> Request (ResourceT IO))   -- ^ Request Hook
+#endif
                         -> OAuth                      -- ^ OAuth Application
                         -> m Credential -- ^ Temporary Credential (Request Token & Secret).
 getTemporaryCredential' hook oa = liftIO $ withManager $ OA.getTemporaryCredential' hook oa
@@ -75,7 +80,11 @@ getAccessTokenProxy, getTokenCredentialProxy
 getAccessTokenProxy p oa cr = liftIO $ withManager $ OA.getAccessTokenProxy p oa cr
 
 getAccessToken' :: MonadIO m
+#if MIN_VERSION_http_conduit(2, 0, 0)
+                => (Request -> Request)                                 -- ^ Request Hook
+#else
                 => (Request (ResourceT IO) -> Request (ResourceT IO))   -- ^ Request Hook
+#endif
                 -> OAuth                      -- ^ OAuth Application
                 -> Credential                 -- ^ Temporary Credential with oauth_verifier
                 -> m Credential     -- ^ Token Credential (Access Token & Secret)