{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Soup.Structs.Cookie.Cookie' implements HTTP cookies, as described by \<ulink
-- url=\"http:\/\/tools.ietf.org\/html\/rfc6265.txt\">RFC 6265\<\/ulink>.
-- 
-- To have a t'GI.Soup.Objects.Session.Session' handle cookies for your appliction
-- automatically, use a t'GI.Soup.Objects.CookieJar.CookieJar'.
-- 
-- /Since: 2.24/

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

module GI.Soup.Structs.Cookie
    ( 

-- * Exported types
    Cookie(..)                              ,
    newZeroCookie                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appliesToUri]("GI.Soup.Structs.Cookie#g:method:appliesToUri"), [copy]("GI.Soup.Structs.Cookie#g:method:copy"), [domainMatches]("GI.Soup.Structs.Cookie#g:method:domainMatches"), [equal]("GI.Soup.Structs.Cookie#g:method:equal"), [free]("GI.Soup.Structs.Cookie#g:method:free"), [toCookieHeader]("GI.Soup.Structs.Cookie#g:method:toCookieHeader"), [toSetCookieHeader]("GI.Soup.Structs.Cookie#g:method:toSetCookieHeader").
-- 
-- ==== Getters
-- [getDomain]("GI.Soup.Structs.Cookie#g:method:getDomain"), [getExpires]("GI.Soup.Structs.Cookie#g:method:getExpires"), [getHttpOnly]("GI.Soup.Structs.Cookie#g:method:getHttpOnly"), [getName]("GI.Soup.Structs.Cookie#g:method:getName"), [getPath]("GI.Soup.Structs.Cookie#g:method:getPath"), [getSameSitePolicy]("GI.Soup.Structs.Cookie#g:method:getSameSitePolicy"), [getSecure]("GI.Soup.Structs.Cookie#g:method:getSecure"), [getValue]("GI.Soup.Structs.Cookie#g:method:getValue").
-- 
-- ==== Setters
-- [setDomain]("GI.Soup.Structs.Cookie#g:method:setDomain"), [setExpires]("GI.Soup.Structs.Cookie#g:method:setExpires"), [setHttpOnly]("GI.Soup.Structs.Cookie#g:method:setHttpOnly"), [setMaxAge]("GI.Soup.Structs.Cookie#g:method:setMaxAge"), [setName]("GI.Soup.Structs.Cookie#g:method:setName"), [setPath]("GI.Soup.Structs.Cookie#g:method:setPath"), [setSameSitePolicy]("GI.Soup.Structs.Cookie#g:method:setSameSitePolicy"), [setSecure]("GI.Soup.Structs.Cookie#g:method:setSecure"), [setValue]("GI.Soup.Structs.Cookie#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveCookieMethod                     ,
#endif

-- ** appliesToUri #method:appliesToUri#

#if defined(ENABLE_OVERLOADING)
    CookieAppliesToUriMethodInfo            ,
#endif
    cookieAppliesToUri                      ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    CookieCopyMethodInfo                    ,
#endif
    cookieCopy                              ,


-- ** domainMatches #method:domainMatches#

#if defined(ENABLE_OVERLOADING)
    CookieDomainMatchesMethodInfo           ,
#endif
    cookieDomainMatches                     ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    CookieEqualMethodInfo                   ,
#endif
    cookieEqual                             ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    CookieFreeMethodInfo                    ,
#endif
    cookieFree                              ,


-- ** getDomain #method:getDomain#

#if defined(ENABLE_OVERLOADING)
    CookieGetDomainMethodInfo               ,
#endif
    cookieGetDomain                         ,


-- ** getExpires #method:getExpires#

#if defined(ENABLE_OVERLOADING)
    CookieGetExpiresMethodInfo              ,
#endif
    cookieGetExpires                        ,


-- ** getHttpOnly #method:getHttpOnly#

#if defined(ENABLE_OVERLOADING)
    CookieGetHttpOnlyMethodInfo             ,
#endif
    cookieGetHttpOnly                       ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    CookieGetNameMethodInfo                 ,
#endif
    cookieGetName                           ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    CookieGetPathMethodInfo                 ,
#endif
    cookieGetPath                           ,


-- ** getSameSitePolicy #method:getSameSitePolicy#

#if defined(ENABLE_OVERLOADING)
    CookieGetSameSitePolicyMethodInfo       ,
#endif
    cookieGetSameSitePolicy                 ,


-- ** getSecure #method:getSecure#

#if defined(ENABLE_OVERLOADING)
    CookieGetSecureMethodInfo               ,
#endif
    cookieGetSecure                         ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    CookieGetValueMethodInfo                ,
#endif
    cookieGetValue                          ,


-- ** new #method:new#

    cookieNew                               ,


-- ** parse #method:parse#

    cookieParse                             ,


-- ** setDomain #method:setDomain#

#if defined(ENABLE_OVERLOADING)
    CookieSetDomainMethodInfo               ,
#endif
    cookieSetDomain                         ,


-- ** setExpires #method:setExpires#

#if defined(ENABLE_OVERLOADING)
    CookieSetExpiresMethodInfo              ,
#endif
    cookieSetExpires                        ,


-- ** setHttpOnly #method:setHttpOnly#

#if defined(ENABLE_OVERLOADING)
    CookieSetHttpOnlyMethodInfo             ,
#endif
    cookieSetHttpOnly                       ,


-- ** setMaxAge #method:setMaxAge#

#if defined(ENABLE_OVERLOADING)
    CookieSetMaxAgeMethodInfo               ,
#endif
    cookieSetMaxAge                         ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    CookieSetNameMethodInfo                 ,
#endif
    cookieSetName                           ,


-- ** setPath #method:setPath#

#if defined(ENABLE_OVERLOADING)
    CookieSetPathMethodInfo                 ,
#endif
    cookieSetPath                           ,


-- ** setSameSitePolicy #method:setSameSitePolicy#

#if defined(ENABLE_OVERLOADING)
    CookieSetSameSitePolicyMethodInfo       ,
#endif
    cookieSetSameSitePolicy                 ,


-- ** setSecure #method:setSecure#

#if defined(ENABLE_OVERLOADING)
    CookieSetSecureMethodInfo               ,
#endif
    cookieSetSecure                         ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    CookieSetValueMethodInfo                ,
#endif
    cookieSetValue                          ,


-- ** toCookieHeader #method:toCookieHeader#

#if defined(ENABLE_OVERLOADING)
    CookieToCookieHeaderMethodInfo          ,
#endif
    cookieToCookieHeader                    ,


-- ** toSetCookieHeader #method:toSetCookieHeader#

#if defined(ENABLE_OVERLOADING)
    CookieToSetCookieHeaderMethodInfo       ,
#endif
    cookieToSetCookieHeader                 ,




 -- * Properties


-- ** domain #attr:domain#
-- | the \"domain\" attribute, or else the hostname that the
-- cookie came from.

    clearCookieDomain                       ,
#if defined(ENABLE_OVERLOADING)
    cookie_domain                           ,
#endif
    getCookieDomain                         ,
    setCookieDomain                         ,


-- ** expires #attr:expires#
-- | the cookie expiration time, or 'P.Nothing' for a session cookie

    clearCookieExpires                      ,
#if defined(ENABLE_OVERLOADING)
    cookie_expires                          ,
#endif
    getCookieExpires                        ,
    setCookieExpires                        ,


-- ** httpOnly #attr:httpOnly#
-- | 'P.True' if the cookie should not be exposed to scripts

#if defined(ENABLE_OVERLOADING)
    cookie_httpOnly                         ,
#endif
    getCookieHttpOnly                       ,
    setCookieHttpOnly                       ,


-- ** name #attr:name#
-- | the cookie name

    clearCookieName                         ,
#if defined(ENABLE_OVERLOADING)
    cookie_name                             ,
#endif
    getCookieName                           ,
    setCookieName                           ,


-- ** path #attr:path#
-- | the \"path\" attribute, or 'P.Nothing'

    clearCookiePath                         ,
#if defined(ENABLE_OVERLOADING)
    cookie_path                             ,
#endif
    getCookiePath                           ,
    setCookiePath                           ,


-- ** secure #attr:secure#
-- | 'P.True' if the cookie should only be tranferred over SSL

#if defined(ENABLE_OVERLOADING)
    cookie_secure                           ,
#endif
    getCookieSecure                         ,
    setCookieSecure                         ,


-- ** value #attr:value#
-- | the cookie value

    clearCookieValue                        ,
#if defined(ENABLE_OVERLOADING)
    cookie_value                            ,
#endif
    getCookieValue                          ,
    setCookieValue                          ,




    ) 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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Structs.Date as Soup.Date
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

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

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

foreign import ccall "soup_cookie_get_type" c_soup_cookie_get_type :: 
    IO GType

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

instance B.Types.TypedObject Cookie where
    glibType :: IO GType
glibType = IO GType
c_soup_cookie_get_type

instance B.Types.GBoxed Cookie

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

-- | Construct a `Cookie` struct initialized to zero.
newZeroCookie :: MonadIO m => m Cookie
newZeroCookie :: forall (m :: * -> *). MonadIO m => m Cookie
newZeroCookie = 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
$ Int -> IO (Ptr Cookie)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
48 IO (Ptr Cookie) -> (Ptr Cookie -> IO Cookie) -> IO Cookie
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Cookie

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


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #name
-- @
getCookieName :: MonadIO m => Cookie -> m (Maybe T.Text)
getCookieName :: forall (m :: * -> *). MonadIO m => Cookie -> m (Maybe Text)
getCookieName Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieName :: MonadIO m => Cookie -> CString -> m ()
setCookieName :: forall (m :: * -> *). MonadIO m => Cookie -> CString -> m ()
setCookieName Cookie
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearCookieName :: MonadIO m => Cookie -> m ()
clearCookieName :: forall (m :: * -> *). MonadIO m => Cookie -> m ()
clearCookieName Cookie
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CookieNameFieldInfo
instance AttrInfo CookieNameFieldInfo where
    type AttrBaseTypeConstraint CookieNameFieldInfo = (~) Cookie
    type AttrAllowedOps CookieNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CookieNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint CookieNameFieldInfo = (~)CString
    type AttrTransferType CookieNameFieldInfo = CString
    type AttrGetType CookieNameFieldInfo = Maybe T.Text
    type AttrLabel CookieNameFieldInfo = "name"
    type AttrOrigin CookieNameFieldInfo = Cookie
    attrGet = getCookieName
    attrSet = setCookieName
    attrConstruct = undefined
    attrClear = clearCookieName
    attrTransfer _ v = do
        return v

cookie_name :: AttrLabelProxy "name"
cookie_name = AttrLabelProxy

#endif


-- | Get the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #value
-- @
getCookieValue :: MonadIO m => Cookie -> m (Maybe T.Text)
getCookieValue :: forall (m :: * -> *). MonadIO m => Cookie -> m (Maybe Text)
getCookieValue Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #value 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieValue :: MonadIO m => Cookie -> CString -> m ()
setCookieValue :: forall (m :: * -> *). MonadIO m => Cookie -> CString -> m ()
setCookieValue Cookie
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@value@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #value
-- @
clearCookieValue :: MonadIO m => Cookie -> m ()
clearCookieValue :: forall (m :: * -> *). MonadIO m => Cookie -> m ()
clearCookieValue Cookie
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CookieValueFieldInfo
instance AttrInfo CookieValueFieldInfo where
    type AttrBaseTypeConstraint CookieValueFieldInfo = (~) Cookie
    type AttrAllowedOps CookieValueFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CookieValueFieldInfo = (~) CString
    type AttrTransferTypeConstraint CookieValueFieldInfo = (~)CString
    type AttrTransferType CookieValueFieldInfo = CString
    type AttrGetType CookieValueFieldInfo = Maybe T.Text
    type AttrLabel CookieValueFieldInfo = "value"
    type AttrOrigin CookieValueFieldInfo = Cookie
    attrGet = getCookieValue
    attrSet = setCookieValue
    attrConstruct = undefined
    attrClear = clearCookieValue
    attrTransfer _ v = do
        return v

cookie_value :: AttrLabelProxy "value"
cookie_value = AttrLabelProxy

#endif


-- | Get the value of the “@domain@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #domain
-- @
getCookieDomain :: MonadIO m => Cookie -> m (Maybe T.Text)
getCookieDomain :: forall (m :: * -> *). MonadIO m => Cookie -> m (Maybe Text)
getCookieDomain Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@domain@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #domain 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieDomain :: MonadIO m => Cookie -> CString -> m ()
setCookieDomain :: forall (m :: * -> *). MonadIO m => Cookie -> CString -> m ()
setCookieDomain Cookie
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@domain@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #domain
-- @
clearCookieDomain :: MonadIO m => Cookie -> m ()
clearCookieDomain :: forall (m :: * -> *). MonadIO m => Cookie -> m ()
clearCookieDomain Cookie
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CookieDomainFieldInfo
instance AttrInfo CookieDomainFieldInfo where
    type AttrBaseTypeConstraint CookieDomainFieldInfo = (~) Cookie
    type AttrAllowedOps CookieDomainFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CookieDomainFieldInfo = (~) CString
    type AttrTransferTypeConstraint CookieDomainFieldInfo = (~)CString
    type AttrTransferType CookieDomainFieldInfo = CString
    type AttrGetType CookieDomainFieldInfo = Maybe T.Text
    type AttrLabel CookieDomainFieldInfo = "domain"
    type AttrOrigin CookieDomainFieldInfo = Cookie
    attrGet = getCookieDomain
    attrSet = setCookieDomain
    attrConstruct = undefined
    attrClear = clearCookieDomain
    attrTransfer _ v = do
        return v

cookie_domain :: AttrLabelProxy "domain"
cookie_domain = AttrLabelProxy

#endif


-- | Get the value of the “@path@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #path
-- @
getCookiePath :: MonadIO m => Cookie -> m (Maybe T.Text)
getCookiePath :: forall (m :: * -> *). MonadIO m => Cookie -> m (Maybe Text)
getCookiePath Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr Cookie -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@path@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #path 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookiePath :: MonadIO m => Cookie -> CString -> m ()
setCookiePath :: forall (m :: * -> *). MonadIO m => Cookie -> CString -> m ()
setCookiePath Cookie
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@path@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #path
-- @
clearCookiePath :: MonadIO m => Cookie -> m ()
clearCookiePath :: forall (m :: * -> *). MonadIO m => Cookie -> m ()
clearCookiePath Cookie
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data CookiePathFieldInfo
instance AttrInfo CookiePathFieldInfo where
    type AttrBaseTypeConstraint CookiePathFieldInfo = (~) Cookie
    type AttrAllowedOps CookiePathFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CookiePathFieldInfo = (~) CString
    type AttrTransferTypeConstraint CookiePathFieldInfo = (~)CString
    type AttrTransferType CookiePathFieldInfo = CString
    type AttrGetType CookiePathFieldInfo = Maybe T.Text
    type AttrLabel CookiePathFieldInfo = "path"
    type AttrOrigin CookiePathFieldInfo = Cookie
    attrGet = getCookiePath
    attrSet = setCookiePath
    attrConstruct = undefined
    attrClear = clearCookiePath
    attrTransfer _ v = do
        return v

cookie_path :: AttrLabelProxy "path"
cookie_path = AttrLabelProxy

#endif


-- | Get the value of the “@expires@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #expires
-- @
getCookieExpires :: MonadIO m => Cookie -> m (Maybe Soup.Date.Date)
getCookieExpires :: forall (m :: * -> *). MonadIO m => Cookie -> m (Maybe Date)
getCookieExpires Cookie
s = IO (Maybe Date) -> m (Maybe Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Date) -> m (Maybe Date))
-> IO (Maybe Date) -> m (Maybe Date)
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO (Maybe Date)) -> IO (Maybe Date)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO (Maybe Date)) -> IO (Maybe Date))
-> (Ptr Cookie -> IO (Maybe Date)) -> IO (Maybe Date)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr Date
val <- Ptr (Ptr Date) -> IO (Ptr Date)
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr (Ptr Date)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO (Ptr Soup.Date.Date)
    Maybe Date
