version 0.3.2.00.3.2.0

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