{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.NM.Structs.SriovVF
    ( 

-- * Exported types
    SriovVF(..)                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addVlan]("GI.NM.Structs.SriovVF#g:method:addVlan"), [dup]("GI.NM.Structs.SriovVF#g:method:dup"), [equal]("GI.NM.Structs.SriovVF#g:method:equal"), [ref]("GI.NM.Structs.SriovVF#g:method:ref"), [removeVlan]("GI.NM.Structs.SriovVF#g:method:removeVlan"), [unref]("GI.NM.Structs.SriovVF#g:method:unref").
-- 
-- ==== Getters
-- [getAttribute]("GI.NM.Structs.SriovVF#g:method:getAttribute"), [getAttributeNames]("GI.NM.Structs.SriovVF#g:method:getAttributeNames"), [getIndex]("GI.NM.Structs.SriovVF#g:method:getIndex"), [getVlanIds]("GI.NM.Structs.SriovVF#g:method:getVlanIds"), [getVlanProtocol]("GI.NM.Structs.SriovVF#g:method:getVlanProtocol"), [getVlanQos]("GI.NM.Structs.SriovVF#g:method:getVlanQos").
-- 
-- ==== Setters
-- [setAttribute]("GI.NM.Structs.SriovVF#g:method:setAttribute"), [setVlanProtocol]("GI.NM.Structs.SriovVF#g:method:setVlanProtocol"), [setVlanQos]("GI.NM.Structs.SriovVF#g:method:setVlanQos").

#if defined(ENABLE_OVERLOADING)
    ResolveSriovVFMethod                    ,
#endif

-- ** addVlan #method:addVlan#

#if defined(ENABLE_OVERLOADING)
    SriovVFAddVlanMethodInfo                ,
#endif
    sriovVFAddVlan                          ,


-- ** attributeValidate #method:attributeValidate#

    sriovVFAttributeValidate                ,


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    SriovVFDupMethodInfo                    ,
#endif
    sriovVFDup                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    SriovVFEqualMethodInfo                  ,
#endif
    sriovVFEqual                            ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetAttributeMethodInfo           ,
#endif
    sriovVFGetAttribute                     ,


-- ** getAttributeNames #method:getAttributeNames#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetAttributeNamesMethodInfo      ,
#endif
    sriovVFGetAttributeNames                ,


-- ** getIndex #method:getIndex#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetIndexMethodInfo               ,
#endif
    sriovVFGetIndex                         ,


-- ** getVlanIds #method:getVlanIds#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetVlanIdsMethodInfo             ,
#endif
    sriovVFGetVlanIds                       ,


-- ** getVlanProtocol #method:getVlanProtocol#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetVlanProtocolMethodInfo        ,
#endif
    sriovVFGetVlanProtocol                  ,


-- ** getVlanQos #method:getVlanQos#

#if defined(ENABLE_OVERLOADING)
    SriovVFGetVlanQosMethodInfo             ,
#endif
    sriovVFGetVlanQos                       ,


-- ** new #method:new#

    sriovVFNew                              ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    SriovVFRefMethodInfo                    ,
#endif
    sriovVFRef                              ,


-- ** removeVlan #method:removeVlan#

#if defined(ENABLE_OVERLOADING)
    SriovVFRemoveVlanMethodInfo             ,
#endif
    sriovVFRemoveVlan                       ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    SriovVFSetAttributeMethodInfo           ,
#endif
    sriovVFSetAttribute                     ,


-- ** setVlanProtocol #method:setVlanProtocol#

#if defined(ENABLE_OVERLOADING)
    SriovVFSetVlanProtocolMethodInfo        ,
#endif
    sriovVFSetVlanProtocol                  ,


-- ** setVlanQos #method:setVlanQos#

#if defined(ENABLE_OVERLOADING)
    SriovVFSetVlanQosMethodInfo             ,
#endif
    sriovVFSetVlanQos                       ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    SriovVFUnrefMethodInfo                  ,
#endif
    sriovVFUnref                            ,




    ) 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.Kind as DK
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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums

