google-server-api 0.3.1.1 → 0.3.2.0
raw patch · 6 files changed
+359/−8 lines, 6 filesdep +http-media
Dependencies added: http-media
Files
- google-server-api.cabal +7/−4
- src/Google/Client.hs +84/−1
- src/Google/Form.hs +57/−1
- src/Google/JWT.hs +4/−0
- src/Google/Response.hs +33/−2
- src/Google/Type.hs +174/−0
google-server-api.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 852a652d4f3bb87da7dfb8fa221c883c79eb107343b11697153df9a85febd341+-- hash: d90c01868fd5ad9fcc24aa1c288d115515bc43534e9f4110da048a8f7500864d name: google-server-api-version: 0.3.1.1+version: 0.3.2.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@@ -17,7 +19,6 @@ license: MIT license-file: LICENSE build-type: Simple-cabal-version: >= 1.10 extra-source-files: README.md @@ -31,6 +32,7 @@ Google.Form Google.JWT Google.Response+ Google.Type other-modules: Paths_google_server_api hs-source-dirs:@@ -48,6 +50,7 @@ , http-api-data >=0.3.7.2 , http-client >=0.5.10 , http-client-tls >=0.3.5.3+ , http-media >=0.7.1.2 , mime-mail >=0.4.14 , monad-control >=1.0.2.3 , monad-logger >=0.3.28.1
src/Google/Client.hs view
@@ -12,6 +12,9 @@ , getCalendarEventList , postCalendarEvent , postGmailSend+ , getDriveFileList+ , createDriveFileMultipart+ , downloadDriveFile ) where import Data.Aeson (FromJSON, ToJSON)@@ -59,6 +62,7 @@ import Google.JWT (JWT) import qualified Google.JWT as JWT import qualified Google.Response as Response+import qualified Google.Type as Type #if !MIN_VERSION_servant(0, 16, 0) type ClientError = ServantError@@ -101,7 +105,25 @@ Header "Authorization" Bearer :> ReqBody '[ JSON] Form.GmailSend :> Post '[ JSON] Response.GmailSend+ :<|> "drive":> "v3" :> "files" :>+ Header "Authorization" Bearer :>+ QueryParam "q" Type.QueryString :>+ QueryParam "orderBy" [Type.Order] :>+ Get '[ JSON] Response.FileList+ :<|> "upload" :> "drive":> "v3" :> "files" :>+ Header "Authorization" Bearer :>+ QueryParam "uploadType" Text :>+ ReqBody '[ Type.Multipart] Form.MultipartBody :>+ Post '[ JSON] Response.FileResource+ :<|> "drive":> "v3" :> "files" :>+ Capture "fileId" Type.FileId :>+ "export" :>+ Header "Authorization" Bearer :>+ QueryParam "mimeType" Type.ConversionFormat :>+ Get '[ Type.Arbitrary] Type.MediaContent ++ api :: Proxy API api = Proxy @@ -120,7 +142,29 @@ -> Form.CalendarEvent -> ClientM Response.CalendarEvent postGmailSend' :: Maybe Bearer -> Form.GmailSend -> ClientM Response.GmailSend-getToken' :<|> getCalendarEventList' :<|> postCalendarEvent' :<|> postGmailSend' = client api+getDriveFileList' ::+ Maybe Bearer+ -> Maybe Type.QueryString+ -> Maybe [Type.Order]+ -> ClientM Response.FileList+createDriveFileMultipart' ::+ Maybe Bearer+ -> Maybe Text+ -> Form.MultipartBody+ -> ClientM Response.FileResource+downloadDriveFile' ::+ Type.FileId+ -> Maybe Bearer+ -> Maybe Type.ConversionFormat+ -> ClientM Type.MediaContent+getToken'+ :<|> getCalendarEventList'+ :<|> postCalendarEvent'+ :<|> postGmailSend'+ :<|> getDriveFileList'+ :<|> createDriveFileMultipart'+ :<|> downloadDriveFile'+ = client api getToken :: Maybe JWT.Email@@ -179,6 +223,45 @@ let gmailSend = Form.GmailSend {raw = decodeUtf8 $ encode $ LBS.toStrict mail} runClientM (postGmailSend' (pure . toBearer $ token) gmailSend)+ (mkClientEnv manager googleBaseUrl)++getDriveFileList ::+ Response.Token+ -> Form.GetFileParams+ -> IO (Either ServantError Response.FileList)+getDriveFileList token Form.GetFileParams{..} = do+ manager <- newManager tlsManagerSettings+ runClientM+ (getDriveFileList'+ (pure . toBearer $ token)+ query+ orderBy)+ (mkClientEnv manager googleBaseUrl)++createDriveFileMultipart ::+ Response.Token+ -> Form.MultipartBody+ -> IO (Either ServantError Response.FileResource)+createDriveFileMultipart token body = do+ manager <- newManager tlsManagerSettings+ runClientM+ (createDriveFileMultipart'+ (pure . toBearer $ token)+ (Just "multipart")+ body)+ (mkClientEnv manager googleBaseUrl)++downloadDriveFile ::+ Response.Token+ -> Form.DownloadFileParams+ -> IO (Either ServantError Response.MediaContent)+downloadDriveFile token Form.DownloadFileParams {..} = do+ manager <- newManager tlsManagerSettings+ runClientM+ (downloadDriveFile'+ fileId+ (pure . toBearer $ token)+ (Just conversionFormat)) (mkClientEnv manager googleBaseUrl) toBearer :: Response.Token -> Bearer
src/Google/Form.hs view
@@ -12,25 +12,44 @@ , DateTime(..) , Email(..) , toMail+ , MultipartBody(..)+ , GetFileParams(..)+ , DownloadFileParams(..) , Token(..) ) where +import Data.Aeson (encode) import Data.Aeson.TH (defaultOptions, deriveJSON)+import qualified Data.ByteString.Base64 as BSB+import qualified Data.ByteString.Lazy as LBS import Data.Maybe (maybeToList) import Data.Monoid ((<>)) import Data.String (IsString(..)) import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8) import Data.Text.Lazy (fromStrict) import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Network.Mail.Mime (Address(..), Mail(..), renderAddress, simpleMail)+import Servant.API (MimeRender(..)) import Web.FormUrlEncoded (Form(..), ToForm(toForm)) import Web.Internal.HttpApiData (toQueryParam) import Web.HttpApiData (ToHttpApiData(..))- import qualified Data.HashMap.Strict as HashMap +import Google.Type+ ( ConversionFormat+ , FileId+ , MediaContent(..)+ , MediaType(..)+ , Metadata+ , Multipart+ , Order+ , QueryString+ )++ data Account = Account { email :: Text } deriving (Eq, Generic, Show, Typeable)@@ -106,3 +125,40 @@ } deriving (Eq, Generic, Show, Typeable) deriveJSON defaultOptions ''GmailSend+++data GetFileParams = GetFileParams+ { query :: Maybe QueryString+ , orderBy :: Maybe [Order]+ } deriving (Eq, Generic, Show, Typeable)+++data MultipartBody = MultipartBody+ { metadata :: Metadata+ , mediaType :: MediaType+ , mediaContent :: MediaContent+ } deriving (Eq, Generic, Show, Typeable)++instance MimeRender Multipart MultipartBody where+ mimeRender _ MultipartBody{..} =+ mconcat+ [ "\r\n--" <> boundary <> "\r\n"+ , "Content-Type: application/json; charset=UTF-8"+ , "\r\n\r\n"+ , encode metadata+ , "\r\n--" <> boundary <> "\r\n"+ , "Content-Type: " <> (LBS.fromStrict $ encodeUtf8 $ mediaTypeName mediaType)+ , "\r\n"+ , "Content-Transfer-Encoding: base64"+ , "\r\n\r\n"+ , LBS.fromStrict $ BSB.encode $ (content mediaContent)+ , "\r\n--" <> boundary <> "--"+ ]+ where+ boundary = "314159265358979323846"+++data DownloadFileParams = DownloadFileParams+ { fileId :: FileId+ , conversionFormat :: ConversionFormat+ } deriving (Eq, Generic, Show, Typeable)
src/Google/JWT.hs view
@@ -76,6 +76,8 @@ = ScopeCalendarFull | ScopeCalendarRead | ScopeGmailSend+ | ScopeDriveFile+ | ScopeDriveMetadataRead deriving (Eq, Show, Read, Ord) {-| Make sure if you added new scope, update configuration in page bellow.@@ -85,6 +87,8 @@ scopeUrl ScopeCalendarFull = "https://www.googleapis.com/auth/calendar" scopeUrl ScopeCalendarRead = "https://www.googleapis.com/auth/calendar.readonly" scopeUrl ScopeGmailSend = "https://www.googleapis.com/auth/gmail.send"+scopeUrl ScopeDriveFile = "https://www.googleapis.com/auth/drive.file"+scopeUrl ScopeDriveMetadataRead = "https://www.googleapis.com/auth/drive.metadata.readonly" -- | Get the private key obtained from the -- Google API Console from a PEM 'String'.
src/Google/Response.hs view
@@ -5,7 +5,18 @@ Define data types to represent all of the responses that are received from the Google API. -}-module Google.Response where+module Google.Response+ ( Token(..)+ , Account(..)+ , DateTime(..)+ , ZonedDateTime(..)+ , CalendarEvent(..)+ , CalendarEventList(..)+ , GmailSend(..)+ , FileResource(..)+ , FileList(..)+ , MediaContent(..)+ ) where import Data.Aeson.Casing (snakeCase) import Data.Aeson.TH (Options(..), defaultOptions, deriveJSON)@@ -18,6 +29,9 @@ import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC) import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..), parseUrlPieces, toUrlPieces) +import Google.Type (FileId, MediaType, MediaContent(..))++ data Token = Token { accessToken :: Text , tokenType :: Text@@ -66,7 +80,6 @@ (toUTC x) == (toUTC y) ) - data CalendarEvent = CalendarEvent { status :: Text , creator :: Account@@ -102,3 +115,21 @@ instance FromForm GmailSend instance ToForm GmailSend+++data FileResource = FileResource+ { kind :: Text+ , id :: FileId+ , name :: Text+ , mimeType :: MediaType+ } deriving (Eq, Generic, Show, Typeable)++deriveJSON defaultOptions ''FileResource+++data FileList = FileList+ { kind :: Text+ , files :: [FileResource]+ } deriving (Eq, Generic, Show, Typeable)++deriveJSON defaultOptions ''FileList
+ src/Google/Type.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE TemplateHaskell #-}++{- |+Module : Google.Type++Define basic data types.+-}+module Google.Type+ ( FileId(..)+ , MediaType(..)+ , MediaContent(..)+ , Metadata(..)+ , Arbitrary+ , Multipart+ , ConversionFormat(..)+ , SortKey(..)+ , QueryString(..)+ , Order(..)+ ) where++import Data.Aeson.TH (Options(..), defaultOptions, deriveJSON)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Char (toLower)+import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Text (Text, intercalate)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import Network.HTTP.Media ((//), (/:))+import qualified Network.HTTP.Media as Media+import Servant.API (Accept(..), MimeUnrender(..))+import Web.HttpApiData (ToHttpApiData(..), toUrlPieces)+++newtype FileId = FileId+ { fileId :: Text+ } deriving (Eq, Generic, Show, Typeable, ToHttpApiData)++deriveJSON defaultOptions {unwrapUnaryRecords = True} ''FileId+++newtype MediaType = MediaType+ { mediaTypeName :: Text+ } deriving (Eq, Generic, Show, Typeable)++deriveJSON defaultOptions {unwrapUnaryRecords = True} ''MediaType+++newtype MediaContent = MediaContent+ { content :: BS.ByteString+ } deriving (Eq, Generic, Show, Typeable)+++data Metadata = Metadata+ { name :: Maybe Text+ , mimeType :: Maybe MediaType+ , parents :: Maybe [FileId]+ } deriving (Eq, Generic, Show, Typeable)++deriveJSON defaultOptions ''Metadata+++data Arbitrary++instance Accept Arbitrary where+ contentTypes _ =+ fromFormat <$>+ FormatHtml :|+ [ FormatHtmlZipped+ , FormatPlainText+ , FormatRichText+ , FormatOpenOfficeDoc+ , FormatPdf+ , FormatMsWordDoc+ , FormatEpub+ ]++instance MimeUnrender Arbitrary MediaContent where+ mimeUnrender _ = Right . MediaContent . LBS.toStrict+++data Multipart++instance Accept Multipart where+ contentType _ = "multipart" // "related" /: ("boundary", "314159265358979323846")+++-- https://developers.google.com/drive/api/v3/ref-export-formats+data ConversionFormat+ = FormatHtml+ | FormatHtmlZipped+ | FormatPlainText+ | FormatRichText+ | FormatOpenOfficeDoc+ | FormatPdf+ | FormatMsWordDoc+ | FormatEpub+ | FormatMsExcel+ | FormatOpenOfficeSheet+ | FormatCsv+ | FormatTsv+ | FormatJpeg+ | FormatPng+ | FormatSvg+ | FormatMsPowerPoint+ | FormatMsOfficePresentation+ | FormatJson+ deriving (Eq, Generic, Show, Typeable)++fromFormat :: ConversionFormat -> Media.MediaType+fromFormat FormatHtml = "text" // "html"+fromFormat FormatHtmlZipped = "application" // "zip"+fromFormat FormatPlainText = "text" // "plain"+fromFormat FormatRichText = "application" // "rtf"+fromFormat FormatOpenOfficeDoc = "application" // "vnd.oasis.opendocument.text"+fromFormat FormatPdf = "application" // "pdf"+fromFormat FormatMsWordDoc = "application" // "vnd.openxmlformats-officedocument.wordprocessingml.document"+fromFormat FormatEpub = "application" // "epub+zip"+fromFormat FormatMsExcel = "application" // "vnd.openxmlformats-officedocument.spreadsheetml.sheet"+fromFormat FormatOpenOfficeSheet = "application" // "x-vnd.oasis.opendocument.spreadsheet"+fromFormat FormatCsv = "text" // "csv"+fromFormat FormatTsv = "text" // "tab-separated-values"+fromFormat FormatJpeg = "image" // "jpeg"+fromFormat FormatPng = "image" // "png"+fromFormat FormatSvg = "image" // "svg+xml"+fromFormat FormatMsPowerPoint = "application" // "vnd.openxmlformats-officedocument.presentationml.presentation"+fromFormat FormatMsOfficePresentation = "application" // "vnd.openxmlformavnd.oasis.opendocument.presentation"+fromFormat FormatJson = "application" // "vnd.google-apps.script+json"++instance ToHttpApiData ConversionFormat where+ toUrlPiece = toUrlPiece . show . fromFormat+++data SortKey+ = CreatedTime+ | Folder+ | ModifiedByMeTime+ | ModifiedTime+ | Name+ | NameNatural+ | QuotaBytesUsed+ | Recency+ | SsharedWithMeTime+ | Starred+ | ViewedByMeTime+ deriving (Eq, Generic, Show, Typeable)++instance ToHttpApiData SortKey where+ toUrlPiece NameNatural = "name_natural"+ toUrlPiece key = toUrlPiece . headToLower . show $ key+ where+ headToLower :: String -> String+ headToLower [] = []+ headToLower (x : xs) = toLower x : xs+++newtype QueryString = QueryString+ { queryString :: Text+ } deriving (Eq, Generic, Show, Typeable, ToHttpApiData)++deriveJSON defaultOptions {unwrapUnaryRecords = True} ''QueryString+++data Order+ = Asc SortKey+ | Desc SortKey+ deriving (Eq, Generic, Show, Typeable)++instance ToHttpApiData Order where+ toUrlPiece (Asc key) = toUrlPiece key+ toUrlPiece (Desc key) = toUrlPiece key <> " desc"++instance ToHttpApiData [Order] where+ toUrlPiece = (intercalate ",") . toUrlPieces