{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- 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/

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

module GI.Gst.Structs.ProtectionMeta
    ( 

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


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveProtectionMetaMethod             ,
#endif

-- ** getInfo #method:getInfo#

    protectionMetaGetInfo                   ,




 -- * Properties


-- ** info #attr:info#
-- | the cryptographic information needed to decrypt the sample.

    clearProtectionMetaInfo                 ,
    getProtectionMetaInfo                   ,
#if defined(ENABLE_OVERLOADING)
    protectionMeta_info                     ,
#endif
    setProtectionMetaInfo                   ,


-- ** meta #attr:meta#
-- | the parent t'GI.Gst.Structs.Meta.Meta'.

    getProtectionMetaMeta                   ,
#if defined(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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
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 qualified GHC.Records as R

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 (SP.ManagedPtr ProtectionMeta)
    deriving (ProtectionMeta -> ProtectionMeta -> Bool
(ProtectionMeta -> ProtectionMeta -> Bool)
-> (ProtectionMeta -> ProtectionMeta -> Bool) -> Eq ProtectionMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtectionMeta -> ProtectionMeta -> Bool
== :: ProtectionMeta -> ProtectionMeta -> Bool
$c/= :: ProtectionMeta -> ProtectionMeta -> Bool
/= :: ProtectionMeta -> ProtectionMeta -> Bool
Eq)

instance SP.ManagedPtrNewtype ProtectionMeta where
    toManagedPtr :: ProtectionMeta -> ManagedPtr ProtectionMeta
toManagedPtr (ProtectionMeta ManagedPtr ProtectionMeta
p) = ManagedPtr ProtectionMeta
p

instance BoxedPtr ProtectionMeta where
    boxedPtrCopy :: ProtectionMeta -> IO ProtectionMeta
boxedPtrCopy = \ProtectionMeta
p -> ProtectionMeta
-> (Ptr ProtectionMeta -> IO ProtectionMeta) -> IO ProtectionMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ProtectionMeta
p (Int -> Ptr ProtectionMeta -> IO (Ptr ProtectionMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
24 (Ptr ProtectionMeta -> IO (Ptr ProtectionMeta))
-> (Ptr ProtectionMeta -> IO ProtectionMeta)
-> Ptr ProtectionMeta
-> IO ProtectionMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ProtectionMeta -> ProtectionMeta)
-> Ptr ProtectionMeta -> IO ProtectionMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ProtectionMeta -> ProtectionMeta
ProtectionMeta)
    boxedPtrFree :: ProtectionMeta -> IO ()
boxedPtrFree = \ProtectionMeta
x -> ProtectionMeta -> (Ptr ProtectionMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ProtectionMeta
x Ptr ProtectionMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ProtectionMeta where
    boxedPtrCalloc :: IO (Ptr ProtectionMeta)
boxedPtrCalloc = Int -> IO (Ptr ProtectionMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
24


-- | Construct a `ProtectionMeta` struct initialized to zero.
newZeroProtectionMeta :: MonadIO m => m ProtectionMeta
newZeroProtectionMeta :: forall (m :: * -> *). MonadIO m => m ProtectionMeta
newZeroProtectionMeta = IO ProtectionMeta -> m ProtectionMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtectionMeta -> m ProtectionMeta)
-> IO ProtectionMeta -> m ProtectionMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr ProtectionMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ProtectionMeta)
-> (Ptr ProtectionMeta -> IO ProtectionMeta) -> IO ProtectionMeta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ProtectionMeta -> ProtectionMeta)
-> Ptr ProtectionMeta -> IO ProtectionMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ProtectionMeta -> ProtectionMeta
ProtectionMeta

instance tag ~ 'AttrSet => Constructible ProtectionMeta tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ProtectionMeta -> ProtectionMeta)
-> [AttrOp ProtectionMeta tag] -> m ProtectionMeta
new ManagedPtr ProtectionMeta -> ProtectionMeta
_ [AttrOp ProtectionMeta tag]
attrs = do
        ProtectionMeta
o <- m ProtectionMeta
forall (m :: * -> *). MonadIO m => m ProtectionMeta
newZeroProtectionMeta
        ProtectionMeta -> [AttrOp ProtectionMeta 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ProtectionMeta
o [AttrOp ProtectionMeta tag]
[AttrOp ProtectionMeta 'AttrSet]
attrs
        ProtectionMeta -> m ProtectionMeta
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ProtectionMeta
o


-- | 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 :: forall (m :: * -> *). MonadIO m => ProtectionMeta -> m Meta
getProtectionMetaMeta ProtectionMeta
s = IO Meta -> m Meta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Meta -> m Meta) -> IO Meta -> m Meta
forall a b. (a -> b) -> a -> b
$ ProtectionMeta -> (Ptr ProtectionMeta -> IO Meta) -> IO Meta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ProtectionMeta
s ((Ptr ProtectionMeta -> IO Meta) -> IO Meta)
-> (Ptr ProtectionMeta -> IO Meta) -> IO Meta
forall a b. (a -> b) -> a -> b
$ \Ptr ProtectionMeta
ptr -> do
    let val :: Ptr Meta
val = Ptr ProtectionMeta
ptr Ptr ProtectionMeta -> Int -> Ptr Meta
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.Meta.Meta)
    Meta
val' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
val
    Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
val'

#if defined(ENABLE_OVERLOADING)
data ProtectionMetaMetaFieldInfo
instance AttrInfo ProtectionMetaMetaFieldInfo where
    type AttrBaseTypeConstraint ProtectionMetaMetaFieldInfo = (~) ProtectionMeta
    type AttrAllowedOps ProtectionMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ProtectionMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint ProtectionMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType ProtectionMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType ProtectionMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel ProtectionMetaMetaFieldInfo = "meta"
    type AttrOrigin ProtectionMetaMetaFieldInfo = ProtectionMeta
    attrGet = getProtectionMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.ProtectionMeta.meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-ProtectionMeta.html#g:attr:meta"
        })

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 :: forall (m :: * -> *).
MonadIO m =>
ProtectionMeta -> m (Maybe Structure)
getProtectionMetaInfo ProtectionMeta
s = IO (Maybe Structure) -> m (Maybe Structure)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ ProtectionMeta
-> (Ptr ProtectionMeta -> IO (Maybe Structure))
-> IO (Maybe Structure)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ProtectionMeta
s ((Ptr ProtectionMeta -> IO (Maybe Structure))
 -> IO (Maybe Structure))