#else
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums

#endif

-- | Memory-managed wrapper type.
newtype SriovVF = SriovVF (SP.ManagedPtr SriovVF)
    deriving (SriovVF -> SriovVF -> Bool
(SriovVF -> SriovVF -> Bool)
-> (SriovVF -> SriovVF -> Bool) -> Eq SriovVF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SriovVF -> SriovVF -> Bool
== :: SriovVF -> SriovVF -> Bool
$c/= :: SriovVF -> SriovVF -> Bool
/= :: SriovVF -> SriovVF -> Bool
Eq)

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

foreign import ccall "nm_sriov_vf_get_type" c_nm_sriov_vf_get_type :: 
    IO GType

type instance O.ParentTypes SriovVF = '[]
instance O.HasParentTypes SriovVF

instance B.Types.TypedObject SriovVF where
    glibType :: IO GType
glibType = IO GType
c_nm_sriov_vf_get_type

instance B.Types.GBoxed SriovVF

-- | Convert t'SriovVF' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SriovVF) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_sriov_vf_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SriovVF -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SriovVF
P.Nothing = Ptr GValue -> Ptr SriovVF -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr SriovVF
forall a. Ptr a
FP.nullPtr :: FP.Ptr SriovVF)
    gvalueSet_ Ptr GValue
gv (P.Just SriovVF
obj) = SriovVF -> (Ptr SriovVF -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SriovVF
obj (Ptr GValue -> Ptr SriovVF -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SriovVF)
gvalueGet_ Ptr GValue
gv = do
        Ptr SriovVF
ptr <- Ptr GValue -> IO (Ptr SriovVF)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr SriovVF)
        if Ptr SriovVF
ptr Ptr SriovVF -> Ptr SriovVF -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SriovVF
forall a. Ptr a
FP.nullPtr
        then SriovVF -> Maybe SriovVF
forall a. a -> Maybe a
P.Just (SriovVF -> Maybe SriovVF) -> IO SriovVF -> IO (Maybe SriovVF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SriovVF -> SriovVF) -> Ptr SriovVF -> IO SriovVF
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr SriovVF -> SriovVF
SriovVF Ptr SriovVF
ptr
        else Maybe SriovVF -> IO (Maybe SriovVF)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SriovVF
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SriovVF
type instance O.AttributeList SriovVF = SriovVFAttributeList
type SriovVFAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method SriovVF::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VF index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "SriovVF" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_new" nm_sriov_vf_new :: 
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr SriovVF)

-- | Creates a new t'GI.NM.Structs.SriovVF.SriovVF' object.
-- 
-- /Since: 1.14/
sriovVFNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@index@/: the VF index
    -> m SriovVF
    -- ^ __Returns:__ the new t'GI.NM.Structs.SriovVF.SriovVF' object.
sriovVFNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m SriovVF
sriovVFNew Word32
index = IO SriovVF -> m SriovVF
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovVF -> m SriovVF) -> IO SriovVF -> m SriovVF
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
result <- Word32 -> IO (Ptr SriovVF)
nm_sriov_vf_new Word32
index
    Text -> Ptr SriovVF -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sriovVFNew" Ptr SriovVF
result
    SriovVF
result' <- ((ManagedPtr SriovVF -> SriovVF) -> Ptr SriovVF -> IO SriovVF
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SriovVF -> SriovVF
SriovVF) Ptr SriovVF
result
    SriovVF -> IO SriovVF
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovVF
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SriovVF::add_vlan
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_add_vlan" nm_sriov_vf_add_vlan :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    IO CInt

-- | Adds a VLAN to the VF. Currently kernel only supports one VLAN per VF.
-- 
-- /Since: 1.14/
sriovVFAddVlan ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the VLAN was added; 'P.False' if it already existed
sriovVFAddVlan :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> m Bool
sriovVFAddVlan SriovVF
vf Word32
vlanId = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    CInt
result <- Ptr SriovVF -> Word32 -> IO CInt
nm_sriov_vf_add_vlan Ptr SriovVF
vf' Word32
vlanId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFAddVlanMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod SriovVFAddVlanMethodInfo SriovVF signature where
    overloadedMethod = sriovVFAddVlan