result <- Ptr Date -> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Date
val ((Ptr Date -> IO Date) -> IO (Maybe Date))
-> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. (a -> b) -> a -> b
$ \Ptr Date
val' -> do
        Date
val'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Date -> Date
Soup.Date.Date) Ptr Date
val'
        Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
val''
    Maybe Date -> IO (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
result

-- | Set the value of the “@expires@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #expires 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieExpires :: MonadIO m => Cookie -> Ptr Soup.Date.Date -> m ()
setCookieExpires :: forall (m :: * -> *). MonadIO m => Cookie -> Ptr Date -> m ()
setCookieExpires Cookie
s Ptr Date
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr (Ptr Date) -> Ptr Date -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr (Ptr Date)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr Date
val :: Ptr Soup.Date.Date)

-- | Set the value of the “@expires@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #expires
-- @
clearCookieExpires :: MonadIO m => Cookie -> m ()
clearCookieExpires :: forall (m :: * -> *). MonadIO m => Cookie -> m ()
clearCookieExpires Cookie
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    Ptr (Ptr Date) -> Ptr Date -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr (Ptr Date)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr Date
forall a. Ptr a
FP.nullPtr :: Ptr Soup.Date.Date)

#if defined(ENABLE_OVERLOADING)
data CookieExpiresFieldInfo
instance AttrInfo CookieExpiresFieldInfo where
    type AttrBaseTypeConstraint CookieExpiresFieldInfo = (~) Cookie
    type AttrAllowedOps CookieExpiresFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint CookieExpiresFieldInfo = (~) (Ptr Soup.Date.Date)
    type AttrTransferTypeConstraint CookieExpiresFieldInfo = (~)(Ptr Soup.Date.Date)
    type AttrTransferType CookieExpiresFieldInfo = (Ptr Soup.Date.Date)
    type AttrGetType CookieExpiresFieldInfo = Maybe Soup.Date.Date
    type AttrLabel CookieExpiresFieldInfo = "expires"
    type AttrOrigin CookieExpiresFieldInfo = Cookie
    attrGet = getCookieExpires
    attrSet = setCookieExpires
    attrConstruct = undefined
    attrClear = clearCookieExpires
    attrTransfer _ v = do
        return v

