{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' stores HSTS policies and enforces them when
-- required. t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' implements t'GI.Soup.Interfaces.SessionFeature.SessionFeature', so you
-- can add an HSTS enforcer to a session with
-- 'GI.Soup.Objects.Session.sessionAddFeature' or 'GI.Soup.Objects.Session.sessionAddFeatureByType'.
-- 
-- t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' keeps track of all the HTTPS destinations that,
-- when connected to, return the Strict-Transport-Security header with
-- valid values. t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' will forget those destinations
-- upon expiry or when the server requests it.
-- 
-- When the t'GI.Soup.Objects.Session.Session' the t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' is attached to queues
-- or restarts a message, the t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' will rewrite the URI
-- to HTTPS if the destination is a known HSTS host and is contacted
-- over an insecure transport protocol (HTTP). Users of
-- t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' are advised to listen to changes in
-- SoupMessage:uri in order to be aware of changes in the message URI.
-- 
-- Note that t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' does not support any form of long-term
-- HSTS policy persistence. See @/SoupHSTSDBEnforcer/@ for a persistent
-- enforcer.

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

module GI.Soup.Objects.HSTSEnforcer
    ( 

-- * Exported types
    HSTSEnforcer(..)                        ,
    IsHSTSEnforcer                          ,
    toHSTSEnforcer                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFeature]("GI.Soup.Interfaces.SessionFeature#g:method:addFeature"), [attach]("GI.Soup.Interfaces.SessionFeature#g:method:attach"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [detach]("GI.Soup.Interfaces.SessionFeature#g:method:detach"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasFeature]("GI.Soup.Interfaces.SessionFeature#g:method:hasFeature"), [hasValidPolicy]("GI.Soup.Objects.HSTSEnforcer#g:method:hasValidPolicy"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isPersistent]("GI.Soup.Objects.HSTSEnforcer#g:method:isPersistent"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeFeature]("GI.Soup.Interfaces.SessionFeature#g:method:removeFeature"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDomains]("GI.Soup.Objects.HSTSEnforcer#g:method:getDomains"), [getPolicies]("GI.Soup.Objects.HSTSEnforcer#g:method:getPolicies"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPolicy]("GI.Soup.Objects.HSTSEnforcer#g:method:setPolicy"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSessionPolicy]("GI.Soup.Objects.HSTSEnforcer#g:method:setSessionPolicy").

#if defined(ENABLE_OVERLOADING)
    ResolveHSTSEnforcerMethod               ,
#endif

-- ** getDomains #method:getDomains#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerGetDomainsMethodInfo        ,
#endif
    hSTSEnforcerGetDomains                  ,


-- ** getPolicies #method:getPolicies#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerGetPoliciesMethodInfo       ,
#endif
    hSTSEnforcerGetPolicies                 ,


-- ** hasValidPolicy #method:hasValidPolicy#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerHasValidPolicyMethodInfo    ,
#endif
    hSTSEnforcerHasValidPolicy              ,


-- ** isPersistent #method:isPersistent#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerIsPersistentMethodInfo      ,
#endif
    hSTSEnforcerIsPersistent                ,


-- ** new #method:new#

    hSTSEnforcerNew                         ,


-- ** setPolicy #method:setPolicy#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerSetPolicyMethodInfo         ,
#endif
    hSTSEnforcerSetPolicy                   ,


-- ** setSessionPolicy #method:setSessionPolicy#

#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerSetSessionPolicyMethodInfo  ,
#endif
    hSTSEnforcerSetSessionPolicy            ,




 -- * Signals


-- ** changed #signal:changed#

    C_HSTSEnforcerChangedCallback           ,
    HSTSEnforcerChangedCallback             ,
#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerChangedSignalInfo           ,
#endif
    afterHSTSEnforcerChanged                ,
    genClosure_HSTSEnforcerChanged          ,
    mk_HSTSEnforcerChangedCallback          ,
    noHSTSEnforcerChangedCallback           ,
    onHSTSEnforcerChanged                   ,
    wrap_HSTSEnforcerChangedCallback        ,


-- ** hstsEnforced #signal:hstsEnforced#

    C_HSTSEnforcerHstsEnforcedCallback      ,
    HSTSEnforcerHstsEnforcedCallback        ,
#if defined(ENABLE_OVERLOADING)
    HSTSEnforcerHstsEnforcedSignalInfo      ,
#endif
    afterHSTSEnforcerHstsEnforced           ,
    genClosure_HSTSEnforcerHstsEnforced     ,
    mk_HSTSEnforcerHstsEnforcedCallback     ,
    noHSTSEnforcerHstsEnforcedCallback      ,
    onHSTSEnforcerHstsEnforced              ,
    wrap_HSTSEnforcerHstsEnforcedCallback   ,




    ) 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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Soup.Interfaces.SessionFeature as Soup.SessionFeature
import {-# SOURCE #-} qualified GI.Soup.Objects.Message as Soup.Message
import {-# SOURCE #-} qualified GI.Soup.Structs.HSTSPolicy as Soup.HSTSPolicy

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

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

foreign import ccall "soup_hsts_enforcer_get_type"
    c_soup_hsts_enforcer_get_type :: IO B.Types.GType

instance B.Types.TypedObject HSTSEnforcer where
    glibType :: IO GType
glibType = IO GType
c_soup_hsts_enforcer_get_type

instance B.Types.GObject HSTSEnforcer

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveHSTSEnforcerMethod (t :: Symbol) (o :: *) :: * where
    ResolveHSTSEnforcerMethod "addFeature" o = Soup.SessionFeature.SessionFeatureAddFeatureMethodInfo
    ResolveHSTSEnforcerMethod "attach" o = Soup.SessionFeature.SessionFeatureAttachMethodInfo
    ResolveHSTSEnforcerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveHSTSEnforcerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveHSTSEnforcerMethod "detach" o = Soup.SessionFeature.SessionFeatureDetachMethodInfo
    ResolveHSTSEnforcerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveHSTSEnforcerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveHSTSEnforcerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveHSTSEnforcerMethod "hasFeature" o = Soup.SessionFeature.SessionFeatureHasFeatureMethodInfo
    ResolveHSTSEnforcerMethod "hasValidPolicy" o = HSTSEnforcerHasValidPolicyMethodInfo
    ResolveHSTSEnforcerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveHSTSEnforcerMethod "isPersistent" o = HSTSEnforcerIsPersistentMethodInfo
    ResolveHSTSEnforcerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveHSTSEnforcerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveHSTSEnforcerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveHSTSEnforcerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveHSTSEnforcerMethod "removeFeature" o = Soup.SessionFeature.SessionFeatureRemoveFeatureMethodInfo
    ResolveHSTSEnforcerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveHSTSEnforcerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveHSTSEnforcerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveHSTSEnforcerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveHSTSEnforcerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveHSTSEnforcerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveHSTSEnforcerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveHSTSEnforcerMethod "getDomains" o = HSTSEnforcerGetDomainsMethodInfo
    ResolveHSTSEnforcerMethod "getPolicies" o = HSTSEnforcerGetPoliciesMethodInfo
    ResolveHSTSEnforcerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveHSTSEnforcerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveHSTSEnforcerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveHSTSEnforcerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveHSTSEnforcerMethod "setPolicy" o = HSTSEnforcerSetPolicyMethodInfo
    ResolveHSTSEnforcerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveHSTSEnforcerMethod "setSessionPolicy" o = HSTSEnforcerSetSessionPolicyMethodInfo
    ResolveHSTSEnforcerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal HSTSEnforcer::changed
-- | Emitted when /@hstsEnforcer@/ changes. If a policy has been added,
-- /@newPolicy@/ will contain the newly-added policy and
-- /@oldPolicy@/ will be 'P.Nothing'. If a policy has been deleted,
-- /@oldPolicy@/ will contain the to-be-deleted policy and
-- /@newPolicy@/ will be 'P.Nothing'. If a policy has been changed,
-- /@oldPolicy@/ will contain its old value, and /@newPolicy@/ its
-- new value.
-- 
-- Note that you shouldn\'t modify the policies from a callback to
-- this signal.
type HSTSEnforcerChangedCallback =
    Soup.HSTSPolicy.HSTSPolicy
    -- ^ /@oldPolicy@/: the old t'GI.Soup.Structs.HSTSPolicy.HSTSPolicy' value
    -> Soup.HSTSPolicy.HSTSPolicy
    -- ^ /@newPolicy@/: the new t'GI.Soup.Structs.HSTSPolicy.HSTSPolicy' value
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `HSTSEnforcerChangedCallback`@.
noHSTSEnforcerChangedCallback :: Maybe HSTSEnforcerChangedCallback
noHSTSEnforcerChangedCallback :: Maybe HSTSEnforcerChangedCallback
noHSTSEnforcerChangedCallback = Maybe HSTSEnforcerChangedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_HSTSEnforcerChanged :: MonadIO m => HSTSEnforcerChangedCallback -> m (GClosure C_HSTSEnforcerChangedCallback)
genClosure_HSTSEnforcerChanged :: forall (m :: * -> *).
MonadIO m =>
HSTSEnforcerChangedCallback
-> m (GClosure C_HSTSEnforcerChangedCallback)
genClosure_HSTSEnforcerChanged HSTSEnforcerChangedCallback
cb = IO (GClosure C_HSTSEnforcerChangedCallback)
-> m (GClosure C_HSTSEnforcerChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_HSTSEnforcerChangedCallback)
 -> m (GClosure C_HSTSEnforcerChangedCallback))
-> IO (GClosure C_HSTSEnforcerChangedCallback)
-> m (GClosure C_HSTSEnforcerChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerChangedCallback
cb' = HSTSEnforcerChangedCallback -> C_HSTSEnforcerChangedCallback
wrap_HSTSEnforcerChangedCallback HSTSEnforcerChangedCallback
cb
    C_HSTSEnforcerChangedCallback
-> IO (FunPtr C_HSTSEnforcerChangedCallback)
mk_HSTSEnforcerChangedCallback C_HSTSEnforcerChangedCallback
cb' IO (FunPtr C_HSTSEnforcerChangedCallback)
-> (FunPtr C_HSTSEnforcerChangedCallback
    -> IO (GClosure C_HSTSEnforcerChangedCallback))
-> IO (GClosure C_HSTSEnforcerChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_HSTSEnforcerChangedCallback
-> IO (GClosure C_HSTSEnforcerChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `HSTSEnforcerChangedCallback` into a `C_HSTSEnforcerChangedCallback`.
wrap_HSTSEnforcerChangedCallback ::
    HSTSEnforcerChangedCallback ->
    C_HSTSEnforcerChangedCallback
wrap_HSTSEnforcerChangedCallback :: HSTSEnforcerChangedCallback -> C_HSTSEnforcerChangedCallback
wrap_HSTSEnforcerChangedCallback HSTSEnforcerChangedCallback
_cb Ptr ()
_ Ptr HSTSPolicy
oldPolicy Ptr HSTSPolicy
newPolicy Ptr ()
_ = do
    (ManagedPtr HSTSPolicy -> HSTSPolicy)
-> Ptr HSTSPolicy -> (HSTSPolicy -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr HSTSPolicy -> HSTSPolicy
Soup.HSTSPolicy.HSTSPolicy Ptr HSTSPolicy
oldPolicy ((HSTSPolicy -> IO ()) -> IO ()) -> (HSTSPolicy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HSTSPolicy
oldPolicy' -> do
        (ManagedPtr HSTSPolicy -> HSTSPolicy)
-> Ptr HSTSPolicy -> (HSTSPolicy -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr HSTSPolicy -> HSTSPolicy
Soup.HSTSPolicy.HSTSPolicy Ptr HSTSPolicy
newPolicy ((HSTSPolicy -> IO ()) -> IO ()) -> (HSTSPolicy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HSTSPolicy
newPolicy' -> do
            HSTSEnforcerChangedCallback
_cb  HSTSPolicy
oldPolicy' HSTSPolicy
newPolicy'


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' hSTSEnforcer #changed callback
-- @
-- 
-- 
onHSTSEnforcerChanged :: (IsHSTSEnforcer a, MonadIO m) => a -> HSTSEnforcerChangedCallback -> m SignalHandlerId
onHSTSEnforcerChanged :: forall a (m :: * -> *).
(IsHSTSEnforcer a, MonadIO m) =>
a -> HSTSEnforcerChangedCallback -> m SignalHandlerId
onHSTSEnforcerChanged a
obj HSTSEnforcerChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerChangedCallback
cb' = HSTSEnforcerChangedCallback -> C_HSTSEnforcerChangedCallback
wrap_HSTSEnforcerChangedCallback HSTSEnforcerChangedCallback
cb
    FunPtr C_HSTSEnforcerChangedCallback
cb'' <- C_HSTSEnforcerChangedCallback
-> IO (FunPtr C_HSTSEnforcerChangedCallback)
mk_HSTSEnforcerChangedCallback C_HSTSEnforcerChangedCallback
cb'
    a
-> Text
-> FunPtr C_HSTSEnforcerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_HSTSEnforcerChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' hSTSEnforcer #changed callback
-- @
-- 
-- 
afterHSTSEnforcerChanged :: (IsHSTSEnforcer a, MonadIO m) => a -> HSTSEnforcerChangedCallback -> m SignalHandlerId
afterHSTSEnforcerChanged :: forall a (m :: * -> *).
(IsHSTSEnforcer a, MonadIO m) =>
a -> HSTSEnforcerChangedCallback -> m SignalHandlerId
afterHSTSEnforcerChanged a
obj HSTSEnforcerChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerChangedCallback
cb' = HSTSEnforcerChangedCallback -> C_HSTSEnforcerChangedCallback
wrap_HSTSEnforcerChangedCallback HSTSEnforcerChangedCallback
cb
    FunPtr C_HSTSEnforcerChangedCallback
cb'' <- C_HSTSEnforcerChangedCallback
-> IO (FunPtr C_HSTSEnforcerChangedCallback)
mk_HSTSEnforcerChangedCallback C_HSTSEnforcerChangedCallback
cb'
    a
-> Text
-> FunPtr C_HSTSEnforcerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_HSTSEnforcerChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerChangedSignalInfo
instance SignalInfo HSTSEnforcerChangedSignalInfo where
    type HaskellCallbackType HSTSEnforcerChangedSignalInfo = HSTSEnforcerChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_HSTSEnforcerChangedCallback cb
        cb'' <- mk_HSTSEnforcerChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- signal HSTSEnforcer::hsts-enforced
-- | Emitted when /@hstsEnforcer@/ has upgraded the protocol
-- for /@message@/ to HTTPS as a result of matching its domain with
-- a HSTS policy.
type HSTSEnforcerHstsEnforcedCallback =
    Soup.Message.Message
    -- ^ /@message@/: the message for which HSTS is being enforced
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `HSTSEnforcerHstsEnforcedCallback`@.
noHSTSEnforcerHstsEnforcedCallback :: Maybe HSTSEnforcerHstsEnforcedCallback
noHSTSEnforcerHstsEnforcedCallback :: Maybe HSTSEnforcerHstsEnforcedCallback
noHSTSEnforcerHstsEnforcedCallback = Maybe HSTSEnforcerHstsEnforcedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_HSTSEnforcerHstsEnforced :: MonadIO m => HSTSEnforcerHstsEnforcedCallback -> m (GClosure C_HSTSEnforcerHstsEnforcedCallback)
genClosure_HSTSEnforcerHstsEnforced :: forall (m :: * -> *).
MonadIO m =>
HSTSEnforcerHstsEnforcedCallback
-> m (GClosure C_HSTSEnforcerHstsEnforcedCallback)
genClosure_HSTSEnforcerHstsEnforced HSTSEnforcerHstsEnforcedCallback
cb = IO (GClosure C_HSTSEnforcerHstsEnforcedCallback)
-> m (GClosure C_HSTSEnforcerHstsEnforcedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_HSTSEnforcerHstsEnforcedCallback)
 -> m (GClosure C_HSTSEnforcerHstsEnforcedCallback))
-> IO (GClosure C_HSTSEnforcerHstsEnforcedCallback)
-> m (GClosure C_HSTSEnforcerHstsEnforcedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerHstsEnforcedCallback
cb' = HSTSEnforcerHstsEnforcedCallback
-> C_HSTSEnforcerHstsEnforcedCallback
wrap_HSTSEnforcerHstsEnforcedCallback HSTSEnforcerHstsEnforcedCallback
cb
    C_HSTSEnforcerHstsEnforcedCallback
-> IO (FunPtr C_HSTSEnforcerHstsEnforcedCallback)
mk_HSTSEnforcerHstsEnforcedCallback C_HSTSEnforcerHstsEnforcedCallback
cb' IO (FunPtr C_HSTSEnforcerHstsEnforcedCallback)
-> (FunPtr C_HSTSEnforcerHstsEnforcedCallback
    -> IO (GClosure C_HSTSEnforcerHstsEnforcedCallback))
-> IO (GClosure C_HSTSEnforcerHstsEnforcedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_HSTSEnforcerHstsEnforcedCallback
-> IO (GClosure C_HSTSEnforcerHstsEnforcedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `HSTSEnforcerHstsEnforcedCallback` into a `C_HSTSEnforcerHstsEnforcedCallback`.
wrap_HSTSEnforcerHstsEnforcedCallback ::
    HSTSEnforcerHstsEnforcedCallback ->
    C_HSTSEnforcerHstsEnforcedCallback
wrap_HSTSEnforcerHstsEnforcedCallback :: HSTSEnforcerHstsEnforcedCallback
-> C_HSTSEnforcerHstsEnforcedCallback
wrap_HSTSEnforcerHstsEnforcedCallback HSTSEnforcerHstsEnforcedCallback
_cb Ptr ()
_ Ptr Message
message Ptr ()
_ = do
    Message
message' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
message
    HSTSEnforcerHstsEnforcedCallback
_cb  Message
message'


-- | Connect a signal handler for the [hstsEnforced](#signal:hstsEnforced) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' hSTSEnforcer #hstsEnforced callback
-- @
-- 
-- 
onHSTSEnforcerHstsEnforced :: (IsHSTSEnforcer a, MonadIO m) => a -> HSTSEnforcerHstsEnforcedCallback -> m SignalHandlerId
onHSTSEnforcerHstsEnforced :: forall a (m :: * -> *).
(IsHSTSEnforcer a, MonadIO m) =>
a -> HSTSEnforcerHstsEnforcedCallback -> m SignalHandlerId
onHSTSEnforcerHstsEnforced a
obj HSTSEnforcerHstsEnforcedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerHstsEnforcedCallback
cb' = HSTSEnforcerHstsEnforcedCallback
-> C_HSTSEnforcerHstsEnforcedCallback
wrap_HSTSEnforcerHstsEnforcedCallback HSTSEnforcerHstsEnforcedCallback
cb
    FunPtr C_HSTSEnforcerHstsEnforcedCallback
cb'' <- C_HSTSEnforcerHstsEnforcedCallback
-> IO (FunPtr C_HSTSEnforcerHstsEnforcedCallback)
mk_HSTSEnforcerHstsEnforcedCallback C_HSTSEnforcerHstsEnforcedCallback
cb'
    a
-> Text
-> FunPtr C_HSTSEnforcerHstsEnforcedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hsts-enforced" FunPtr C_HSTSEnforcerHstsEnforcedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [hstsEnforced](#signal:hstsEnforced) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' hSTSEnforcer #hstsEnforced callback
-- @
-- 
-- 
afterHSTSEnforcerHstsEnforced :: (IsHSTSEnforcer a, MonadIO m) => a -> HSTSEnforcerHstsEnforcedCallback -> m SignalHandlerId
afterHSTSEnforcerHstsEnforced :: forall a (m :: * -> *).
(IsHSTSEnforcer a, MonadIO m) =>
a -> HSTSEnforcerHstsEnforcedCallback -> m SignalHandlerId
afterHSTSEnforcerHstsEnforced a
obj HSTSEnforcerHstsEnforcedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HSTSEnforcerHstsEnforcedCallback
cb' = HSTSEnforcerHstsEnforcedCallback
-> C_HSTSEnforcerHstsEnforcedCallback
wrap_HSTSEnforcerHstsEnforcedCallback HSTSEnforcerHstsEnforcedCallback
cb
    FunPtr C_HSTSEnforcerHstsEnforcedCallback
cb'' <- C_HSTSEnforcerHstsEnforcedCallback
-> IO (FunPtr C_HSTSEnforcerHstsEnforcedCallback)
mk_HSTSEnforcerHstsEnforcedCallback C_HSTSEnforcerHstsEnforcedCallback
cb'
    a
-> Text
-> FunPtr C_HSTSEnforcerHstsEnforcedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hsts-enforced" FunPtr C_HSTSEnforcerHstsEnforcedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerHstsEnforcedSignalInfo
instance SignalInfo HSTSEnforcerHstsEnforcedSignalInfo where
    type HaskellCallbackType HSTSEnforcerHstsEnforcedSignalInfo = HSTSEnforcerHstsEnforcedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_HSTSEnforcerHstsEnforcedCallback cb
        cb'' <- mk_HSTSEnforcerHstsEnforcedCallback cb'
        connectSignalFunPtr obj "hsts-enforced" cb'' connectMode detail

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList HSTSEnforcer = HSTSEnforcerSignalList
type HSTSEnforcerSignalList = ('[ '("changed", HSTSEnforcerChangedSignalInfo), '("hstsEnforced", HSTSEnforcerHstsEnforcedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "soup_hsts_enforcer_new" soup_hsts_enforcer_new :: 
    IO (Ptr HSTSEnforcer)

-- | Creates a new t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'. The base t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer' class
-- does not support persistent storage of HSTS policies, see
-- t'GI.Soup.Objects.HSTSEnforcerDB.HSTSEnforcerDB' for that.
-- 
-- /Since: 2.68/
hSTSEnforcerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m HSTSEnforcer
    -- ^ __Returns:__ a new t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
hSTSEnforcerNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m HSTSEnforcer
hSTSEnforcerNew  = IO HSTSEnforcer -> m HSTSEnforcer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HSTSEnforcer -> m HSTSEnforcer)
-> IO HSTSEnforcer -> m HSTSEnforcer
forall a b. (a -> b) -> a -> b
$ do
    Ptr HSTSEnforcer
result <- IO (Ptr HSTSEnforcer)
soup_hsts_enforcer_new
    Text -> Ptr HSTSEnforcer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"hSTSEnforcerNew" Ptr HSTSEnforcer
result
    HSTSEnforcer
result' <- ((ManagedPtr HSTSEnforcer -> HSTSEnforcer)
-> Ptr HSTSEnforcer -> IO HSTSEnforcer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr HSTSEnforcer -> HSTSEnforcer
HSTSEnforcer) Ptr HSTSEnforcer
result
    HSTSEnforcer -> IO HSTSEnforcer
forall (m :: * -> *) a. Monad m => a -> m a
return HSTSEnforcer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method HSTSEnforcer::get_domains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session_policies"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to include session policies"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "soup_hsts_enforcer_get_domains" soup_hsts_enforcer_get_domains :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    CInt ->                                 -- session_policies : TBasicType TBoolean
    IO (Ptr (GList CString))

-- | Gets a list of domains for which there are policies in /@enforcer@/.
-- 
-- /Since: 2.68/
hSTSEnforcerGetDomains ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> Bool
    -- ^ /@sessionPolicies@/: whether to include session policies
    -> m [T.Text]
    -- ^ __Returns:__ a newly allocated
    -- list of domains. Use @/g_list_free_full()/@ and 'GI.GLib.Functions.free' to free the
    -- list.
hSTSEnforcerGetDomains :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> Bool -> m [Text]
hSTSEnforcerGetDomains a
hstsEnforcer Bool
sessionPolicies = 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 HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    let sessionPolicies' :: CInt
sessionPolicies' = (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
sessionPolicies
    Ptr (GList CString)
result <- Ptr HSTSEnforcer -> CInt -> IO (Ptr (GList CString))
soup_hsts_enforcer_get_domains Ptr HSTSEnforcer
hstsEnforcer' CInt
sessionPolicies'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
result
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerGetDomainsMethodInfo
instance (signature ~ (Bool -> m [T.Text]), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerGetDomainsMethodInfo a signature where
    overloadedMethod = hSTSEnforcerGetDomains

instance O.OverloadedMethodInfo HSTSEnforcerGetDomainsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerGetDomains",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerGetDomains"
        }


#endif

-- method HSTSEnforcer::get_policies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "session_policies"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to include session policies"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Soup" , name = "HSTSPolicy" }))
-- throws : False
-- Skip return : False

foreign import ccall "soup_hsts_enforcer_get_policies" soup_hsts_enforcer_get_policies :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    CInt ->                                 -- session_policies : TBasicType TBoolean
    IO (Ptr (GList (Ptr Soup.HSTSPolicy.HSTSPolicy)))

-- | Gets a list with the policies in /@enforcer@/.
-- 
-- /Since: 2.68/
hSTSEnforcerGetPolicies ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> Bool
    -- ^ /@sessionPolicies@/: whether to include session policies
    -> m [Soup.HSTSPolicy.HSTSPolicy]
    -- ^ __Returns:__ a newly
    -- allocated list of policies. Use @/g_list_free_full()/@ and
    -- 'GI.Soup.Structs.HSTSPolicy.hSTSPolicyFree' to free the list.
hSTSEnforcerGetPolicies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> Bool -> m [HSTSPolicy]
hSTSEnforcerGetPolicies a
hstsEnforcer Bool
sessionPolicies = IO [HSTSPolicy] -> m [HSTSPolicy]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HSTSPolicy] -> m [HSTSPolicy])
-> IO [HSTSPolicy] -> m [HSTSPolicy]
forall a b. (a -> b) -> a -> b
$ do
    Ptr HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    let sessionPolicies' :: CInt
sessionPolicies' = (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
sessionPolicies
    Ptr (GList (Ptr HSTSPolicy))
result <- Ptr HSTSEnforcer -> CInt -> IO (Ptr (GList (Ptr HSTSPolicy)))
soup_hsts_enforcer_get_policies Ptr HSTSEnforcer
hstsEnforcer' CInt
sessionPolicies'
    [Ptr HSTSPolicy]
result' <- Ptr (GList (Ptr HSTSPolicy)) -> IO [Ptr HSTSPolicy]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr HSTSPolicy))
result
    [HSTSPolicy]
result'' <- (Ptr HSTSPolicy -> IO HSTSPolicy)
-> [Ptr HSTSPolicy] -> IO [HSTSPolicy]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr HSTSPolicy -> HSTSPolicy)
-> Ptr HSTSPolicy -> IO HSTSPolicy
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr HSTSPolicy -> HSTSPolicy
Soup.HSTSPolicy.HSTSPolicy) [Ptr HSTSPolicy]
result'
    Ptr (GList (Ptr HSTSPolicy)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr HSTSPolicy))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    [HSTSPolicy] -> IO [HSTSPolicy]
forall (m :: * -> *) a. Monad m => a -> m a
return [HSTSPolicy]
result''

#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerGetPoliciesMethodInfo
instance (signature ~ (Bool -> m [Soup.HSTSPolicy.HSTSPolicy]), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerGetPoliciesMethodInfo a signature where
    overloadedMethod = hSTSEnforcerGetPolicies

instance O.OverloadedMethodInfo HSTSEnforcerGetPoliciesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerGetPolicies",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerGetPolicies"
        }


#endif

-- method HSTSEnforcer::has_valid_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , 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 "a domain." , 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_hsts_enforcer_has_valid_policy" soup_hsts_enforcer_has_valid_policy :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    CString ->                              -- domain : TBasicType TUTF8
    IO CInt

-- | Gets whether /@hstsEnforcer@/ has a currently valid policy for /@domain@/.
-- 
-- /Since: 2.68/
hSTSEnforcerHasValidPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> T.Text
    -- ^ /@domain@/: a domain.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if access to /@domain@/ should happen over HTTPS, false
    -- otherwise.
hSTSEnforcerHasValidPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> Text -> m Bool
hSTSEnforcerHasValidPolicy a
hstsEnforcer Text
domain = 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 HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    CInt
result <- Ptr HSTSEnforcer -> CString -> IO CInt
soup_hsts_enforcer_has_valid_policy Ptr HSTSEnforcer
hstsEnforcer' CString
domain'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
domain'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerHasValidPolicyMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerHasValidPolicyMethodInfo a signature where
    overloadedMethod = hSTSEnforcerHasValidPolicy

instance O.OverloadedMethodInfo HSTSEnforcerHasValidPolicyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerHasValidPolicy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerHasValidPolicy"
        }


#endif

-- method HSTSEnforcer::is_persistent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , 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_hsts_enforcer_is_persistent" soup_hsts_enforcer_is_persistent :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    IO CInt

-- | Gets whether /@hstsEnforcer@/ stores policies persistenly.
-- 
-- /Since: 2.68/
hSTSEnforcerIsPersistent ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@hstsEnforcer@/ storage is persistent or 'P.False' otherwise.
hSTSEnforcerIsPersistent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> m Bool
hSTSEnforcerIsPersistent a
hstsEnforcer = 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 HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    CInt
result <- Ptr HSTSEnforcer -> IO CInt
soup_hsts_enforcer_is_persistent Ptr HSTSEnforcer
hstsEnforcer'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerIsPersistentMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerIsPersistentMethodInfo a signature where
    overloadedMethod = hSTSEnforcerIsPersistent

instance O.OverloadedMethodInfo HSTSEnforcerIsPersistentMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerIsPersistent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerIsPersistent"
        }


#endif

-- method HSTSEnforcer::set_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the policy of the HSTS host"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_hsts_enforcer_set_policy" soup_hsts_enforcer_set_policy :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    Ptr Soup.HSTSPolicy.HSTSPolicy ->       -- policy : TInterface (Name {namespace = "Soup", name = "HSTSPolicy"})
    IO ()

-- | Sets /@policy@/ to /@hstsEnforcer@/. If /@policy@/ is expired, any
-- existing HSTS policy for its host will be removed instead. If a
-- policy existed for this host, it will be replaced. Otherwise, the
-- new policy will be inserted. If the policy is a session policy, that
-- is, one created with 'GI.Soup.Structs.HSTSPolicy.hSTSPolicyNewSessionPolicy', the policy
-- will not expire and will be enforced during the lifetime of
-- /@hstsEnforcer@/\'s t'GI.Soup.Objects.Session.Session'.
-- 
-- /Since: 2.68/
hSTSEnforcerSetPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> Soup.HSTSPolicy.HSTSPolicy
    -- ^ /@policy@/: the policy of the HSTS host
    -> m ()
hSTSEnforcerSetPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> HSTSPolicy -> m ()
hSTSEnforcerSetPolicy a
hstsEnforcer HSTSPolicy
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 HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    Ptr HSTSPolicy
policy' <- HSTSPolicy -> IO (Ptr HSTSPolicy)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr HSTSPolicy
policy
    Ptr HSTSEnforcer -> Ptr HSTSPolicy -> IO ()
soup_hsts_enforcer_set_policy Ptr HSTSEnforcer
hstsEnforcer' Ptr HSTSPolicy
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    HSTSPolicy -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr HSTSPolicy
policy
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HSTSEnforcerSetPolicyMethodInfo
instance (signature ~ (Soup.HSTSPolicy.HSTSPolicy -> m ()), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerSetPolicyMethodInfo a signature where
    overloadedMethod = hSTSEnforcerSetPolicy

instance O.OverloadedMethodInfo HSTSEnforcerSetPolicyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerSetPolicy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerSetPolicy"
        }


#endif

-- method HSTSEnforcer::set_session_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "hsts_enforcer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "HSTSEnforcer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupHSTSEnforcer"
--                 , 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 "policy domain or hostname"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "include_subdomains"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if the policy applies on sub domains"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_hsts_enforcer_set_session_policy" soup_hsts_enforcer_set_session_policy :: 
    Ptr HSTSEnforcer ->                     -- hsts_enforcer : TInterface (Name {namespace = "Soup", name = "HSTSEnforcer"})
    CString ->                              -- domain : TBasicType TUTF8
    CInt ->                                 -- include_subdomains : TBasicType TBoolean
    IO ()

-- | Sets a session policy for /@domain@/. A session policy is a policy
-- that is permanent to the lifetime of /@hstsEnforcer@/\'s t'GI.Soup.Objects.Session.Session'
-- and doesn\'t expire.
-- 
-- /Since: 2.68/
hSTSEnforcerSetSessionPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
    a
    -- ^ /@hstsEnforcer@/: a t'GI.Soup.Objects.HSTSEnforcer.HSTSEnforcer'
    -> T.Text
    -- ^ /@domain@/: policy domain or hostname
    -> Bool
    -- ^ /@includeSubdomains@/: 'P.True' if the policy applies on sub domains
    -> m ()
hSTSEnforcerSetSessionPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHSTSEnforcer a) =>
a -> Text -> Bool -> m ()
hSTSEnforcerSetSessionPolicy a
hstsEnforcer Text
domain Bool
includeSubdomains = 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 HSTSEnforcer
hstsEnforcer' <- a -> IO (Ptr HSTSEnforcer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
hstsEnforcer
    CString
domain' <- Text -> IO CString
textToCString Text
domain
    let includeSubdomains' :: CInt
includeSubdomains' = (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
includeSubdomains
    Ptr HSTSEnforcer -> CString -> CInt -> IO ()
soup_hsts_enforcer_set_session_policy Ptr HSTSEnforcer
hstsEnforcer' CString
domain' CInt
includeSubdomains'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
hstsEnforcer
    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 HSTSEnforcerSetSessionPolicyMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsHSTSEnforcer a) => O.OverloadedMethod HSTSEnforcerSetSessionPolicyMethodInfo a signature where
    overloadedMethod = hSTSEnforcerSetSessionPolicy

instance O.OverloadedMethodInfo HSTSEnforcerSetSessionPolicyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.HSTSEnforcer.hSTSEnforcerSetSessionPolicy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-HSTSEnforcer.html#v:hSTSEnforcerSetSessionPolicy"
        }


#endif