instance O.OverloadedMethodInfo SriovVFAddVlanMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFAddVlan",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFAddVlan"
        })


#endif

-- method SriovVF::dup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "SriovVF" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_dup" nm_sriov_vf_dup :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO (Ptr SriovVF)

-- | Creates a copy of /@vf@/.
-- 
-- /Since: 1.14/
sriovVFDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m SriovVF
    -- ^ __Returns:__ a copy of /@vf@/
sriovVFDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> m SriovVF
sriovVFDup SriovVF
vf = IO SriovVF -> m SriovVF
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovVF -> m SriovVF) -> IO SriovVF -> m SriovVF
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr SriovVF
result <- Ptr SriovVF -> IO (Ptr SriovVF)
nm_sriov_vf_dup Ptr SriovVF
vf'
    Text -> Ptr SriovVF -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sriovVFDup" Ptr SriovVF
result
    SriovVF
result' <- ((ManagedPtr SriovVF -> SriovVF) -> Ptr SriovVF -> IO SriovVF
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SriovVF -> SriovVF
SriovVF) Ptr SriovVF
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    SriovVF -> IO SriovVF
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovVF
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFDupMethodInfo
instance (signature ~ (m SriovVF), MonadIO m) => O.OverloadedMethod SriovVFDupMethodInfo SriovVF signature where
    overloadedMethod = sriovVFDup

instance O.OverloadedMethodInfo SriovVFDupMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFDup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFDup"
        })


#endif

-- method SriovVF::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF to compare @vf to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_equal" nm_sriov_vf_equal :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Ptr SriovVF ->                          -- other : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO CInt

-- | Determines if two t'GI.NM.Structs.SriovVF.SriovVF' objects have the same index,
-- attributes and VLANs.
-- 
-- /Since: 1.14/
sriovVFEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> SriovVF
    -- ^ /@other@/: the t'GI.NM.Structs.SriovVF.SriovVF' to compare /@vf@/ to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False'
    --    if they do not.
sriovVFEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> SriovVF -> m Bool
sriovVFEqual SriovVF
vf SriovVF
other = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr SriovVF
other' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
other
    CInt
result <- Ptr SriovVF -> Ptr SriovVF -> IO CInt
nm_sriov_vf_equal Ptr SriovVF
vf' Ptr SriovVF
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFEqualMethodInfo
instance (signature ~ (SriovVF -> m Bool), MonadIO m) => O.OverloadedMethod SriovVFEqualMethodInfo SriovVF signature where
    overloadedMethod = sriovVFEqual

instance O.OverloadedMethodInfo SriovVFEqualMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFEqual"
        })


#endif

-- method SriovVF::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a VF attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_attribute" nm_sriov_vf_get_attribute :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Gets the value of the attribute with name /@name@/ on /@vf@/
-- 
-- /Since: 1.14/
sriovVFGetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> T.Text
    -- ^ /@name@/: the name of a VF attribute
    -> m GVariant
    -- ^ __Returns:__ the value of the attribute with name /@name@/ on
    --   /@vf@/, or 'P.Nothing' if /@vf@/ has no such attribute.
sriovVFGetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Text -> m GVariant
sriovVFGetAttribute SriovVF
vf Text
name = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
result <- Ptr SriovVF -> CString -> IO (Ptr GVariant)
nm_sriov_vf_get_attribute Ptr SriovVF
vf' CString
name'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sriovVFGetAttribute" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFGetAttributeMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m) => O.OverloadedMethod SriovVFGetAttributeMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetAttribute

instance O.OverloadedMethodInfo SriovVFGetAttributeMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetAttribute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetAttribute"
        })


#endif

