{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.WebKit2.Objects.SecurityManager
    ( 

-- * Exported types
    SecurityManager(..)                     ,
    IsSecurityManager                       ,
    toSecurityManager                       ,
    noSecurityManager                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveSecurityManagerMethod            ,
#endif


-- ** registerUriSchemeAsCorsEnabled #method:registerUriSchemeAsCorsEnabled#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsCorsEnabledMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsCorsEnabled,


-- ** registerUriSchemeAsDisplayIsolated #method:registerUriSchemeAsDisplayIsolated#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsDisplayIsolatedMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsDisplayIsolated,


-- ** registerUriSchemeAsEmptyDocument #method:registerUriSchemeAsEmptyDocument#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsEmptyDocumentMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsEmptyDocument,


-- ** registerUriSchemeAsLocal #method:registerUriSchemeAsLocal#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsLocalMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsLocal ,


-- ** registerUriSchemeAsNoAccess #method:registerUriSchemeAsNoAccess#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsNoAccessMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsNoAccess,


-- ** registerUriSchemeAsSecure #method:registerUriSchemeAsSecure#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerRegisterUriSchemeAsSecureMethodInfo,
#endif
    securityManagerRegisterUriSchemeAsSecure,


-- ** uriSchemeIsCorsEnabled #method:uriSchemeIsCorsEnabled#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsCorsEnabledMethodInfo,
#endif
    securityManagerUriSchemeIsCorsEnabled   ,


-- ** uriSchemeIsDisplayIsolated #method:uriSchemeIsDisplayIsolated#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsDisplayIsolatedMethodInfo,
#endif
    securityManagerUriSchemeIsDisplayIsolated,


-- ** uriSchemeIsEmptyDocument #method:uriSchemeIsEmptyDocument#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsEmptyDocumentMethodInfo,
#endif
    securityManagerUriSchemeIsEmptyDocument ,


-- ** uriSchemeIsLocal #method:uriSchemeIsLocal#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsLocalMethodInfo,
#endif
    securityManagerUriSchemeIsLocal         ,


-- ** uriSchemeIsNoAccess #method:uriSchemeIsNoAccess#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsNoAccessMethodInfo,
#endif
    securityManagerUriSchemeIsNoAccess      ,


-- ** uriSchemeIsSecure #method:uriSchemeIsSecure#

#if defined(ENABLE_OVERLOADING)
    SecurityManagerUriSchemeIsSecureMethodInfo,
#endif
    securityManagerUriSchemeIsSecure        ,




    ) 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.GI.Base.Signals as B.Signals
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 GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype SecurityManager = SecurityManager (ManagedPtr SecurityManager)
    deriving (SecurityManager -> SecurityManager -> Bool
(SecurityManager -> SecurityManager -> Bool)
-> (SecurityManager -> SecurityManager -> Bool)
-> Eq SecurityManager
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecurityManager -> SecurityManager -> Bool
$c/= :: SecurityManager -> SecurityManager -> Bool
== :: SecurityManager -> SecurityManager -> Bool
$c== :: SecurityManager -> SecurityManager -> Bool
Eq)
foreign import ccall "webkit_security_manager_get_type"
    c_webkit_security_manager_get_type :: IO GType

instance GObject SecurityManager where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_security_manager_get_type
    

-- | Convert 'SecurityManager' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue SecurityManager where
    toGValue :: SecurityManager -> IO GValue
toGValue o :: SecurityManager
o = do
        GType
gtype <- IO GType
c_webkit_security_manager_get_type
        SecurityManager -> (Ptr SecurityManager -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SecurityManager
o (GType
-> (GValue -> Ptr SecurityManager -> IO ())
-> Ptr SecurityManager
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr SecurityManager -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO SecurityManager
fromGValue gv :: GValue
gv = do
        Ptr SecurityManager
ptr <- GValue -> IO (Ptr SecurityManager)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr SecurityManager)
        (ManagedPtr SecurityManager -> SecurityManager)
-> Ptr SecurityManager -> IO SecurityManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SecurityManager -> SecurityManager
SecurityManager Ptr SecurityManager
ptr
        
    

-- | Type class for types which can be safely cast to `SecurityManager`, for instance with `toSecurityManager`.
class (GObject o, O.IsDescendantOf SecurityManager o) => IsSecurityManager o
instance (GObject o, O.IsDescendantOf SecurityManager o) => IsSecurityManager o

instance O.HasParentTypes SecurityManager
type instance O.ParentTypes SecurityManager = '[GObject.Object.Object]

-- | Cast to `SecurityManager`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toSecurityManager :: (MonadIO m, IsSecurityManager o) => o -> m SecurityManager
toSecurityManager :: o -> m SecurityManager
toSecurityManager = IO SecurityManager -> m SecurityManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SecurityManager -> m SecurityManager)
-> (o -> IO SecurityManager) -> o -> m SecurityManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SecurityManager -> SecurityManager)
-> o -> IO SecurityManager
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr SecurityManager -> SecurityManager
SecurityManager

