summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorarowM <>2020-05-22 08:55:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-05-22 08:55:00 (GMT)
commit7b0d1a6fc416199e36cdd35abfd0f77fd571d8e7 (patch)
tree13b3f1bdb29cf0c59dd06c0b35c271f216d71c2c
parent1f639b3bb08f406d18a5dd140982c25ff7efb67d (diff)
version 0.3.2.00.3.2.0
-rw-r--r--google-server-api.cabal11
-rw-r--r--src/Google/Client.hs85
-rw-r--r--src/Google/Form.hs58
-rw-r--r--src/Google/JWT.hs4
-rw-r--r--src/Google/Response.hs35
-rw-r--r--src/Google/Type.hs174
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