-- method SriovVF::get_attribute_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_attribute_names" nm_sriov_vf_get_attribute_names :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO (Ptr CString)

-- | Gets an array of attribute names defined on /@vf@/.
-- 
-- /Since: 1.14/
sriovVFGetAttributeNames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of attribute names
sriovVFGetAttributeNames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> m [Text]
sriovVFGetAttributeNames SriovVF
vf = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr CString
result <- Ptr SriovVF -> IO (Ptr CString)
nm_sriov_vf_get_attribute_names Ptr SriovVF
vf'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sriovVFGetAttributeNames" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFGetAttributeNamesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod SriovVFGetAttributeNamesMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetAttributeNames

instance O.OverloadedMethodInfo SriovVFGetAttributeNamesMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetAttributeNames",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetAttributeNames"
        })


#endif

-- method SriovVF::get_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_index" nm_sriov_vf_get_index :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO Word32

-- | Gets the index property of this VF object.
-- 
-- /Since: 1.14/
sriovVFGetIndex ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m Word32
    -- ^ __Returns:__ the VF index
sriovVFGetIndex :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> m Word32
sriovVFGetIndex SriovVF
vf = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Word32
result <- Ptr SriovVF -> IO Word32
nm_sriov_vf_get_index Ptr SriovVF
vf'
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SriovVFGetIndexMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod SriovVFGetIndexMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetIndex

instance O.OverloadedMethodInfo SriovVFGetIndexMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetIndex"
        })


#endif

-- method SriovVF::get_vlan_ids
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "on return, the number of VLANs configured"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "on return, the number of VLANs configured"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt))
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_vlan_ids" nm_sriov_vf_get_vlan_ids :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Ptr Word32 ->                           -- length : TBasicType TUInt
    IO (Ptr Word32)

-- | Returns the VLANs currently configured on the VF. Currently kernel only
-- supports one VLAN per VF.
-- 
-- /Since: 1.14/
sriovVFGetVlanIds ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m [Word32]
    -- ^ __Returns:__ a list of VLAN ids configured on the VF.
sriovVFGetVlanIds :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> m [Word32]
sriovVFGetVlanIds SriovVF
vf = IO [Word32] -> m [Word32]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Word32] -> m [Word32]) -> IO [Word32] -> m [Word32]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr Word32
length_ <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
result <- Ptr SriovVF -> Ptr Word32 -> IO (Ptr Word32)
nm_sriov_vf_get_vlan_ids Ptr SriovVF
vf' Ptr Word32
length_
    Word32
length_' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
length_
    Text -> Ptr Word32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sriovVFGetVlanIds" Ptr Word32
result
    [Word32]
result' <- (Word32 -> Ptr Word32 -> IO [Word32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength Word32
length_') Ptr Word32
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
length_
    [Word32] -> IO [Word32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32]
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFGetVlanIdsMethodInfo
instance (signature ~ (m [Word32]), MonadIO m) => O.OverloadedMethod SriovVFGetVlanIdsMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetVlanIds

instance O.OverloadedMethodInfo SriovVFGetVlanIdsMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetVlanIds",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetVlanIds"
        })


#endif

-- method SriovVF::get_vlan_protocol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "NM" , name = "SriovVFVlanProtocol" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_vlan_protocol" nm_sriov_vf_get_vlan_protocol :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    IO CUInt

-- | Returns the configured protocol for the given VLAN.
-- 
-- /Since: 1.14/
sriovVFGetVlanProtocol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> m NM.Enums.SriovVFVlanProtocol
    -- ^ __Returns:__ the configured protocol
sriovVFGetVlanProtocol :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> m SriovVFVlanProtocol
sriovVFGetVlanProtocol SriovVF
vf Word32
vlanId = IO SriovVFVlanProtocol -> m SriovVFVlanProtocol
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SriovVFVlanProtocol -> m SriovVFVlanProtocol)
-> IO SriovVFVlanProtocol -> m SriovVFVlanProtocol
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    CUInt
result <- Ptr SriovVF -> Word32 -> IO CUInt
nm_sriov_vf_get_vlan_protocol Ptr SriovVF
vf' Word32
vlanId
    let result' :: SriovVFVlanProtocol
