{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Manages network configuration.
-- 
-- /Since: 2.40/

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

module GI.WebKit.Objects.NetworkSession
    ( 

-- * Exported types
    NetworkSession(..)                      ,
    IsNetworkSession                        ,
    toNetworkSession                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [allowTlsCertificateForHost]("GI.WebKit.Objects.NetworkSession#g:method:allowTlsCertificateForHost"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [downloadUri]("GI.WebKit.Objects.NetworkSession#g:method:downloadUri"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isEphemeral]("GI.WebKit.Objects.NetworkSession#g:method:isEphemeral"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prefetchDns]("GI.WebKit.Objects.NetworkSession#g:method:prefetchDns"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCookieManager]("GI.WebKit.Objects.NetworkSession#g:method:getCookieManager"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getItpEnabled]("GI.WebKit.Objects.NetworkSession#g:method:getItpEnabled"), [getItpSummary]("GI.WebKit.Objects.NetworkSession#g:method:getItpSummary"), [getItpSummaryFinish]("GI.WebKit.Objects.NetworkSession#g:method:getItpSummaryFinish"), [getPersistentCredentialStorageEnabled]("GI.WebKit.Objects.NetworkSession#g:method:getPersistentCredentialStorageEnabled"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTlsErrorsPolicy]("GI.WebKit.Objects.NetworkSession#g:method:getTlsErrorsPolicy"), [getWebsiteDataManager]("GI.WebKit.Objects.NetworkSession#g:method:getWebsiteDataManager").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setItpEnabled]("GI.WebKit.Objects.NetworkSession#g:method:setItpEnabled"), [setPersistentCredentialStorageEnabled]("GI.WebKit.Objects.NetworkSession#g:method:setPersistentCredentialStorageEnabled"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setProxySettings]("GI.WebKit.Objects.NetworkSession#g:method:setProxySettings"), [setTlsErrorsPolicy]("GI.WebKit.Objects.NetworkSession#g:method:setTlsErrorsPolicy").

#if defined(ENABLE_OVERLOADING)
    ResolveNetworkSessionMethod             ,
#endif

-- ** allowTlsCertificateForHost #method:allowTlsCertificateForHost#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionAllowTlsCertificateForHostMethodInfo,
#endif
    networkSessionAllowTlsCertificateForHost,


-- ** downloadUri #method:downloadUri#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionDownloadUriMethodInfo     ,
#endif
    networkSessionDownloadUri               ,


-- ** getCookieManager #method:getCookieManager#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetCookieManagerMethodInfo,
#endif
    networkSessionGetCookieManager          ,


-- ** getDefault #method:getDefault#

    networkSessionGetDefault                ,


-- ** getItpEnabled #method:getItpEnabled#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetItpEnabledMethodInfo   ,
#endif
    networkSessionGetItpEnabled             ,


-- ** getItpSummary #method:getItpSummary#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetItpSummaryMethodInfo   ,
#endif
    networkSessionGetItpSummary             ,


-- ** getItpSummaryFinish #method:getItpSummaryFinish#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetItpSummaryFinishMethodInfo,
#endif
    networkSessionGetItpSummaryFinish       ,


-- ** getPersistentCredentialStorageEnabled #method:getPersistentCredentialStorageEnabled#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetPersistentCredentialStorageEnabledMethodInfo,
#endif
    networkSessionGetPersistentCredentialStorageEnabled,


-- ** getTlsErrorsPolicy #method:getTlsErrorsPolicy#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetTlsErrorsPolicyMethodInfo,
#endif
    networkSessionGetTlsErrorsPolicy        ,


-- ** getWebsiteDataManager #method:getWebsiteDataManager#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionGetWebsiteDataManagerMethodInfo,
#endif
    networkSessionGetWebsiteDataManager     ,


-- ** isEphemeral #method:isEphemeral#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionIsEphemeralMethodInfo     ,
#endif
    networkSessionIsEphemeral               ,


-- ** new #method:new#

    networkSessionNew                       ,


-- ** newEphemeral #method:newEphemeral#

    networkSessionNewEphemeral              ,


-- ** prefetchDns #method:prefetchDns#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionPrefetchDnsMethodInfo     ,
#endif
    networkSessionPrefetchDns               ,


-- ** setItpEnabled #method:setItpEnabled#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionSetItpEnabledMethodInfo   ,
#endif
    networkSessionSetItpEnabled             ,


-- ** setMemoryPressureSettings #method:setMemoryPressureSettings#

    networkSessionSetMemoryPressureSettings ,


-- ** setPersistentCredentialStorageEnabled #method:setPersistentCredentialStorageEnabled#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionSetPersistentCredentialStorageEnabledMethodInfo,
#endif
    networkSessionSetPersistentCredentialStorageEnabled,


-- ** setProxySettings #method:setProxySettings#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionSetProxySettingsMethodInfo,
#endif
    networkSessionSetProxySettings          ,


-- ** setTlsErrorsPolicy #method:setTlsErrorsPolicy#

#if defined(ENABLE_OVERLOADING)
    NetworkSessionSetTlsErrorsPolicyMethodInfo,
#endif
    networkSessionSetTlsErrorsPolicy        ,




 -- * Properties


-- ** cacheDirectory #attr:cacheDirectory#
-- | The base caches directory used to create the t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'. If 'P.Nothing', a default location will be used.
-- 
-- /Since: 2.40/

#if defined(ENABLE_OVERLOADING)
    NetworkSessionCacheDirectoryPropertyInfo,
#endif
    constructNetworkSessionCacheDirectory   ,
#if defined(ENABLE_OVERLOADING)
    networkSessionCacheDirectory            ,
#endif


-- ** dataDirectory #attr:dataDirectory#
-- | The base data directory used to create the t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'. If 'P.Nothing', a default location will be used.
-- 
-- /Since: 2.40/

#if defined(ENABLE_OVERLOADING)
    NetworkSessionDataDirectoryPropertyInfo ,
#endif
    constructNetworkSessionDataDirectory    ,
#if defined(ENABLE_OVERLOADING)
    networkSessionDataDirectory             ,
#endif


-- ** isEphemeral #attr:isEphemeral#
-- | Whether to create an ephermeral t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager' for the session.
-- 
-- /Since: 2.40/

#if defined(ENABLE_OVERLOADING)
    NetworkSessionIsEphemeralPropertyInfo   ,
#endif
    constructNetworkSessionIsEphemeral      ,
    getNetworkSessionIsEphemeral            ,




 -- * Signals


-- ** downloadStarted #signal:downloadStarted#

    NetworkSessionDownloadStartedCallback   ,
#if defined(ENABLE_OVERLOADING)
    NetworkSessionDownloadStartedSignalInfo ,
#endif
    afterNetworkSessionDownloadStarted      ,
    onNetworkSessionDownloadStarted         ,




    ) 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 qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.Action as Gio.Action
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import qualified GI.Gio.Objects.UnixFDList as Gio.UnixFDList
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Objects.FileFilter as Gtk.FileFilter
import qualified GI.Gtk.Objects.PageSetup as Gtk.PageSetup
import qualified GI.Gtk.Objects.PrintSettings as Gtk.PrintSettings
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Gtk.Objects.Window as Gtk.Window
import qualified GI.JavaScriptCore.Objects.Value as JavaScriptCore.Value
import qualified GI.Soup.Structs.Cookie as Soup.Cookie
import qualified GI.Soup.Structs.MessageHeaders as Soup.MessageHeaders
import qualified GI.WebKit.Callbacks as WebKit.Callbacks
import {-# SOURCE #-} qualified GI.WebKit.Enums as WebKit.Enums
import {-# SOURCE #-} qualified GI.WebKit.Flags as WebKit.Flags
import {-# SOURCE #-} qualified GI.WebKit.Interfaces.PermissionRequest as WebKit.PermissionRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.AuthenticationRequest as WebKit.AuthenticationRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.AutomationSession as WebKit.AutomationSession
import {-# SOURCE #-} qualified GI.WebKit.Objects.BackForwardList as WebKit.BackForwardList
import {-# SOURCE #-} qualified GI.WebKit.Objects.BackForwardListItem as WebKit.BackForwardListItem
import {-# SOURCE #-} qualified GI.WebKit.Objects.ColorChooserRequest as WebKit.ColorChooserRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.ContextMenu as WebKit.ContextMenu
import {-# SOURCE #-} qualified GI.WebKit.Objects.ContextMenuItem as WebKit.ContextMenuItem
import {-# SOURCE #-} qualified GI.WebKit.Objects.CookieManager as WebKit.CookieManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.Download as WebKit.Download
import {-# SOURCE #-} qualified GI.WebKit.Objects.EditorState as WebKit.EditorState
import {-# SOURCE #-} qualified GI.WebKit.Objects.FaviconDatabase as WebKit.FaviconDatabase
import {-# SOURCE #-} qualified GI.WebKit.Objects.FileChooserRequest as WebKit.FileChooserRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.FindController as WebKit.FindController
import {-# SOURCE #-} qualified GI.WebKit.Objects.FormSubmissionRequest as WebKit.FormSubmissionRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.GeolocationManager as WebKit.GeolocationManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.HitTestResult as WebKit.HitTestResult
import {-# SOURCE #-} qualified GI.WebKit.Objects.InputMethodContext as WebKit.InputMethodContext
import {-# SOURCE #-} qualified GI.WebKit.Objects.Notification as WebKit.Notification
import {-# SOURCE #-} qualified GI.WebKit.Objects.OptionMenu as WebKit.OptionMenu
import {-# SOURCE #-} qualified GI.WebKit.Objects.PolicyDecision as WebKit.PolicyDecision
import {-# SOURCE #-} qualified GI.WebKit.Objects.PrintOperation as WebKit.PrintOperation
import {-# SOURCE #-} qualified GI.WebKit.Objects.SecurityManager as WebKit.SecurityManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.Settings as WebKit.Settings
import {-# SOURCE #-} qualified GI.WebKit.Objects.URIRequest as WebKit.URIRequest
import {-# SOURCE #-} qualified GI.WebKit.Objects.URIResponse as WebKit.URIResponse
import {-# SOURCE #-} qualified GI.WebKit.Objects.UserContentManager as WebKit.UserContentManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.UserMessage as WebKit.UserMessage
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebContext as WebKit.WebContext
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebInspector as WebKit.WebInspector
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebResource as WebKit.WebResource
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebView as WebKit.WebView
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebViewBase as WebKit.WebViewBase
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebsiteDataManager as WebKit.WebsiteDataManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebsitePolicies as WebKit.WebsitePolicies
import {-# SOURCE #-} qualified GI.WebKit.Objects.WindowProperties as WebKit.WindowProperties
import {-# SOURCE #-} qualified GI.WebKit.Structs.ApplicationInfo as WebKit.ApplicationInfo
import {-# SOURCE #-} qualified GI.WebKit.Structs.Credential as WebKit.Credential
import {-# SOURCE #-} qualified GI.WebKit.Structs.Feature as WebKit.Feature
import {-# SOURCE #-} qualified GI.WebKit.Structs.FeatureList as WebKit.FeatureList
import {-# SOURCE #-} qualified GI.WebKit.Structs.GeolocationPosition as WebKit.GeolocationPosition
import {-# SOURCE #-} qualified GI.WebKit.Structs.ITPFirstParty as WebKit.ITPFirstParty
import {-# SOURCE #-} qualified GI.WebKit.Structs.ITPThirdParty as WebKit.ITPThirdParty
import {-# SOURCE #-} qualified GI.WebKit.Structs.InputMethodUnderline as WebKit.InputMethodUnderline
import {-# SOURCE #-} qualified GI.WebKit.Structs.MemoryPressureSettings as WebKit.MemoryPressureSettings
import {-# SOURCE #-} qualified GI.WebKit.Structs.NavigationAction as WebKit.NavigationAction
import {-# SOURCE #-} qualified GI.WebKit.Structs.NetworkProxySettings as WebKit.NetworkProxySettings
import {-# SOURCE #-} qualified GI.WebKit.Structs.OptionMenuItem as WebKit.OptionMenuItem
import {-# SOURCE #-} qualified GI.WebKit.Structs.PermissionStateQuery as WebKit.PermissionStateQuery
import {-# SOURCE #-} qualified GI.WebKit.Structs.ScriptDialog as WebKit.ScriptDialog
import {-# SOURCE #-} qualified GI.WebKit.Structs.ScriptMessageReply as WebKit.ScriptMessageReply
import {-# SOURCE #-} qualified GI.WebKit.Structs.SecurityOrigin as WebKit.SecurityOrigin
import {-# SOURCE #-} qualified GI.WebKit.Structs.UserContentFilter as WebKit.UserContentFilter
import {-# SOURCE #-} qualified GI.WebKit.Structs.UserScript as WebKit.UserScript
import {-# SOURCE #-} qualified GI.WebKit.Structs.UserStyleSheet as WebKit.UserStyleSheet
import {-# SOURCE #-} qualified GI.WebKit.Structs.WebViewSessionState as WebKit.WebViewSessionState
import {-# SOURCE #-} qualified GI.WebKit.Structs.WebsiteData as WebKit.WebsiteData

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import {-# SOURCE #-} qualified GI.WebKit.Enums as WebKit.Enums
import {-# SOURCE #-} qualified GI.WebKit.Objects.CookieManager as WebKit.CookieManager
import {-# SOURCE #-} qualified GI.WebKit.Objects.Download as WebKit.Download
import {-# SOURCE #-} qualified GI.WebKit.Objects.WebsiteDataManager as WebKit.WebsiteDataManager
import {-# SOURCE #-} qualified GI.WebKit.Structs.ITPThirdParty as WebKit.ITPThirdParty
import {-# SOURCE #-} qualified GI.WebKit.Structs.MemoryPressureSettings as WebKit.MemoryPressureSettings
import {-# SOURCE #-} qualified GI.WebKit.Structs.NetworkProxySettings as WebKit.NetworkProxySettings

#endif

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

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

foreign import ccall "webkit_network_session_get_type"
    c_webkit_network_session_get_type :: IO B.Types.GType

instance B.Types.TypedObject NetworkSession where
    glibType :: IO GType
glibType = IO GType
c_webkit_network_session_get_type

instance B.Types.GObject NetworkSession

-- | Type class for types which can be safely cast to `NetworkSession`, for instance with `toNetworkSession`.
class (SP.GObject o, O.IsDescendantOf NetworkSession o) => IsNetworkSession o
instance (SP.GObject o, O.IsDescendantOf NetworkSession o) => IsNetworkSession o

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

-- | Cast to `NetworkSession`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toNetworkSession :: (MIO.MonadIO m, IsNetworkSession o) => o -> m NetworkSession
toNetworkSession :: forall (m :: * -> *) o.
(MonadIO m, IsNetworkSession o) =>
o -> m NetworkSession
toNetworkSession = IO NetworkSession -> m NetworkSession
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO NetworkSession -> m NetworkSession)
-> (o -> IO NetworkSession) -> o -> m NetworkSession
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr NetworkSession -> NetworkSession)
-> o -> IO NetworkSession
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr NetworkSession -> NetworkSession
NetworkSession

-- | Convert 'NetworkSession' 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 NetworkSession) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_network_session_get_type
    gvalueSet_ :: Ptr GValue -> Maybe NetworkSession -> IO ()
gvalueSet_ Ptr GValue
gv Maybe NetworkSession
P.Nothing = Ptr GValue -> Ptr NetworkSession -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr NetworkSession
forall a. Ptr a
FP.nullPtr :: FP.Ptr NetworkSession)
    gvalueSet_ Ptr GValue
gv (P.Just NetworkSession
obj) = NetworkSession -> (Ptr NetworkSession -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr NetworkSession
obj (Ptr GValue -> Ptr NetworkSession -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe NetworkSession)
gvalueGet_ Ptr GValue
gv = do
        Ptr NetworkSession
ptr <- Ptr GValue -> IO (Ptr NetworkSession)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr NetworkSession)
        if Ptr NetworkSession
ptr Ptr NetworkSession -> Ptr NetworkSession -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr NetworkSession
forall a. Ptr a
FP.nullPtr
        then NetworkSession -> Maybe NetworkSession
forall a. a -> Maybe a
P.Just (NetworkSession -> Maybe NetworkSession)
-> IO NetworkSession -> IO (Maybe NetworkSession)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr NetworkSession -> NetworkSession)
-> Ptr NetworkSession -> IO NetworkSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr NetworkSession -> NetworkSession
NetworkSession Ptr NetworkSession
ptr
        else Maybe NetworkSession -> IO (Maybe NetworkSession)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NetworkSession
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveNetworkSessionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveNetworkSessionMethod "allowTlsCertificateForHost" o = NetworkSessionAllowTlsCertificateForHostMethodInfo
    ResolveNetworkSessionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNetworkSessionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNetworkSessionMethod "downloadUri" o = NetworkSessionDownloadUriMethodInfo
    ResolveNetworkSessionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNetworkSessionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNetworkSessionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNetworkSessionMethod "isEphemeral" o = NetworkSessionIsEphemeralMethodInfo
    ResolveNetworkSessionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNetworkSessionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNetworkSessionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNetworkSessionMethod "prefetchDns" o = NetworkSessionPrefetchDnsMethodInfo
    ResolveNetworkSessionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNetworkSessionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNetworkSessionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNetworkSessionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNetworkSessionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNetworkSessionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNetworkSessionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNetworkSessionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNetworkSessionMethod "getCookieManager" o = NetworkSessionGetCookieManagerMethodInfo
    ResolveNetworkSessionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNetworkSessionMethod "getItpEnabled" o = NetworkSessionGetItpEnabledMethodInfo
    ResolveNetworkSessionMethod "getItpSummary" o = NetworkSessionGetItpSummaryMethodInfo
    ResolveNetworkSessionMethod "getItpSummaryFinish" o = NetworkSessionGetItpSummaryFinishMethodInfo
    ResolveNetworkSessionMethod "getPersistentCredentialStorageEnabled" o = NetworkSessionGetPersistentCredentialStorageEnabledMethodInfo
    ResolveNetworkSessionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNetworkSessionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNetworkSessionMethod "getTlsErrorsPolicy" o = NetworkSessionGetTlsErrorsPolicyMethodInfo
    ResolveNetworkSessionMethod "getWebsiteDataManager" o = NetworkSessionGetWebsiteDataManagerMethodInfo
    ResolveNetworkSessionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNetworkSessionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNetworkSessionMethod "setItpEnabled" o = NetworkSessionSetItpEnabledMethodInfo
    ResolveNetworkSessionMethod "setPersistentCredentialStorageEnabled" o = NetworkSessionSetPersistentCredentialStorageEnabledMethodInfo
    ResolveNetworkSessionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNetworkSessionMethod "setProxySettings" o = NetworkSessionSetProxySettingsMethodInfo
    ResolveNetworkSessionMethod "setTlsErrorsPolicy" o = NetworkSessionSetTlsErrorsPolicyMethodInfo
    ResolveNetworkSessionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal NetworkSession::download-started
-- | This signal is emitted when a new download request is made.
-- 
-- /Since: 2.40/
type NetworkSessionDownloadStartedCallback =
    WebKit.Download.Download
    -- ^ /@download@/: the t'GI.WebKit.Objects.Download.Download' associated with this event
    -> IO ()

type C_NetworkSessionDownloadStartedCallback =
    Ptr NetworkSession ->                   -- object
    Ptr WebKit.Download.Download ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_NetworkSessionDownloadStartedCallback`.
foreign import ccall "wrapper"
    mk_NetworkSessionDownloadStartedCallback :: C_NetworkSessionDownloadStartedCallback -> IO (FunPtr C_NetworkSessionDownloadStartedCallback)

wrap_NetworkSessionDownloadStartedCallback :: 
    GObject a => (a -> NetworkSessionDownloadStartedCallback) ->
    C_NetworkSessionDownloadStartedCallback
wrap_NetworkSessionDownloadStartedCallback :: forall a.
GObject a =>
(a -> NetworkSessionDownloadStartedCallback)
-> C_NetworkSessionDownloadStartedCallback
wrap_NetworkSessionDownloadStartedCallback a -> NetworkSessionDownloadStartedCallback
gi'cb Ptr NetworkSession
gi'selfPtr Ptr Download
download Ptr ()
_ = do
    Download
download' <- ((ManagedPtr Download -> Download) -> Ptr Download -> IO Download
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Download -> Download
WebKit.Download.Download) Ptr Download
download
    Ptr NetworkSession -> (NetworkSession -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr NetworkSession
gi'selfPtr ((NetworkSession -> IO ()) -> IO ())
-> (NetworkSession -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NetworkSession
gi'self -> a -> NetworkSessionDownloadStartedCallback
gi'cb (NetworkSession -> a
forall a b. Coercible a b => a -> b
Coerce.coerce NetworkSession
gi'self)  Download
download'


-- | Connect a signal handler for the [downloadStarted](#signal:downloadStarted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' networkSession #downloadStarted callback
-- @
-- 
-- 
onNetworkSessionDownloadStarted :: (IsNetworkSession a, MonadIO m) => a -> ((?self :: a) => NetworkSessionDownloadStartedCallback) -> m SignalHandlerId
onNetworkSessionDownloadStarted :: forall a (m :: * -> *).
(IsNetworkSession a, MonadIO m) =>
a
-> ((?self::a) => NetworkSessionDownloadStartedCallback)
-> m SignalHandlerId
onNetworkSessionDownloadStarted a
obj (?self::a) => NetworkSessionDownloadStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> NetworkSessionDownloadStartedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => NetworkSessionDownloadStartedCallback
NetworkSessionDownloadStartedCallback
cb
    let wrapped' :: C_NetworkSessionDownloadStartedCallback
wrapped' = (a -> NetworkSessionDownloadStartedCallback)
-> C_NetworkSessionDownloadStartedCallback
forall a.
GObject a =>
(a -> NetworkSessionDownloadStartedCallback)
-> C_NetworkSessionDownloadStartedCallback
wrap_NetworkSessionDownloadStartedCallback a -> NetworkSessionDownloadStartedCallback
wrapped
    FunPtr C_NetworkSessionDownloadStartedCallback
wrapped'' <- C_NetworkSessionDownloadStartedCallback
-> IO (FunPtr C_NetworkSessionDownloadStartedCallback)
mk_NetworkSessionDownloadStartedCallback C_NetworkSessionDownloadStartedCallback
wrapped'
    a
-> Text
-> FunPtr C_NetworkSessionDownloadStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"download-started" FunPtr C_NetworkSessionDownloadStartedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [downloadStarted](#signal:downloadStarted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' networkSession #downloadStarted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterNetworkSessionDownloadStarted :: (IsNetworkSession a, MonadIO m) => a -> ((?self :: a) => NetworkSessionDownloadStartedCallback) -> m SignalHandlerId
afterNetworkSessionDownloadStarted :: forall a (m :: * -> *).
(IsNetworkSession a, MonadIO m) =>
a
-> ((?self::a) => NetworkSessionDownloadStartedCallback)
-> m SignalHandlerId
afterNetworkSessionDownloadStarted a
obj (?self::a) => NetworkSessionDownloadStartedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> NetworkSessionDownloadStartedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => NetworkSessionDownloadStartedCallback
NetworkSessionDownloadStartedCallback
cb
    let wrapped' :: C_NetworkSessionDownloadStartedCallback
wrapped' = (a -> NetworkSessionDownloadStartedCallback)
-> C_NetworkSessionDownloadStartedCallback
forall a.
GObject a =>
(a -> NetworkSessionDownloadStartedCallback)
-> C_NetworkSessionDownloadStartedCallback
wrap_NetworkSessionDownloadStartedCallback a -> NetworkSessionDownloadStartedCallback
wrapped
    FunPtr C_NetworkSessionDownloadStartedCallback
wrapped'' <- C_NetworkSessionDownloadStartedCallback
-> IO (FunPtr C_NetworkSessionDownloadStartedCallback)
mk_NetworkSessionDownloadStartedCallback C_NetworkSessionDownloadStartedCallback
wrapped'
    a
-> Text
-> FunPtr C_NetworkSessionDownloadStartedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"download-started" FunPtr C_NetworkSessionDownloadStartedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data NetworkSessionDownloadStartedSignalInfo
instance SignalInfo NetworkSessionDownloadStartedSignalInfo where
    type HaskellCallbackType NetworkSessionDownloadStartedSignalInfo = NetworkSessionDownloadStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_NetworkSessionDownloadStartedCallback cb
        cb'' <- mk_NetworkSessionDownloadStartedCallback cb'
        connectSignalFunPtr obj "download-started" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession::download-started"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#g:signal:downloadStarted"})

#endif

-- VVV Prop "cache-directory"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@cache-directory@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkSessionCacheDirectory :: (IsNetworkSession o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkSessionCacheDirectory :: forall o (m :: * -> *).
(IsNetworkSession o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkSessionCacheDirectory Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"cache-directory" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkSessionCacheDirectoryPropertyInfo
instance AttrInfo NetworkSessionCacheDirectoryPropertyInfo where
    type AttrAllowedOps NetworkSessionCacheDirectoryPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint NetworkSessionCacheDirectoryPropertyInfo = IsNetworkSession
    type AttrSetTypeConstraint NetworkSessionCacheDirectoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkSessionCacheDirectoryPropertyInfo = (~) T.Text
    type AttrTransferType NetworkSessionCacheDirectoryPropertyInfo = T.Text
    type AttrGetType NetworkSessionCacheDirectoryPropertyInfo = ()
    type AttrLabel NetworkSessionCacheDirectoryPropertyInfo = "cache-directory"
    type AttrOrigin NetworkSessionCacheDirectoryPropertyInfo = NetworkSession
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkSessionCacheDirectory
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.cacheDirectory"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#g:attr:cacheDirectory"
        })
#endif

-- VVV Prop "data-directory"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@data-directory@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkSessionDataDirectory :: (IsNetworkSession o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNetworkSessionDataDirectory :: forall o (m :: * -> *).
(IsNetworkSession o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNetworkSessionDataDirectory Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"data-directory" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data NetworkSessionDataDirectoryPropertyInfo
instance AttrInfo NetworkSessionDataDirectoryPropertyInfo where
    type AttrAllowedOps NetworkSessionDataDirectoryPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint NetworkSessionDataDirectoryPropertyInfo = IsNetworkSession
    type AttrSetTypeConstraint NetworkSessionDataDirectoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NetworkSessionDataDirectoryPropertyInfo = (~) T.Text
    type AttrTransferType NetworkSessionDataDirectoryPropertyInfo = T.Text
    type AttrGetType NetworkSessionDataDirectoryPropertyInfo = ()
    type AttrLabel NetworkSessionDataDirectoryPropertyInfo = "data-directory"
    type AttrOrigin NetworkSessionDataDirectoryPropertyInfo = NetworkSession
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkSessionDataDirectory
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.dataDirectory"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#g:attr:dataDirectory"
        })
#endif

-- VVV Prop "is-ephemeral"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@is-ephemeral@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' networkSession #isEphemeral
-- @
getNetworkSessionIsEphemeral :: (MonadIO m, IsNetworkSession o) => o -> m Bool
getNetworkSessionIsEphemeral :: forall (m :: * -> *) o.
(MonadIO m, IsNetworkSession o) =>
o -> m Bool
getNetworkSessionIsEphemeral o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-ephemeral"

-- | Construct a `GValueConstruct` with valid value for the “@is-ephemeral@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructNetworkSessionIsEphemeral :: (IsNetworkSession o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructNetworkSessionIsEphemeral :: forall o (m :: * -> *).
(IsNetworkSession o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructNetworkSessionIsEphemeral Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-ephemeral" Bool
val

#if defined(ENABLE_OVERLOADING)
data NetworkSessionIsEphemeralPropertyInfo
instance AttrInfo NetworkSessionIsEphemeralPropertyInfo where
    type AttrAllowedOps NetworkSessionIsEphemeralPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NetworkSessionIsEphemeralPropertyInfo = IsNetworkSession
    type AttrSetTypeConstraint NetworkSessionIsEphemeralPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint NetworkSessionIsEphemeralPropertyInfo = (~) Bool
    type AttrTransferType NetworkSessionIsEphemeralPropertyInfo = Bool
    type AttrGetType NetworkSessionIsEphemeralPropertyInfo = Bool
    type AttrLabel NetworkSessionIsEphemeralPropertyInfo = "is-ephemeral"
    type AttrOrigin NetworkSessionIsEphemeralPropertyInfo = NetworkSession
    attrGet = getNetworkSessionIsEphemeral
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructNetworkSessionIsEphemeral
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.isEphemeral"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#g:attr:isEphemeral"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList NetworkSession
type instance O.AttributeList NetworkSession = NetworkSessionAttributeList
type NetworkSessionAttributeList = ('[ '("cacheDirectory", NetworkSessionCacheDirectoryPropertyInfo), '("dataDirectory", NetworkSessionDataDirectoryPropertyInfo), '("isEphemeral", NetworkSessionIsEphemeralPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
networkSessionCacheDirectory :: AttrLabelProxy "cacheDirectory"
networkSessionCacheDirectory = AttrLabelProxy

networkSessionDataDirectory :: AttrLabelProxy "dataDirectory"
networkSessionDataDirectory = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList NetworkSession = NetworkSessionSignalList
type NetworkSessionSignalList = ('[ '("downloadStarted", NetworkSessionDownloadStartedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method NetworkSession::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data_directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a base directory for data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cache_directory"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a base directory for caches, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "NetworkSession" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_new" webkit_network_session_new :: 
    CString ->                              -- data_directory : TBasicType TUTF8
    CString ->                              -- cache_directory : TBasicType TUTF8
    IO (Ptr NetworkSession)

-- | Creates a new t'GI.WebKit.Objects.NetworkSession.NetworkSession' with a persistent t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'.
-- The parameters /@dataDirectory@/ and /@cacheDirectory@/ will be used as construct
-- properties of the t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager' of the network session. Note that if
-- 'P.Nothing' is passed, the default directory will be passed to t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'
-- so that 'GI.WebKit.Objects.WebsiteDataManager.websiteDataManagerGetBaseDataDirectory' and
-- 'GI.WebKit.Objects.WebsiteDataManager.websiteDataManagerGetBaseCacheDirectory' always return a value for
-- non ephemeral sessions.
-- 
-- It must be passed as construct parameter of a t'GI.WebKit.Objects.WebView.WebView'.
-- 
-- /Since: 2.40/
networkSessionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@dataDirectory@/: a base directory for data, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@cacheDirectory@/: a base directory for caches, or 'P.Nothing'
    -> m NetworkSession
    -- ^ __Returns:__ the newly created t'GI.WebKit.Objects.NetworkSession.NetworkSession'
networkSessionNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> m NetworkSession
networkSessionNew Maybe Text
dataDirectory Maybe Text
cacheDirectory = IO NetworkSession -> m NetworkSession
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NetworkSession -> m NetworkSession)
-> IO NetworkSession -> m NetworkSession
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeDataDirectory <- case Maybe Text
dataDirectory of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDataDirectory -> do
            Ptr CChar
jDataDirectory' <- Text -> IO (Ptr CChar)
textToCString Text
jDataDirectory
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDataDirectory'
    Ptr CChar
maybeCacheDirectory <- case Maybe Text
cacheDirectory of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jCacheDirectory -> do
            Ptr CChar
jCacheDirectory' <- Text -> IO (Ptr CChar)
textToCString Text
jCacheDirectory
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jCacheDirectory'
    Ptr NetworkSession
result <- Ptr CChar -> Ptr CChar -> IO (Ptr NetworkSession)
webkit_network_session_new Ptr CChar
maybeDataDirectory Ptr CChar
maybeCacheDirectory
    Text -> Ptr NetworkSession -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionNew" Ptr NetworkSession
result
    NetworkSession
result' <- ((ManagedPtr NetworkSession -> NetworkSession)
-> Ptr NetworkSession -> IO NetworkSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr NetworkSession -> NetworkSession
NetworkSession) Ptr NetworkSession
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDataDirectory
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeCacheDirectory
    NetworkSession -> IO NetworkSession
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkSession
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NetworkSession::new_ephemeral
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "NetworkSession" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_new_ephemeral" webkit_network_session_new_ephemeral :: 
    IO (Ptr NetworkSession)

-- | Creates a new t'GI.WebKit.Objects.NetworkSession.NetworkSession' with an ephemeral t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'.
-- 
-- /Since: 2.40/
networkSessionNewEphemeral ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m NetworkSession
    -- ^ __Returns:__ a new ephemeral t'GI.WebKit.Objects.NetworkSession.NetworkSession'.
networkSessionNewEphemeral :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m NetworkSession
networkSessionNewEphemeral  = IO NetworkSession -> m NetworkSession
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NetworkSession -> m NetworkSession)
-> IO NetworkSession -> m NetworkSession
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
result <- IO (Ptr NetworkSession)
webkit_network_session_new_ephemeral
    Text -> Ptr NetworkSession -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionNewEphemeral" Ptr NetworkSession
result
    NetworkSession
result' <- ((ManagedPtr NetworkSession -> NetworkSession)
-> Ptr NetworkSession -> IO NetworkSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr NetworkSession -> NetworkSession
NetworkSession) Ptr NetworkSession
result
    NetworkSession -> IO NetworkSession
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkSession
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NetworkSession::allow_tls_certificate_for_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the host for which a certificate is to be allowed"
--                 , 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 "webkit_network_session_allow_tls_certificate_for_host" webkit_network_session_allow_tls_certificate_for_host :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    CString ->                              -- host : TBasicType TUTF8
    IO ()

-- | Ignore further TLS errors on the /@host@/ for the certificate present in /@info@/.
-- 
-- If /@host@/ is an IPv6 address, it should not be surrounded by brackets. This
-- expectation matches 'GI.GLib.Structs.Uri.uriGetHost'.
-- 
-- /Since: 2.40/
networkSessionAllowTlsCertificateForHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a, Gio.TlsCertificate.IsTlsCertificate b) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> b
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> T.Text
    -- ^ /@host@/: the host for which a certificate is to be allowed
    -> m ()
networkSessionAllowTlsCertificateForHost :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNetworkSession a,
 IsTlsCertificate b) =>
a -> b -> Text -> m ()
networkSessionAllowTlsCertificateForHost a
session b
certificate Text
host = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    Ptr CChar
host' <- Text -> IO (Ptr CChar)
textToCString Text
host
    Ptr NetworkSession -> Ptr TlsCertificate -> Ptr CChar -> IO ()
webkit_network_session_allow_tls_certificate_for_host Ptr NetworkSession
session' Ptr TlsCertificate
certificate' Ptr CChar
host'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
host'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionAllowTlsCertificateForHostMethodInfo
instance (signature ~ (b -> T.Text -> m ()), MonadIO m, IsNetworkSession a, Gio.TlsCertificate.IsTlsCertificate b) => O.OverloadedMethod NetworkSessionAllowTlsCertificateForHostMethodInfo a signature where
    overloadedMethod = networkSessionAllowTlsCertificateForHost

instance O.OverloadedMethodInfo NetworkSessionAllowTlsCertificateForHostMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionAllowTlsCertificateForHost",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionAllowTlsCertificateForHost"
        })


#endif

-- method NetworkSession::download_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI to download"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "WebKit" , name = "Download" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_download_uri" webkit_network_session_download_uri :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr WebKit.Download.Download)

-- | Requests downloading of the specified URI string.
-- 
-- The download operation will not be associated to any t'GI.WebKit.Objects.WebView.WebView',
-- if you are interested in starting a download from a particular t'GI.WebKit.Objects.WebView.WebView' use
-- 'GI.WebKit.Objects.WebView.webViewDownloadUri' instead.
-- 
-- /Since: 2.40/
networkSessionDownloadUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> T.Text
    -- ^ /@uri@/: the URI to download
    -> m WebKit.Download.Download
    -- ^ __Returns:__ a new t'GI.WebKit.Objects.Download.Download' representing
    --    the download operation.
networkSessionDownloadUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> Text -> m Download
networkSessionDownloadUri a
session Text
uri = IO Download -> m Download
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Download -> m Download) -> IO Download -> m Download
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr Download
result <- Ptr NetworkSession -> Ptr CChar -> IO (Ptr Download)
webkit_network_session_download_uri Ptr NetworkSession
session' Ptr CChar
uri'
    Text -> Ptr Download -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionDownloadUri" Ptr Download
result
    Download
result' <- ((ManagedPtr Download -> Download) -> Ptr Download -> IO Download
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Download -> Download
WebKit.Download.Download) Ptr Download
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
    Download -> IO Download
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Download
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionDownloadUriMethodInfo
instance (signature ~ (T.Text -> m WebKit.Download.Download), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionDownloadUriMethodInfo a signature where
    overloadedMethod = networkSessionDownloadUri

instance O.OverloadedMethodInfo NetworkSessionDownloadUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionDownloadUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionDownloadUri"
        })


#endif

-- method NetworkSession::get_cookie_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit" , name = "CookieManager" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_get_cookie_manager" webkit_network_session_get_cookie_manager :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO (Ptr WebKit.CookieManager.CookieManager)

-- | Get the t'GI.WebKit.Objects.CookieManager.CookieManager' of /@session@/.
-- 
-- /Since: 2.40/
networkSessionGetCookieManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m WebKit.CookieManager.CookieManager
    -- ^ __Returns:__ a t'GI.WebKit.Objects.CookieManager.CookieManager'
networkSessionGetCookieManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m CookieManager
networkSessionGetCookieManager a
session = IO CookieManager -> m CookieManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CookieManager -> m CookieManager)
-> IO CookieManager -> m CookieManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr CookieManager
result <- Ptr NetworkSession -> IO (Ptr CookieManager)
webkit_network_session_get_cookie_manager Ptr NetworkSession
session'
    Text -> Ptr CookieManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionGetCookieManager" Ptr CookieManager
result
    CookieManager
result' <- ((ManagedPtr CookieManager -> CookieManager)
-> Ptr CookieManager -> IO CookieManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr CookieManager -> CookieManager
WebKit.CookieManager.CookieManager) Ptr CookieManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    CookieManager -> IO CookieManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CookieManager
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetCookieManagerMethodInfo
instance (signature ~ (m WebKit.CookieManager.CookieManager), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionGetCookieManagerMethodInfo a signature where
    overloadedMethod = networkSessionGetCookieManager

instance O.OverloadedMethodInfo NetworkSessionGetCookieManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetCookieManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetCookieManager"
        })


#endif

-- method NetworkSession::get_itp_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , 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 "webkit_network_session_get_itp_enabled" webkit_network_session_get_itp_enabled :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO CInt

-- | Get whether Intelligent Tracking Prevention (ITP) is enabled or not.
-- 
-- /Since: 2.40/
networkSessionGetItpEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if ITP is enabled, or 'P.False' otherwise.
networkSessionGetItpEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m Bool
networkSessionGetItpEnabled a
session = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CInt
result <- Ptr NetworkSession -> IO CInt
webkit_network_session_get_itp_enabled Ptr NetworkSession
session'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetItpEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionGetItpEnabledMethodInfo a signature where
    overloadedMethod = networkSessionGetItpEnabled

instance O.OverloadedMethodInfo NetworkSessionGetItpEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetItpEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetItpEnabled"
        })


#endif

-- method NetworkSession::get_itp_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , 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 "webkit_network_session_get_itp_summary" webkit_network_session_get_itp_summary :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously get the list of t'GI.WebKit.Structs.ITPThirdParty.ITPThirdParty' seen for /@session@/.
-- 
-- Every t'GI.WebKit.Structs.ITPThirdParty.ITPThirdParty'
-- contains the list of t'GI.WebKit.Structs.ITPFirstParty.ITPFirstParty' under which it has been seen.
-- 
-- When the operation is finished, /@callback@/ will be called. You can then call
-- 'GI.WebKit.Objects.NetworkSession.networkSessionGetItpSummaryFinish' to get the result of the operation.
-- 
-- /Since: 2.40/
networkSessionGetItpSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
networkSessionGetItpSummary :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNetworkSession a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
networkSessionGetItpSummary a
session Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr NetworkSession
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
webkit_network_session_get_itp_summary Ptr NetworkSession
session' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetItpSummaryMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsNetworkSession a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod NetworkSessionGetItpSummaryMethodInfo a signature where
    overloadedMethod = networkSessionGetItpSummary

instance O.OverloadedMethodInfo NetworkSessionGetItpSummaryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetItpSummary",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetItpSummary"
        })


#endif

-- method NetworkSession::get_itp_summary_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "WebKit" , name = "ITPThirdParty" }))
-- throws : True
-- Skip return : False

foreign import ccall "webkit_network_session_get_itp_summary_finish" webkit_network_session_get_itp_summary_finish :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr WebKit.ITPThirdParty.ITPThirdParty)))

-- | Finish an asynchronous operation started with 'GI.WebKit.Objects.NetworkSession.networkSessionGetItpSummary'.
-- 
-- /Since: 2.40/
networkSessionGetItpSummaryFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m [WebKit.ITPThirdParty.ITPThirdParty]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.WebKit.Structs.ITPThirdParty.ITPThirdParty'.
    --    You must free the t'GI.GLib.Structs.List.List' with @/g_list_free()/@ and unref the t'GI.WebKit.Structs.ITPThirdParty.ITPThirdParty's with
    --    'GI.WebKit.Structs.ITPThirdParty.iTPThirdPartyUnref' when you\'re done with them. /(Can throw 'Data.GI.Base.GError.GError')/
networkSessionGetItpSummaryFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNetworkSession a, IsAsyncResult b) =>
a -> b -> m [ITPThirdParty]
networkSessionGetItpSummaryFinish a
session b
result_ = IO [ITPThirdParty] -> m [ITPThirdParty]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ITPThirdParty] -> m [ITPThirdParty])
-> IO [ITPThirdParty] -> m [ITPThirdParty]
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [ITPThirdParty] -> IO () -> IO [ITPThirdParty]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr ITPThirdParty))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr ITPThirdParty))))
-> IO (Ptr (GList (Ptr ITPThirdParty)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr ITPThirdParty))))
 -> IO (Ptr (GList (Ptr ITPThirdParty))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr ITPThirdParty))))
-> IO (Ptr (GList (Ptr ITPThirdParty)))
forall a b. (a -> b) -> a -> b
$ Ptr NetworkSession
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr ITPThirdParty)))
webkit_network_session_get_itp_summary_finish Ptr NetworkSession
session' Ptr AsyncResult
result_'
        [Ptr ITPThirdParty]
result' <- Ptr (GList (Ptr ITPThirdParty)) -> IO [Ptr ITPThirdParty]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ITPThirdParty))
result
        [ITPThirdParty]
result'' <- (Ptr ITPThirdParty -> IO ITPThirdParty)
-> [Ptr ITPThirdParty] -> IO [ITPThirdParty]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ITPThirdParty -> ITPThirdParty)
-> Ptr ITPThirdParty -> IO ITPThirdParty
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ITPThirdParty -> ITPThirdParty
WebKit.ITPThirdParty.ITPThirdParty) [Ptr ITPThirdParty]
result'
        Ptr (GList (Ptr ITPThirdParty)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr ITPThirdParty))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [ITPThirdParty] -> IO [ITPThirdParty]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ITPThirdParty]
result''
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetItpSummaryFinishMethodInfo
instance (signature ~ (b -> m [WebKit.ITPThirdParty.ITPThirdParty]), MonadIO m, IsNetworkSession a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod NetworkSessionGetItpSummaryFinishMethodInfo a signature where
    overloadedMethod = networkSessionGetItpSummaryFinish

instance O.OverloadedMethodInfo NetworkSessionGetItpSummaryFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetItpSummaryFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetItpSummaryFinish"
        })


#endif

-- method NetworkSession::get_persistent_credential_storage_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , 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 "webkit_network_session_get_persistent_credential_storage_enabled" webkit_network_session_get_persistent_credential_storage_enabled :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO CInt

-- | Get whether persistent credential storage is enabled or not.
-- 
-- See also 'GI.WebKit.Objects.NetworkSession.networkSessionSetPersistentCredentialStorageEnabled'.
-- 
-- /Since: 2.40/
networkSessionGetPersistentCredentialStorageEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if persistent credential storage is enabled, or 'P.False' otherwise.
networkSessionGetPersistentCredentialStorageEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m Bool
networkSessionGetPersistentCredentialStorageEnabled a
session = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CInt
result <- Ptr NetworkSession -> IO CInt
webkit_network_session_get_persistent_credential_storage_enabled Ptr NetworkSession
session'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetPersistentCredentialStorageEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionGetPersistentCredentialStorageEnabledMethodInfo a signature where
    overloadedMethod = networkSessionGetPersistentCredentialStorageEnabled

instance O.OverloadedMethodInfo NetworkSessionGetPersistentCredentialStorageEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetPersistentCredentialStorageEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetPersistentCredentialStorageEnabled"
        })


#endif

-- method NetworkSession::get_tls_errors_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "TLSErrorsPolicy" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_get_tls_errors_policy" webkit_network_session_get_tls_errors_policy :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO CUInt

-- | Get the TLS errors policy of /@session@/.
-- 
-- /Since: 2.40/
networkSessionGetTlsErrorsPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m WebKit.Enums.TLSErrorsPolicy
    -- ^ __Returns:__ a t'GI.WebKit.Enums.TLSErrorsPolicy'
networkSessionGetTlsErrorsPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m TLSErrorsPolicy
networkSessionGetTlsErrorsPolicy a
session = IO TLSErrorsPolicy -> m TLSErrorsPolicy
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TLSErrorsPolicy -> m TLSErrorsPolicy)
-> IO TLSErrorsPolicy -> m TLSErrorsPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CUInt
result <- Ptr NetworkSession -> IO CUInt
webkit_network_session_get_tls_errors_policy Ptr NetworkSession
session'
    let result' :: TLSErrorsPolicy
result' = (Int -> TLSErrorsPolicy
forall a. Enum a => Int -> a
toEnum (Int -> TLSErrorsPolicy)
-> (CUInt -> Int) -> CUInt -> TLSErrorsPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    TLSErrorsPolicy -> IO TLSErrorsPolicy
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TLSErrorsPolicy
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetTlsErrorsPolicyMethodInfo
instance (signature ~ (m WebKit.Enums.TLSErrorsPolicy), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionGetTlsErrorsPolicyMethodInfo a signature where
    overloadedMethod = networkSessionGetTlsErrorsPolicy

instance O.OverloadedMethodInfo NetworkSessionGetTlsErrorsPolicyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetTlsErrorsPolicy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetTlsErrorsPolicy"
        })


#endif

-- method NetworkSession::get_website_data_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "WebsiteDataManager" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_get_website_data_manager" webkit_network_session_get_website_data_manager :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO (Ptr WebKit.WebsiteDataManager.WebsiteDataManager)

-- | Get the t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager' of /@session@/.
-- 
-- /Since: 2.40/
networkSessionGetWebsiteDataManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m WebKit.WebsiteDataManager.WebsiteDataManager
    -- ^ __Returns:__ a t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager'
networkSessionGetWebsiteDataManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m WebsiteDataManager
networkSessionGetWebsiteDataManager a
session = IO WebsiteDataManager -> m WebsiteDataManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebsiteDataManager -> m WebsiteDataManager)
-> IO WebsiteDataManager -> m WebsiteDataManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr WebsiteDataManager
result <- Ptr NetworkSession -> IO (Ptr WebsiteDataManager)
webkit_network_session_get_website_data_manager Ptr NetworkSession
session'
    Text -> Ptr WebsiteDataManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionGetWebsiteDataManager" Ptr WebsiteDataManager
result
    WebsiteDataManager
result' <- ((ManagedPtr WebsiteDataManager -> WebsiteDataManager)
-> Ptr WebsiteDataManager -> IO WebsiteDataManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebsiteDataManager -> WebsiteDataManager
WebKit.WebsiteDataManager.WebsiteDataManager) Ptr WebsiteDataManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    WebsiteDataManager -> IO WebsiteDataManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebsiteDataManager
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionGetWebsiteDataManagerMethodInfo
instance (signature ~ (m WebKit.WebsiteDataManager.WebsiteDataManager), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionGetWebsiteDataManagerMethodInfo a signature where
    overloadedMethod = networkSessionGetWebsiteDataManager

instance O.OverloadedMethodInfo NetworkSessionGetWebsiteDataManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionGetWebsiteDataManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionGetWebsiteDataManager"
        })


#endif

-- method NetworkSession::is_ephemeral
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , 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 "webkit_network_session_is_ephemeral" webkit_network_session_is_ephemeral :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    IO CInt

-- | Get whether /@session@/ is ephemeral.
-- A t'GI.WebKit.Objects.NetworkSession.NetworkSession' is ephemeral when its t'GI.WebKit.Objects.WebsiteDataManager.WebsiteDataManager' is ephemeral.
-- See [WebsiteDataManager:isEphemeral]("GI.WebKit.Objects.WebsiteDataManager#g:attr:isEphemeral") for more details.
-- 
-- /Since: 2.40/
networkSessionIsEphemeral ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@session@/ is pehmeral, or 'P.False' otherwise
networkSessionIsEphemeral :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> m Bool
networkSessionIsEphemeral a
session = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    CInt
result <- Ptr NetworkSession -> IO CInt
webkit_network_session_is_ephemeral Ptr NetworkSession
session'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NetworkSessionIsEphemeralMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionIsEphemeralMethodInfo a signature where
    overloadedMethod = networkSessionIsEphemeral

instance O.OverloadedMethodInfo NetworkSessionIsEphemeralMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionIsEphemeral",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionIsEphemeral"
        })


#endif

-- method NetworkSession::prefetch_dns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hostname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a hostname to be resolved"
--                 , 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 "webkit_network_session_prefetch_dns" webkit_network_session_prefetch_dns :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CString ->                              -- hostname : TBasicType TUTF8
    IO ()

-- | Resolve the domain name of the given /@hostname@/ in advance, so that if a URI
-- of /@hostname@/ is requested the load will be performed more quickly.
-- 
-- /Since: 2.40/
networkSessionPrefetchDns ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> T.Text
    -- ^ /@hostname@/: a hostname to be resolved
    -> m ()
networkSessionPrefetchDns :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> Text -> m ()
networkSessionPrefetchDns a
session Text
hostname = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    Ptr CChar
hostname' <- Text -> IO (Ptr CChar)
textToCString Text
hostname
    Ptr NetworkSession -> Ptr CChar -> IO ()
webkit_network_session_prefetch_dns Ptr NetworkSession
session' Ptr CChar
hostname'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
hostname'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionPrefetchDnsMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionPrefetchDnsMethodInfo a signature where
    overloadedMethod = networkSessionPrefetchDns

instance O.OverloadedMethodInfo NetworkSessionPrefetchDnsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionPrefetchDns",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionPrefetchDns"
        })


#endif

-- method NetworkSession::set_itp_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , 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 "webkit_network_session_set_itp_enabled" webkit_network_session_set_itp_enabled :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enable or disable Intelligent Tracking Prevention (ITP).
-- 
-- When ITP is enabled resource load statistics
-- are collected and used to decide whether to allow or block third-party cookies and prevent user tracking.
-- Note that while ITP is enabled the accept policy 'GI.WebKit.Enums.CookieAcceptPolicyNoThirdParty' is ignored and
-- 'GI.WebKit.Enums.CookieAcceptPolicyAlways' is used instead. See also @/webkit_cookie_session_set_accept_policy()/@.
-- 
-- /Since: 2.40/
networkSessionSetItpEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> Bool
    -- ^ /@enabled@/: value to set
    -> m ()
networkSessionSetItpEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> Bool -> m ()
networkSessionSetItpEnabled a
session Bool
enabled = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr NetworkSession -> CInt -> IO ()
webkit_network_session_set_itp_enabled Ptr NetworkSession
session' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionSetItpEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionSetItpEnabledMethodInfo a signature where
    overloadedMethod = networkSessionSetItpEnabled

instance O.OverloadedMethodInfo NetworkSessionSetItpEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionSetItpEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionSetItpEnabled"
        })


#endif

-- method NetworkSession::set_persistent_credential_storage_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , 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 "webkit_network_session_set_persistent_credential_storage_enabled" webkit_network_session_set_persistent_credential_storage_enabled :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Enable or disable persistent credential storage.
-- 
-- When enabled, which is the default for
-- non-ephemeral sessions, the network process will try to read and write HTTP authentiacation
-- credentials from persistent storage.
-- 
-- /Since: 2.40/
networkSessionSetPersistentCredentialStorageEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> Bool
    -- ^ /@enabled@/: value to set
    -> m ()
networkSessionSetPersistentCredentialStorageEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> Bool -> m ()
networkSessionSetPersistentCredentialStorageEnabled a
session Bool
enabled = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr NetworkSession -> CInt -> IO ()
webkit_network_session_set_persistent_credential_storage_enabled Ptr NetworkSession
session' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionSetPersistentCredentialStorageEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionSetPersistentCredentialStorageEnabledMethodInfo a signature where
    overloadedMethod = networkSessionSetPersistentCredentialStorageEnabled

instance O.OverloadedMethodInfo NetworkSessionSetPersistentCredentialStorageEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionSetPersistentCredentialStorageEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionSetPersistentCredentialStorageEnabled"
        })


#endif

-- method NetworkSession::set_proxy_settings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_mode"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "NetworkProxyMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkProxyMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "proxy_settings"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "NetworkProxySettings" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkProxySettings, or %NULL"
--                 , 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 "webkit_network_session_set_proxy_settings" webkit_network_session_set_proxy_settings :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CUInt ->                                -- proxy_mode : TInterface (Name {namespace = "WebKit", name = "NetworkProxyMode"})
    Ptr WebKit.NetworkProxySettings.NetworkProxySettings -> -- proxy_settings : TInterface (Name {namespace = "WebKit", name = "NetworkProxySettings"})
    IO ()

-- | Set the network proxy settings to be used by connections started in /@session@/ session.
-- 
-- By default 'GI.WebKit.Enums.NetworkProxyModeDefault' is used, which means that the
-- system settings will be used ('GI.Gio.Functions.proxyResolverGetDefault').
-- If you want to override the system default settings, you can either use
-- 'GI.WebKit.Enums.NetworkProxyModeNoProxy' to make sure no proxies are used at all,
-- or 'GI.WebKit.Enums.NetworkProxyModeCustom' to provide your own proxy settings.
-- When /@proxyMode@/ is 'GI.WebKit.Enums.NetworkProxyModeCustom' /@proxySettings@/ must be
-- a valid t'GI.WebKit.Structs.NetworkProxySettings.NetworkProxySettings'; otherwise, /@proxySettings@/ must be 'P.Nothing'.
-- 
-- /Since: 2.40/
networkSessionSetProxySettings ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> WebKit.Enums.NetworkProxyMode
    -- ^ /@proxyMode@/: a t'GI.WebKit.Enums.NetworkProxyMode'
    -> Maybe (WebKit.NetworkProxySettings.NetworkProxySettings)
    -- ^ /@proxySettings@/: a t'GI.WebKit.Structs.NetworkProxySettings.NetworkProxySettings', or 'P.Nothing'
    -> m ()
networkSessionSetProxySettings :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> NetworkProxyMode -> Maybe NetworkProxySettings -> m ()
networkSessionSetProxySettings a
session NetworkProxyMode
proxyMode Maybe NetworkProxySettings
proxySettings = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let proxyMode' :: CUInt
proxyMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NetworkProxyMode -> Int) -> NetworkProxyMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkProxyMode -> Int
forall a. Enum a => a -> Int
fromEnum) NetworkProxyMode
proxyMode
    Ptr NetworkProxySettings
maybeProxySettings <- case Maybe NetworkProxySettings
proxySettings of
        Maybe NetworkProxySettings
Nothing -> Ptr NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr NetworkProxySettings
forall a. Ptr a
nullPtr
        Just NetworkProxySettings
jProxySettings -> do
            Ptr NetworkProxySettings
jProxySettings' <- NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr NetworkProxySettings
jProxySettings
            Ptr NetworkProxySettings -> IO (Ptr NetworkProxySettings)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr NetworkProxySettings
jProxySettings'
    Ptr NetworkSession -> CUInt -> Ptr NetworkProxySettings -> IO ()
webkit_network_session_set_proxy_settings Ptr NetworkSession
session' CUInt
proxyMode' Ptr NetworkProxySettings
maybeProxySettings
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    Maybe NetworkProxySettings
-> (NetworkProxySettings -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe NetworkProxySettings
proxySettings NetworkProxySettings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionSetProxySettingsMethodInfo
instance (signature ~ (WebKit.Enums.NetworkProxyMode -> Maybe (WebKit.NetworkProxySettings.NetworkProxySettings) -> m ()), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionSetProxySettingsMethodInfo a signature where
    overloadedMethod = networkSessionSetProxySettings

instance O.OverloadedMethodInfo NetworkSessionSetProxySettingsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionSetProxySettings",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionSetProxySettings"
        })


#endif

-- method NetworkSession::set_tls_errors_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "session"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "NetworkSession" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNetworkSession"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface Name { namespace = "WebKit" , name = "TLSErrorsPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitTLSErrorsPolicy"
--                 , 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 "webkit_network_session_set_tls_errors_policy" webkit_network_session_set_tls_errors_policy :: 
    Ptr NetworkSession ->                   -- session : TInterface (Name {namespace = "WebKit", name = "NetworkSession"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "WebKit", name = "TLSErrorsPolicy"})
    IO ()

-- | Set the TLS errors policy of /@session@/ as /@policy@/.
-- 
-- /Since: 2.40/
networkSessionSetTlsErrorsPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsNetworkSession a) =>
    a
    -- ^ /@session@/: a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
    -> WebKit.Enums.TLSErrorsPolicy
    -- ^ /@policy@/: a t'GI.WebKit.Enums.TLSErrorsPolicy'
    -> m ()
networkSessionSetTlsErrorsPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNetworkSession a) =>
a -> TLSErrorsPolicy -> m ()
networkSessionSetTlsErrorsPolicy a
session TLSErrorsPolicy
policy = 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 NetworkSession
session' <- a -> IO (Ptr NetworkSession)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
session
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TLSErrorsPolicy -> Int) -> TLSErrorsPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSErrorsPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) TLSErrorsPolicy
policy
    Ptr NetworkSession -> CUInt -> IO ()
webkit_network_session_set_tls_errors_policy Ptr NetworkSession
session' CUInt
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
session
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NetworkSessionSetTlsErrorsPolicyMethodInfo
instance (signature ~ (WebKit.Enums.TLSErrorsPolicy -> m ()), MonadIO m, IsNetworkSession a) => O.OverloadedMethod NetworkSessionSetTlsErrorsPolicyMethodInfo a signature where
    overloadedMethod = networkSessionSetTlsErrorsPolicy

instance O.OverloadedMethodInfo NetworkSessionSetTlsErrorsPolicyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit.Objects.NetworkSession.networkSessionSetTlsErrorsPolicy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit-6.0.3/docs/GI-WebKit-Objects-NetworkSession.html#v:networkSessionSetTlsErrorsPolicy"
        })


#endif

-- method NetworkSession::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit" , name = "NetworkSession" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_network_session_get_default" webkit_network_session_get_default :: 
    IO (Ptr NetworkSession)

-- | Get the default network session.
-- The default network session is created using 'GI.WebKit.Objects.NetworkSession.networkSessionNew' and passing
-- 'P.Nothing' as data and cache directories.
-- 
-- /Since: 2.40/
networkSessionGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m NetworkSession
    -- ^ __Returns:__ a t'GI.WebKit.Objects.NetworkSession.NetworkSession'
networkSessionGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m NetworkSession
networkSessionGetDefault  = IO NetworkSession -> m NetworkSession
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NetworkSession -> m NetworkSession)
-> IO NetworkSession -> m NetworkSession
forall a b. (a -> b) -> a -> b
$ do
    Ptr NetworkSession
result <- IO (Ptr NetworkSession)
webkit_network_session_get_default
    Text -> Ptr NetworkSession -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"networkSessionGetDefault" Ptr NetworkSession
result
    NetworkSession
result' <- ((ManagedPtr NetworkSession -> NetworkSession)
-> Ptr NetworkSession -> IO NetworkSession
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr NetworkSession -> NetworkSession
NetworkSession) Ptr NetworkSession
result
    NetworkSession -> IO NetworkSession
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NetworkSession
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method NetworkSession::set_memory_pressure_settings
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "settings"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit" , name = "MemoryPressureSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a WebKitMemoryPressureSettings."
--                 , 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 "webkit_network_session_set_memory_pressure_settings" webkit_network_session_set_memory_pressure_settings :: 
    Ptr WebKit.MemoryPressureSettings.MemoryPressureSettings -> -- settings : TInterface (Name {namespace = "WebKit", name = "MemoryPressureSettings"})
    IO ()

-- | Sets /@settings@/ as the t'GI.WebKit.Structs.MemoryPressureSettings.MemoryPressureSettings'.
-- 
-- Sets /@settings@/ as the t'GI.WebKit.Structs.MemoryPressureSettings.MemoryPressureSettings' to be used by the network
-- process created by any instance of t'GI.WebKit.Objects.NetworkSession.NetworkSession' after this function
-- is called.
-- 
-- Be sure to call this function before creating any t'GI.WebKit.Objects.NetworkSession.NetworkSession'.
-- 
-- The periodic check for used memory is disabled by default on network processes. This will
-- be enabled only if custom settings have been set using this function. After that, in order
-- to remove the custom settings and disable the periodic check, this function must be called
-- passing 'P.Nothing' as the value of /@settings@/.
-- 
-- /Since: 2.40/
networkSessionSetMemoryPressureSettings ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WebKit.MemoryPressureSettings.MemoryPressureSettings
    -- ^ /@settings@/: a WebKitMemoryPressureSettings.
    -> m ()
networkSessionSetMemoryPressureSettings :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MemoryPressureSettings -> m ()
networkSessionSetMemoryPressureSettings MemoryPressureSettings
settings = 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 MemoryPressureSettings
settings' <- MemoryPressureSettings -> IO (Ptr MemoryPressureSettings)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MemoryPressureSettings
settings
    Ptr MemoryPressureSettings -> IO ()
webkit_network_session_set_memory_pressure_settings Ptr MemoryPressureSettings
settings'
    MemoryPressureSettings -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MemoryPressureSettings
settings
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif