{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

Metadata type that holds information about a sample from a protection-protected
track, including the information needed to decrypt it (if it is encrypted).

/Since: 1.6/
-}

#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
       && !defined(__HADDOCK_VERSION__))

module GI.Gst.Structs.ProtectionMeta
    (

-- * Exported types
    ProtectionMeta(..)                      ,
    newZeroProtectionMeta                   ,
    noProtectionMeta                        ,


 -- * Methods
-- ** getInfo #method:getInfo#

    protectionMetaGetInfo                   ,




 -- * Properties
-- ** info #attr:info#
{- | the cryptographic information needed to decrypt the sample.
-}
    clearProtectionMetaInfo                 ,
    getProtectionMetaInfo                   ,
#if ENABLE_OVERLOADING
    protectionMeta_info                     ,
#endif
    setProtectionMetaInfo                   ,


-- ** meta #attr:meta#
{- | the parent 'GI.Gst.Structs.Meta.Meta'.
-}
    getProtectionMetaMeta                   ,
#if ENABLE_OVERLOADING
    protectionMeta_meta                     ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Gst.Structs.Meta as Gst.Meta
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

-- | Memory-managed wrapper type.
newtype ProtectionMeta = ProtectionMeta (ManagedPtr ProtectionMeta)
instance WrappedPtr ProtectionMeta where
    wrappedPtrCalloc = callocBytes 24
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 24 >=> wrapPtr ProtectionMeta)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `ProtectionMeta` struct initialized to zero.
newZeroProtectionMeta :: MonadIO m => m ProtectionMeta
newZeroProtectionMeta = liftIO $ wrappedPtrCalloc >>= wrapPtr ProtectionMeta

instance tag ~ 'AttrSet => Constructible ProtectionMeta tag where
    new _ attrs = do
        o <- newZeroProtectionMeta
        GI.Attributes.set o attrs
        return o


-- | A convenience alias for `Nothing` :: `Maybe` `ProtectionMeta`.
noProtectionMeta :: Maybe ProtectionMeta
noProtectionMeta = Nothing

{- |
Get the value of the “@meta@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' protectionMeta #meta
@
-}
getProtectionMetaMeta :: MonadIO m => ProtectionMeta -> m Gst.Meta.Meta
getProtectionMetaMeta s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 0 :: (Ptr Gst.Meta.Meta)
    val' <- (newPtr Gst.Meta.Meta) val
    return val'

#if ENABLE_OVERLOADING
data ProtectionMetaMetaFieldInfo
instance AttrInfo ProtectionMetaMetaFieldInfo where
    type AttrAllowedOps ProtectionMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ProtectionMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrBaseTypeConstraint ProtectionMetaMetaFieldInfo = (~) ProtectionMeta
    type AttrGetType ProtectionMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel ProtectionMetaMetaFieldInfo = "meta"
    type AttrOrigin ProtectionMetaMetaFieldInfo = ProtectionMeta
    attrGet _ = getProtectionMetaMeta
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

protectionMeta_meta :: AttrLabelProxy "meta"
protectionMeta_meta = AttrLabelProxy

#endif


{- |
Get the value of the “@info@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' protectionMeta #info
@
-}
getProtectionMetaInfo :: MonadIO m => ProtectionMeta -> m (Maybe Gst.Structure.Structure)
getProtectionMetaInfo s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (Ptr Gst.Structure.Structure)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Gst.Structure.Structure) val'
        return val''
    return result

{- |
Set the value of the “@info@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' protectionMeta [ #info 'Data.GI.Base.Attributes.:=' value ]
@
-}
setProtectionMetaInfo :: MonadIO m => ProtectionMeta -> Ptr Gst.Structure.Structure -> m ()
setProtectionMetaInfo s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Ptr Gst.Structure.Structure)

{- |
Set the value of the “@info@” field to `Nothing`.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.clear' #info
@
-}
clearProtectionMetaInfo :: MonadIO m => ProtectionMeta -> m ()
clearProtectionMetaInfo s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: Ptr Gst.Structure.Structure)

#if ENABLE_OVERLOADING
data ProtectionMetaInfoFieldInfo
instance AttrInfo ProtectionMetaInfoFieldInfo where
    type AttrAllowedOps ProtectionMetaInfoFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ProtectionMetaInfoFieldInfo = (~) (Ptr Gst.Structure.Structure)
    type AttrBaseTypeConstraint ProtectionMetaInfoFieldInfo = (~) ProtectionMeta
    type AttrGetType ProtectionMetaInfoFieldInfo = Maybe Gst.Structure.Structure
    type AttrLabel ProtectionMetaInfoFieldInfo = "info"
    type AttrOrigin ProtectionMetaInfoFieldInfo = ProtectionMeta
    attrGet _ = getProtectionMetaInfo
    attrSet _ = setProtectionMetaInfo
    attrConstruct = undefined
    attrClear _ = clearProtectionMetaInfo

protectionMeta_info :: AttrLabelProxy "info"
protectionMeta_info = AttrLabelProxy

#endif



#if ENABLE_OVERLOADING
instance O.HasAttributeList ProtectionMeta
type instance O.AttributeList ProtectionMeta = ProtectionMetaAttributeList
type ProtectionMetaAttributeList = ('[ '("meta", ProtectionMetaMetaFieldInfo), '("info", ProtectionMetaInfoFieldInfo)] :: [(Symbol, *)])
#endif

-- method ProtectionMeta::get_info
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "MetaInfo"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_protection_meta_get_info" gst_protection_meta_get_info ::
    IO (Ptr Gst.MetaInfo.MetaInfo)

{- |
/No description available in the introspection data./
-}
protectionMetaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gst.MetaInfo.MetaInfo
protectionMetaGetInfo  = liftIO $ do
    result <- gst_protection_meta_get_info
    checkUnexpectedReturnNULL "protectionMetaGetInfo" result
    result' <- (newPtr Gst.MetaInfo.MetaInfo) result
    return result'

#if ENABLE_OVERLOADING
#endif

#if ENABLE_OVERLOADING
type family ResolveProtectionMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveProtectionMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveProtectionMetaMethod t ProtectionMeta, O.MethodInfo info ProtectionMeta p) => OL.IsLabel t (ProtectionMeta -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif

#endif