result' = (Int -> SriovVFVlanProtocol
forall a. Enum a => Int -> a
toEnum (Int -> SriovVFVlanProtocol)
-> (CUInt -> Int) -> CUInt -> SriovVFVlanProtocol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    SriovVFVlanProtocol -> IO SriovVFVlanProtocol
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SriovVFVlanProtocol
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFGetVlanProtocolMethodInfo
instance (signature ~ (Word32 -> m NM.Enums.SriovVFVlanProtocol), MonadIO m) => O.OverloadedMethod SriovVFGetVlanProtocolMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetVlanProtocol

instance O.OverloadedMethodInfo SriovVFGetVlanProtocolMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetVlanProtocol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetVlanProtocol"
        })


#endif

-- method SriovVF::get_vlan_qos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_get_vlan_qos" nm_sriov_vf_get_vlan_qos :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    IO Word32

-- | Returns the QoS value for the given VLAN.
-- 
-- /Since: 1.14/
sriovVFGetVlanQos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> m Word32
    -- ^ __Returns:__ the QoS value
sriovVFGetVlanQos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> m Word32
sriovVFGetVlanQos SriovVF
vf Word32
vlanId = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Word32
result <- Ptr SriovVF -> Word32 -> IO Word32
nm_sriov_vf_get_vlan_qos Ptr SriovVF
vf' Word32
vlanId
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SriovVFGetVlanQosMethodInfo
instance (signature ~ (Word32 -> m Word32), MonadIO m) => O.OverloadedMethod SriovVFGetVlanQosMethodInfo SriovVF signature where
    overloadedMethod = sriovVFGetVlanQos

instance O.OverloadedMethodInfo SriovVFGetVlanQosMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFGetVlanQos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFGetVlanQos"
        })


#endif

-- method SriovVF::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_ref" nm_sriov_vf_ref :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO ()

-- | Increases the reference count of the object.
-- 
-- /Since: 1.14/
sriovVFRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m ()
sriovVFRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => SriovVF -> m ()
sriovVFRef SriovVF
vf = 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
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr SriovVF -> IO ()
nm_sriov_vf_ref Ptr SriovVF
vf'
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SriovVFRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SriovVFRefMethodInfo SriovVF signature where
    overloadedMethod = sriovVFRef

instance O.OverloadedMethodInfo SriovVFRefMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFRef"
        })


#endif

-- method SriovVF::remove_vlan
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_remove_vlan" nm_sriov_vf_remove_vlan :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    IO CInt

-- | Removes a VLAN from a VF.
-- 
-- /Since: 1.14/
sriovVFRemoveVlan ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the VLAN was removed, 'P.False' if the VLAN /@vlanId@/
    --     did not belong to the VF.
sriovVFRemoveVlan :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> m Bool
sriovVFRemoveVlan SriovVF
vf Word32
vlanId = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    CInt
result <- Ptr SriovVF -> Word32 -> IO CInt
nm_sriov_vf_remove_vlan Ptr SriovVF
vf' Word32
vlanId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SriovVFRemoveVlanMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod SriovVFRemoveVlanMethodInfo SriovVF signature where
    overloadedMethod = sriovVFRemoveVlan

instance O.OverloadedMethodInfo SriovVFRemoveVlanMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFRemoveVlan",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFRemoveVlan"
        })


#endif

-- method SriovVF::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a route attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_set_attribute" nm_sriov_vf_set_attribute :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets the named attribute on /@vf@/ to the given value.
-- 
-- /Since: 1.14/
sriovVFSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> T.Text
    -- ^ /@name@/: the name of a route attribute
    -> Maybe (GVariant)
    -- ^ /@value@/: the value
    -> m ()
sriovVFSetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Text -> Maybe GVariant -> m ()
sriovVFSetAttribute SriovVF
vf Text
name Maybe GVariant
value = 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
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeValue <- case Maybe GVariant
value of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jValue -> do
            Ptr GVariant
jValue' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jValue
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jValue'
    Ptr SriovVF -> CString -> Ptr GVariant -> IO ()
nm_sriov_vf_set_attribute Ptr SriovVF
vf' CString
name' Ptr GVariant
maybeValue
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
value GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SriovVFSetAttributeMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m) => O.OverloadedMethod SriovVFSetAttributeMethodInfo SriovVF signature where
    overloadedMethod = sriovVFSetAttribute

instance O.OverloadedMethodInfo SriovVFSetAttributeMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFSetAttribute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFSetAttribute"
        })


#endif

-- method SriovVF::set_vlan_protocol
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "protocol"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SriovVFVlanProtocol" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN protocol" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_set_vlan_protocol" nm_sriov_vf_set_vlan_protocol :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    CUInt ->                                -- protocol : TInterface (Name {namespace = "NM", name = "SriovVFVlanProtocol"})
    IO ()

-- | Sets the protocol for the given VLAN.
-- 
-- /Since: 1.14/
sriovVFSetVlanProtocol ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> NM.Enums.SriovVFVlanProtocol
    -- ^ /@protocol@/: the VLAN protocol
    -> m ()
sriovVFSetVlanProtocol :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> SriovVFVlanProtocol -> m ()
sriovVFSetVlanProtocol SriovVF
vf Word32
vlanId SriovVFVlanProtocol
protocol = 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
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    let protocol' :: CUInt
protocol' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SriovVFVlanProtocol -> Int) -> SriovVFVlanProtocol -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SriovVFVlanProtocol -> Int
forall a. Enum a => a -> Int
fromEnum) SriovVFVlanProtocol
protocol
    Ptr SriovVF -> Word32 -> CUInt -> IO ()
nm_sriov_vf_set_vlan_protocol Ptr SriovVF
vf' Word32
vlanId CUInt
protocol'
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SriovVFSetVlanProtocolMethodInfo
instance (signature ~ (Word32 -> NM.Enums.SriovVFVlanProtocol -> m ()), MonadIO m) => O.OverloadedMethod SriovVFSetVlanProtocolMethodInfo SriovVF signature where
    overloadedMethod = sriovVFSetVlanProtocol

instance O.OverloadedMethodInfo SriovVFSetVlanProtocolMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFSetVlanProtocol",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFSetVlanProtocol"
        })


#endif

-- method SriovVF::set_vlan_qos
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vlan_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the VLAN id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "qos"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a QoS (priority) value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_set_vlan_qos" nm_sriov_vf_set_vlan_qos :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    Word32 ->                               -- vlan_id : TBasicType TUInt
    Word32 ->                               -- qos : TBasicType TUInt32
    IO ()

-- | Sets a QoS value for the given VLAN.
-- 
-- /Since: 1.14/
sriovVFSetVlanQos ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> Word32
    -- ^ /@vlanId@/: the VLAN id
    -> Word32
    -- ^ /@qos@/: a QoS (priority) value
    -> m ()
sriovVFSetVlanQos :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SriovVF -> Word32 -> Word32 -> m ()
sriovVFSetVlanQos SriovVF
vf Word32
vlanId Word32
qos = 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
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr SriovVF -> Word32 -> Word32 -> IO ()
nm_sriov_vf_set_vlan_qos Ptr SriovVF
vf' Word32
vlanId Word32
qos
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SriovVFSetVlanQosMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod SriovVFSetVlanQosMethodInfo SriovVF signature where
    overloadedMethod = sriovVFSetVlanQos

instance O.OverloadedMethodInfo SriovVFSetVlanQosMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFSetVlanQos",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFSetVlanQos"
        })


#endif