-- | A convenience alias for `Nothing` :: `Maybe` `SecurityManager`.
noSecurityManager :: Maybe SecurityManager
noSecurityManager :: Maybe SecurityManager
noSecurityManager = Maybe SecurityManager
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveSecurityManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveSecurityManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSecurityManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSecurityManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSecurityManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSecurityManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSecurityManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSecurityManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSecurityManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSecurityManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSecurityManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsCorsEnabled" o = SecurityManagerRegisterUriSchemeAsCorsEnabledMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsDisplayIsolated" o = SecurityManagerRegisterUriSchemeAsDisplayIsolatedMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsEmptyDocument" o = SecurityManagerRegisterUriSchemeAsEmptyDocumentMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsLocal" o = SecurityManagerRegisterUriSchemeAsLocalMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsNoAccess" o = SecurityManagerRegisterUriSchemeAsNoAccessMethodInfo
    ResolveSecurityManagerMethod "registerUriSchemeAsSecure" o = SecurityManagerRegisterUriSchemeAsSecureMethodInfo
    ResolveSecurityManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSecurityManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSecurityManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSecurityManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSecurityManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsCorsEnabled" o = SecurityManagerUriSchemeIsCorsEnabledMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsDisplayIsolated" o = SecurityManagerUriSchemeIsDisplayIsolatedMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsEmptyDocument" o = SecurityManagerUriSchemeIsEmptyDocumentMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsLocal" o = SecurityManagerUriSchemeIsLocalMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsNoAccess" o = SecurityManagerUriSchemeIsNoAccessMethodInfo
    ResolveSecurityManagerMethod "uriSchemeIsSecure" o = SecurityManagerUriSchemeIsSecureMethodInfo
    ResolveSecurityManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSecurityManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSecurityManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSecurityManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSecurityManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSecurityManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSecurityManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSecurityManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SecurityManager
type instance O.AttributeList SecurityManager = SecurityManagerAttributeList
type SecurityManagerAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SecurityManager = SecurityManagerSignalList
type SecurityManagerSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method SecurityManager::register_uri_scheme_as_cors_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_cors_enabled" webkit_security_manager_register_uri_scheme_as_cors_enabled :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as a CORS (Cross-origin resource sharing) enabled scheme.
-- This means that CORS requests are allowed. See W3C CORS specification
-- http:\/\/www.w3.org\/TR\/cors\/.
securityManagerRegisterUriSchemeAsCorsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsCorsEnabled :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsCorsEnabled securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_cors_enabled Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsCorsEnabledMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsCorsEnabledMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsCorsEnabled

#endif

-- method SecurityManager::register_uri_scheme_as_display_isolated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_display_isolated" webkit_security_manager_register_uri_scheme_as_display_isolated :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as a display isolated scheme. This means that pages cannot
-- display these URIs unless they are from the same scheme.
securityManagerRegisterUriSchemeAsDisplayIsolated ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsDisplayIsolated :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsDisplayIsolated securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_display_isolated Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsDisplayIsolatedMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsDisplayIsolatedMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsDisplayIsolated

#endif

-- method SecurityManager::register_uri_scheme_as_empty_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_empty_document" webkit_security_manager_register_uri_scheme_as_empty_document :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as an empty document scheme. This means that
-- they are allowed to commit synchronously.
securityManagerRegisterUriSchemeAsEmptyDocument ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsEmptyDocument :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsEmptyDocument securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_empty_document Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsEmptyDocumentMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsEmptyDocumentMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsEmptyDocument

#endif

-- method SecurityManager::register_uri_scheme_as_local
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_local" webkit_security_manager_register_uri_scheme_as_local :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as a local scheme. This means that other non-local pages
-- cannot link to or access URIs of this scheme.
securityManagerRegisterUriSchemeAsLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsLocal :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsLocal securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_local Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsLocalMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsLocalMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsLocal

#endif

-- method SecurityManager::register_uri_scheme_as_no_access
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_no_access" webkit_security_manager_register_uri_scheme_as_no_access :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as a no-access scheme. This means that pages loaded
-- with this URI scheme cannot access pages loaded with any other URI scheme.
securityManagerRegisterUriSchemeAsNoAccess ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsNoAccess :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsNoAccess securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_no_access Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsNoAccessMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsNoAccessMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsNoAccess

#endif

-- method SecurityManager::register_uri_scheme_as_secure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_register_uri_scheme_as_secure" webkit_security_manager_register_uri_scheme_as_secure :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO ()