cookie_expires :: AttrLabelProxy "expires"
cookie_expires = AttrLabelProxy

#endif


-- | Get the value of the “@secure@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #secure
-- @
getCookieSecure :: MonadIO m => Cookie -> m Bool
getCookieSecure :: forall (m :: * -> *). MonadIO m => Cookie -> m Bool
getCookieSecure Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO Bool) -> IO Bool)
-> (Ptr Cookie -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@secure@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #secure 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieSecure :: MonadIO m => Cookie -> Bool -> m ()
setCookieSecure :: forall (m :: * -> *). MonadIO m => Cookie -> Bool -> m ()
setCookieSecure Cookie
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data CookieSecureFieldInfo
instance AttrInfo CookieSecureFieldInfo where
    type AttrBaseTypeConstraint CookieSecureFieldInfo = (~) Cookie
    type AttrAllowedOps CookieSecureFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CookieSecureFieldInfo = (~) Bool
    type AttrTransferTypeConstraint CookieSecureFieldInfo = (~)Bool
    type AttrTransferType CookieSecureFieldInfo = Bool
    type AttrGetType CookieSecureFieldInfo = Bool
    type AttrLabel CookieSecureFieldInfo = "secure"
    type AttrOrigin CookieSecureFieldInfo = Cookie
    attrGet = getCookieSecure
    attrSet = setCookieSecure
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cookie_secure :: AttrLabelProxy "secure"
cookie_secure = AttrLabelProxy

#endif


-- | Get the value of the “@http_only@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' cookie #httpOnly
-- @
getCookieHttpOnly :: MonadIO m => Cookie -> m Bool
getCookieHttpOnly :: forall (m :: * -> *). MonadIO m => Cookie -> m Bool
getCookieHttpOnly Cookie
s = 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
$ Cookie -> (Ptr Cookie -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO Bool) -> IO Bool)
-> (Ptr Cookie -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@http_only@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' cookie [ #httpOnly 'Data.GI.Base.Attributes.:=' value ]
-- @
setCookieHttpOnly :: MonadIO m => Cookie -> Bool -> m ()
setCookieHttpOnly :: forall (m :: * -> *). MonadIO m => Cookie -> Bool -> m ()
setCookieHttpOnly Cookie
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cookie -> (Ptr Cookie -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Cookie
s ((Ptr Cookie -> IO ()) -> IO ()) -> (Ptr Cookie -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Cookie
ptr Ptr Cookie -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
44) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data CookieHttpOnlyFieldInfo
instance AttrInfo CookieHttpOnlyFieldInfo where
    type AttrBaseTypeConstraint CookieHttpOnlyFieldInfo = (~) Cookie
    type AttrAllowedOps CookieHttpOnlyFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint CookieHttpOnlyFieldInfo = (~) Bool
    type AttrTransferTypeConstraint CookieHttpOnlyFieldInfo = (~)Bool
    type AttrTransferType CookieHttpOnlyFieldInfo = Bool
    type AttrGetType CookieHttpOnlyFieldInfo = Bool
    type AttrLabel CookieHttpOnlyFieldInfo = "http_only"
    type AttrOrigin CookieHttpOnlyFieldInfo = Cookie
    attrGet = getCookieHttpOnly
    attrSet = setCookieHttpOnly
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

cookie_httpOnly :: AttrLabelProxy "httpOnly"
cookie_httpOnly = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Cookie
type instance O.AttributeList Cookie = CookieAttributeList
type CookieAttributeList = ('[ '("name", CookieNameFieldInfo), '("value", CookieValueFieldInfo), '("domain", CookieDomainFieldInfo), '("path", CookiePathFieldInfo), '("expires", CookieExpiresFieldInfo), '("secure", CookieSecureFieldInfo), '("httpOnly", CookieHttpOnlyFieldInfo)] :: [(Symbol, *)])
#endif

-- method Cookie::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cookie name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cookie value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cookie domain or hostname"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cookie path, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max_age"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "max age of the cookie, or -1 for a session cookie"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Cookie" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_new" soup_cookie_new :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    CString ->                              -- domain : TBasicType TUTF8
    CString ->                              -- path : TBasicType TUTF8
    Int32 ->                                -- max_age : TBasicType TInt
    IO (Ptr Cookie)

-- | Creates a new t'GI.Soup.Structs.Cookie.Cookie' with the given attributes. (Use
-- 'GI.Soup.Structs.Cookie.cookieSetSecure' and 'GI.Soup.Structs.Cookie.cookieSetHttpOnly' if you
-- need to set those attributes on the returned cookie.)
-- 
-- If /@domain@/ starts with \".\", that indicates a domain (which matches
-- the string after the \".\", or any hostname that has /@domain@/ as a
-- suffix). Otherwise, it is a hostname and must match exactly.
-- 
-- /@maxAge@/ is used to set the \"expires\" attribute on the cookie; pass
-- -1 to not include the attribute (indicating that the cookie expires
-- with the current session), 0 for an already-expired cookie, or a
-- lifetime in seconds. You can use the constants
-- 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_HOUR', 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_DAY',
-- 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_WEEK' and 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_YEAR' (or
-- multiples thereof) to calculate this value. (If you really care
-- about setting the exact time that the cookie will expire, use
-- 'GI.Soup.Structs.Cookie.cookieSetExpires'.)
-- 
-- /Since: 2.24/
cookieNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: cookie name
    -> T.Text
    -- ^ /@value@/: cookie value
    -> T.Text
    -- ^ /@domain@/: cookie domain or hostname
    -> T.Text
    -- ^ /@path@/: cookie path, or 'P.Nothing'
    -> Int32
    -- ^ /@maxAge@/: max age of the cookie, or -1 for a session cookie
    -> m Cookie
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Cookie.Cookie'.
cookieNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> Text -> Text -> Int32 -> m Cookie
cookieNew Text
name Text
value Text
domain Text
path Int32
maxAge = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
value' <- Text -> IO CString
textToCString Text
value
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cookie
result <- CString
-> CString -> CString -> CString -> Int32 -> IO (Ptr Cookie)
soup_cookie_new CString
name' CString
value' CString
domain' CString
path' Int32
maxAge
    Text -> Ptr Cookie -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieNew" Ptr Cookie