-- method SriovVF::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "vf"
--           , argType = TInterface Name { namespace = "NM" , name = "SriovVF" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMSriovVF" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_sriov_vf_unref" nm_sriov_vf_unref :: 
    Ptr SriovVF ->                          -- vf : TInterface (Name {namespace = "NM", name = "SriovVF"})
    IO ()

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero, the object will be destroyed.
-- 
-- /Since: 1.14/
sriovVFUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SriovVF
    -- ^ /@vf@/: the t'GI.NM.Structs.SriovVF.SriovVF'
    -> m ()
sriovVFUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => SriovVF -> m ()
sriovVFUnref SriovVF
vf = 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
$ do
    Ptr SriovVF
vf' <- SriovVF -> IO (Ptr SriovVF)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SriovVF
vf
    Ptr SriovVF -> IO ()
nm_sriov_vf_unref Ptr SriovVF
vf'
    SriovVF -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SriovVF
vf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SriovVFUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SriovVFUnrefMethodInfo SriovVF signature where
    overloadedMethod = sriovVFUnref

instance O.OverloadedMethodInfo SriovVFUnrefMethodInfo SriovVF where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.SriovVF.sriovVFUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-SriovVF.html#v:sriovVFUnref"
        })


#endif

-- method SriovVF::attribute_validate
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the attribute value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "known"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "on return, whether the attribute name is a known one"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_sriov_vf_attribute_validate" nm_sriov_vf_attribute_validate :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    Ptr CInt ->                             -- known : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Validates a VF attribute, i.e. checks that the attribute is a known one,
-- the value is of the correct type and well-formed.
-- 
-- /Since: 1.42/
sriovVFAttributeValidate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the attribute name
    -> GVariant
    -- ^ /@value@/: the attribute value
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sriovVFAttributeValidate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> GVariant -> m Bool
sriovVFAttributeValidate Text
name GVariant
value = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr CInt
known <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ CString -> Ptr GVariant -> Ptr CInt -> Ptr (Ptr GError) -> IO CInt
nm_sriov_vf_attribute_validate CString
name' Ptr GVariant
value' Ptr CInt
known
        CInt
known' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
known
        let known'' :: Bool
known'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
known'
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
known
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
known''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
known
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSriovVFMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSriovVFMethod "addVlan" o = SriovVFAddVlanMethodInfo
    ResolveSriovVFMethod "dup" o = SriovVFDupMethodInfo
    ResolveSriovVFMethod "equal" o = SriovVFEqualMethodInfo
    ResolveSriovVFMethod "ref" o = SriovVFRefMethodInfo
    ResolveSriovVFMethod "removeVlan" o = SriovVFRemoveVlanMethodInfo
    ResolveSriovVFMethod "unref" o = SriovVFUnrefMethodInfo
    ResolveSriovVFMethod "getAttribute" o = SriovVFGetAttributeMethodInfo
    ResolveSriovVFMethod "getAttributeNames" o = SriovVFGetAttributeNamesMethodInfo
    ResolveSriovVFMethod "getIndex" o = SriovVFGetIndexMethodInfo
    ResolveSriovVFMethod "getVlanIds" o = SriovVFGetVlanIdsMethodInfo
    ResolveSriovVFMethod "getVlanProtocol" o = SriovVFGetVlanProtocolMethodInfo
    ResolveSriovVFMethod "getVlanQos" o = SriovVFGetVlanQosMethodInfo
    ResolveSriovVFMethod "setAttribute" o = SriovVFSetAttributeMethodInfo
    ResolveSriovVFMethod "setVlanProtocol" o = SriovVFSetVlanProtocolMethodInfo
    ResolveSriovVFMethod "setVlanQos" o = SriovVFSetVlanQosMethodInfo
    ResolveSriovVFMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSriovVFMethod t SriovVF, O.OverloadedMethod info SriovVF p) => OL.IsLabel t (SriovVF -> 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 ~ ResolveSriovVFMethod t SriovVF, O.OverloadedMethod info SriovVF p, R.HasField t SriovVF p) => R.HasField t SriovVF p where
    getField = O.overloadedMethod @info

#endif

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

#endif