diff options
author | arowM <> | 2020-05-22 08:55:00 (GMT) |
---|---|---|
committer | hdiff <hdiff@hdiff.luite.com> | 2020-05-22 08:55:00 (GMT) |
commit | 7b0d1a6fc416199e36cdd35abfd0f77fd571d8e7 (patch) | |
tree | 13b3f1bdb29cf0c59dd06c0b35c271f216d71c2c | |
parent | 1f639b3bb08f406d18a5dd140982c25ff7efb67d (diff) |
version 0.3.2.00.3.2.0
-rw-r--r-- | google-server-api.cabal | 11 | ||||
-rw-r--r-- | src/Google/Client.hs | 85 | ||||
-rw-r--r-- | src/Google/Form.hs | 58 | ||||
-rw-r--r-- | src/Google/JWT.hs | 4 | ||||
-rw-r--r-- | src/Google/Response.hs | 35 | ||||
-rw-r--r-- | src/Google/Type.hs | 174 |
6 files changed, 359 insertions, 8 deletions
diff --git a/google-server-api.cabal b/google-server-api.cabal index 3834344..d901806 100644 --- a/google-server-api.cabal +++ b/google-server-api.cabal @@ -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 @@ copyright: 2018 Kadzuya Okamoto license: MIT license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: README.md @@ -31,6 +32,7 @@ library Google.Form Google.JWT Google.Response + Google.Type other-modules: Paths_google_server_api hs-source-dirs: @@ -48,6 +50,7 @@ library , 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 diff --git a/src/Google/Client.hs b/src/Google/Client.hs index 525b3fc..9c336be 100644 --- a/src/Google/Client.hs +++ b/src/Google/Client.hs @@ -12,6 +12,9 @@ module Google.Client , getCalendarEventList , postCalendarEvent , postGmailSend + , getDriveFileList + , createDriveFileMultipart + , downloadDriveFile ) where import Data.Aeson (FromJSON, ToJSON) @@ -59,6 +62,7 @@ import qualified Google.Form as Form 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,6 +105,24 @@ type API 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 @@ postCalendarEvent' :: -> 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 @@ -181,6 +225,45 @@ postGmailSend token email = do (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 toBearer Response.Token {accessToken} = Bearer $ "Bearer " <> accessToken diff --git a/src/Google/Form.hs b/src/Google/Form.hs index 759d021..b0b9ccc 100644 --- a/src/Google/Form.hs +++ b/src/Google/Form.hs @@ -12,25 +12,44 @@ module Google.Form , 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 @@ data GmailSend = GmailSend } 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) diff --git a/src/Google/JWT.hs b/src/Google/JWT.hs index dbe1235..cbb59ba 100644 --- a/src/Google/JWT.hs +++ b/src/Google/JWT.hs @@ -76,6 +76,8 @@ data Scope = 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 :: Scope -> Text 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'. diff --git a/src/Google/Response.hs b/src/Google/Response.hs index 95cee38..71172bb 100644 --- a/src/Google/Response.hs +++ b/src/Google/Response.hs @@ -5,7 +5,18 @@ Module : Google.Response 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.Clock (UTCTime) 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 @@ instance Eq ZonedDateTime where (toUTC x) == (toUTC y) ) - data CalendarEvent = CalendarEvent { status :: Text , creator :: Account @@ -102,3 +115,21 @@ deriveJSON defaultOptions ''GmailSend 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 diff --git a/src/Google/Type.hs b/src/Google/Type.hs new file mode 100644 index 0000000..acf7084 --- /dev/null +++ b/src/Google/Type.hs @@ -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 |