{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

{- |
Module      :  Google.Form

Define data types to represent all of the requests that are sent to the API.
-}
module Google.Form
  ( CalendarEvent(..)
  , GmailSend(..)
  , Account(..)
  , DateTime(..)
  , ExtendedProperty(..)
  , ExtendedProperties(..)
  , 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)
#if !MIN_VERSION_base(4, 11, 0)
import Data.Monoid ((<>))
#endif
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.HttpApiData (ToHttpApiData(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap

import Google.Type
  ( ConversionFormat
  , FileId
  , MediaContent(..)
  , MediaType(..)
  , Metadata
  , Multipart
  , Order
  , QueryString
  )


data Account = Account
  { Account -> Text
email :: Text
  } deriving (Account -> Account -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''Account

instance IsString Account where
  fromString :: String -> Account
fromString = Text -> Account
Account forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

newtype DateTime = DateTime
  { DateTime -> UTCTime
dateTime :: UTCTime
  } deriving (DateTime -> DateTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateTime -> DateTime -> Bool
$c/= :: DateTime -> DateTime -> Bool
== :: DateTime -> DateTime -> Bool
$c== :: DateTime -> DateTime -> Bool
Eq, forall x. Rep DateTime x -> DateTime
forall x. DateTime -> Rep DateTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DateTime x -> DateTime
$cfrom :: forall x. DateTime -> Rep DateTime x
Generic, Int -> DateTime -> ShowS
[DateTime] -> ShowS
DateTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DateTime] -> ShowS
$cshowList :: [DateTime] -> ShowS
show :: DateTime -> String
$cshow :: DateTime -> String
showsPrec :: Int -> DateTime -> ShowS
$cshowsPrec :: Int -> DateTime -> ShowS
Show, Typeable, DateTime -> Builder
DateTime -> ByteString
DateTime -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: DateTime -> Text
$ctoQueryParam :: DateTime -> Text
toHeader :: DateTime -> ByteString
$ctoHeader :: DateTime -> ByteString
toEncodedUrlPiece :: DateTime -> Builder
$ctoEncodedUrlPiece :: DateTime -> Builder
toUrlPiece :: DateTime -> Text
$ctoUrlPiece :: DateTime -> Text
ToHttpApiData)

deriveJSON defaultOptions ''DateTime

newtype ExtendedProperty = ExtendedProperty
  { ExtendedProperty -> (Text, Text)
pair :: (Text, Text)
  } deriving (ExtendedProperty -> ExtendedProperty -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedProperty -> ExtendedProperty -> Bool
$c/= :: ExtendedProperty -> ExtendedProperty -> Bool
== :: ExtendedProperty -> ExtendedProperty -> Bool
$c== :: ExtendedProperty -> ExtendedProperty -> Bool
Eq, forall x. Rep ExtendedProperty x -> ExtendedProperty
forall x. ExtendedProperty -> Rep ExtendedProperty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtendedProperty x -> ExtendedProperty
$cfrom :: forall x. ExtendedProperty -> Rep ExtendedProperty x
Generic, Int -> ExtendedProperty -> ShowS
[ExtendedProperty] -> ShowS
ExtendedProperty -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedProperty] -> ShowS
$cshowList :: [ExtendedProperty] -> ShowS
show :: ExtendedProperty -> String
$cshow :: ExtendedProperty -> String
showsPrec :: Int -> ExtendedProperty -> ShowS
$cshowsPrec :: Int -> ExtendedProperty -> ShowS
Show, Typeable)

instance ToHttpApiData ExtendedProperty where
  toQueryParam :: ExtendedProperty -> Text
toQueryParam ExtendedProperty {(Text, Text)
pair :: (Text, Text)
$sel:pair:ExtendedProperty :: ExtendedProperty -> (Text, Text)
..} =
    forall a b. (a, b) -> a
fst (Text, Text)
pair forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (Text, Text)
pair

data ExtendedProperties = ExtendedProperties
  { ExtendedProperties -> HashMap Text Text
private :: HashMap Text Text
  , ExtendedProperties -> HashMap Text Text
shared :: HashMap Text Text
  } deriving (ExtendedProperties -> ExtendedProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedProperties -> ExtendedProperties -> Bool
$c/= :: ExtendedProperties -> ExtendedProperties -> Bool
== :: ExtendedProperties -> ExtendedProperties -> Bool
$c== :: ExtendedProperties -> ExtendedProperties -> Bool
Eq, forall x. Rep ExtendedProperties x -> ExtendedProperties
forall x. ExtendedProperties -> Rep ExtendedProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtendedProperties x -> ExtendedProperties
$cfrom :: forall x. ExtendedProperties -> Rep ExtendedProperties x
Generic, Int -> ExtendedProperties -> ShowS
[ExtendedProperties] -> ShowS
ExtendedProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedProperties] -> ShowS
$cshowList :: [ExtendedProperties] -> ShowS
show :: ExtendedProperties -> String
$cshow :: ExtendedProperties -> String
showsPrec :: Int -> ExtendedProperties -> ShowS
$cshowsPrec :: Int -> ExtendedProperties -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''ExtendedProperties

data CalendarEvent = CalendarEvent
  { CalendarEvent -> Account
creator :: Account
  , CalendarEvent -> [Account]
attendees :: [Account]
  , CalendarEvent -> Text
summary :: Text
  , CalendarEvent -> Text
description :: Text
  , CalendarEvent -> DateTime
start :: DateTime
  , CalendarEvent -> DateTime
end :: DateTime
  , CalendarEvent -> Maybe ExtendedProperties
extendedProperties :: Maybe ExtendedProperties
  } deriving (CalendarEvent -> CalendarEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarEvent -> CalendarEvent -> Bool
$c/= :: CalendarEvent -> CalendarEvent -> Bool
== :: CalendarEvent -> CalendarEvent -> Bool
$c== :: CalendarEvent -> CalendarEvent -> Bool
Eq, forall x. Rep CalendarEvent x -> CalendarEvent
forall x. CalendarEvent -> Rep CalendarEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CalendarEvent x -> CalendarEvent
$cfrom :: forall x. CalendarEvent -> Rep CalendarEvent x
Generic, Int -> CalendarEvent -> ShowS
[CalendarEvent] -> ShowS
CalendarEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarEvent] -> ShowS
$cshowList :: [CalendarEvent] -> ShowS
show :: CalendarEvent -> String
$cshow :: CalendarEvent -> String
showsPrec :: Int -> CalendarEvent -> ShowS
$cshowsPrec :: Int -> CalendarEvent -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''CalendarEvent

data Token = Token
  { Token -> Text
grantType :: Text
  , Token -> Text
assertion :: Text
  } deriving (Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Typeable)

instance ToForm Token where
  toForm :: Token -> Form
toForm Token
token =
    HashMap Text [Text] -> Form
Form forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$
    [ (Text
"grant_type", [forall a. ToHttpApiData a => a -> Text
toQueryParam (Token -> Text
grantType Token
token)])
    , (Text
"assertion", [forall a. ToHttpApiData a => a -> Text
toQueryParam (Token -> Text
assertion Token
token)])
    ]

data Email = Email
  { Email -> Text
to :: Text
  , Email -> Text
from :: Text
  , Email -> Maybe Text
replyTo :: Maybe Text
  , Email -> [Text]
ccs :: [Text]
  , Email -> Text
subject :: Text
  , Email -> Text
body :: Text
  } deriving (Email -> Email -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c== :: Email -> Email -> Bool
Eq, forall x. Rep Email x -> Email
forall x. Email -> Rep Email x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Email x -> Email
$cfrom :: forall x. Email -> Rep Email x
Generic, Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''Email

toMail :: Email -> IO Mail
toMail :: Email -> IO Mail
toMail Email {[Text]
Maybe Text
Text
body :: Text
subject :: Text
ccs :: [Text]
replyTo :: Maybe Text
from :: Text
to :: Text
$sel:body:Email :: Email -> Text
$sel:subject:Email :: Email -> Text
$sel:ccs:Email :: Email -> [Text]
$sel:replyTo:Email :: Email -> Maybe Text
$sel:from:Email :: Email -> Text
$sel:to:Email :: Email -> Text
..} = do
  Mail
mail <-
    Address
-> Address -> Text -> Text -> Text -> [(Text, String)] -> IO Mail
simpleMail
      (Maybe Text -> Text -> Address
Address forall a. Maybe a
Nothing Text
to)
      (Maybe Text -> Text -> Address
Address forall a. Maybe a
Nothing Text
from)
      Text
subject
      Text
body'
      Text
body'
      []
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Mail
mail
      { mailHeaders :: Headers
mailHeaders =
          Mail -> Headers
mailHeaders Mail
mail forall a. Semigroup a => a -> a -> a
<> do
            Text
rt <- forall a. Maybe a -> [a]
maybeToList Maybe Text
replyTo
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"Reply-To", Address -> Text
renderAddress forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Address
Address forall a. Maybe a
Nothing Text
rt)
      , mailCc :: [Address]
mailCc = forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text -> Text -> Address
Address forall a. Maybe a
Nothing) [Text]
ccs
      }
  where
    body' :: Text
body' = Text -> Text
fromStrict Text
body

data GmailSend = GmailSend
  { GmailSend -> Text
raw :: Text
  } deriving (GmailSend -> GmailSend -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GmailSend -> GmailSend -> Bool
$c/= :: GmailSend -> GmailSend -> Bool
== :: GmailSend -> GmailSend -> Bool
$c== :: GmailSend -> GmailSend -> Bool
Eq, forall x. Rep GmailSend x -> GmailSend
forall x. GmailSend -> Rep GmailSend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GmailSend x -> GmailSend
$cfrom :: forall x. GmailSend -> Rep GmailSend x
Generic, Int -> GmailSend -> ShowS
[GmailSend] -> ShowS
GmailSend -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GmailSend] -> ShowS
$cshowList :: [GmailSend] -> ShowS
show :: GmailSend -> String
$cshow :: GmailSend -> String
showsPrec :: Int -> GmailSend -> ShowS
$cshowsPrec :: Int -> GmailSend -> ShowS
Show, Typeable)

deriveJSON defaultOptions ''GmailSend


data GetFileParams = GetFileParams
  { GetFileParams -> Maybe QueryString
query :: Maybe QueryString
  , GetFileParams -> Maybe [Order]
orderBy :: Maybe [Order]
  } deriving (GetFileParams -> GetFileParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFileParams -> GetFileParams -> Bool
$c/= :: GetFileParams -> GetFileParams -> Bool
== :: GetFileParams -> GetFileParams -> Bool
$c== :: GetFileParams -> GetFileParams -> Bool
Eq, forall x. Rep GetFileParams x -> GetFileParams
forall x. GetFileParams -> Rep GetFileParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFileParams x -> GetFileParams
$cfrom :: forall x. GetFileParams -> Rep GetFileParams x
Generic, Int -> GetFileParams -> ShowS
[GetFileParams] -> ShowS
GetFileParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFileParams] -> ShowS
$cshowList :: [GetFileParams] -> ShowS
show :: GetFileParams -> String
$cshow :: GetFileParams -> String
showsPrec :: Int -> GetFileParams -> ShowS
$cshowsPrec :: Int -> GetFileParams -> ShowS
Show, Typeable)


data MultipartBody = MultipartBody
  { MultipartBody -> Metadata
metadata :: Metadata
  , MultipartBody -> MediaType
mediaType :: MediaType
  , MultipartBody -> MediaContent
mediaContent :: MediaContent
  } deriving (MultipartBody -> MultipartBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultipartBody -> MultipartBody -> Bool
$c/= :: MultipartBody -> MultipartBody -> Bool
== :: MultipartBody -> MultipartBody -> Bool
$c== :: MultipartBody -> MultipartBody -> Bool
Eq, forall x. Rep MultipartBody x -> MultipartBody
forall x. MultipartBody -> Rep MultipartBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultipartBody x -> MultipartBody
$cfrom :: forall x. MultipartBody -> Rep MultipartBody x
Generic, Int -> MultipartBody -> ShowS
[MultipartBody] -> ShowS
MultipartBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultipartBody] -> ShowS
$cshowList :: [MultipartBody] -> ShowS
show :: MultipartBody -> String
$cshow :: MultipartBody -> String
showsPrec :: Int -> MultipartBody -> ShowS
$cshowsPrec :: Int -> MultipartBody -> ShowS
Show, Typeable)

instance MimeRender Multipart MultipartBody where
  mimeRender :: Proxy Multipart -> MultipartBody -> ByteString
mimeRender Proxy Multipart
_ MultipartBody{MediaType
Metadata
MediaContent
mediaContent :: MediaContent
mediaType :: MediaType
metadata :: Metadata
$sel:mediaContent:MultipartBody :: MultipartBody -> MediaContent
$sel:mediaType:MultipartBody :: MultipartBody -> MediaType
$sel:metadata:MultipartBody :: MultipartBody -> Metadata
..} =
    forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
"\r\n--" forall a. Semigroup a => a -> a -> a
<> ByteString
boundary forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n"
      , ByteString
"Content-Type: application/json; charset=UTF-8"
      , ByteString
"\r\n\r\n"
      , forall a. ToJSON a => a -> ByteString
encode Metadata
metadata
      , ByteString
"\r\n--" forall a. Semigroup a => a -> a -> a
<> ByteString
boundary forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n"
      , ByteString
"Content-Type: " forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
LBS.fromStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ MediaType -> Text
mediaTypeName MediaType
mediaType)
      , ByteString
"\r\n"
      , ByteString
"Content-Transfer-Encoding: base64"
      , ByteString
"\r\n\r\n"
      , ByteString -> ByteString
LBS.fromStrict forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSB.encode forall a b. (a -> b) -> a -> b
$ (MediaContent -> ByteString
content MediaContent
mediaContent)
      , ByteString
"\r\n--" forall a. Semigroup a => a -> a -> a
<> ByteString
boundary forall a. Semigroup a => a -> a -> a
<> ByteString
"--"
      ]
    where
      boundary :: ByteString
boundary = ByteString
"314159265358979323846"


data DownloadFileParams = DownloadFileParams
  { DownloadFileParams -> FileId
fileId :: FileId
  , DownloadFileParams -> ConversionFormat
conversionFormat :: ConversionFormat
  } deriving (DownloadFileParams -> DownloadFileParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DownloadFileParams -> DownloadFileParams -> Bool
$c/= :: DownloadFileParams -> DownloadFileParams -> Bool
== :: DownloadFileParams -> DownloadFileParams -> Bool
$c== :: DownloadFileParams -> DownloadFileParams -> Bool
Eq, forall x. Rep DownloadFileParams x -> DownloadFileParams
forall x. DownloadFileParams -> Rep DownloadFileParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DownloadFileParams x -> DownloadFileParams
$cfrom :: forall x. DownloadFileParams -> Rep DownloadFileParams x
Generic, Int -> DownloadFileParams -> ShowS
[DownloadFileParams] -> ShowS
DownloadFileParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DownloadFileParams] -> ShowS
$cshowList :: [DownloadFileParams] -> ShowS
show :: DownloadFileParams -> String
$cshow :: DownloadFileParams -> String
showsPrec :: Int -> DownloadFileParams -> ShowS
$cshowsPrec :: Int -> DownloadFileParams -> ShowS
Show, Typeable)