result
    Cookie
result' <- ((ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Cookie) Ptr Cookie
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    Cookie -> IO Cookie
forall (m :: * -> *) a. Monad m => a -> m a
return Cookie
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Cookie::applies_to_uri
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_applies_to_uri" soup_cookie_applies_to_uri :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO CInt

-- | Tests if /@cookie@/ should be sent to /@uri@/.
-- 
-- (At the moment, this does not check that /@cookie@/\'s domain matches
-- /@uri@/, because it assumes that the caller has already done that.
-- But don\'t rely on that; it may change in the future.)
-- 
-- /Since: 2.24/
cookieAppliesToUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Soup.URI.URI
    -- ^ /@uri@/: a t'GI.Soup.Structs.URI.URI'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@cookie@/ should be sent to /@uri@/, 'P.False' if
    -- not
cookieAppliesToUri :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> URI -> m Bool
cookieAppliesToUri Cookie
cookie URI
uri = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    CInt
result <- Ptr Cookie -> Ptr URI -> IO CInt
soup_cookie_applies_to_uri Ptr Cookie
cookie' Ptr URI
uri'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieAppliesToUriMethodInfo
instance (signature ~ (Soup.URI.URI -> m Bool), MonadIO m) => O.OverloadedMethod CookieAppliesToUriMethodInfo Cookie signature where
    overloadedMethod = cookieAppliesToUri

instance O.OverloadedMethodInfo CookieAppliesToUriMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieAppliesToUri",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieAppliesToUri"
        }


#endif

-- method Cookie::copy
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TInterface Name { namespace = "Soup" , name = "Cookie" })
-- throws : False
-- Skip return : False

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

-- | Copies /@cookie@/.
-- 
-- /Since: 2.24/
cookieCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m Cookie
    -- ^ __Returns:__ a copy of /@cookie@/
cookieCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> m Cookie
cookieCopy Cookie
cookie = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr Cookie
result <- Ptr Cookie -> IO (Ptr Cookie)
soup_cookie_copy Ptr Cookie
cookie'
    Text -> Ptr Cookie -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieCopy" Ptr Cookie
result
    Cookie
result' <- ((ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Cookie) Ptr Cookie
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Cookie -> IO Cookie
forall (m :: * -> *) a. Monad m => a -> m a
return Cookie
result'

#if defined(ENABLE_OVERLOADING)
data CookieCopyMethodInfo
instance (signature ~ (m Cookie), MonadIO m) => O.OverloadedMethod CookieCopyMethodInfo Cookie signature where
    overloadedMethod = cookieCopy

