diff --git a/gogol.cabal b/gogol.cabal --- a/gogol.cabal +++ b/gogol.cabal @@ -1,5 +1,5 @@ name: gogol -version: 0.4.0 +version: 0.5.0 synopsis: Comprehensive Google Services SDK. homepage: https://github.com/brendanhay/gogol bug-reports: https://github.com/brendanhay/gogol/issues @@ -66,7 +66,7 @@ , directory >= 1.2 , exceptions >= 0.6 , filepath >= 1.2 - , gogol-core == 0.4.0.* + , gogol-core == 0.5.0.* , http-client >= 0.5 && < 1 , http-conduit >= 2.3 && < 3 , http-media >= 0.6 diff --git a/src/Network/Google.hs b/src/Network/Google.hs --- a/src/Network/Google.hs +++ b/src/Network/Google.hs @@ -63,7 +63,7 @@ , download , upload - , Body (..) + , GBody (..) , bodyContentType , sourceBody @@ -266,7 +266,7 @@ , GoogleRequest (MediaUpload a) ) => a - -> Body + -> GBody -> m (Rs (MediaUpload a)) upload x = send . MediaUpload x diff --git a/src/Network/Google/Auth.hs b/src/Network/Google/Auth.hs --- a/src/Network/Google/Auth.hs +++ b/src/Network/Google/Auth.hs @@ -39,6 +39,7 @@ , Store , initStore , retrieveAuthFromStore + , retrieveTokenFromStore , Auth (..) , authToAuthorizedUser @@ -131,19 +132,22 @@ initStore c l m = exchange c l m >>= fmap Store . liftIO . newMVar -- | Retrieve auth from storage -retrieveAuthFromStore :: (MonadIO m, MonadCatch m, AllowScopes s) - => Store s - -> m (Auth s) -retrieveAuthFromStore (Store s) = liftIO (readMVar s) +retrieveAuthFromStore + :: (MonadIO m, AllowScopes s) + => Store s + -> m (Auth s) +retrieveAuthFromStore (Store s) = + liftIO (readMVar s) -- | Concurrently read the current token, and if expired, then -- safely perform a single serial refresh. -getToken :: (MonadIO m, MonadCatch m, AllowScopes s) - => Store s - -> Logger - -> Manager - -> m (OAuthToken s) -getToken (Store s) l m = do +retrieveTokenFromStore + :: (MonadIO m, MonadCatch m, AllowScopes s) + => Store s + -> Logger + -> Manager + -> m (OAuthToken s) +retrieveTokenFromStore (Store s) l m = do x <- liftIO (readMVar s) mx <- validate x if mx @@ -193,7 +197,7 @@ -> Logger -> Manager -> m Client.Request -authorize rq s l m = bearer <$> getToken s l m +authorize rq s l m = bearer <$> retrieveTokenFromStore s l m where bearer t = rq { Client.requestHeaders = diff --git a/src/Network/Google/Auth/InstalledApplication.hs b/src/Network/Google/Auth/InstalledApplication.hs --- a/src/Network/Google/Auth/InstalledApplication.hs +++ b/src/Network/Google/Auth/InstalledApplication.hs @@ -140,7 +140,7 @@ -- | Perform a refresh to obtain a valid 'OAuthToken' with a new expiry time. -- --- /See:/ . +-- /See:/ . refreshToken :: (MonadIO m, MonadCatch m) => OAuthClient -> (OAuthToken s) @@ -148,7 +148,7 @@ -> Manager -> m (OAuthToken s) refreshToken c t = refreshRequest $ - accountsRequest + tokenRequest { Client.requestBody = textBody $ "grant_type=refresh_token" <> "&client_id=" <> toQueryParam (_clientId c) diff --git a/src/Network/Google/Internal/Body.hs b/src/Network/Google/Internal/Body.hs --- a/src/Network/Google/Internal/Body.hs +++ b/src/Network/Google/Internal/Body.hs @@ -14,7 +14,7 @@ import Data.Conduit.Binary (sourceFile) import Data.Maybe (fromMaybe) import qualified Data.Text as Text -import Network.Google.Types (Body (..)) +import Network.Google.Types (GBody (..)) import Network.HTTP.Conduit (requestBodySource) import Network.HTTP.Media (MediaType, parseAccept, (//)) import qualified Network.Mime as MIME @@ -35,13 +35,13 @@ . Text.takeWhileEnd (/= '/') . Text.pack --- | Construct a 'Body' from a 'FilePath'. +-- | Construct a 'GBody' from a 'FilePath'. -- -- This uses 'getMIMEType' to calculate the MIME type from the file extension, -- you can use 'bodyContentType' to set a MIME type explicitly. -sourceBody :: MonadIO m => FilePath -> m Body +sourceBody :: MonadIO m => FilePath -> m GBody sourceBody f = do n <- getFileSize f - pure $ Body + pure $ GBody (getMIMEType f) (requestBodySource (fromIntegral n) (sourceFile f)) diff --git a/src/Network/Google/Internal/HTTP.hs b/src/Network/Google/Internal/HTTP.hs --- a/src/Network/Google/Internal/HTTP.hs +++ b/src/Network/Google/Internal/HTTP.hs @@ -20,8 +20,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Resource (MonadResource (..)) -import Data.Conduit (($$+-)) -import Data.Monoid (Dual (..), Endo (..), (<>)) +import Data.Monoid (Dual (..), Endo (..), (<>)) import GHC.Exts (toList) @@ -34,8 +33,6 @@ import Network.HTTP.Media (RenderHeader (..)) import Network.HTTP.Types -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Conduit.List as Conduit import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as Build @@ -128,11 +125,11 @@ err e = return (Left e) getContent :: MonadIO m - => [Body] + => [GBody] -> m ([Header] -> [Header], RequestBody) -getContent [] = pure (id, mempty) -getContent [Body t s] = pure (((hContentType, renderHeader t) :), s) -getContent bs = do +getContent [] = pure (id, mempty) +getContent [GBody t s] = pure (((hContentType, renderHeader t) :), s) +getContent bs = do b <- genBoundary pure ( (multipartHeader b :) , renderParts b bs diff --git a/src/Network/Google/Internal/Multipart.hs b/src/Network/Google/Internal/Multipart.hs --- a/src/Network/Google/Internal/Multipart.hs +++ b/src/Network/Google/Internal/Multipart.hs @@ -15,7 +15,7 @@ import qualified Data.ByteString as BS import Data.ByteString.Builder.Extra (byteStringCopy) import Data.Monoid ((<>)) -import Network.Google.Types (Body (..)) +import Network.Google.Types (GBody (..)) import Network.HTTP.Client import Network.HTTP.Client.MultipartFormData (webkitBoundary) import Network.HTTP.Media (RenderHeader (..)) @@ -57,10 +57,10 @@ copy :: ByteString -> RequestBody copy bs = RequestBodyBuilder (fromIntegral (BS.length bs)) (byteStringCopy bs) -renderParts :: Boundary -> [Body] -> RequestBody +renderParts :: Boundary -> [GBody] -> RequestBody renderParts b = (<> part b) . foldMap go where - go (Body ct x) = + go (GBody ct x) = start b <> copy "Content-Type: " <> copy (renderHeader ct)