8dbbd09 · gogol · git.iko.soy

git.iko.soy/gogol

Adding basic examples

commit8dbbd090cbe026a6fe56a26599fd811063fe3b71 authorBrendan Hay <brendan.g.hay@gmail.com> dateFri 23 Oct 2015, 19:30 (11 years ago) parent97884f6

6 files changed+74−32

compare with develop

unifiedsplit

core/src/Network/Google/Types.hs+15−8 examples/src/Example/Storage.hs+33 gen/src/Gen/Text.hs+2 gogol-youtube-reporting/gen/Network/Google/Resource/YouTubeReporting/Media/Download.hs+19−19 gogol/src/Network/Google/Internal/HTTP.hs+3−2 gogol/src/Network/Google/Internal/Multipart.hs+2−3

core/src/Network/Google/Types.hs+15−8

@@ -8,6 +8,7 @@

88{-# LANGUAGE OverloadedStrings #-}

99{-# LANGUAGE RecordWildCards #-}

1010{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE TupleSections #-}

1112{-# LANGUAGE TypeFamilies #-}

1213{-# LANGUAGE TypeOperators #-}

1314{-# LANGUAGE UndecidableInstances #-}

@@ -25,7 +26,6 @@ module Network.Google.Types where

2526import Control.Applicative

2627import Control.Exception.Lens (exception)

2728import Control.Lens hiding (coerce)

28−import Control.Monad

2929import Control.Monad.Catch

3030import Control.Monad.Trans.Resource

3131import Data.Aeson

@@ -116,14 +116,15 @@ data SerializeError = SerializeError'

116116 { _serializeId :: !ServiceId

117117 , _serializeHeaders :: [HTTP.Header]

118118 , _serializeStatus :: !Status

119− , _serializeMessage :: String

119+ , _serializeMessage :: !String

120+ , _serializeBody :: !(Maybe LBS.ByteString)

120121 } deriving (Eq, Show, Typeable)

121122

122123data ServiceError = ServiceError'

123124 { _serviceId :: !ServiceId

124125 , _serviceStatus :: !Status

125− , _serviceHeaders :: [HTTP.Header]

126− , _serviceBody :: Maybe LBS.ByteString

126+ , _serviceHeaders :: ![HTTP.Header]

127+ , _serviceBody :: !(Maybe LBS.ByteString)

127128 } deriving (Eq, Show, Typeable)

128129

129130class AsError a where

@@ -249,7 +250,7 @@ data Client a = Client

249250 , _cliCheck :: !(Status -> Bool)

250251 , _cliService :: !Service

251252 , _cliRequest :: !Request

252− , _cliResponse :: !(Stream -> ResourceT IO (Either String a))

253+ , _cliResponse :: !(Stream -> ResourceT IO (Either (String, LBS.ByteString) a))

253254 }

254255

255256clientService :: Lens' (Client a) Service

@@ -261,7 +262,7 @@ mime p = client (fromStream p) (Just (contentType p))

261262discard :: Method -> [Int] -> Request -> Service -> Client ()

262263discard = client (\b -> closeResumableSource b >> pure (Right ())) Nothing

263264

264−client :: (Stream -> ResourceT IO (Either String a))

265+client :: (Stream -> ResourceT IO (Either (String, LBS.ByteString) a))

265266 -> Maybe MediaType

266267 -> Method

267268 -> [Int]

@@ -299,13 +300,19 @@ instance ToJSON a => ToBody JSON a where

299300 toBody Proxy = RequestBodyLBS . encode

300301

301302class Accept c => FromStream c a where

302− fromStream :: Proxy c -> Stream -> ResourceT IO (Either String a)

303+ fromStream :: Proxy c

304+ -> Stream

305+ -> ResourceT IO (Either (String, LBS.ByteString) a)

303306

304307instance FromStream OctetStream Stream where

305308 fromStream Proxy = pure . Right

306309

307310instance FromJSON a => FromStream JSON a where

308− fromStream Proxy = sinkLBS >=> pure . eitherDecode

311+ fromStream Proxy s = do

312+ bs <- sinkLBS s

313+ case eitherDecode bs of

314+ Left e -> pure $! Left (e, bs)

315+ Right x -> pure $! Right x

309316

310317class GoogleRequest a where

311318 type Rs a :: *

examples/src/Example/Storage.hsnew file+33

@@ -0,0 +1,33 @@

1+-- |

2+-- Module : Example.Storage

4+-- License : Mozilla Public License, v. 2.0.

5+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

6+-- Stability : provisional

7+-- Portability : non-portable (GHC extensions)

8+--

9+module Example.Storage where

10+

11+import Control.Lens

12+import Data.Conduit.Binary

13+import Data.Text (Text)

14+import qualified Data.Text as Text

15+import Data.Time.Clock.POSIX

16+import Network.Google

17+import Network.Google.Storage

18+import System.IO

19+

20+example :: Text -> FilePath -> IO ()

21+example b f = do

22+-- ts <- truncate <$> getPOSIXTime

23+

24+ l <- newLogger Debug stdout

25+ e <- newEnv Discover <&> envLogger .~ l

26+

27+ let key = Text.pack f

28+ src = requestBodySourceChunked (sourceFile f)

29+ obj = object' & objContentType ?~ "application/octet-stream"

30+

31+ runResourceT . runGoogle e $ do

32+ _ <- upload (objectsInsert b obj & oiName ?~ key) src

33+ pure ()

gen/src/Gen/Text.hs+2

@@ -135,6 +135,8 @@ renameReserved x

135135 , "Data"

136136 , "TimeOfDay"

137137 , "LocalTime"

138+ , "MediaDownload"

139+ , "MediaUpload"

138140 ] ++ map Text.pack (reservedNames haskellDef)

139141

140142camelAcronym :: Text -> Text

gogol-youtube-reporting/gen/Network/Google/Resource/YouTubeReporting/Media/Download.hs+19−19

@@ -31,7 +31,7 @@ module Network.Google.Resource.YouTubeReporting.Media.Download

3131

3232 -- * Creating a Request

3333 , mediaDownload

34− , MediaDownload

34+ , MediaDownload'

3535

3636 -- * Request Lenses

3737 , mdXgafv

@@ -48,7 +48,7 @@ import Network.Google.Prelude

4848import Network.Google.YouTubeReporting.Types

4949

5050-- | A resource alias for @youtubereporting.media.download@ method which the

51−-- 'MediaDownload' request conforms to.

51+-- 'MediaDownload'' request conforms to.

5252type MediaDownloadResource =

5353 "v1" :>

5454 "media" :>

@@ -79,7 +79,7 @@ type MediaDownloadResource =

7979-- \`\/v1\/media\/{+name}?alt=media\`.

8080--

8181-- /See:/ 'mediaDownload' smart constructor.

82−data MediaDownload = MediaDownload

82+data MediaDownload' = MediaDownload'

8383 { _mdXgafv :: !(Maybe Text)

8484 , _mdUploadProtocol :: !(Maybe Text)

8585 , _mdResourceName :: !Text

@@ -111,9 +111,9 @@ data MediaDownload = MediaDownload

111111-- * 'mdCallback'

112112mediaDownload

113113 :: Text -- ^ 'mdResourceName'

114− -> MediaDownload

114+ -> MediaDownload'

115115mediaDownload pMdResourceName_ =

116− MediaDownload

116+ MediaDownload'

117117 { _mdXgafv = Nothing

118118 , _mdUploadProtocol = Nothing

119119 , _mdResourceName = pMdResourceName_

@@ -125,51 +125,51 @@ mediaDownload pMdResourceName_ =

125125 }

126126

127127-- | V1 error format.

128−mdXgafv :: Lens' MediaDownload (Maybe Text)

128+mdXgafv :: Lens' MediaDownload' (Maybe Text)

129129mdXgafv = lens _mdXgafv (\ s a -> s{_mdXgafv = a})

130130

131131-- | Upload protocol for media (e.g. \"raw\", \"multipart\").

132−mdUploadProtocol :: Lens' MediaDownload (Maybe Text)

132+mdUploadProtocol :: Lens' MediaDownload' (Maybe Text)

133133mdUploadProtocol

134134 = lens _mdUploadProtocol

135135 (\ s a -> s{_mdUploadProtocol = a})

136136

137137-- | Name of the media that is being downloaded. See

138138-- [][ByteStream.ReadRequest.resource_name].

139−mdResourceName :: Lens' MediaDownload Text

139+mdResourceName :: Lens' MediaDownload' Text

140140mdResourceName

141141 = lens _mdResourceName

142142 (\ s a -> s{_mdResourceName = a})

143143

144144-- | Pretty-print response.

145−mdPp :: Lens' MediaDownload Bool

145+mdPp :: Lens' MediaDownload' Bool

146146mdPp = lens _mdPp (\ s a -> s{_mdPp = a})

147147

148148-- | OAuth access token.

149−mdAccessToken :: Lens' MediaDownload (Maybe Text)

149+mdAccessToken :: Lens' MediaDownload' (Maybe Text)

150150mdAccessToken

151151 = lens _mdAccessToken

152152 (\ s a -> s{_mdAccessToken = a})

153153

154154-- | Legacy upload protocol for media (e.g. \"media\", \"multipart\").

155−mdUploadType :: Lens' MediaDownload (Maybe Text)

155+mdUploadType :: Lens' MediaDownload' (Maybe Text)

156156mdUploadType

157157 = lens _mdUploadType (\ s a -> s{_mdUploadType = a})

158158

159159-- | OAuth bearer token.

160−mdBearerToken :: Lens' MediaDownload (Maybe Text)

160+mdBearerToken :: Lens' MediaDownload' (Maybe Text)

161161mdBearerToken

162162 = lens _mdBearerToken

163163 (\ s a -> s{_mdBearerToken = a})

164164

165165-- | JSONP

166−mdCallback :: Lens' MediaDownload (Maybe Text)

166+mdCallback :: Lens' MediaDownload' (Maybe Text)

167167mdCallback

168168 = lens _mdCallback (\ s a -> s{_mdCallback = a})

169169

170−instance GoogleRequest MediaDownload where

171− type Rs MediaDownload = Media

172− requestClient MediaDownload{..}

170+instance GoogleRequest MediaDownload' where

171+ type Rs MediaDownload' = Media

172+ requestClient MediaDownload'{..}

173173 = go _mdResourceName _mdXgafv _mdUploadProtocol

174174 (Just _mdPp)

175175 _mdAccessToken

@@ -182,10 +182,10 @@ instance GoogleRequest MediaDownload where

182182 = buildClient (Proxy :: Proxy MediaDownloadResource)

183183 mempty

184184

185−instance GoogleRequest (MediaDownload MediaDownload)

185+instance GoogleRequest (MediaDownload MediaDownload')

186186 where

187− type Rs (MediaDownload MediaDownload) = Stream

188− requestClient (MediaDownload MediaDownload{..})

187+ type Rs (MediaDownload MediaDownload') = Stream

188+ requestClient (MediaDownload MediaDownload'{..})

189189 = go _mdResourceName _mdXgafv _mdUploadProtocol

190190 (Just _mdPp)

191191 _mdAccessToken

gogol/src/Network/Google/Internal/HTTP.hs+3−2

@@ -68,12 +68,13 @@ perform Env{..} x = catches go handlers

6868 r <- _cliResponse (responseBody rs)

6969

7070 pure $! case r of

71− Right y -> Right y

72− Left e -> Left . SerializeError $ SerializeError'

71+ Right y -> Right y

72+ Left (e, bs) -> Left . SerializeError $ SerializeError'

7373 { _serializeId = _svcId

7474 , _serializeHeaders = responseHeaders rs

7575 , _serializeStatus = responseStatus rs

7676 , _serializeMessage = e

77+ , _serializeBody = Just bs

7778 }

7879

7980 request ct b = def

gogol/src/Network/Google/Internal/Multipart.hs+2−3

@@ -1,4 +1,4 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+ {-# LANGUAGE OverloadedStrings #-}

33-- |

44-- Module : Network.Google.Internal.Multipart

@@ -18,7 +18,6 @@ import qualified Data.CaseInsensitive as CI

1818import Data.Monoid

1919import Network.Google.Types

2020import Network.HTTP.Client

21−import qualified Network.HTTP.Client.Conduit as Client

2221import Network.HTTP.Client.MultipartFormData (webkitBoundary)

2322import Network.HTTP.Media

2423import Network.HTTP.Types

@@ -47,7 +46,7 @@ genBoundary = Boundary <$> liftIO webkitBoundary

4746multipartHeader :: Boundary -> Header

4847multipartHeader (Boundary bs) =

4948 ( hContentType

50− , "multipart/related; boundary=\"" <> bs <> "\""

49+ , "multipart/related; boundary=" <> bs

5150 )

5251

5352start :: Boundary -> RequestBody