{-# LANGUAGE TypeApplications #-}


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

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

module GI.Soup.Objects.CookieJar
    ( 

-- * Exported types
    CookieJar(..)                           ,
    IsCookieJar                             ,
    toCookieJar                             ,
    noCookieJar                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCookieJarMethod                  ,
#endif


-- ** addCookie #method:addCookie#

#if defined(ENABLE_OVERLOADING)
    CookieJarAddCookieMethodInfo            ,
#endif
    cookieJarAddCookie                      ,


-- ** addCookieWithFirstParty #method:addCookieWithFirstParty#

#if defined(ENABLE_OVERLOADING)
    CookieJarAddCookieWithFirstPartyMethodInfo,
#endif
    cookieJarAddCookieWithFirstParty        ,


-- ** allCookies #method:allCookies#

#if defined(ENABLE_OVERLOADING)
    CookieJarAllCookiesMethodInfo           ,
#endif
    cookieJarAllCookies                     ,


-- ** deleteCookie #method:deleteCookie#

#if defined(ENABLE_OVERLOADING)
    CookieJarDeleteCookieMethodInfo         ,
#endif
    cookieJarDeleteCookie                   ,


-- ** getAcceptPolicy #method:getAcceptPolicy#

#if defined(ENABLE_OVERLOADING)
    CookieJarGetAcceptPolicyMethodInfo      ,
#endif
    cookieJarGetAcceptPolicy                ,


-- ** getCookieList #method:getCookieList#

#if defined(ENABLE_OVERLOADING)
    CookieJarGetCookieListMethodInfo        ,
#endif
    cookieJarGetCookieList                  ,


-- ** getCookies #method:getCookies#

#if defined(ENABLE_OVERLOADING)
    CookieJarGetCookiesMethodInfo           ,
#endif
    cookieJarGetCookies                     ,


-- ** isPersistent #method:isPersistent#

#if defined(ENABLE_OVERLOADING)
    CookieJarIsPersistentMethodInfo         ,
#endif
    cookieJarIsPersistent                   ,


-- ** new #method:new#

    cookieJarNew                            ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    CookieJarSaveMethodInfo                 ,
#endif
    cookieJarSave                           ,


-- ** setAcceptPolicy #method:setAcceptPolicy#

#if defined(ENABLE_OVERLOADING)
    CookieJarSetAcceptPolicyMethodInfo      ,
#endif
    cookieJarSetAcceptPolicy                ,


-- ** setCookie #method:setCookie#

#if defined(ENABLE_OVERLOADING)
    CookieJarSetCookieMethodInfo            ,
#endif
    cookieJarSetCookie                      ,


-- ** setCookieWithFirstParty #method:setCookieWithFirstParty#

#if defined(ENABLE_OVERLOADING)
    CookieJarSetCookieWithFirstPartyMethodInfo,
#endif
    cookieJarSetCookieWithFirstParty        ,




 -- * Properties
-- ** acceptPolicy #attr:acceptPolicy#
-- | The policy the jar should follow to accept or reject cookies
-- 
-- /Since: 2.30/

#if defined(ENABLE_OVERLOADING)
    CookieJarAcceptPolicyPropertyInfo       ,
#endif
    constructCookieJarAcceptPolicy          ,
#if defined(ENABLE_OVERLOADING)
    cookieJarAcceptPolicy                   ,
#endif
    getCookieJarAcceptPolicy                ,
    setCookieJarAcceptPolicy                ,


-- ** readOnly #attr:readOnly#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    CookieJarReadOnlyPropertyInfo           ,
#endif
    constructCookieJarReadOnly              ,
#if defined(ENABLE_OVERLOADING)
    cookieJarReadOnly                       ,
#endif
    getCookieJarReadOnly                    ,




 -- * Signals
-- ** changed #signal:changed#

    C_CookieJarChangedCallback              ,
    CookieJarChangedCallback                ,
#if defined(ENABLE_OVERLOADING)
    CookieJarChangedSignalInfo              ,
#endif
    afterCookieJarChanged                   ,
    genClosure_CookieJarChanged             ,
    mk_CookieJarChangedCallback             ,
    noCookieJarChangedCallback              ,
    onCookieJarChanged                      ,
    wrap_CookieJarChangedCallback           ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Interfaces.SessionFeature as Soup.SessionFeature
import {-# SOURCE #-} qualified GI.Soup.Structs.Cookie as Soup.Cookie
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

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

instance GObject CookieJar where
    gobjectType :: IO GType
gobjectType = IO GType
c_soup_cookie_jar_get_type
    

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

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

instance O.HasParentTypes CookieJar
type instance O.ParentTypes CookieJar = '[GObject.Object.Object, Soup.SessionFeature.SessionFeature]

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

-- | A convenience alias for `Nothing` :: `Maybe` `CookieJar`.
noCookieJar :: Maybe CookieJar
noCookieJar :: Maybe CookieJar
noCookieJar = Maybe CookieJar
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveCookieJarMethod (t :: Symbol) (o :: *) :: * where
    ResolveCookieJarMethod "addCookie" o = CookieJarAddCookieMethodInfo
    ResolveCookieJarMethod "addCookieWithFirstParty" o = CookieJarAddCookieWithFirstPartyMethodInfo
    ResolveCookieJarMethod "addFeature" o = Soup.SessionFeature.SessionFeatureAddFeatureMethodInfo
    ResolveCookieJarMethod "allCookies" o = CookieJarAllCookiesMethodInfo
    ResolveCookieJarMethod "attach" o = Soup.SessionFeature.SessionFeatureAttachMethodInfo
    ResolveCookieJarMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCookieJarMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCookieJarMethod "deleteCookie" o = CookieJarDeleteCookieMethodInfo
    ResolveCookieJarMethod "detach" o = Soup.SessionFeature.SessionFeatureDetachMethodInfo
    ResolveCookieJarMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCookieJarMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCookieJarMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCookieJarMethod "hasFeature" o = Soup.SessionFeature.SessionFeatureHasFeatureMethodInfo
    ResolveCookieJarMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCookieJarMethod "isPersistent" o = CookieJarIsPersistentMethodInfo
    ResolveCookieJarMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCookieJarMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCookieJarMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCookieJarMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCookieJarMethod "removeFeature" o = Soup.SessionFeature.SessionFeatureRemoveFeatureMethodInfo
    ResolveCookieJarMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCookieJarMethod "save" o = CookieJarSaveMethodInfo
    ResolveCookieJarMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCookieJarMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCookieJarMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCookieJarMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCookieJarMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCookieJarMethod "getAcceptPolicy" o = CookieJarGetAcceptPolicyMethodInfo
    ResolveCookieJarMethod "getCookieList" o = CookieJarGetCookieListMethodInfo
    ResolveCookieJarMethod "getCookies" o = CookieJarGetCookiesMethodInfo
    ResolveCookieJarMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCookieJarMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCookieJarMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCookieJarMethod "setAcceptPolicy" o = CookieJarSetAcceptPolicyMethodInfo
    ResolveCookieJarMethod "setCookie" o = CookieJarSetCookieMethodInfo
    ResolveCookieJarMethod "setCookieWithFirstParty" o = CookieJarSetCookieWithFirstPartyMethodInfo
    ResolveCookieJarMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCookieJarMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCookieJarMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCookieJarMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal CookieJar::changed
-- | Emitted when /@jar@/ changes. If a cookie has been added,
-- /@newCookie@/ will contain the newly-added cookie and
-- /@oldCookie@/ will be 'P.Nothing'. If a cookie has been deleted,
-- /@oldCookie@/ will contain the to-be-deleted cookie and
-- /@newCookie@/ will be 'P.Nothing'. If a cookie has been changed,
-- /@oldCookie@/ will contain its old value, and /@newCookie@/ its
-- new value.
type CookieJarChangedCallback =
    Soup.Cookie.Cookie
    -- ^ /@oldCookie@/: the old t'GI.Soup.Structs.Cookie.Cookie' value
    -> Soup.Cookie.Cookie
    -- ^ /@newCookie@/: the new t'GI.Soup.Structs.Cookie.Cookie' value
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `CookieJarChangedCallback`@.
noCookieJarChangedCallback :: Maybe CookieJarChangedCallback
noCookieJarChangedCallback :: Maybe CookieJarChangedCallback
noCookieJarChangedCallback = Maybe CookieJarChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_CookieJarChangedCallback =
    Ptr () ->                               -- object
    Ptr Soup.Cookie.Cookie ->
    Ptr Soup.Cookie.Cookie ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_CookieJarChanged :: MonadIO m => CookieJarChangedCallback -> m (GClosure C_CookieJarChangedCallback)
genClosure_CookieJarChanged :: CookieJarChangedCallback -> m (GClosure C_CookieJarChangedCallback)
genClosure_CookieJarChanged cb :: CookieJarChangedCallback
cb = IO (GClosure C_CookieJarChangedCallback)
-> m (GClosure C_CookieJarChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_CookieJarChangedCallback)
 -> m (GClosure C_CookieJarChangedCallback))
-> IO (GClosure C_CookieJarChangedCallback)
-> m (GClosure C_CookieJarChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_CookieJarChangedCallback
cb' = CookieJarChangedCallback -> C_CookieJarChangedCallback
wrap_CookieJarChangedCallback CookieJarChangedCallback
cb
    C_CookieJarChangedCallback
-> IO (FunPtr C_CookieJarChangedCallback)
mk_CookieJarChangedCallback C_CookieJarChangedCallback
cb' IO (FunPtr C_CookieJarChangedCallback)
-> (FunPtr C_CookieJarChangedCallback
    -> IO (GClosure C_CookieJarChangedCallback))
-> IO (GClosure C_CookieJarChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_CookieJarChangedCallback
-> IO (GClosure C_CookieJarChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `CookieJarChangedCallback` into a `C_CookieJarChangedCallback`.
wrap_CookieJarChangedCallback ::
    CookieJarChangedCallback ->
    C_CookieJarChangedCallback
wrap_CookieJarChangedCallback :: CookieJarChangedCallback -> C_CookieJarChangedCallback
wrap_CookieJarChangedCallback _cb :: CookieJarChangedCallback
_cb _ oldCookie :: Ptr Cookie
oldCookie newCookie :: Ptr Cookie
newCookie _ = do
    (ManagedPtr Cookie -> Cookie)
-> Ptr Cookie -> (Cookie -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr Cookie -> Cookie
Soup.Cookie.Cookie Ptr Cookie
oldCookie ((Cookie -> IO ()) -> IO ()) -> (Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \oldCookie' :: Cookie
oldCookie' -> do
        (ManagedPtr Cookie -> Cookie)
-> Ptr Cookie -> (Cookie -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr Cookie -> Cookie
Soup.Cookie.Cookie Ptr Cookie
newCookie ((Cookie -> IO ()) -> IO ()) -> (Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \newCookie' :: Cookie
newCookie' -> do
            CookieJarChangedCallback
_cb  Cookie
oldCookie' Cookie
newCookie'


-- | Connect a signal handler for the [changed](#signal:changed) 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' cookieJar #changed callback
-- @
-- 
-- 
onCookieJarChanged :: (IsCookieJar a, MonadIO m) => a -> CookieJarChangedCallback -> m SignalHandlerId
onCookieJarChanged :: a -> CookieJarChangedCallback -> m SignalHandlerId
onCookieJarChanged obj :: a
obj cb :: CookieJarChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_CookieJarChangedCallback
cb' = CookieJarChangedCallback -> C_CookieJarChangedCallback
wrap_CookieJarChangedCallback CookieJarChangedCallback
cb
    FunPtr C_CookieJarChangedCallback
cb'' <- C_CookieJarChangedCallback
-> IO (FunPtr C_CookieJarChangedCallback)
mk_CookieJarChangedCallback C_CookieJarChangedCallback
cb'
    a
-> Text
-> FunPtr C_CookieJarChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_CookieJarChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) 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' cookieJar #changed callback
-- @
-- 
-- 
afterCookieJarChanged :: (IsCookieJar a, MonadIO m) => a -> CookieJarChangedCallback -> m SignalHandlerId
afterCookieJarChanged :: a -> CookieJarChangedCallback -> m SignalHandlerId
afterCookieJarChanged obj :: a
obj cb :: CookieJarChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_CookieJarChangedCallback
cb' = CookieJarChangedCallback -> C_CookieJarChangedCallback
wrap_CookieJarChangedCallback CookieJarChangedCallback
cb
    FunPtr C_CookieJarChangedCallback
cb'' <- C_CookieJarChangedCallback
-> IO (FunPtr C_CookieJarChangedCallback)
mk_CookieJarChangedCallback C_CookieJarChangedCallback
cb'
    a
-> Text
-> FunPtr C_CookieJarChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "changed" FunPtr C_CookieJarChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data CookieJarChangedSignalInfo
instance SignalInfo CookieJarChangedSignalInfo where
    type HaskellCallbackType CookieJarChangedSignalInfo = CookieJarChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_CookieJarChangedCallback cb
        cb'' <- mk_CookieJarChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- VVV Prop "accept-policy"
   -- Type: TInterface (Name {namespace = "Soup", name = "CookieJarAcceptPolicy"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@accept-policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookieJar #acceptPolicy
-- @
getCookieJarAcceptPolicy :: (MonadIO m, IsCookieJar o) => o -> m Soup.Enums.CookieJarAcceptPolicy
getCookieJarAcceptPolicy :: o -> m CookieJarAcceptPolicy
getCookieJarAcceptPolicy obj :: o
obj = IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy)
-> IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy
forall a b. (a -> b) -> a -> b
$ o -> String -> IO CookieJarAcceptPolicy
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "accept-policy"

-- | Set the value of the “@accept-policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookieJar [ #acceptPolicy 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieJarAcceptPolicy :: (MonadIO m, IsCookieJar o) => o -> Soup.Enums.CookieJarAcceptPolicy -> m ()
setCookieJarAcceptPolicy :: o -> CookieJarAcceptPolicy -> m ()
setCookieJarAcceptPolicy obj :: o
obj val :: CookieJarAcceptPolicy
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> CookieJarAcceptPolicy -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj "accept-policy" CookieJarAcceptPolicy
val

-- | Construct a `GValueConstruct` with valid value for the “@accept-policy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCookieJarAcceptPolicy :: (IsCookieJar o) => Soup.Enums.CookieJarAcceptPolicy -> IO (GValueConstruct o)
constructCookieJarAcceptPolicy :: CookieJarAcceptPolicy -> IO (GValueConstruct o)
constructCookieJarAcceptPolicy val :: CookieJarAcceptPolicy
val = String -> CookieJarAcceptPolicy -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "accept-policy" CookieJarAcceptPolicy
val

#if defined(ENABLE_OVERLOADING)
data CookieJarAcceptPolicyPropertyInfo
instance AttrInfo CookieJarAcceptPolicyPropertyInfo where
    type AttrAllowedOps CookieJarAcceptPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CookieJarAcceptPolicyPropertyInfo = IsCookieJar
    type AttrSetTypeConstraint CookieJarAcceptPolicyPropertyInfo = (~) Soup.Enums.CookieJarAcceptPolicy
    type AttrTransferTypeConstraint CookieJarAcceptPolicyPropertyInfo = (~) Soup.Enums.CookieJarAcceptPolicy
    type AttrTransferType CookieJarAcceptPolicyPropertyInfo = Soup.Enums.CookieJarAcceptPolicy
    type AttrGetType CookieJarAcceptPolicyPropertyInfo = Soup.Enums.CookieJarAcceptPolicy
    type AttrLabel CookieJarAcceptPolicyPropertyInfo = "accept-policy"
    type AttrOrigin CookieJarAcceptPolicyPropertyInfo = CookieJar
    attrGet = getCookieJarAcceptPolicy
    attrSet = setCookieJarAcceptPolicy
    attrTransfer _ v = do
        return v
    attrConstruct = constructCookieJarAcceptPolicy
    attrClear = undefined
#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@read-only@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCookieJarReadOnly :: (IsCookieJar o) => Bool -> IO (GValueConstruct o)
constructCookieJarReadOnly :: Bool -> IO (GValueConstruct o)
constructCookieJarReadOnly val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "read-only" Bool
val

#if defined(ENABLE_OVERLOADING)
data CookieJarReadOnlyPropertyInfo
instance AttrInfo CookieJarReadOnlyPropertyInfo where
    type AttrAllowedOps CookieJarReadOnlyPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CookieJarReadOnlyPropertyInfo = IsCookieJar
    type AttrSetTypeConstraint CookieJarReadOnlyPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint CookieJarReadOnlyPropertyInfo = (~) Bool
    type AttrTransferType CookieJarReadOnlyPropertyInfo = Bool
    type AttrGetType CookieJarReadOnlyPropertyInfo = Bool
    type AttrLabel CookieJarReadOnlyPropertyInfo = "read-only"
    type AttrOrigin CookieJarReadOnlyPropertyInfo = CookieJar
    attrGet = getCookieJarReadOnly
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCookieJarReadOnly
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CookieJar
type instance O.AttributeList CookieJar = CookieJarAttributeList
type CookieJarAttributeList = ('[ '("acceptPolicy", CookieJarAcceptPolicyPropertyInfo), '("readOnly", CookieJarReadOnlyPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
cookieJarAcceptPolicy :: AttrLabelProxy "acceptPolicy"
cookieJarAcceptPolicy = AttrLabelProxy

cookieJarReadOnly :: AttrLabelProxy "readOnly"
cookieJarReadOnly = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "soup_cookie_jar_new" soup_cookie_jar_new :: 
    IO (Ptr CookieJar)

-- | Creates a new t'GI.Soup.Objects.CookieJar.CookieJar'. The base t'GI.Soup.Objects.CookieJar.CookieJar' class does
-- not support persistent storage of cookies; use a subclass for that.
-- 
-- /Since: 2.24/
cookieJarNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m CookieJar
    -- ^ __Returns:__ a new t'GI.Soup.Objects.CookieJar.CookieJar'
cookieJarNew :: m CookieJar
cookieJarNew  = IO CookieJar -> m CookieJar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CookieJar -> m CookieJar) -> IO CookieJar -> m CookieJar
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
result <- IO (Ptr CookieJar)
soup_cookie_jar_new
    Text -> Ptr CookieJar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "cookieJarNew" Ptr CookieJar
result
    CookieJar
result' <- ((ManagedPtr CookieJar -> CookieJar)
-> Ptr CookieJar -> IO CookieJar
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CookieJar -> CookieJar
CookieJar) Ptr CookieJar
result
    CookieJar -> IO CookieJar
forall (m :: * -> *) a. Monad m => a -> m a
return CookieJar
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CookieJar::add_cookie
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cookie"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Cookie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_add_cookie" soup_cookie_jar_add_cookie :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.Cookie.Cookie ->               -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO ()

-- | Adds /@cookie@/ to /@jar@/, emitting the \'changed\' signal if we are modifying
-- an existing cookie or adding a valid new cookie (\'valid\' means
-- that the cookie\'s expire date is not in the past).
-- 
-- /@cookie@/ will be \'stolen\' by the jar, so don\'t free it afterwards.
-- 
-- /Since: 2.26/
cookieJarAddCookie ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.Cookie.Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m ()
cookieJarAddCookie :: a -> Cookie -> m ()
cookieJarAddCookie jar :: a
jar cookie :: Cookie
cookie = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Cookie
cookie
    Ptr CookieJar -> Ptr Cookie -> IO ()
soup_cookie_jar_add_cookie Ptr CookieJar
jar' Ptr Cookie
cookie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarAddCookieMethodInfo
instance (signature ~ (Soup.Cookie.Cookie -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarAddCookieMethodInfo a signature where
    overloadedMethod = cookieJarAddCookie

#endif

-- method CookieJar::add_cookie_with_first_party
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_party"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI for the main document"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cookie"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Cookie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_add_cookie_with_first_party" soup_cookie_jar_add_cookie_with_first_party :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.URI.URI ->                     -- first_party : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr Soup.Cookie.Cookie ->               -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO ()

-- | Adds /@cookie@/ to /@jar@/, emitting the \'changed\' signal if we are modifying
-- an existing cookie or adding a valid new cookie (\'valid\' means
-- that the cookie\'s expire date is not in the past).
-- 
-- /@firstParty@/ will be used to reject cookies coming from third party
-- resources in case such a security policy is set in the /@jar@/.
-- 
-- /@cookie@/ will be \'stolen\' by the jar, so don\'t free it afterwards.
-- 
-- /Since: 2.40/
cookieJarAddCookieWithFirstParty ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.URI.URI
    -- ^ /@firstParty@/: the URI for the main document
    -> Soup.Cookie.Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m ()
cookieJarAddCookieWithFirstParty :: a -> URI -> Cookie -> m ()
cookieJarAddCookieWithFirstParty jar :: a
jar firstParty :: URI
firstParty cookie :: Cookie
cookie = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr URI
firstParty' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
firstParty
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Cookie
cookie
    Ptr CookieJar -> Ptr URI -> Ptr Cookie -> IO ()
soup_cookie_jar_add_cookie_with_first_party Ptr CookieJar
jar' Ptr URI
firstParty' Ptr Cookie
cookie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
firstParty
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarAddCookieWithFirstPartyMethodInfo
instance (signature ~ (Soup.URI.URI -> Soup.Cookie.Cookie -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarAddCookieWithFirstPartyMethodInfo a signature where
    overloadedMethod = cookieJarAddCookieWithFirstParty

#endif

-- method CookieJar::all_cookies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "Soup" , name = "Cookie" }))
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_all_cookies" soup_cookie_jar_all_cookies :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    IO (Ptr (GSList (Ptr Soup.Cookie.Cookie)))

-- | Constructs a t'GI.GLib.Structs.SList.SList' with every cookie inside the /@jar@/.
-- The cookies in the list are a copy of the original, so
-- you have to free them when you are done with them.
-- 
-- /Since: 2.26/
cookieJarAllCookies ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> m [Soup.Cookie.Cookie]
    -- ^ __Returns:__ a t'GI.GLib.Structs.SList.SList'
    -- with all the cookies in the /@jar@/.
cookieJarAllCookies :: a -> m [Cookie]
cookieJarAllCookies jar :: a
jar = IO [Cookie] -> m [Cookie]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Cookie] -> m [Cookie]) -> IO [Cookie] -> m [Cookie]
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr (GSList (Ptr Cookie))
result <- Ptr CookieJar -> IO (Ptr (GSList (Ptr Cookie)))
soup_cookie_jar_all_cookies Ptr CookieJar
jar'
    [Ptr Cookie]
result' <- Ptr (GSList (Ptr Cookie)) -> IO [Ptr Cookie]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Cookie))
result
    [Cookie]
result'' <- (Ptr Cookie -> IO Cookie) -> [Ptr Cookie] -> IO [Cookie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Soup.Cookie.Cookie) [Ptr Cookie]
result'
    Ptr (GSList (Ptr Cookie)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Cookie))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    [Cookie] -> IO [Cookie]
forall (m :: * -> *) a. Monad m => a -> m a
return [Cookie]
result''

#if defined(ENABLE_OVERLOADING)
data CookieJarAllCookiesMethodInfo
instance (signature ~ (m [Soup.Cookie.Cookie]), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarAllCookiesMethodInfo a signature where
    overloadedMethod = cookieJarAllCookies

#endif

-- method CookieJar::delete_cookie
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cookie"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Cookie" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookie" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_delete_cookie" soup_cookie_jar_delete_cookie :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.Cookie.Cookie ->               -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO ()

-- | Deletes /@cookie@/ from /@jar@/, emitting the \'changed\' signal.
-- 
-- /Since: 2.26/
cookieJarDeleteCookie ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.Cookie.Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m ()
cookieJarDeleteCookie :: a -> Cookie -> m ()
cookieJarDeleteCookie jar :: a
jar cookie :: Cookie
cookie = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr CookieJar -> Ptr Cookie -> IO ()
soup_cookie_jar_delete_cookie Ptr CookieJar
jar' Ptr Cookie
cookie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarDeleteCookieMethodInfo
instance (signature ~ (Soup.Cookie.Cookie -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarDeleteCookieMethodInfo a signature where
    overloadedMethod = cookieJarDeleteCookie

#endif

-- method CookieJar::get_accept_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Soup" , name = "CookieJarAcceptPolicy" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_get_accept_policy" soup_cookie_jar_get_accept_policy :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    IO CUInt

-- | Gets /@jar@/\'s t'GI.Soup.Enums.CookieJarAcceptPolicy'
-- 
-- /Since: 2.30/
cookieJarGetAcceptPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> m Soup.Enums.CookieJarAcceptPolicy
    -- ^ __Returns:__ the t'GI.Soup.Enums.CookieJarAcceptPolicy' set in the /@jar@/
cookieJarGetAcceptPolicy :: a -> m CookieJarAcceptPolicy
cookieJarGetAcceptPolicy jar :: a
jar = IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy)
-> IO CookieJarAcceptPolicy -> m CookieJarAcceptPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    CUInt
result <- Ptr CookieJar -> IO CUInt
soup_cookie_jar_get_accept_policy Ptr CookieJar
jar'
    let result' :: CookieJarAcceptPolicy
result' = (Int -> CookieJarAcceptPolicy
forall a. Enum a => Int -> a
toEnum (Int -> CookieJarAcceptPolicy)
-> (CUInt -> Int) -> CUInt -> CookieJarAcceptPolicy
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
jar
    CookieJarAcceptPolicy -> IO CookieJarAcceptPolicy
forall (m :: * -> *) a. Monad m => a -> m a
return CookieJarAcceptPolicy
result'

#if defined(ENABLE_OVERLOADING)
data CookieJarGetAcceptPolicyMethodInfo
instance (signature ~ (m Soup.Enums.CookieJarAcceptPolicy), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarGetAcceptPolicyMethodInfo a signature where
    overloadedMethod = cookieJarGetAcceptPolicy

#endif

-- method CookieJar::get_cookie_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupURI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "for_http"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether or not the return value is being passed directly\nto an HTTP operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "Soup" , name = "Cookie" }))
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_get_cookie_list" soup_cookie_jar_get_cookie_list :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CInt ->                                 -- for_http : TBasicType TBoolean
    IO (Ptr (GSList (Ptr Soup.Cookie.Cookie)))

-- | Retrieves the list of cookies that would be sent with a request to /@uri@/
-- as a t'GI.GLib.Structs.SList.SList' of t'GI.Soup.Structs.Cookie.Cookie' objects.
-- 
-- If /@forHttp@/ is 'P.True', the return value will include cookies marked
-- \"HttpOnly\" (that is, cookies that the server wishes to keep hidden
-- from client-side scripting operations such as the JavaScript
-- document.cookies property). Since t'GI.Soup.Objects.CookieJar.CookieJar' sets the Cookie
-- header itself when making the actual HTTP request, you should
-- almost certainly be setting /@forHttp@/ to 'P.False' if you are calling
-- this.
-- 
-- /Since: 2.40/
cookieJarGetCookieList ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.URI.URI
    -- ^ /@uri@/: a t'GI.Soup.Structs.URI.URI'
    -> Bool
    -- ^ /@forHttp@/: whether or not the return value is being passed directly
    -- to an HTTP operation
    -> m [Soup.Cookie.Cookie]
    -- ^ __Returns:__ a t'GI.GLib.Structs.SList.SList'
    -- with the cookies in the /@jar@/ that would be sent with a request to /@uri@/.
cookieJarGetCookieList :: a -> URI -> Bool -> m [Cookie]
cookieJarGetCookieList jar :: a
jar uri :: URI
uri forHttp :: Bool
forHttp = IO [Cookie] -> m [Cookie]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Cookie] -> m [Cookie]) -> IO [Cookie] -> m [Cookie]
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let forHttp' :: CInt
forHttp' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
forHttp
    Ptr (GSList (Ptr Cookie))
result <- Ptr CookieJar -> Ptr URI -> CInt -> IO (Ptr (GSList (Ptr Cookie)))
soup_cookie_jar_get_cookie_list Ptr CookieJar
jar' Ptr URI
uri' CInt
forHttp'
    [Ptr Cookie]
result' <- Ptr (GSList (Ptr Cookie)) -> IO [Ptr Cookie]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Cookie))
result
    [Cookie]
result'' <- (Ptr Cookie -> IO Cookie) -> [Ptr Cookie] -> IO [Cookie]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Soup.Cookie.Cookie) [Ptr Cookie]
result'
    Ptr (GSList (Ptr Cookie)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Cookie))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    [Cookie] -> IO [Cookie]
forall (m :: * -> *) a. Monad m => a -> m a
return [Cookie]
result''

#if defined(ENABLE_OVERLOADING)
data CookieJarGetCookieListMethodInfo
instance (signature ~ (Soup.URI.URI -> Bool -> m [Soup.Cookie.Cookie]), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarGetCookieListMethodInfo a signature where
    overloadedMethod = cookieJarGetCookieList

#endif

-- method CookieJar::get_cookies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupURI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "for_http"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether or not the return value is being passed directly\nto an HTTP operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_get_cookies" soup_cookie_jar_get_cookies :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CInt ->                                 -- for_http : TBasicType TBoolean
    IO CString

-- | Retrieves (in Cookie-header form) the list of cookies that would
-- be sent with a request to /@uri@/.
-- 
-- If /@forHttp@/ is 'P.True', the return value will include cookies marked
-- \"HttpOnly\" (that is, cookies that the server wishes to keep hidden
-- from client-side scripting operations such as the JavaScript
-- document.cookies property). Since t'GI.Soup.Objects.CookieJar.CookieJar' sets the Cookie
-- header itself when making the actual HTTP request, you should
-- almost certainly be setting /@forHttp@/ to 'P.False' if you are calling
-- this.
-- 
-- /Since: 2.24/
cookieJarGetCookies ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.URI.URI
    -- ^ /@uri@/: a t'GI.Soup.Structs.URI.URI'
    -> Bool
    -- ^ /@forHttp@/: whether or not the return value is being passed directly
    -- to an HTTP operation
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the cookies, in string form, or 'P.Nothing' if
    -- there are no cookies for /@uri@/.
cookieJarGetCookies :: a -> URI -> Bool -> m (Maybe Text)
cookieJarGetCookies jar :: a
jar uri :: URI
uri forHttp :: Bool
forHttp = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    let forHttp' :: CInt
forHttp' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
forHttp
    CString
result <- Ptr CookieJar -> Ptr URI -> CInt -> IO CString
soup_cookie_jar_get_cookies Ptr CookieJar
jar' Ptr URI
uri' CInt
forHttp'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data CookieJarGetCookiesMethodInfo
instance (signature ~ (Soup.URI.URI -> Bool -> m (Maybe T.Text)), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarGetCookiesMethodInfo a signature where
    overloadedMethod = cookieJarGetCookies

#endif

-- method CookieJar::is_persistent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_is_persistent" soup_cookie_jar_is_persistent :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    IO CInt

-- | Gets whether /@jar@/ stores cookies persistenly.
-- 
-- /Since: 2.40/
cookieJarIsPersistent ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@jar@/ storage is persistent or 'P.False' otherwise.
cookieJarIsPersistent :: a -> m Bool
cookieJarIsPersistent jar :: a
jar = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    CInt
result <- Ptr CookieJar -> IO CInt
soup_cookie_jar_is_persistent Ptr CookieJar
jar'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieJarIsPersistentMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarIsPersistentMethodInfo a signature where
    overloadedMethod = cookieJarIsPersistent

#endif

-- method CookieJar::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_save" soup_cookie_jar_save :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    IO ()

{-# DEPRECATED cookieJarSave ["This is a no-op."] #-}
-- | This function exists for backward compatibility, but does not do
-- anything any more; cookie jars are saved automatically when they
-- are changed.
-- 
-- /Since: 2.24/
cookieJarSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> m ()
cookieJarSave :: a -> m ()
cookieJarSave jar :: a
jar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr CookieJar -> IO ()
soup_cookie_jar_save Ptr CookieJar
jar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarSaveMethodInfo
instance (signature ~ (m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarSaveMethodInfo a signature where
    overloadedMethod = cookieJarSave

#endif

-- method CookieJar::set_accept_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "CookieJarAcceptPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJarAcceptPolicy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_set_accept_policy" soup_cookie_jar_set_accept_policy :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "Soup", name = "CookieJarAcceptPolicy"})
    IO ()

-- | Sets /@policy@/ as the cookie acceptance policy for /@jar@/.
-- 
-- /Since: 2.30/
cookieJarSetAcceptPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.Enums.CookieJarAcceptPolicy
    -- ^ /@policy@/: a t'GI.Soup.Enums.CookieJarAcceptPolicy'
    -> m ()
cookieJarSetAcceptPolicy :: a -> CookieJarAcceptPolicy -> m ()
cookieJarSetAcceptPolicy jar :: a
jar policy :: CookieJarAcceptPolicy
policy = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CookieJarAcceptPolicy -> Int) -> CookieJarAcceptPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookieJarAcceptPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) CookieJarAcceptPolicy
policy
    Ptr CookieJar -> CUInt -> IO ()
soup_cookie_jar_set_accept_policy Ptr CookieJar
jar' CUInt
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarSetAcceptPolicyMethodInfo
instance (signature ~ (Soup.Enums.CookieJarAcceptPolicy -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarSetAcceptPolicyMethodInfo a signature where
    overloadedMethod = cookieJarSetAcceptPolicy

#endif

-- method CookieJar::set_cookie
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI setting the cookie"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cookie"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stringified cookie to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_set_cookie" soup_cookie_jar_set_cookie :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- cookie : TBasicType TUTF8
    IO ()

-- | Adds /@cookie@/ to /@jar@/, exactly as though it had appeared in a
-- Set-Cookie header returned from a request to /@uri@/.
-- 
-- Keep in mind that if the t'GI.Soup.Enums.CookieJarAcceptPolicy'
-- 'GI.Soup.Enums.CookieJarAcceptPolicyNoThirdParty' is set you\'ll need to use
-- 'GI.Soup.Objects.CookieJar.cookieJarSetCookieWithFirstParty', otherwise the jar
-- will have no way of knowing if the cookie is being set by a third
-- party or not.
-- 
-- /Since: 2.24/
cookieJarSetCookie ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.URI.URI
    -- ^ /@uri@/: the URI setting the cookie
    -> T.Text
    -- ^ /@cookie@/: the stringified cookie to set
    -> m ()
cookieJarSetCookie :: a -> URI -> Text -> m ()
cookieJarSetCookie jar :: a
jar uri :: URI
uri cookie :: Text
cookie = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CString
cookie' <- Text -> IO CString
textToCString Text
cookie
    Ptr CookieJar -> Ptr URI -> CString -> IO ()
soup_cookie_jar_set_cookie Ptr CookieJar
jar' Ptr URI
uri' CString
cookie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
cookie'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarSetCookieMethodInfo
instance (signature ~ (Soup.URI.URI -> T.Text -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarSetCookieMethodInfo a signature where
    overloadedMethod = cookieJarSetCookie

#endif

-- method CookieJar::set_cookie_with_first_party
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "jar"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "CookieJar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupCookieJar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI setting the cookie"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_party"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the URI for the main document"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cookie"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stringified cookie to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_jar_set_cookie_with_first_party" soup_cookie_jar_set_cookie_with_first_party :: 
    Ptr CookieJar ->                        -- jar : TInterface (Name {namespace = "Soup", name = "CookieJar"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr Soup.URI.URI ->                     -- first_party : TInterface (Name {namespace = "Soup", name = "URI"})
    CString ->                              -- cookie : TBasicType TUTF8
    IO ()

-- | Adds /@cookie@/ to /@jar@/, exactly as though it had appeared in a
-- Set-Cookie header returned from a request to /@uri@/. /@firstParty@/
-- will be used to reject cookies coming from third party resources in
-- case such a security policy is set in the /@jar@/.
-- 
-- /Since: 2.30/
cookieJarSetCookieWithFirstParty ::
    (B.CallStack.HasCallStack, MonadIO m, IsCookieJar a) =>
    a
    -- ^ /@jar@/: a t'GI.Soup.Objects.CookieJar.CookieJar'
    -> Soup.URI.URI
    -- ^ /@uri@/: the URI setting the cookie
    -> Soup.URI.URI
    -- ^ /@firstParty@/: the URI for the main document
    -> T.Text
    -- ^ /@cookie@/: the stringified cookie to set
    -> m ()
cookieJarSetCookieWithFirstParty :: a -> URI -> URI -> Text -> m ()
cookieJarSetCookieWithFirstParty jar :: a
jar uri :: URI
uri firstParty :: URI
firstParty cookie :: Text
cookie = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr CookieJar
jar' <- a -> IO (Ptr CookieJar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jar
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr URI
firstParty' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
firstParty
    CString
cookie' <- Text -> IO CString
textToCString Text
cookie
    Ptr CookieJar -> Ptr URI -> Ptr URI -> CString -> IO ()
soup_cookie_jar_set_cookie_with_first_party Ptr CookieJar
jar' Ptr URI
uri' Ptr URI
firstParty' CString
cookie'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jar
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
firstParty
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
cookie'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieJarSetCookieWithFirstPartyMethodInfo
instance (signature ~ (Soup.URI.URI -> Soup.URI.URI -> T.Text -> m ()), MonadIO m, IsCookieJar a) => O.MethodInfo CookieJarSetCookieWithFirstPartyMethodInfo a signature where
    overloadedMethod = cookieJarSetCookieWithFirstParty

#endif