{-# 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
(Account -> Account -> Bool)
-> (Account -> Account -> Bool) -> Eq Account
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. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
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
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
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 (Text -> Account) -> (String -> Text) -> String -> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

newtype DateTime = DateTime
  { DateTime -> UTCTime
dateTime :: UTCTime
  } deriving (DateTime -> DateTime -> Bool
(DateTime -> DateTime -> Bool)
-> (DateTime -> DateTime -> Bool) -> Eq DateTime
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. DateTime -> Rep DateTime x)
-> (forall x. Rep DateTime x -> DateTime) -> Generic DateTime
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
(Int -> DateTime -> ShowS)
-> (DateTime -> String) -> ([DateTime] -> ShowS) -> Show DateTime
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 -> ByteString
DateTime -> Builder
DateTime -> Text
(DateTime -> Text)
-> (DateTime -> Builder)
-> (DateTime -> ByteString)
-> (DateTime -> Text)
-> ToHttpApiData DateTime
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
(ExtendedProperty -> ExtendedProperty -> Bool)
-> (ExtendedProperty -> ExtendedProperty -> Bool)
-> Eq ExtendedProperty
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. ExtendedProperty -> Rep ExtendedProperty x)
-> (forall x. Rep ExtendedProperty x -> ExtendedProperty)
-> Generic ExtendedProperty
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
(Int -> ExtendedProperty -> ShowS)
-> (ExtendedProperty -> String)
-> ([ExtendedProperty] -> ShowS)
-> Show ExtendedProperty
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)
..} =
    (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
pair Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text, Text) -> Text
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
(ExtendedProperties -> ExtendedProperties -> Bool)
-> (ExtendedProperties -> ExtendedProperties -> Bool)
-> Eq ExtendedProperties
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. ExtendedProperties -> Rep ExtendedProperties x)
-> (forall x. Rep ExtendedProperties x -> ExtendedProperties)
-> Generic ExtendedProperties
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
(Int -> ExtendedProperties -> ShowS)
-> (ExtendedProperties -> String)
-> ([ExtendedProperties] -> ShowS)
-> Show ExtendedProperties
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
(CalendarEvent -> CalendarEvent -> Bool)
-> (CalendarEvent -> CalendarEvent -> Bool) -> Eq CalendarEvent
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. CalendarEvent -> Rep CalendarEvent x)
-> (forall x. Rep CalendarEvent x -> CalendarEvent)
-> Generic CalendarEvent
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
(Int -> CalendarEvent -> ShowS)
-> (CalendarEvent -> String)
-> ([CalendarEvent] -> ShowS)
-> Show CalendarEvent
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
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
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. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
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
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
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 (HashMap Text [Text] -> Form)
-> ([(Text, [Text])] -> HashMap Text [Text])
-> [(Text, [Text])]
-> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [Text])] -> HashMap Text [Text]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, [Text])] -> Form) -> [(Text, [Text])] -> Form
forall a b. (a -> b) -> a -> b
$
    [ (Text
"grant_type", [Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (Token -> Text
grantType Token
token)])
    , (Text
"assertion", [Text -> Text
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
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
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. Email -> Rep Email x)
-> (forall x. Rep Email x -> Email) -> Generic Email
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
(Int -> Email -> ShowS)
-> (Email -> String) -> ([Email] -> ShowS) -> Show Email
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 Maybe Text
forall a. Maybe a
Nothing Text
to)
      (Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing Text
from)
      Text
subject
      Text
body'
      Text
body'
      []
  Mail -> IO Mail
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mail -> IO Mail) -> Mail -> IO Mail
forall a b. (a -> b) -> a -> b
$
    Mail
mail
      { mailHeaders :: Headers
mailHeaders =
          Mail -> Headers
mailHeaders Mail
mail Headers -> Headers -> Headers
forall a. Semigroup a => a -> a -> a
<> do
            Text
rt <- Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
replyTo
            (ByteString, Text) -> Headers
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
"Reply-To", Address -> Text
renderAddress (Address -> Text) -> Address -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing Text
rt)
      , mailCc :: [Address]
mailCc = (Text -> Address) -> [Text] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text -> Text -> Address
Address Maybe Text
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
(GmailSend -> GmailSend -> Bool)
-> (GmailSend -> GmailSend -> Bool) -> Eq GmailSend
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. GmailSend -> Rep GmailSend x)
-> (forall x. Rep GmailSend x -> GmailSend) -> Generic GmailSend
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
(Int -> GmailSend -> ShowS)
-> (GmailSend -> String)
-> ([GmailSend] -> ShowS)
-> Show GmailSend
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
(GetFileParams -> GetFileParams -> Bool)
-> (GetFileParams -> GetFileParams -> Bool) -> Eq GetFileParams
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. GetFileParams -> Rep GetFileParams x)
-> (forall x. Rep GetFileParams x -> GetFileParams)
-> Generic GetFileParams
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
(Int -> GetFileParams -> ShowS)
-> (GetFileParams -> String)
-> ([GetFileParams] -> ShowS)
-> Show GetFileParams
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
(MultipartBody -> MultipartBody -> Bool)
-> (MultipartBody -> MultipartBody -> Bool) -> Eq MultipartBody
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. MultipartBody -> Rep MultipartBody x)
-> (forall x. Rep MultipartBody x -> MultipartBody)
-> Generic MultipartBody
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
(Int -> MultipartBody -> ShowS)
-> (MultipartBody -> String)
-> ([MultipartBody] -> ShowS)
-> Show MultipartBody
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
..} =
    [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
      [ ByteString
"\r\n--" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n"
      , ByteString
"Content-Type: application/json; charset=UTF-8"
      , ByteString
"\r\n\r\n"
      , Metadata -> ByteString
forall a. ToJSON a => a -> ByteString
encode Metadata
metadata
      , ByteString
"\r\n--" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\r\n"
      , ByteString
"Content-Type: " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSB.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (MediaContent -> ByteString
content MediaContent
mediaContent)
      , ByteString
"\r\n--" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
boundary ByteString -> ByteString -> ByteString
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
(DownloadFileParams -> DownloadFileParams -> Bool)
-> (DownloadFileParams -> DownloadFileParams -> Bool)
-> Eq DownloadFileParams
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. DownloadFileParams -> Rep DownloadFileParams x)
-> (forall x. Rep DownloadFileParams x -> DownloadFileParams)
-> Generic DownloadFileParams
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
(Int -> DownloadFileParams -> ShowS)
-> (DownloadFileParams -> String)
-> ([DownloadFileParams] -> ShowS)
-> Show DownloadFileParams
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)