instance O.OverloadedMethodInfo CookieCopyMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieCopy"
        }


#endif

-- method Cookie::domain_matches
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "host"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a URI" , 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_domain_matches" soup_cookie_domain_matches :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CString ->                              -- host : TBasicType TUTF8
    IO CInt

-- | Checks if the /@cookie@/\'s domain and /@host@/ match in the sense that
-- /@cookie@/ should be sent when making a request to /@host@/, or that
-- /@cookie@/ should be accepted when receiving a response from /@host@/.
-- 
-- /Since: 2.30/
cookieDomainMatches ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> T.Text
    -- ^ /@host@/: a URI
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the domains match, 'P.False' otherwise
cookieDomainMatches :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Text -> m Bool
cookieDomainMatches Cookie
cookie Text
host = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
host' <- Text -> IO CString
textToCString Text
host
    CInt
result <- Ptr Cookie -> CString -> IO CInt
soup_cookie_domain_matches Ptr Cookie
cookie' CString
host'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
host'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieDomainMatchesMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod CookieDomainMatchesMethodInfo Cookie signature where
    overloadedMethod = cookieDomainMatches

instance O.OverloadedMethodInfo CookieDomainMatchesMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieDomainMatches",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieDomainMatches"
        }


#endif

-- method Cookie::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cookie1"
--           , 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
--           }
--       , Arg
--           { argCName = "cookie2"
--           , 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_equal" soup_cookie_equal :: 
    Ptr Cookie ->                           -- cookie1 : TInterface (Name {namespace = "Soup", name = "Cookie"})
    Ptr Cookie ->                           -- cookie2 : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CInt

-- | Tests if /@cookie1@/ and /@cookie2@/ are equal.
-- 
-- Note that currently, this does not check that the cookie domains
-- match. This may change in the future.
-- 
-- /Since: 2.24/
cookieEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie1@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Cookie
    -- ^ /@cookie2@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m Bool
    -- ^ __Returns:__ whether the cookies are equal.
cookieEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Cookie -> m Bool
cookieEqual Cookie
cookie1 Cookie
cookie2 = 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 Cookie
cookie1' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie1
    Ptr Cookie
cookie2' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie2
    CInt
result <- Ptr Cookie -> Ptr Cookie -> IO CInt
soup_cookie_equal Ptr Cookie
cookie1' Ptr Cookie
cookie2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie1
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieEqualMethodInfo
instance (signature ~ (Cookie -> m Bool), MonadIO m) => O.OverloadedMethod CookieEqualMethodInfo Cookie signature where
    overloadedMethod = cookieEqual

instance O.OverloadedMethodInfo CookieEqualMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieEqual",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieEqual"
        }


#endif

-- method Cookie::free
-- method type : OrdinaryMethod
-- Args: [ 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_free" soup_cookie_free :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO ()

-- | Frees /@cookie@/
-- 
-- /Since: 2.24/
cookieFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m ()
cookieFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m ()
cookieFree 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr Cookie -> IO ()
soup_cookie_free Ptr Cookie
cookie'
    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 CookieFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod CookieFreeMethodInfo Cookie signature where
    overloadedMethod = cookieFree

instance O.OverloadedMethodInfo CookieFreeMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieFree"
        }


#endif

-- method Cookie::get_domain
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_domain" soup_cookie_get_domain :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Gets /@cookie@/\'s domain
-- 
-- /Since: 2.32/
cookieGetDomain ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ /@cookie@/\'s domain
cookieGetDomain :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieGetDomain Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_get_domain Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieGetDomain" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetDomainMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieGetDomainMethodInfo Cookie signature where
    overloadedMethod = cookieGetDomain

instance O.OverloadedMethodInfo CookieGetDomainMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetDomain",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetDomain"
        }


#endif

-- method Cookie::get_expires
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TInterface Name { namespace = "Soup" , name = "Date" })
-- throws : False
-- Skip return : False

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

-- | Gets /@cookie@/\'s expiration time.
-- 
-- /Since: 2.32/
cookieGetExpires ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m (Maybe Soup.Date.Date)
    -- ^ __Returns:__ /@cookie@/\'s expiration
    -- time, which is owned by /@cookie@/ and should not be modified or
    -- freed.
cookieGetExpires :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> m (Maybe Date)
cookieGetExpires Cookie
cookie = IO (Maybe Date) -> m (Maybe Date)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Date) -> m (Maybe Date))
-> IO (Maybe Date) -> m (Maybe Date)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr Date
result <- Ptr Cookie -> IO (Ptr Date)
soup_cookie_get_expires Ptr Cookie
cookie'
    Maybe Date
maybeResult <- Ptr Date -> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Date
result ((Ptr Date -> IO Date) -> IO (Maybe Date))
-> (Ptr Date -> IO Date) -> IO (Maybe Date)
forall a b. (a -> b) -> a -> b
$ \Ptr Date
result' -> do
        Date
result'' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Date -> Date
Soup.Date.Date) Ptr Date
result'
        Date -> IO Date
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result''
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Maybe Date -> IO (Maybe Date)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Date
maybeResult

#if defined(ENABLE_OVERLOADING)
data CookieGetExpiresMethodInfo
instance (signature ~ (m (Maybe Soup.Date.Date)), MonadIO m) => O.OverloadedMethod CookieGetExpiresMethodInfo Cookie signature where
    overloadedMethod = cookieGetExpires

instance O.OverloadedMethodInfo CookieGetExpiresMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetExpires",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetExpires"
        }


#endif

-- method Cookie::get_http_only
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_http_only" soup_cookie_get_http_only :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CInt

-- | Gets /@cookie@/\'s HttpOnly attribute
-- 
-- /Since: 2.32/
cookieGetHttpOnly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m Bool
    -- ^ __Returns:__ /@cookie@/\'s HttpOnly attribute
cookieGetHttpOnly :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Bool
cookieGetHttpOnly Cookie
cookie = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CInt
result <- Ptr Cookie -> IO CInt
soup_cookie_get_http_only Ptr Cookie
cookie'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetHttpOnlyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod CookieGetHttpOnlyMethodInfo Cookie signature where
    overloadedMethod = cookieGetHttpOnly

instance O.OverloadedMethodInfo CookieGetHttpOnlyMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetHttpOnly",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetHttpOnly"
        }


#endif

-- method Cookie::get_name
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_name" soup_cookie_get_name :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Gets /@cookie@/\'s name
-- 
-- /Since: 2.32/
cookieGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ /@cookie@/\'s name
cookieGetName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieGetName Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_get_name Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieGetNameMethodInfo Cookie signature where
    overloadedMethod = cookieGetName

instance O.OverloadedMethodInfo CookieGetNameMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetName"
        }


#endif