-> (Ptr ProtectionMeta -> IO (Maybe Structure))
-> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr ProtectionMeta
ptr -> do
    Ptr Structure
val <- Ptr (Ptr Structure) -> IO (Ptr Structure)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ProtectionMeta
ptr Ptr ProtectionMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO (Ptr Gst.Structure.Structure)
    Maybe Structure
result <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Structure
val ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \Ptr Structure
val' -> do
        Structure
val'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
val'
        Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
val''
    Maybe Structure -> IO (Maybe Structure)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
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 :: forall (m :: * -> *).
MonadIO m =>
ProtectionMeta -> Ptr Structure -> m ()
setProtectionMetaInfo ProtectionMeta
s Ptr Structure
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ProtectionMeta -> (Ptr ProtectionMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ProtectionMeta
s ((Ptr ProtectionMeta -> IO ()) -> IO ())
-> (Ptr ProtectionMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ProtectionMeta
ptr -> do
    Ptr (Ptr Structure) -> Ptr Structure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ProtectionMeta
ptr Ptr ProtectionMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Structure
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 :: forall (m :: * -> *). MonadIO m => ProtectionMeta -> m ()
clearProtectionMetaInfo ProtectionMeta
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ProtectionMeta -> (Ptr ProtectionMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ProtectionMeta
s ((Ptr ProtectionMeta -> IO ()) -> IO ())
-> (Ptr ProtectionMeta -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ProtectionMeta
ptr -> do
    Ptr (Ptr Structure) -> Ptr Structure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ProtectionMeta
ptr Ptr ProtectionMeta -> Int -> Ptr (Ptr Structure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (Ptr Structure
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Structure.Structure)

#if defined(ENABLE_OVERLOADING)
data ProtectionMetaInfoFieldInfo
instance AttrInfo ProtectionMetaInfoFieldInfo where
    type AttrBaseTypeConstraint ProtectionMetaInfoFieldInfo = (~) ProtectionMeta
    type AttrAllowedOps ProtectionMetaInfoFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ProtectionMetaInfoFieldInfo = (~) (Ptr Gst.Structure.Structure)
    type AttrTransferTypeConstraint ProtectionMetaInfoFieldInfo = (~)(Ptr Gst.Structure.Structure)
    type AttrTransferType ProtectionMetaInfoFieldInfo = (Ptr Gst.Structure.Structure)
    type AttrGetType ProtectionMetaInfoFieldInfo = Maybe Gst.Structure.Structure
    type AttrLabel ProtectionMetaInfoFieldInfo = "info"
    type AttrOrigin ProtectionMetaInfoFieldInfo = ProtectionMeta
    attrGet = getProtectionMetaInfo
    attrSet = setProtectionMetaInfo
    attrConstruct = undefined
    attrClear = clearProtectionMetaInfo
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.ProtectionMeta.info"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-ProtectionMeta.html#g:attr:info"
        })

protectionMeta_info :: AttrLabelProxy "info"
protectionMeta_info = AttrLabelProxy

#endif



#if defined(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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MetaInfo
protectionMetaGetInfo  = IO MetaInfo -> m MetaInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaInfo -> m MetaInfo) -> IO MetaInfo -> m MetaInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr MetaInfo
result <- IO (Ptr MetaInfo)
gst_protection_meta_get_info
    Text -> Ptr MetaInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"protectionMetaGetInfo" Ptr MetaInfo
result
    MetaInfo
result' <- ((ManagedPtr MetaInfo -> MetaInfo) -> Ptr MetaInfo -> IO MetaInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr MetaInfo -> MetaInfo
Gst.MetaInfo.MetaInfo) Ptr MetaInfo
result
    MetaInfo -> IO MetaInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MetaInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveProtectionMetaMethod t ProtectionMeta, O.OverloadedMethod info ProtectionMeta p, R.HasField t ProtectionMeta p) => R.HasField t ProtectionMeta p where
    getField = O.overloadedMethod @info

#endif

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

#endif