{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Network.Google.Resource.YouTube.Watermarks.UnSet
(
WatermarksUnSetResource
, watermarksUnSet
, WatermarksUnSet
, wusChannelId
, wusOnBehalfOfContentOwner
) where
import Network.Google.Prelude
import Network.Google.YouTube.Types
type WatermarksUnSetResource =
"youtube" :>
"v3" :>
"watermarks" :>
"unset" :>
QueryParam "channelId" Text :>
QueryParam "onBehalfOfContentOwner" Text :>
QueryParam "alt" AltJSON :> Post '[JSON] ()
data WatermarksUnSet = WatermarksUnSet'
{ _wusChannelId :: !Text
, _wusOnBehalfOfContentOwner :: !(Maybe Text)
} deriving (Eq,Show,Data,Typeable,Generic)
watermarksUnSet
:: Text
-> WatermarksUnSet
watermarksUnSet pWusChannelId_ =
WatermarksUnSet'
{ _wusChannelId = pWusChannelId_
, _wusOnBehalfOfContentOwner = Nothing
}
wusChannelId :: Lens' WatermarksUnSet Text
wusChannelId
= lens _wusChannelId (\ s a -> s{_wusChannelId = a})
wusOnBehalfOfContentOwner :: Lens' WatermarksUnSet (Maybe Text)
wusOnBehalfOfContentOwner
= lens _wusOnBehalfOfContentOwner
(\ s a -> s{_wusOnBehalfOfContentOwner = a})
instance GoogleRequest WatermarksUnSet where
type Rs WatermarksUnSet = ()
type Scopes WatermarksUnSet =
'["https://www.googleapis.com/auth/youtube",
"https://www.googleapis.com/auth/youtube.force-ssl",
"https://www.googleapis.com/auth/youtubepartner"]
requestClient WatermarksUnSet'{..}
= go (Just _wusChannelId) _wusOnBehalfOfContentOwner
(Just AltJSON)
youTubeService
where go
= buildClient
(Proxy :: Proxy WatermarksUnSetResource)
mempty