-- method Cookie::get_path
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_path" soup_cookie_get_path :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Gets /@cookie@/\'s path
-- 
-- /Since: 2.32/
cookieGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ /@cookie@/\'s path
cookieGetPath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieGetPath Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_get_path Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieGetPath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieGetPathMethodInfo Cookie signature where
    overloadedMethod = cookieGetPath

instance O.OverloadedMethodInfo CookieGetPathMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetPath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetPath"
        }


#endif

-- method Cookie::get_same_site_policy
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TInterface Name { namespace = "Soup" , name = "SameSitePolicy" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_same_site_policy" soup_cookie_get_same_site_policy :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 2.70/
cookieGetSameSitePolicy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m Soup.Enums.SameSitePolicy
    -- ^ __Returns:__ a t'GI.Soup.Enums.SameSitePolicy'
cookieGetSameSitePolicy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> m SameSitePolicy
cookieGetSameSitePolicy Cookie
cookie = IO SameSitePolicy -> m SameSitePolicy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SameSitePolicy -> m SameSitePolicy)
-> IO SameSitePolicy -> m SameSitePolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CUInt
result <- Ptr Cookie -> IO CUInt
soup_cookie_get_same_site_policy Ptr Cookie
cookie'
    let result' :: SameSitePolicy
result' = (Int -> SameSitePolicy
forall a. Enum a => Int -> a
toEnum (Int -> SameSitePolicy)
-> (CUInt -> Int) -> CUInt -> SameSitePolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    SameSitePolicy -> IO SameSitePolicy
forall (m :: * -> *) a. Monad m => a -> m a
return SameSitePolicy
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetSameSitePolicyMethodInfo
instance (signature ~ (m Soup.Enums.SameSitePolicy), MonadIO m) => O.OverloadedMethod CookieGetSameSitePolicyMethodInfo Cookie signature where
    overloadedMethod = cookieGetSameSitePolicy

instance O.OverloadedMethodInfo CookieGetSameSitePolicyMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetSameSitePolicy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetSameSitePolicy"
        }


#endif

-- method Cookie::get_secure
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_secure" soup_cookie_get_secure :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CInt

-- | Gets /@cookie@/\'s secure attribute
-- 
-- /Since: 2.32/
cookieGetSecure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m Bool
    -- ^ __Returns:__ /@cookie@/\'s secure attribute
cookieGetSecure :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Bool
cookieGetSecure Cookie
cookie = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CInt
result <- Ptr Cookie -> IO CInt
soup_cookie_get_secure Ptr Cookie
cookie'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetSecureMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod CookieGetSecureMethodInfo Cookie signature where
    overloadedMethod = cookieGetSecure

instance O.OverloadedMethodInfo CookieGetSecureMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetSecure",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetSecure"
        }


#endif

-- method Cookie::get_value
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_get_value" soup_cookie_get_value :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Gets /@cookie@/\'s value
-- 
-- /Since: 2.32/
cookieGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ /@cookie@/\'s value
cookieGetValue :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieGetValue Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_get_value Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieGetValue" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieGetValueMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieGetValueMethodInfo Cookie signature where
    overloadedMethod = cookieGetValue

instance O.OverloadedMethodInfo CookieGetValueMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieGetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieGetValue"
        }


#endif

-- method Cookie::set_domain
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new domain" , 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_set_domain" soup_cookie_set_domain :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CString ->                              -- domain : TBasicType TUTF8
    IO ()

-- | Sets /@cookie@/\'s domain to /@domain@/
-- 
-- /Since: 2.24/
cookieSetDomain ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> T.Text
    -- ^ /@domain@/: the new domain
    -> m ()
cookieSetDomain :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Text -> m ()
cookieSetDomain Cookie
cookie Text
domain = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    Ptr Cookie -> CString -> IO ()
soup_cookie_set_domain Ptr Cookie
cookie' CString
domain'
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieSetDomainMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod CookieSetDomainMethodInfo Cookie signature where
    overloadedMethod = cookieSetDomain

instance O.OverloadedMethodInfo CookieSetDomainMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetDomain",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetDomain"
        }


#endif

-- method Cookie::set_expires
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "expires"
--           , argType = TInterface Name { namespace = "Soup" , name = "Date" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new expiration time, or %NULL"
--                 , 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_set_expires" soup_cookie_set_expires :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    Ptr Soup.Date.Date ->                   -- expires : TInterface (Name {namespace = "Soup", name = "Date"})
    IO ()

-- | Sets /@cookie@/\'s expiration time to /@expires@/. If /@expires@/ is 'P.Nothing',
-- /@cookie@/ will be a session cookie and will expire at the end of the
-- client\'s session.
-- 
-- (This sets the same property as 'GI.Soup.Structs.Cookie.cookieSetMaxAge'.)
-- 
-- /Since: 2.24/
cookieSetExpires ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Soup.Date.Date
    -- ^ /@expires@/: the new expiration time, or 'P.Nothing'
    -> m ()
cookieSetExpires :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Date -> m ()
cookieSetExpires Cookie
cookie Date
expires = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr Date
expires' <- Date -> IO (Ptr Date)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Date
expires
    Ptr Cookie -> Ptr Date -> IO ()
soup_cookie_set_expires Ptr Cookie
cookie' Ptr Date
expires'
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Date -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Date
expires
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieSetExpiresMethodInfo
instance (signature ~ (Soup.Date.Date -> m ()), MonadIO m) => O.OverloadedMethod CookieSetExpiresMethodInfo Cookie signature where
    overloadedMethod = cookieSetExpires

instance O.OverloadedMethodInfo CookieSetExpiresMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetExpires",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetExpires"
        }


#endif

-- method Cookie::set_http_only
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "http_only"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value for the HttpOnly attribute"
--                 , 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_set_http_only" soup_cookie_set_http_only :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CInt ->                                 -- http_only : TBasicType TBoolean
    IO ()

-- | Sets /@cookie@/\'s HttpOnly attribute to /@httpOnly@/. If 'P.True', /@cookie@/
-- will be marked as \"http only\", meaning it should not be exposed to
-- web page scripts or other untrusted code.
-- 
-- /Since: 2.24/
cookieSetHttpOnly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Bool
    -- ^ /@httpOnly@/: the new value for the HttpOnly attribute
    -> m ()
cookieSetHttpOnly :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Bool -> m ()
cookieSetHttpOnly Cookie
cookie Bool
httpOnly = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    let httpOnly' :: CInt
httpOnly' = (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
httpOnly
    Ptr Cookie -> CInt -> IO ()
soup_cookie_set_http_only Ptr Cookie
cookie' CInt
httpOnly'
    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 CookieSetHttpOnlyMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod CookieSetHttpOnlyMethodInfo Cookie signature where
    overloadedMethod = cookieSetHttpOnly

instance O.OverloadedMethodInfo CookieSetHttpOnlyMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetHttpOnly",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetHttpOnly"
        }