-- | Register /@scheme@/ as a secure scheme. This means that mixed
-- content warnings won\'t be generated for this scheme when
-- included by an HTTPS page.
securityManagerRegisterUriSchemeAsSecure ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m ()
securityManagerRegisterUriSchemeAsSecure :: a -> Text -> m ()
securityManagerRegisterUriSchemeAsSecure securityManager :: a
securityManager scheme :: Text
scheme = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    Ptr SecurityManager -> CString -> IO ()
webkit_security_manager_register_uri_scheme_as_secure Ptr SecurityManager
securityManager' CString
scheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SecurityManagerRegisterUriSchemeAsSecureMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerRegisterUriSchemeAsSecureMethodInfo a signature where
    overloadedMethod = securityManagerRegisterUriSchemeAsSecure

#endif

-- method SecurityManager::uri_scheme_is_cors_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_cors_enabled" webkit_security_manager_uri_scheme_is_cors_enabled :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as a CORS enabled scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsCorsEnabled'.
securityManagerUriSchemeIsCorsEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is a CORS enabled scheme or 'P.False' otherwise.
securityManagerUriSchemeIsCorsEnabled :: a -> Text -> m Bool
securityManagerUriSchemeIsCorsEnabled securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_cors_enabled Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsCorsEnabledMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsCorsEnabledMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsCorsEnabled

#endif

-- method SecurityManager::uri_scheme_is_display_isolated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_display_isolated" webkit_security_manager_uri_scheme_is_display_isolated :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as a display isolated scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsDisplayIsolated'.
securityManagerUriSchemeIsDisplayIsolated ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is a display isolated scheme or 'P.False' otherwise.
securityManagerUriSchemeIsDisplayIsolated :: a -> Text -> m Bool
securityManagerUriSchemeIsDisplayIsolated securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_display_isolated Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsDisplayIsolatedMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsDisplayIsolatedMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsDisplayIsolated

#endif

-- method SecurityManager::uri_scheme_is_empty_document
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_empty_document" webkit_security_manager_uri_scheme_is_empty_document :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as an empty document scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsEmptyDocument'.
securityManagerUriSchemeIsEmptyDocument ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is an empty document scheme or 'P.False' otherwise.
securityManagerUriSchemeIsEmptyDocument :: a -> Text -> m Bool
securityManagerUriSchemeIsEmptyDocument securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_empty_document Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsEmptyDocumentMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsEmptyDocumentMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsEmptyDocument

#endif

-- method SecurityManager::uri_scheme_is_local
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_local" webkit_security_manager_uri_scheme_is_local :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as a local scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsLocal'.
securityManagerUriSchemeIsLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is a local scheme or 'P.False' otherwise.
securityManagerUriSchemeIsLocal :: a -> Text -> m Bool
securityManagerUriSchemeIsLocal securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_local Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsLocalMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsLocalMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsLocal

#endif

-- method SecurityManager::uri_scheme_is_no_access
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_no_access" webkit_security_manager_uri_scheme_is_no_access :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as a no-access scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsNoAccess'.
securityManagerUriSchemeIsNoAccess ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is a no-access scheme or 'P.False' otherwise.
securityManagerUriSchemeIsNoAccess :: a -> Text -> m Bool
securityManagerUriSchemeIsNoAccess securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_no_access Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsNoAccessMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsNoAccessMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsNoAccess

#endif

-- method SecurityManager::uri_scheme_is_secure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "security_manager"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "SecurityManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitSecurityManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_security_manager_uri_scheme_is_secure" webkit_security_manager_uri_scheme_is_secure :: 
    Ptr SecurityManager ->                  -- security_manager : TInterface (Name {namespace = "WebKit2", name = "SecurityManager"})
    CString ->                              -- scheme : TBasicType TUTF8
    IO CInt

-- | Whether /@scheme@/ is considered as a secure scheme.
-- See also 'GI.WebKit2.Objects.SecurityManager.securityManagerRegisterUriSchemeAsSecure'.
securityManagerUriSchemeIsSecure ::
    (B.CallStack.HasCallStack, MonadIO m, IsSecurityManager a) =>
    a
    -- ^ /@securityManager@/: a t'GI.WebKit2.Objects.SecurityManager.SecurityManager'
    -> T.Text
    -- ^ /@scheme@/: a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@scheme@/ is a secure scheme or 'P.False' otherwise.
securityManagerUriSchemeIsSecure :: a -> Text -> m Bool
securityManagerUriSchemeIsSecure securityManager :: a
securityManager scheme :: Text
scheme = IO Bool -> m Bool
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 SecurityManager
securityManager' <- a -> IO (Ptr SecurityManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
securityManager
    CString
scheme' <- Text -> IO CString
textToCString Text
scheme
    CInt
result <- Ptr SecurityManager -> CString -> IO CInt
webkit_security_manager_uri_scheme_is_secure Ptr SecurityManager
securityManager' CString
scheme'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
securityManager
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
scheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SecurityManagerUriSchemeIsSecureMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsSecurityManager a) => O.MethodInfo SecurityManagerUriSchemeIsSecureMethodInfo a signature where
    overloadedMethod = securityManagerUriSchemeIsSecure

#endif