google-server-api 0.2.0.1 → 0.3.0.0
raw patch · 3 files changed
+101/−180 lines, 3 filesdep ~HsOpenSSLdep ~RSAdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HsOpenSSL, RSA, aeson, aeson-casing, base64-bytestring, bytestring, http-api-data, http-client, http-client-tls, mime-mail, monad-control, monad-logger, mtl, servant, servant-client, text, time, transformers, transformers-base, unix-time, unordered-containers, wai, wai-extra, warp
API changes (from Hackage documentation)
- Google.Client: run :: forall r m a e. (HasHttpManager r, MonadIO m, MonadError e m, MonadLogger m, MonadReader r m) => e -> ReaderT r (ExceptT ServantError IO) a -> m a
+ Google.Form: instance Data.String.IsString Google.Form.Account
- Google.Client: getToken :: (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m) => Maybe Email -> JWT -> [Scope] -> m Token
+ Google.Client: getToken :: Maybe Email -> JWT -> [Scope] -> IO (Either ServantError Token)
- Google.Client: postCalendarEvent :: (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m) => Token -> CalendarEvent -> m CalendarEvent
+ Google.Client: postCalendarEvent :: Token -> CalendarEvent -> IO (Either ServantError CalendarEvent)
- Google.Client: postGmailSend :: (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m) => Token -> Email -> m GmailSend
+ Google.Client: postGmailSend :: Token -> Email -> IO (Either ServantError GmailSend)
Files
- google-server-api.cabal +62/−84
- src/Google/Client.hs +35/−96
- src/Google/Form.hs +4/−0
google-server-api.cabal view
@@ -1,88 +1,66 @@-name: google-server-api-version: 0.2.0.1-synopsis: Google APIs for server to server applications-description:- This library provides a way to use Google API for server to server applications.-homepage: https://github.com/arowM/haskell-google-server-api#readme-license: MIT-license-file: LICENSE-author: Kadzuya Okamoto-maintainer: arow.okamoto+github@gmail.com-copyright: 2018 Kadzuya Okamoto-category: Web-build-type: Simple-extra-source-files: README.md-cabal-version: >=1.10+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: f103dcbf98029b7f6d92e1567345d75693b1ffe818a833de202c0c5225fb5777 -library- hs-source-dirs: src- exposed-modules: Google.Client- , Google.Form- , Google.JWT- , Google.Response- build-depends: base >= 4.9 && < 5- , aeson >= 1.1- , aeson-casing >= 0.1- , base64-bytestring >= 1.0- , bytestring >= 0.10- , http-api-data >= 0.3- , http-client >= 0.3- , http-client-tls >= 0.3- , HsOpenSSL >= 0.11- , mime-mail >= 0.4- , monad-control >= 1.0- , monad-logger >= 0.3- , mtl >= 2.2- , RSA >= 2.3- , servant >= 0.1- , servant-client >= 0.2- , text >= 1.2- , time >= 1.6- , transformers >= 0.5- , transformers-base >= 0.4- , unix-time >= 0.3- , unordered-containers >= 0.2- , wai >= 3.2- , wai-extra >= 3.0- , warp >= 3.2- default-language: Haskell2010- ghc-options: -Wall -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction- default-extensions: ConstraintKinds- , DataKinds- , DefaultSignatures- , DeriveDataTypeable- , DeriveFunctor- , DeriveGeneric- , DuplicateRecordFields- , EmptyDataDecls- , FlexibleContexts- , FlexibleInstances- , GADTs- , GeneralizedNewtypeDeriving- , InstanceSigs- , LambdaCase- , MultiParamTypeClasses- , NamedFieldPuns- , NoMonomorphismRestriction- , OverloadedLabels- , OverloadedStrings- , PackageImports- , PartialTypeSignatures- , PatternSynonyms- , PolyKinds- , RankNTypes- , RecordWildCards- , ScopedTypeVariables- , StandaloneDeriving- , TupleSections- , TypeApplications- , TypeFamilies- , TypeOperators- , ViewPatterns- other-extensions: OverloadedLists- , QuasiQuotes- , TemplateHaskell+name: google-server-api+version: 0.3.0.0+synopsis: Google APIs for server to server applications+description: This library provides a way to use Google API for server to server applications.+category: Web+homepage: https://github.com/arowM/haskell-google-server-api#readme+bug-reports: https://github.com/arowM/haskell-google-server-api/issues+author: Kadzuya Okamoto+maintainer: arow.okamoto+github@gmail.com+copyright: 2018 Kadzuya Okamoto+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ README.md source-repository head- type: git+ type: git location: https://github.com/arowM/haskell-google-server-api++library+ exposed-modules:+ Google.Client+ Google.Form+ Google.JWT+ Google.Response+ other-modules:+ Paths_google_server_api+ hs-source-dirs:+ src+ default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ HsOpenSSL >=0.11.4.13+ , RSA >=2.3.0+ , aeson >=1.2.4.0+ , aeson-casing >=0.1.0.5+ , base >=4.9 && <5+ , base64-bytestring >=1.0.0.1+ , bytestring >=0.10.8.2+ , http-api-data >=0.3.7.2+ , http-client >=0.5.10+ , http-client-tls >=0.3.5.3+ , mime-mail >=0.4.14+ , monad-control >=1.0.2.3+ , monad-logger >=0.3.28.1+ , mtl >=2.2.2+ , servant >=0.13+ , servant-client >=0.13+ , text >=1.2.3.0+ , time >=1.8.0.2+ , transformers >=0.5.2.0+ , transformers-base >=0.4.4+ , unix-time >=0.3.8+ , unordered-containers >=0.2.9.0+ , wai >=3.2.1.1+ , wai-extra >=3.0.22.0+ , warp >=3.2.18.1+ default-language: Haskell2010
src/Google/Client.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} {- | Module : Google.Client@@ -9,17 +10,11 @@ ( getToken , postCalendarEvent , postGmailSend- , run ) where -import Control.Monad ((<=<))-import Control.Monad.Except (ExceptT(..), MonadError, runExceptT, throwError)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Logger (MonadLogger, logError)-import Control.Monad.Reader (MonadReader, ask)-import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Data.Aeson (FromJSON, ToJSON) import Data.ByteString.Base64.URL (encode)+import qualified Data.ByteString.Lazy as LBS import Data.Data (Data) import Data.Monoid ((<>)) import Data.Proxy (Proxy(..))@@ -27,7 +22,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Typeable (Typeable) import GHC.Generics (Generic)-import Network.HTTP.Client (HasHttpManager(..), newManager)+import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.Mail.Mime import Servant.API@@ -44,20 +39,16 @@ ) import Servant.Client ( BaseUrl(BaseUrl)- , ClientEnv(..) , ClientM , Scheme(..) , ServantError , client+ , mkClientEnv , runClientM ) -import Google.JWT (JWT)--import qualified Data.ByteString.Lazy as LBS-import qualified Data.Text as T-import qualified Data.Text.IO as T import qualified Google.Form as Form+import Google.JWT (JWT) import qualified Google.JWT as JWT import qualified Google.Response as Response @@ -103,87 +94,47 @@ getToken' :<|> postCalendarEvent' :<|> postGmailSend' = client api getToken ::- (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m)- => Maybe JWT.Email+ Maybe JWT.Email -> JWT -> [JWT.Scope]- -> m Response.Token-getToken maccount jwt scopes =- (liftEither =<<) . runExceptT . ExceptT $ do- manager <- liftIO $ newManager tlsManagerSettings- Right a <- liftIO $ JWT.getSignedJWT jwt maccount scopes Nothing- liftIO $- runClientM- (getToken' $- Form.Token- { grantType = googleGrantType- , assertion = decodeUtf8 . JWT.unSignedJWT $ a- })- (ClientEnv manager googleBaseUrl)+ -> IO (Either ServantError Response.Token)+getToken maccount jwt scopes = do+ manager <- newManager tlsManagerSettings+ Right a <- JWT.getSignedJWT jwt maccount scopes Nothing+ runClientM+ (getToken' $+ Form.Token+ { grantType = googleGrantType+ , assertion = decodeUtf8 . JWT.unSignedJWT $ a+ })+ (mkClientEnv manager googleBaseUrl) postCalendarEvent ::- (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m)- => Response.Token+ Response.Token -> Form.CalendarEvent- -> m Response.CalendarEvent-postCalendarEvent token event =- runExceptTIO . ExceptT $ do- manager <- newManager tlsManagerSettings- runClientM- (postCalendarEvent'- (Form.email . Form.creator $ event)- (pure . toBearer $ token)- event)- (ClientEnv manager googleBaseUrl)+ -> IO (Either ServantError Response.CalendarEvent)+postCalendarEvent token event = do+ manager <- newManager tlsManagerSettings+ runClientM+ (postCalendarEvent'+ (Form.email . Form.creator $ event)+ (pure . toBearer $ token)+ event)+ (mkClientEnv manager googleBaseUrl) postGmailSend ::- (HasHttpManager r, MonadError ServantError m, MonadIO m, MonadReader r m)- => Response.Token- -> Form.Email- -> m Response.GmailSend-postGmailSend token email =- runExceptTIO . ExceptT $ do- manager <- newManager tlsManagerSettings- mail <- liftIO (renderMail' =<< Form.toMail email)- let gmailSend =- Form.GmailSend {raw = decodeUtf8 $ encode $ LBS.toStrict mail}- T.putStrLn $ "gmailSend: " <> tshow gmailSend- T.putStrLn $ "from: " <> tshow (Form.to email)- runClientM- (postGmailSend' (pure . toBearer $ token) gmailSend)- (ClientEnv manager googleBaseUrl)+ Response.Token -> Form.Email -> IO (Either ServantError Response.GmailSend)+postGmailSend token email = do+ manager <- newManager tlsManagerSettings+ mail <- (renderMail' =<< Form.toMail email)+ let gmailSend = Form.GmailSend {raw = decodeUtf8 $ encode $ LBS.toStrict mail}+ runClientM+ (postGmailSend' (pure . toBearer $ token) gmailSend)+ (mkClientEnv manager googleBaseUrl) toBearer :: Response.Token -> Bearer toBearer Response.Token {accessToken} = Bearer $ "Bearer " <> accessToken -{- | Convert `ServantError` to arbitrary error type.--}-run ::- forall r m a e.- ( HasHttpManager r- , MonadIO m- , MonadError e m- , MonadLogger m- , MonadReader r m- )- => e- -> ReaderT r (ExceptT ServantError IO) a- -> m a-run err m = either doGoogleErr pure =<< run' m- where- doGoogleErr :: forall x. ServantError -> m x- doGoogleErr googleErr = do- $(logError) $ "Got error response from google API: " <> tshow googleErr- throwError err--run' ::- forall r n e a. (HasHttpManager r, MonadIO n, MonadReader r n)- => ReaderT r (ExceptT e IO) a- -> n (Either e a)-run' m = do- r <- ask- liftIO . runExceptT $ runReaderT m r- {- ================= - Constant values - ================= -}@@ -192,15 +143,3 @@ googleBaseUrl :: BaseUrl googleBaseUrl = BaseUrl Https "www.googleapis.com" 443 ""--{- =================- - Helper functions- - ================= -}-liftEither :: (MonadError e m) => Either e a -> m a-liftEither = either throwError pure--runExceptTIO :: (MonadError e m, MonadIO m) => ExceptT e IO a -> m a-runExceptTIO = liftEither <=< liftIO . runExceptT--tshow :: Show a => a -> Text-tshow = T.pack . show
src/Google/Form.hs view
@@ -18,6 +18,7 @@ import Data.Aeson.TH (defaultOptions, deriveJSON) import Data.Maybe (maybeToList) import Data.Monoid ((<>))+import Data.String (IsString(..)) import Data.Text (Text) import Data.Text.Lazy (fromStrict) import Data.Time.Clock (UTCTime)@@ -34,6 +35,9 @@ } deriving (Eq, Generic, Show, Typeable) deriveJSON defaultOptions ''Account++instance IsString Account where+ fromString = Account . fromString data DateTime = DateTime { dateTime :: UTCTime