#endif

-- method Cookie::set_max_age
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "max_age"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new max age" , 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_set_max_age" soup_cookie_set_max_age :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    Int32 ->                                -- max_age : TBasicType TInt
    IO ()

-- | Sets /@cookie@/\'s max age to /@maxAge@/. If /@maxAge@/ is -1, the cookie
-- is a session cookie, and will expire at the end of the client\'s
-- session. Otherwise, it is the number of seconds until the cookie
-- expires. You can use the constants 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_HOUR',
-- 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_DAY', 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_WEEK' and
-- 'GI.Soup.Constants.COOKIE_MAX_AGE_ONE_YEAR' (or multiples thereof) to calculate
-- this value. (A value of 0 indicates that the cookie should be
-- considered already-expired.)
-- 
-- (This sets the same property as 'GI.Soup.Structs.Cookie.cookieSetExpires'.)
-- 
-- /Since: 2.24/
cookieSetMaxAge ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Int32
    -- ^ /@maxAge@/: the new max age
    -> m ()
cookieSetMaxAge :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Int32 -> m ()
cookieSetMaxAge Cookie
cookie Int32
maxAge = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    Ptr Cookie -> Int32 -> IO ()
soup_cookie_set_max_age Ptr Cookie
cookie' Int32
maxAge
    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 CookieSetMaxAgeMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.OverloadedMethod CookieSetMaxAgeMethodInfo Cookie signature where
    overloadedMethod = cookieSetMaxAge

instance O.OverloadedMethodInfo CookieSetMaxAgeMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetMaxAge",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetMaxAge"
        }


#endif

-- method Cookie::set_name
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new name" , 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_set_name" soup_cookie_set_name :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Sets /@cookie@/\'s name to /@name@/
-- 
-- /Since: 2.24/
cookieSetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> T.Text
    -- ^ /@name@/: the new name
    -> m ()
cookieSetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Text -> m ()
cookieSetName Cookie
cookie Text
name = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cookie -> CString -> IO ()
soup_cookie_set_name Ptr Cookie
cookie' CString
name'
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieSetNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod CookieSetNameMethodInfo Cookie signature where
    overloadedMethod = cookieSetName

instance O.OverloadedMethodInfo CookieSetNameMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetName"
        }


#endif

-- method Cookie::set_path
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new path" , 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_set_path" soup_cookie_set_path :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | Sets /@cookie@/\'s path to /@path@/
-- 
-- /Since: 2.24/
cookieSetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> T.Text
    -- ^ /@path@/: the new path
    -> m ()
cookieSetPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Text -> m ()
cookieSetPath Cookie
cookie Text
path = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cookie -> CString -> IO ()
soup_cookie_set_path Ptr Cookie
cookie' CString
path'
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieSetPathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod CookieSetPathMethodInfo Cookie signature where
    overloadedMethod = cookieSetPath

instance O.OverloadedMethodInfo CookieSetPathMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetPath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetPath"
        }


#endif

-- method Cookie::set_same_site_policy
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "SameSitePolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupSameSitePolicy"
--                 , 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_set_same_site_policy" soup_cookie_set_same_site_policy :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "Soup", name = "SameSitePolicy"})
    IO ()

-- | When used in conjunction with 'GI.Soup.Objects.CookieJar.cookieJarGetCookieListWithSameSiteInfo' this
-- sets the policy of when this cookie should be exposed.
-- 
-- /Since: 2.70/
cookieSetSameSitePolicy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Soup.Enums.SameSitePolicy
    -- ^ /@policy@/: a t'GI.Soup.Enums.SameSitePolicy'
    -> m ()
cookieSetSameSitePolicy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> SameSitePolicy -> m ()
cookieSetSameSitePolicy Cookie
cookie SameSitePolicy
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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SameSitePolicy -> Int) -> SameSitePolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SameSitePolicy -> Int
forall a. Enum a => a -> Int
fromEnum) SameSitePolicy
policy
    Ptr Cookie -> CUInt -> IO ()
soup_cookie_set_same_site_policy Ptr Cookie
cookie' CUInt
policy'
    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 CookieSetSameSitePolicyMethodInfo
instance (signature ~ (Soup.Enums.SameSitePolicy -> m ()), MonadIO m) => O.OverloadedMethod CookieSetSameSitePolicyMethodInfo Cookie signature where
    overloadedMethod = cookieSetSameSitePolicy

instance O.OverloadedMethodInfo CookieSetSameSitePolicyMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetSameSitePolicy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetSameSitePolicy"
        }


#endif

-- method Cookie::set_secure
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "secure"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value for the secure attribute"
--                 , 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_set_secure" soup_cookie_set_secure :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CInt ->                                 -- secure : TBasicType TBoolean
    IO ()

-- | Sets /@cookie@/\'s secure attribute to /@secure@/. If 'P.True', /@cookie@/ will
-- only be transmitted from the client to the server over secure
-- (https) connections.
-- 
-- /Since: 2.24/
cookieSetSecure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> Bool
    -- ^ /@secure@/: the new value for the secure attribute
    -> m ()
cookieSetSecure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Bool -> m ()
cookieSetSecure Cookie
cookie Bool
secure = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    let secure' :: CInt
secure' = (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
secure
    Ptr Cookie -> CInt -> IO ()
soup_cookie_set_secure Ptr Cookie
cookie' CInt
secure'
    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 CookieSetSecureMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod CookieSetSecureMethodInfo Cookie signature where
    overloadedMethod = cookieSetSecure

instance O.OverloadedMethodInfo CookieSetSecureMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetSecure",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetSecure"
        }


#endif

-- method Cookie::set_value
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , 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_set_value" soup_cookie_set_value :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | Sets /@cookie@/\'s value to /@value@/
-- 
-- /Since: 2.24/
cookieSetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> T.Text
    -- ^ /@value@/: the new value
    -> m ()
cookieSetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Cookie -> Text -> m ()
cookieSetValue Cookie
cookie Text
value = 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 Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr Cookie -> CString -> IO ()
soup_cookie_set_value Ptr Cookie
cookie' CString
value'
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CookieSetValueMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod CookieSetValueMethodInfo Cookie signature where
    overloadedMethod = cookieSetValue

instance O.OverloadedMethodInfo CookieSetValueMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieSetValue",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieSetValue"
        }


#endif

-- method Cookie::to_cookie_header
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_to_cookie_header" soup_cookie_to_cookie_header :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Serializes /@cookie@/ in the format used by the Cookie header (ie, for
-- returning a cookie from a t'GI.Soup.Objects.Session.Session' to a server).
-- 
-- /Since: 2.24/
cookieToCookieHeader ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ the header
cookieToCookieHeader :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieToCookieHeader Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_to_cookie_header Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieToCookieHeader" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieToCookieHeaderMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieToCookieHeaderMethodInfo Cookie signature where
    overloadedMethod = cookieToCookieHeader

instance O.OverloadedMethodInfo CookieToCookieHeaderMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieToCookieHeader",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieToCookieHeader"
        }


#endif

-- method Cookie::to_set_cookie_header
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_to_set_cookie_header" soup_cookie_to_set_cookie_header :: 
    Ptr Cookie ->                           -- cookie : TInterface (Name {namespace = "Soup", name = "Cookie"})
    IO CString

-- | Serializes /@cookie@/ in the format used by the Set-Cookie header
-- (ie, for sending a cookie from a t'GI.Soup.Objects.Server.Server' to a client).
-- 
-- /Since: 2.24/
cookieToSetCookieHeader ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Cookie
    -- ^ /@cookie@/: a t'GI.Soup.Structs.Cookie.Cookie'
    -> m T.Text
    -- ^ __Returns:__ the header
cookieToSetCookieHeader :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Cookie -> m Text
cookieToSetCookieHeader Cookie
cookie = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cookie
cookie' <- Cookie -> IO (Ptr Cookie)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Cookie
cookie
    CString
result <- Ptr Cookie -> IO CString
soup_cookie_to_set_cookie_header Ptr Cookie
cookie'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"cookieToSetCookieHeader" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    Cookie -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Cookie
cookie
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CookieToSetCookieHeaderMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod CookieToSetCookieHeaderMethodInfo Cookie signature where
    overloadedMethod = cookieToSetCookieHeader

instance O.OverloadedMethodInfo CookieToSetCookieHeaderMethodInfo Cookie where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Cookie.cookieToSetCookieHeader",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Cookie.html#v:cookieToSetCookieHeader"
        }


#endif

-- method Cookie::parse
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "header"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a cookie string (eg, the value of a Set-Cookie header)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "origin of the cookie, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Cookie" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_cookie_parse" soup_cookie_parse :: 
    CString ->                              -- header : TBasicType TUTF8
    Ptr Soup.URI.URI ->                     -- origin : TInterface (Name {namespace = "Soup", name = "URI"})
    IO (Ptr Cookie)

-- | Parses /@header@/ and returns a t'GI.Soup.Structs.Cookie.Cookie'. (If /@header@/ contains
-- multiple cookies, only the first one will be parsed.)
-- 
-- If /@header@/ does not have \"path\" or \"domain\" attributes, they will
-- be defaulted from /@origin@/. If /@origin@/ is 'P.Nothing', path will default
-- to \"\/\", but domain will be left as 'P.Nothing'. Note that this is not a
-- valid state for a t'GI.Soup.Structs.Cookie.Cookie', and you will need to fill in some
-- appropriate string for the domain if you want to actually make use
-- of the cookie.
-- 
-- /Since: 2.24/
cookieParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@header@/: a cookie string (eg, the value of a Set-Cookie header)
    -> Soup.URI.URI
    -- ^ /@origin@/: origin of the cookie, or 'P.Nothing'
    -> m (Maybe Cookie)
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Cookie.Cookie', or 'P.Nothing' if it could
    -- not be parsed, or contained an illegal \"domain\" attribute for a
    -- cookie originating from /@origin@/.
cookieParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> URI -> m (Maybe Cookie)
cookieParse Text
header URI
origin = IO (Maybe Cookie) -> m (Maybe Cookie)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Cookie) -> m (Maybe Cookie))
-> IO (Maybe Cookie) -> m (Maybe Cookie)
forall a b. (a -> b) -> a -> b
$ do
    CString
header' <- Text -> IO CString
textToCString Text
header
    Ptr URI
origin' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
origin
    Ptr Cookie
result <- CString -> Ptr URI -> IO (Ptr Cookie)
soup_cookie_parse CString
header' Ptr URI
origin'
    Maybe Cookie
maybeResult <- Ptr Cookie -> (Ptr Cookie -> IO Cookie) -> IO (Maybe Cookie)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Cookie
result ((Ptr Cookie -> IO Cookie) -> IO (Maybe Cookie))
-> (Ptr Cookie -> IO Cookie) -> IO (Maybe Cookie)
forall a b. (a -> b) -> a -> b
$ \Ptr Cookie
result' -> do
        Cookie
result'' <- ((ManagedPtr Cookie -> Cookie) -> Ptr Cookie -> IO Cookie
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Cookie -> Cookie
Cookie) Ptr Cookie
result'
        Cookie -> IO Cookie
forall (m :: * -> *) a. Monad m => a -> m a
return Cookie
result''
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
origin
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
header'
    Maybe Cookie -> IO (Maybe Cookie)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cookie
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCookieMethod (t :: Symbol) (o :: *) :: * where
    ResolveCookieMethod "appliesToUri" o = CookieAppliesToUriMethodInfo
    ResolveCookieMethod "copy" o = CookieCopyMethodInfo
    ResolveCookieMethod "domainMatches" o = CookieDomainMatchesMethodInfo
    ResolveCookieMethod "equal" o = CookieEqualMethodInfo
    ResolveCookieMethod "free" o = CookieFreeMethodInfo
    ResolveCookieMethod "toCookieHeader" o = CookieToCookieHeaderMethodInfo
    ResolveCookieMethod "toSetCookieHeader" o = CookieToSetCookieHeaderMethodInfo
    ResolveCookieMethod "getDomain" o = CookieGetDomainMethodInfo
    ResolveCookieMethod "getExpires" o = CookieGetExpiresMethodInfo
    ResolveCookieMethod "getHttpOnly" o = CookieGetHttpOnlyMethodInfo
    ResolveCookieMethod "getName" o = CookieGetNameMethodInfo
    ResolveCookieMethod "getPath" o = CookieGetPathMethodInfo
    ResolveCookieMethod "getSameSitePolicy" o = CookieGetSameSitePolicyMethodInfo
    ResolveCookieMethod "getSecure" o = CookieGetSecureMethodInfo
    ResolveCookieMethod "getValue" o = CookieGetValueMethodInfo
    ResolveCookieMethod "setDomain" o = CookieSetDomainMethodInfo
    ResolveCookieMethod "setExpires" o = CookieSetExpiresMethodInfo
    ResolveCookieMethod "setHttpOnly" o = CookieSetHttpOnlyMethodInfo
    ResolveCookieMethod "setMaxAge" o = CookieSetMaxAgeMethodInfo
    ResolveCookieMethod "setName" o = CookieSetNameMethodInfo
    ResolveCookieMethod "setPath" o = CookieSetPathMethodInfo
    ResolveCookieMethod "setSameSitePolicy" o = CookieSetSameSitePolicyMethodInfo
    ResolveCookieMethod "setSecure" o = CookieSetSecureMethodInfo
    ResolveCookieMethod "setValue" o = CookieSetValueMethodInfo
    ResolveCookieMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif