{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} -- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.SoupAttributes where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading import Data.GI.Base.Properties hiding (new) import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils import qualified GI.GLib as GLib import qualified GI.GLibAttributes as GLibA import qualified GI.Gio as Gio import qualified GI.GioAttributes as GioA import GI.Soup -- VVV Prop "family" -- Type: TInterface "Soup" "AddressFamily" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAddressFamily :: (MonadIO m, AddressK o) => o -> m AddressFamily getAddressFamily obj = liftIO $ getObjectPropertyEnum obj "family" constructAddressFamily :: AddressFamily -> IO ([Char], GValue) constructAddressFamily val = constructObjectPropertyEnum "family" val data AddressFamilyPropertyInfo instance AttrInfo AddressFamilyPropertyInfo where type AttrAllowedOps AddressFamilyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AddressFamilyPropertyInfo = (~) AddressFamily type AttrBaseTypeConstraint AddressFamilyPropertyInfo = AddressK type AttrGetType AddressFamilyPropertyInfo = AddressFamily type AttrLabel AddressFamilyPropertyInfo = "Address::family" attrGet _ = getAddressFamily attrSet _ = undefined attrConstruct _ = constructAddressFamily -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAddressName :: (MonadIO m, AddressK o) => o -> m T.Text getAddressName obj = liftIO $ getObjectPropertyString obj "name" constructAddressName :: T.Text -> IO ([Char], GValue) constructAddressName val = constructObjectPropertyString "name" val data AddressNamePropertyInfo instance AttrInfo AddressNamePropertyInfo where type AttrAllowedOps AddressNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AddressNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint AddressNamePropertyInfo = AddressK type AttrGetType AddressNamePropertyInfo = T.Text type AttrLabel AddressNamePropertyInfo = "Address::name" attrGet _ = getAddressName attrSet _ = undefined attrConstruct _ = constructAddressName -- VVV Prop "physical" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getAddressPhysical :: (MonadIO m, AddressK o) => o -> m T.Text getAddressPhysical obj = liftIO $ getObjectPropertyString obj "physical" data AddressPhysicalPropertyInfo instance AttrInfo AddressPhysicalPropertyInfo where type AttrAllowedOps AddressPhysicalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint AddressPhysicalPropertyInfo = (~) () type AttrBaseTypeConstraint AddressPhysicalPropertyInfo = AddressK type AttrGetType AddressPhysicalPropertyInfo = T.Text type AttrLabel AddressPhysicalPropertyInfo = "Address::physical" attrGet _ = getAddressPhysical attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "port" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAddressPort :: (MonadIO m, AddressK o) => o -> m Int32 getAddressPort obj = liftIO $ getObjectPropertyCInt obj "port" constructAddressPort :: Int32 -> IO ([Char], GValue) constructAddressPort val = constructObjectPropertyCInt "port" val data AddressPortPropertyInfo instance AttrInfo AddressPortPropertyInfo where type AttrAllowedOps AddressPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AddressPortPropertyInfo = (~) Int32 type AttrBaseTypeConstraint AddressPortPropertyInfo = AddressK type AttrGetType AddressPortPropertyInfo = Int32 type AttrLabel AddressPortPropertyInfo = "Address::port" attrGet _ = getAddressPort attrSet _ = undefined attrConstruct _ = constructAddressPort -- VVV Prop "protocol" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAddressProtocol :: (MonadIO m, AddressK o) => o -> m T.Text getAddressProtocol obj = liftIO $ getObjectPropertyString obj "protocol" constructAddressProtocol :: T.Text -> IO ([Char], GValue) constructAddressProtocol val = constructObjectPropertyString "protocol" val data AddressProtocolPropertyInfo instance AttrInfo AddressProtocolPropertyInfo where type AttrAllowedOps AddressProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AddressProtocolPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AddressProtocolPropertyInfo = AddressK type AttrGetType AddressProtocolPropertyInfo = T.Text type AttrLabel AddressProtocolPropertyInfo = "Address::protocol" attrGet _ = getAddressProtocol attrSet _ = undefined attrConstruct _ = constructAddressProtocol -- VVV Prop "sockaddr" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAddressSockaddr :: (MonadIO m, AddressK o) => o -> m (Ptr ()) getAddressSockaddr obj = liftIO $ getObjectPropertyPtr obj "sockaddr" constructAddressSockaddr :: (Ptr ()) -> IO ([Char], GValue) constructAddressSockaddr val = constructObjectPropertyPtr "sockaddr" val data AddressSockaddrPropertyInfo instance AttrInfo AddressSockaddrPropertyInfo where type AttrAllowedOps AddressSockaddrPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AddressSockaddrPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AddressSockaddrPropertyInfo = AddressK type AttrGetType AddressSockaddrPropertyInfo = (Ptr ()) type AttrLabel AddressSockaddrPropertyInfo = "Address::sockaddr" attrGet _ = getAddressSockaddr attrSet _ = undefined attrConstruct _ = constructAddressSockaddr type instance AttributeList Address = '[ '("family", AddressFamilyPropertyInfo), '("name", AddressNamePropertyInfo), '("physical", AddressPhysicalPropertyInfo), '("port", AddressPortPropertyInfo), '("protocol", AddressProtocolPropertyInfo), '("sockaddr", AddressSockaddrPropertyInfo)] -- VVV Prop "host" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAuthHost :: (MonadIO m, AuthK o) => o -> m T.Text getAuthHost obj = liftIO $ getObjectPropertyString obj "host" setAuthHost :: (MonadIO m, AuthK o) => o -> T.Text -> m () setAuthHost obj val = liftIO $ setObjectPropertyString obj "host" val constructAuthHost :: T.Text -> IO ([Char], GValue) constructAuthHost val = constructObjectPropertyString "host" val data AuthHostPropertyInfo instance AttrInfo AuthHostPropertyInfo where type AttrAllowedOps AuthHostPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthHostPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AuthHostPropertyInfo = AuthK type AttrGetType AuthHostPropertyInfo = T.Text type AttrLabel AuthHostPropertyInfo = "Auth::host" attrGet _ = getAuthHost attrSet _ = setAuthHost attrConstruct _ = constructAuthHost -- VVV Prop "is-authenticated" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getAuthIsAuthenticated :: (MonadIO m, AuthK o) => o -> m Bool getAuthIsAuthenticated obj = liftIO $ getObjectPropertyBool obj "is-authenticated" data AuthIsAuthenticatedPropertyInfo instance AttrInfo AuthIsAuthenticatedPropertyInfo where type AttrAllowedOps AuthIsAuthenticatedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint AuthIsAuthenticatedPropertyInfo = (~) () type AttrBaseTypeConstraint AuthIsAuthenticatedPropertyInfo = AuthK type AttrGetType AuthIsAuthenticatedPropertyInfo = Bool type AttrLabel AuthIsAuthenticatedPropertyInfo = "Auth::is-authenticated" attrGet _ = getAuthIsAuthenticated attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-for-proxy" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getAuthIsForProxy :: (MonadIO m, AuthK o) => o -> m Bool getAuthIsForProxy obj = liftIO $ getObjectPropertyBool obj "is-for-proxy" setAuthIsForProxy :: (MonadIO m, AuthK o) => o -> Bool -> m () setAuthIsForProxy obj val = liftIO $ setObjectPropertyBool obj "is-for-proxy" val constructAuthIsForProxy :: Bool -> IO ([Char], GValue) constructAuthIsForProxy val = constructObjectPropertyBool "is-for-proxy" val data AuthIsForProxyPropertyInfo instance AttrInfo AuthIsForProxyPropertyInfo where type AttrAllowedOps AuthIsForProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthIsForProxyPropertyInfo = (~) Bool type AttrBaseTypeConstraint AuthIsForProxyPropertyInfo = AuthK type AttrGetType AuthIsForProxyPropertyInfo = Bool type AttrLabel AuthIsForProxyPropertyInfo = "Auth::is-for-proxy" attrGet _ = getAuthIsForProxy attrSet _ = setAuthIsForProxy attrConstruct _ = constructAuthIsForProxy -- VVV Prop "realm" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getAuthRealm :: (MonadIO m, AuthK o) => o -> m T.Text getAuthRealm obj = liftIO $ getObjectPropertyString obj "realm" setAuthRealm :: (MonadIO m, AuthK o) => o -> T.Text -> m () setAuthRealm obj val = liftIO $ setObjectPropertyString obj "realm" val constructAuthRealm :: T.Text -> IO ([Char], GValue) constructAuthRealm val = constructObjectPropertyString "realm" val data AuthRealmPropertyInfo instance AttrInfo AuthRealmPropertyInfo where type AttrAllowedOps AuthRealmPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthRealmPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AuthRealmPropertyInfo = AuthK type AttrGetType AuthRealmPropertyInfo = T.Text type AttrLabel AuthRealmPropertyInfo = "Auth::realm" attrGet _ = getAuthRealm attrSet _ = setAuthRealm attrConstruct _ = constructAuthRealm -- VVV Prop "scheme-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getAuthSchemeName :: (MonadIO m, AuthK o) => o -> m T.Text getAuthSchemeName obj = liftIO $ getObjectPropertyString obj "scheme-name" data AuthSchemeNamePropertyInfo instance AttrInfo AuthSchemeNamePropertyInfo where type AttrAllowedOps AuthSchemeNamePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint AuthSchemeNamePropertyInfo = (~) () type AttrBaseTypeConstraint AuthSchemeNamePropertyInfo = AuthK type AttrGetType AuthSchemeNamePropertyInfo = T.Text type AttrLabel AuthSchemeNamePropertyInfo = "Auth::scheme-name" attrGet _ = getAuthSchemeName attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Auth = '[ '("host", AuthHostPropertyInfo), '("is-authenticated", AuthIsAuthenticatedPropertyInfo), '("is-for-proxy", AuthIsForProxyPropertyInfo), '("realm", AuthRealmPropertyInfo), '("scheme-name", AuthSchemeNamePropertyInfo)] type instance AttributeList AuthBasic = '[ '("host", AuthHostPropertyInfo), '("is-authenticated", AuthIsAuthenticatedPropertyInfo), '("is-for-proxy", AuthIsForProxyPropertyInfo), '("realm", AuthRealmPropertyInfo), '("scheme-name", AuthSchemeNamePropertyInfo)] type instance AttributeList AuthDigest = '[ '("host", AuthHostPropertyInfo), '("is-authenticated", AuthIsAuthenticatedPropertyInfo), '("is-for-proxy", AuthIsForProxyPropertyInfo), '("realm", AuthRealmPropertyInfo), '("scheme-name", AuthSchemeNamePropertyInfo)] -- VVV Prop "add-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setAuthDomainAddPath :: (MonadIO m, AuthDomainK o) => o -> T.Text -> m () setAuthDomainAddPath obj val = liftIO $ setObjectPropertyString obj "add-path" val constructAuthDomainAddPath :: T.Text -> IO ([Char], GValue) constructAuthDomainAddPath val = constructObjectPropertyString "add-path" val data AuthDomainAddPathPropertyInfo instance AttrInfo AuthDomainAddPathPropertyInfo where type AttrAllowedOps AuthDomainAddPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint AuthDomainAddPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AuthDomainAddPathPropertyInfo = AuthDomainK type AttrGetType AuthDomainAddPathPropertyInfo = () type AttrLabel AuthDomainAddPathPropertyInfo = "AuthDomain::add-path" attrGet _ = undefined attrSet _ = setAuthDomainAddPath attrConstruct _ = constructAuthDomainAddPath -- VVV Prop "filter" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainFilter :: (MonadIO m, AuthDomainK o) => o -> m (Ptr ()) getAuthDomainFilter obj = liftIO $ getObjectPropertyPtr obj "filter" setAuthDomainFilter :: (MonadIO m, AuthDomainK o) => o -> (Ptr ()) -> m () setAuthDomainFilter obj val = liftIO $ setObjectPropertyPtr obj "filter" val constructAuthDomainFilter :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainFilter val = constructObjectPropertyPtr "filter" val data AuthDomainFilterPropertyInfo instance AttrInfo AuthDomainFilterPropertyInfo where type AttrAllowedOps AuthDomainFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainFilterPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainFilterPropertyInfo = AuthDomainK type AttrGetType AuthDomainFilterPropertyInfo = (Ptr ()) type AttrLabel AuthDomainFilterPropertyInfo = "AuthDomain::filter" attrGet _ = getAuthDomainFilter attrSet _ = setAuthDomainFilter attrConstruct _ = constructAuthDomainFilter -- VVV Prop "filter-data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainFilterData :: (MonadIO m, AuthDomainK o) => o -> m (Ptr ()) getAuthDomainFilterData obj = liftIO $ getObjectPropertyPtr obj "filter-data" setAuthDomainFilterData :: (MonadIO m, AuthDomainK o) => o -> (Ptr ()) -> m () setAuthDomainFilterData obj val = liftIO $ setObjectPropertyPtr obj "filter-data" val constructAuthDomainFilterData :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainFilterData val = constructObjectPropertyPtr "filter-data" val data AuthDomainFilterDataPropertyInfo instance AttrInfo AuthDomainFilterDataPropertyInfo where type AttrAllowedOps AuthDomainFilterDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainFilterDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainFilterDataPropertyInfo = AuthDomainK type AttrGetType AuthDomainFilterDataPropertyInfo = (Ptr ()) type AttrLabel AuthDomainFilterDataPropertyInfo = "AuthDomain::filter-data" attrGet _ = getAuthDomainFilterData attrSet _ = setAuthDomainFilterData attrConstruct _ = constructAuthDomainFilterData -- VVV Prop "generic-auth-callback" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainGenericAuthCallback :: (MonadIO m, AuthDomainK o) => o -> m (Ptr ()) getAuthDomainGenericAuthCallback obj = liftIO $ getObjectPropertyPtr obj "generic-auth-callback" setAuthDomainGenericAuthCallback :: (MonadIO m, AuthDomainK o) => o -> (Ptr ()) -> m () setAuthDomainGenericAuthCallback obj val = liftIO $ setObjectPropertyPtr obj "generic-auth-callback" val constructAuthDomainGenericAuthCallback :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainGenericAuthCallback val = constructObjectPropertyPtr "generic-auth-callback" val data AuthDomainGenericAuthCallbackPropertyInfo instance AttrInfo AuthDomainGenericAuthCallbackPropertyInfo where type AttrAllowedOps AuthDomainGenericAuthCallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainGenericAuthCallbackPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainGenericAuthCallbackPropertyInfo = AuthDomainK type AttrGetType AuthDomainGenericAuthCallbackPropertyInfo = (Ptr ()) type AttrLabel AuthDomainGenericAuthCallbackPropertyInfo = "AuthDomain::generic-auth-callback" attrGet _ = getAuthDomainGenericAuthCallback attrSet _ = setAuthDomainGenericAuthCallback attrConstruct _ = constructAuthDomainGenericAuthCallback -- VVV Prop "generic-auth-data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainGenericAuthData :: (MonadIO m, AuthDomainK o) => o -> m (Ptr ()) getAuthDomainGenericAuthData obj = liftIO $ getObjectPropertyPtr obj "generic-auth-data" setAuthDomainGenericAuthData :: (MonadIO m, AuthDomainK o) => o -> (Ptr ()) -> m () setAuthDomainGenericAuthData obj val = liftIO $ setObjectPropertyPtr obj "generic-auth-data" val constructAuthDomainGenericAuthData :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainGenericAuthData val = constructObjectPropertyPtr "generic-auth-data" val data AuthDomainGenericAuthDataPropertyInfo instance AttrInfo AuthDomainGenericAuthDataPropertyInfo where type AttrAllowedOps AuthDomainGenericAuthDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainGenericAuthDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainGenericAuthDataPropertyInfo = AuthDomainK type AttrGetType AuthDomainGenericAuthDataPropertyInfo = (Ptr ()) type AttrLabel AuthDomainGenericAuthDataPropertyInfo = "AuthDomain::generic-auth-data" attrGet _ = getAuthDomainGenericAuthData attrSet _ = setAuthDomainGenericAuthData attrConstruct _ = constructAuthDomainGenericAuthData -- VVV Prop "proxy" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAuthDomainProxy :: (MonadIO m, AuthDomainK o) => o -> m Bool getAuthDomainProxy obj = liftIO $ getObjectPropertyBool obj "proxy" constructAuthDomainProxy :: Bool -> IO ([Char], GValue) constructAuthDomainProxy val = constructObjectPropertyBool "proxy" val data AuthDomainProxyPropertyInfo instance AttrInfo AuthDomainProxyPropertyInfo where type AttrAllowedOps AuthDomainProxyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainProxyPropertyInfo = (~) Bool type AttrBaseTypeConstraint AuthDomainProxyPropertyInfo = AuthDomainK type AttrGetType AuthDomainProxyPropertyInfo = Bool type AttrLabel AuthDomainProxyPropertyInfo = "AuthDomain::proxy" attrGet _ = getAuthDomainProxy attrSet _ = undefined attrConstruct _ = constructAuthDomainProxy -- VVV Prop "realm" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getAuthDomainRealm :: (MonadIO m, AuthDomainK o) => o -> m T.Text getAuthDomainRealm obj = liftIO $ getObjectPropertyString obj "realm" constructAuthDomainRealm :: T.Text -> IO ([Char], GValue) constructAuthDomainRealm val = constructObjectPropertyString "realm" val data AuthDomainRealmPropertyInfo instance AttrInfo AuthDomainRealmPropertyInfo where type AttrAllowedOps AuthDomainRealmPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainRealmPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AuthDomainRealmPropertyInfo = AuthDomainK type AttrGetType AuthDomainRealmPropertyInfo = T.Text type AttrLabel AuthDomainRealmPropertyInfo = "AuthDomain::realm" attrGet _ = getAuthDomainRealm attrSet _ = undefined attrConstruct _ = constructAuthDomainRealm -- VVV Prop "remove-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable] setAuthDomainRemovePath :: (MonadIO m, AuthDomainK o) => o -> T.Text -> m () setAuthDomainRemovePath obj val = liftIO $ setObjectPropertyString obj "remove-path" val constructAuthDomainRemovePath :: T.Text -> IO ([Char], GValue) constructAuthDomainRemovePath val = constructObjectPropertyString "remove-path" val data AuthDomainRemovePathPropertyInfo instance AttrInfo AuthDomainRemovePathPropertyInfo where type AttrAllowedOps AuthDomainRemovePathPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint AuthDomainRemovePathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint AuthDomainRemovePathPropertyInfo = AuthDomainK type AttrGetType AuthDomainRemovePathPropertyInfo = () type AttrLabel AuthDomainRemovePathPropertyInfo = "AuthDomain::remove-path" attrGet _ = undefined attrSet _ = setAuthDomainRemovePath attrConstruct _ = constructAuthDomainRemovePath type instance AttributeList AuthDomain = '[ '("add-path", AuthDomainAddPathPropertyInfo), '("filter", AuthDomainFilterPropertyInfo), '("filter-data", AuthDomainFilterDataPropertyInfo), '("generic-auth-callback", AuthDomainGenericAuthCallbackPropertyInfo), '("generic-auth-data", AuthDomainGenericAuthDataPropertyInfo), '("proxy", AuthDomainProxyPropertyInfo), '("realm", AuthDomainRealmPropertyInfo), '("remove-path", AuthDomainRemovePathPropertyInfo)] -- VVV Prop "auth-callback" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainBasicAuthCallback :: (MonadIO m, AuthDomainBasicK o) => o -> m (Ptr ()) getAuthDomainBasicAuthCallback obj = liftIO $ getObjectPropertyPtr obj "auth-callback" setAuthDomainBasicAuthCallback :: (MonadIO m, AuthDomainBasicK o) => o -> (Ptr ()) -> m () setAuthDomainBasicAuthCallback obj val = liftIO $ setObjectPropertyPtr obj "auth-callback" val constructAuthDomainBasicAuthCallback :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainBasicAuthCallback val = constructObjectPropertyPtr "auth-callback" val data AuthDomainBasicAuthCallbackPropertyInfo instance AttrInfo AuthDomainBasicAuthCallbackPropertyInfo where type AttrAllowedOps AuthDomainBasicAuthCallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainBasicAuthCallbackPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainBasicAuthCallbackPropertyInfo = AuthDomainBasicK type AttrGetType AuthDomainBasicAuthCallbackPropertyInfo = (Ptr ()) type AttrLabel AuthDomainBasicAuthCallbackPropertyInfo = "AuthDomainBasic::auth-callback" attrGet _ = getAuthDomainBasicAuthCallback attrSet _ = setAuthDomainBasicAuthCallback attrConstruct _ = constructAuthDomainBasicAuthCallback -- VVV Prop "auth-data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainBasicAuthData :: (MonadIO m, AuthDomainBasicK o) => o -> m (Ptr ()) getAuthDomainBasicAuthData obj = liftIO $ getObjectPropertyPtr obj "auth-data" setAuthDomainBasicAuthData :: (MonadIO m, AuthDomainBasicK o) => o -> (Ptr ()) -> m () setAuthDomainBasicAuthData obj val = liftIO $ setObjectPropertyPtr obj "auth-data" val constructAuthDomainBasicAuthData :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainBasicAuthData val = constructObjectPropertyPtr "auth-data" val data AuthDomainBasicAuthDataPropertyInfo instance AttrInfo AuthDomainBasicAuthDataPropertyInfo where type AttrAllowedOps AuthDomainBasicAuthDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainBasicAuthDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainBasicAuthDataPropertyInfo = AuthDomainBasicK type AttrGetType AuthDomainBasicAuthDataPropertyInfo = (Ptr ()) type AttrLabel AuthDomainBasicAuthDataPropertyInfo = "AuthDomainBasic::auth-data" attrGet _ = getAuthDomainBasicAuthData attrSet _ = setAuthDomainBasicAuthData attrConstruct _ = constructAuthDomainBasicAuthData type instance AttributeList AuthDomainBasic = '[ '("add-path", AuthDomainAddPathPropertyInfo), '("auth-callback", AuthDomainBasicAuthCallbackPropertyInfo), '("auth-data", AuthDomainBasicAuthDataPropertyInfo), '("filter", AuthDomainFilterPropertyInfo), '("filter-data", AuthDomainFilterDataPropertyInfo), '("generic-auth-callback", AuthDomainGenericAuthCallbackPropertyInfo), '("generic-auth-data", AuthDomainGenericAuthDataPropertyInfo), '("proxy", AuthDomainProxyPropertyInfo), '("realm", AuthDomainRealmPropertyInfo), '("remove-path", AuthDomainRemovePathPropertyInfo)] -- VVV Prop "auth-callback" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainDigestAuthCallback :: (MonadIO m, AuthDomainDigestK o) => o -> m (Ptr ()) getAuthDomainDigestAuthCallback obj = liftIO $ getObjectPropertyPtr obj "auth-callback" setAuthDomainDigestAuthCallback :: (MonadIO m, AuthDomainDigestK o) => o -> (Ptr ()) -> m () setAuthDomainDigestAuthCallback obj val = liftIO $ setObjectPropertyPtr obj "auth-callback" val constructAuthDomainDigestAuthCallback :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainDigestAuthCallback val = constructObjectPropertyPtr "auth-callback" val data AuthDomainDigestAuthCallbackPropertyInfo instance AttrInfo AuthDomainDigestAuthCallbackPropertyInfo where type AttrAllowedOps AuthDomainDigestAuthCallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainDigestAuthCallbackPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainDigestAuthCallbackPropertyInfo = AuthDomainDigestK type AttrGetType AuthDomainDigestAuthCallbackPropertyInfo = (Ptr ()) type AttrLabel AuthDomainDigestAuthCallbackPropertyInfo = "AuthDomainDigest::auth-callback" attrGet _ = getAuthDomainDigestAuthCallback attrSet _ = setAuthDomainDigestAuthCallback attrConstruct _ = constructAuthDomainDigestAuthCallback -- VVV Prop "auth-data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getAuthDomainDigestAuthData :: (MonadIO m, AuthDomainDigestK o) => o -> m (Ptr ()) getAuthDomainDigestAuthData obj = liftIO $ getObjectPropertyPtr obj "auth-data" setAuthDomainDigestAuthData :: (MonadIO m, AuthDomainDigestK o) => o -> (Ptr ()) -> m () setAuthDomainDigestAuthData obj val = liftIO $ setObjectPropertyPtr obj "auth-data" val constructAuthDomainDigestAuthData :: (Ptr ()) -> IO ([Char], GValue) constructAuthDomainDigestAuthData val = constructObjectPropertyPtr "auth-data" val data AuthDomainDigestAuthDataPropertyInfo instance AttrInfo AuthDomainDigestAuthDataPropertyInfo where type AttrAllowedOps AuthDomainDigestAuthDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint AuthDomainDigestAuthDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint AuthDomainDigestAuthDataPropertyInfo = AuthDomainDigestK type AttrGetType AuthDomainDigestAuthDataPropertyInfo = (Ptr ()) type AttrLabel AuthDomainDigestAuthDataPropertyInfo = "AuthDomainDigest::auth-data" attrGet _ = getAuthDomainDigestAuthData attrSet _ = setAuthDomainDigestAuthData attrConstruct _ = constructAuthDomainDigestAuthData type instance AttributeList AuthDomainDigest = '[ '("add-path", AuthDomainAddPathPropertyInfo), '("auth-callback", AuthDomainDigestAuthCallbackPropertyInfo), '("auth-data", AuthDomainDigestAuthDataPropertyInfo), '("filter", AuthDomainFilterPropertyInfo), '("filter-data", AuthDomainFilterDataPropertyInfo), '("generic-auth-callback", AuthDomainGenericAuthCallbackPropertyInfo), '("generic-auth-data", AuthDomainGenericAuthDataPropertyInfo), '("proxy", AuthDomainProxyPropertyInfo), '("realm", AuthDomainRealmPropertyInfo), '("remove-path", AuthDomainRemovePathPropertyInfo)] type instance AttributeList AuthManager = '[ ] type instance AttributeList AuthNTLM = '[ '("host", AuthHostPropertyInfo), '("is-authenticated", AuthIsAuthenticatedPropertyInfo), '("is-for-proxy", AuthIsForProxyPropertyInfo), '("realm", AuthRealmPropertyInfo), '("scheme-name", AuthSchemeNamePropertyInfo)] -- VVV Prop "cache-dir" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCacheCacheDir :: (MonadIO m, CacheK o) => o -> m T.Text getCacheCacheDir obj = liftIO $ getObjectPropertyString obj "cache-dir" constructCacheCacheDir :: T.Text -> IO ([Char], GValue) constructCacheCacheDir val = constructObjectPropertyString "cache-dir" val data CacheCacheDirPropertyInfo instance AttrInfo CacheCacheDirPropertyInfo where type AttrAllowedOps CacheCacheDirPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CacheCacheDirPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CacheCacheDirPropertyInfo = CacheK type AttrGetType CacheCacheDirPropertyInfo = T.Text type AttrLabel CacheCacheDirPropertyInfo = "Cache::cache-dir" attrGet _ = getCacheCacheDir attrSet _ = undefined attrConstruct _ = constructCacheCacheDir -- VVV Prop "cache-type" -- Type: TInterface "Soup" "CacheType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCacheCacheType :: (MonadIO m, CacheK o) => o -> m CacheType getCacheCacheType obj = liftIO $ getObjectPropertyEnum obj "cache-type" constructCacheCacheType :: CacheType -> IO ([Char], GValue) constructCacheCacheType val = constructObjectPropertyEnum "cache-type" val data CacheCacheTypePropertyInfo instance AttrInfo CacheCacheTypePropertyInfo where type AttrAllowedOps CacheCacheTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CacheCacheTypePropertyInfo = (~) CacheType type AttrBaseTypeConstraint CacheCacheTypePropertyInfo = CacheK type AttrGetType CacheCacheTypePropertyInfo = CacheType type AttrLabel CacheCacheTypePropertyInfo = "Cache::cache-type" attrGet _ = getCacheCacheType attrSet _ = undefined attrConstruct _ = constructCacheCacheType type instance AttributeList Cache = '[ '("cache-dir", CacheCacheDirPropertyInfo), '("cache-type", CacheCacheTypePropertyInfo)] type instance AttributeList ContentDecoder = '[ ] type instance AttributeList ContentSniffer = '[ ] -- VVV Prop "accept-policy" -- Type: TInterface "Soup" "CookieJarAcceptPolicy" -- Flags: [PropertyReadable,PropertyWritable] getCookieJarAcceptPolicy :: (MonadIO m, CookieJarK o) => o -> m CookieJarAcceptPolicy getCookieJarAcceptPolicy obj = liftIO $ getObjectPropertyEnum obj "accept-policy" setCookieJarAcceptPolicy :: (MonadIO m, CookieJarK o) => o -> CookieJarAcceptPolicy -> m () setCookieJarAcceptPolicy obj val = liftIO $ setObjectPropertyEnum obj "accept-policy" val constructCookieJarAcceptPolicy :: CookieJarAcceptPolicy -> IO ([Char], GValue) constructCookieJarAcceptPolicy val = constructObjectPropertyEnum "accept-policy" val data CookieJarAcceptPolicyPropertyInfo instance AttrInfo CookieJarAcceptPolicyPropertyInfo where type AttrAllowedOps CookieJarAcceptPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CookieJarAcceptPolicyPropertyInfo = (~) CookieJarAcceptPolicy type AttrBaseTypeConstraint CookieJarAcceptPolicyPropertyInfo = CookieJarK type AttrGetType CookieJarAcceptPolicyPropertyInfo = CookieJarAcceptPolicy type AttrLabel CookieJarAcceptPolicyPropertyInfo = "CookieJar::accept-policy" attrGet _ = getCookieJarAcceptPolicy attrSet _ = setCookieJarAcceptPolicy attrConstruct _ = constructCookieJarAcceptPolicy -- VVV Prop "read-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCookieJarReadOnly :: (MonadIO m, CookieJarK o) => o -> m Bool getCookieJarReadOnly obj = liftIO $ getObjectPropertyBool obj "read-only" constructCookieJarReadOnly :: Bool -> IO ([Char], GValue) constructCookieJarReadOnly val = constructObjectPropertyBool "read-only" val data CookieJarReadOnlyPropertyInfo instance AttrInfo CookieJarReadOnlyPropertyInfo where type AttrAllowedOps CookieJarReadOnlyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CookieJarReadOnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint CookieJarReadOnlyPropertyInfo = CookieJarK type AttrGetType CookieJarReadOnlyPropertyInfo = Bool type AttrLabel CookieJarReadOnlyPropertyInfo = "CookieJar::read-only" attrGet _ = getCookieJarReadOnly attrSet _ = undefined attrConstruct _ = constructCookieJarReadOnly type instance AttributeList CookieJar = '[ '("accept-policy", CookieJarAcceptPolicyPropertyInfo), '("read-only", CookieJarReadOnlyPropertyInfo)] -- VVV Prop "filename" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCookieJarDBFilename :: (MonadIO m, CookieJarDBK o) => o -> m T.Text getCookieJarDBFilename obj = liftIO $ getObjectPropertyString obj "filename" constructCookieJarDBFilename :: T.Text -> IO ([Char], GValue) constructCookieJarDBFilename val = constructObjectPropertyString "filename" val data CookieJarDBFilenamePropertyInfo instance AttrInfo CookieJarDBFilenamePropertyInfo where type AttrAllowedOps CookieJarDBFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CookieJarDBFilenamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint CookieJarDBFilenamePropertyInfo = CookieJarDBK type AttrGetType CookieJarDBFilenamePropertyInfo = T.Text type AttrLabel CookieJarDBFilenamePropertyInfo = "CookieJarDB::filename" attrGet _ = getCookieJarDBFilename attrSet _ = undefined attrConstruct _ = constructCookieJarDBFilename type instance AttributeList CookieJarDB = '[ '("accept-policy", CookieJarAcceptPolicyPropertyInfo), '("filename", CookieJarDBFilenamePropertyInfo), '("read-only", CookieJarReadOnlyPropertyInfo)] -- VVV Prop "filename" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCookieJarTextFilename :: (MonadIO m, CookieJarTextK o) => o -> m T.Text getCookieJarTextFilename obj = liftIO $ getObjectPropertyString obj "filename" constructCookieJarTextFilename :: T.Text -> IO ([Char], GValue) constructCookieJarTextFilename val = constructObjectPropertyString "filename" val data CookieJarTextFilenamePropertyInfo instance AttrInfo CookieJarTextFilenamePropertyInfo where type AttrAllowedOps CookieJarTextFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CookieJarTextFilenamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint CookieJarTextFilenamePropertyInfo = CookieJarTextK type AttrGetType CookieJarTextFilenamePropertyInfo = T.Text type AttrLabel CookieJarTextFilenamePropertyInfo = "CookieJarText::filename" attrGet _ = getCookieJarTextFilename attrSet _ = undefined attrConstruct _ = constructCookieJarTextFilename type instance AttributeList CookieJarText = '[ '("accept-policy", CookieJarAcceptPolicyPropertyInfo), '("filename", CookieJarTextFilenamePropertyInfo), '("read-only", CookieJarReadOnlyPropertyInfo)] type instance AttributeList Logger = '[ ] -- VVV Prop "first-party" -- Type: TInterface "Soup" "URI" -- Flags: [PropertyReadable,PropertyWritable] getMessageFirstParty :: (MonadIO m, MessageK o) => o -> m URI getMessageFirstParty obj = liftIO $ getObjectPropertyBoxed obj "first-party" URI setMessageFirstParty :: (MonadIO m, MessageK o) => o -> URI -> m () setMessageFirstParty obj val = liftIO $ setObjectPropertyBoxed obj "first-party" val constructMessageFirstParty :: URI -> IO ([Char], GValue) constructMessageFirstParty val = constructObjectPropertyBoxed "first-party" val data MessageFirstPartyPropertyInfo instance AttrInfo MessageFirstPartyPropertyInfo where type AttrAllowedOps MessageFirstPartyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageFirstPartyPropertyInfo = (~) URI type AttrBaseTypeConstraint MessageFirstPartyPropertyInfo = MessageK type AttrGetType MessageFirstPartyPropertyInfo = URI type AttrLabel MessageFirstPartyPropertyInfo = "Message::first-party" attrGet _ = getMessageFirstParty attrSet _ = setMessageFirstParty attrConstruct _ = constructMessageFirstParty -- VVV Prop "flags" -- Type: TInterface "Soup" "MessageFlags" -- Flags: [PropertyReadable,PropertyWritable] getMessageFlags :: (MonadIO m, MessageK o) => o -> m [MessageFlags] getMessageFlags obj = liftIO $ getObjectPropertyFlags obj "flags" setMessageFlags :: (MonadIO m, MessageK o) => o -> [MessageFlags] -> m () setMessageFlags obj val = liftIO $ setObjectPropertyFlags obj "flags" val constructMessageFlags :: [MessageFlags] -> IO ([Char], GValue) constructMessageFlags val = constructObjectPropertyFlags "flags" val data MessageFlagsPropertyInfo instance AttrInfo MessageFlagsPropertyInfo where type AttrAllowedOps MessageFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageFlagsPropertyInfo = (~) [MessageFlags] type AttrBaseTypeConstraint MessageFlagsPropertyInfo = MessageK type AttrGetType MessageFlagsPropertyInfo = [MessageFlags] type AttrLabel MessageFlagsPropertyInfo = "Message::flags" attrGet _ = getMessageFlags attrSet _ = setMessageFlags attrConstruct _ = constructMessageFlags -- VVV Prop "http-version" -- Type: TInterface "Soup" "HTTPVersion" -- Flags: [PropertyReadable,PropertyWritable] getMessageHttpVersion :: (MonadIO m, MessageK o) => o -> m HTTPVersion getMessageHttpVersion obj = liftIO $ getObjectPropertyEnum obj "http-version" setMessageHttpVersion :: (MonadIO m, MessageK o) => o -> HTTPVersion -> m () setMessageHttpVersion obj val = liftIO $ setObjectPropertyEnum obj "http-version" val constructMessageHttpVersion :: HTTPVersion -> IO ([Char], GValue) constructMessageHttpVersion val = constructObjectPropertyEnum "http-version" val data MessageHttpVersionPropertyInfo instance AttrInfo MessageHttpVersionPropertyInfo where type AttrAllowedOps MessageHttpVersionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageHttpVersionPropertyInfo = (~) HTTPVersion type AttrBaseTypeConstraint MessageHttpVersionPropertyInfo = MessageK type AttrGetType MessageHttpVersionPropertyInfo = HTTPVersion type AttrLabel MessageHttpVersionPropertyInfo = "Message::http-version" attrGet _ = getMessageHttpVersion attrSet _ = setMessageHttpVersion attrConstruct _ = constructMessageHttpVersion -- VVV Prop "method" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMessageMethod :: (MonadIO m, MessageK o) => o -> m T.Text getMessageMethod obj = liftIO $ getObjectPropertyString obj "method" setMessageMethod :: (MonadIO m, MessageK o) => o -> T.Text -> m () setMessageMethod obj val = liftIO $ setObjectPropertyString obj "method" val constructMessageMethod :: T.Text -> IO ([Char], GValue) constructMessageMethod val = constructObjectPropertyString "method" val data MessageMethodPropertyInfo instance AttrInfo MessageMethodPropertyInfo where type AttrAllowedOps MessageMethodPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageMethodPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MessageMethodPropertyInfo = MessageK type AttrGetType MessageMethodPropertyInfo = T.Text type AttrLabel MessageMethodPropertyInfo = "Message::method" attrGet _ = getMessageMethod attrSet _ = setMessageMethod attrConstruct _ = constructMessageMethod -- VVV Prop "priority" -- Type: TInterface "Soup" "MessagePriority" -- Flags: [PropertyReadable,PropertyWritable] getMessagePriority :: (MonadIO m, MessageK o) => o -> m MessagePriority getMessagePriority obj = liftIO $ getObjectPropertyEnum obj "priority" setMessagePriority :: (MonadIO m, MessageK o) => o -> MessagePriority -> m () setMessagePriority obj val = liftIO $ setObjectPropertyEnum obj "priority" val constructMessagePriority :: MessagePriority -> IO ([Char], GValue) constructMessagePriority val = constructObjectPropertyEnum "priority" val data MessagePriorityPropertyInfo instance AttrInfo MessagePriorityPropertyInfo where type AttrAllowedOps MessagePriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessagePriorityPropertyInfo = (~) MessagePriority type AttrBaseTypeConstraint MessagePriorityPropertyInfo = MessageK type AttrGetType MessagePriorityPropertyInfo = MessagePriority type AttrLabel MessagePriorityPropertyInfo = "Message::priority" attrGet _ = getMessagePriority attrSet _ = setMessagePriority attrConstruct _ = constructMessagePriority -- VVV Prop "reason-phrase" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMessageReasonPhrase :: (MonadIO m, MessageK o) => o -> m T.Text getMessageReasonPhrase obj = liftIO $ getObjectPropertyString obj "reason-phrase" setMessageReasonPhrase :: (MonadIO m, MessageK o) => o -> T.Text -> m () setMessageReasonPhrase obj val = liftIO $ setObjectPropertyString obj "reason-phrase" val constructMessageReasonPhrase :: T.Text -> IO ([Char], GValue) constructMessageReasonPhrase val = constructObjectPropertyString "reason-phrase" val data MessageReasonPhrasePropertyInfo instance AttrInfo MessageReasonPhrasePropertyInfo where type AttrAllowedOps MessageReasonPhrasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageReasonPhrasePropertyInfo = (~) T.Text type AttrBaseTypeConstraint MessageReasonPhrasePropertyInfo = MessageK type AttrGetType MessageReasonPhrasePropertyInfo = T.Text type AttrLabel MessageReasonPhrasePropertyInfo = "Message::reason-phrase" attrGet _ = getMessageReasonPhrase attrSet _ = setMessageReasonPhrase attrConstruct _ = constructMessageReasonPhrase -- VVV Prop "request-body" -- Type: TInterface "Soup" "MessageBody" -- Flags: [PropertyReadable] getMessageRequestBody :: (MonadIO m, MessageK o) => o -> m MessageBody getMessageRequestBody obj = liftIO $ getObjectPropertyBoxed obj "request-body" MessageBody data MessageRequestBodyPropertyInfo instance AttrInfo MessageRequestBodyPropertyInfo where type AttrAllowedOps MessageRequestBodyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageRequestBodyPropertyInfo = (~) () type AttrBaseTypeConstraint MessageRequestBodyPropertyInfo = MessageK type AttrGetType MessageRequestBodyPropertyInfo = MessageBody type AttrLabel MessageRequestBodyPropertyInfo = "Message::request-body" attrGet _ = getMessageRequestBody attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "request-body-data" -- Type: TInterface "GLib" "Bytes" -- Flags: [PropertyReadable] getMessageRequestBodyData :: (MonadIO m, MessageK o) => o -> m GLib.Bytes getMessageRequestBodyData obj = liftIO $ getObjectPropertyBoxed obj "request-body-data" GLib.Bytes data MessageRequestBodyDataPropertyInfo instance AttrInfo MessageRequestBodyDataPropertyInfo where type AttrAllowedOps MessageRequestBodyDataPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageRequestBodyDataPropertyInfo = (~) () type AttrBaseTypeConstraint MessageRequestBodyDataPropertyInfo = MessageK type AttrGetType MessageRequestBodyDataPropertyInfo = GLib.Bytes type AttrLabel MessageRequestBodyDataPropertyInfo = "Message::request-body-data" attrGet _ = getMessageRequestBodyData attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "request-headers" -- Type: TInterface "Soup" "MessageHeaders" -- Flags: [PropertyReadable] getMessageRequestHeaders :: (MonadIO m, MessageK o) => o -> m MessageHeaders getMessageRequestHeaders obj = liftIO $ getObjectPropertyBoxed obj "request-headers" MessageHeaders data MessageRequestHeadersPropertyInfo instance AttrInfo MessageRequestHeadersPropertyInfo where type AttrAllowedOps MessageRequestHeadersPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageRequestHeadersPropertyInfo = (~) () type AttrBaseTypeConstraint MessageRequestHeadersPropertyInfo = MessageK type AttrGetType MessageRequestHeadersPropertyInfo = MessageHeaders type AttrLabel MessageRequestHeadersPropertyInfo = "Message::request-headers" attrGet _ = getMessageRequestHeaders attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "response-body" -- Type: TInterface "Soup" "MessageBody" -- Flags: [PropertyReadable] getMessageResponseBody :: (MonadIO m, MessageK o) => o -> m MessageBody getMessageResponseBody obj = liftIO $ getObjectPropertyBoxed obj "response-body" MessageBody data MessageResponseBodyPropertyInfo instance AttrInfo MessageResponseBodyPropertyInfo where type AttrAllowedOps MessageResponseBodyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageResponseBodyPropertyInfo = (~) () type AttrBaseTypeConstraint MessageResponseBodyPropertyInfo = MessageK type AttrGetType MessageResponseBodyPropertyInfo = MessageBody type AttrLabel MessageResponseBodyPropertyInfo = "Message::response-body" attrGet _ = getMessageResponseBody attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "response-body-data" -- Type: TInterface "GLib" "Bytes" -- Flags: [PropertyReadable] getMessageResponseBodyData :: (MonadIO m, MessageK o) => o -> m GLib.Bytes getMessageResponseBodyData obj = liftIO $ getObjectPropertyBoxed obj "response-body-data" GLib.Bytes data MessageResponseBodyDataPropertyInfo instance AttrInfo MessageResponseBodyDataPropertyInfo where type AttrAllowedOps MessageResponseBodyDataPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageResponseBodyDataPropertyInfo = (~) () type AttrBaseTypeConstraint MessageResponseBodyDataPropertyInfo = MessageK type AttrGetType MessageResponseBodyDataPropertyInfo = GLib.Bytes type AttrLabel MessageResponseBodyDataPropertyInfo = "Message::response-body-data" attrGet _ = getMessageResponseBodyData attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "response-headers" -- Type: TInterface "Soup" "MessageHeaders" -- Flags: [PropertyReadable] getMessageResponseHeaders :: (MonadIO m, MessageK o) => o -> m MessageHeaders getMessageResponseHeaders obj = liftIO $ getObjectPropertyBoxed obj "response-headers" MessageHeaders data MessageResponseHeadersPropertyInfo instance AttrInfo MessageResponseHeadersPropertyInfo where type AttrAllowedOps MessageResponseHeadersPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MessageResponseHeadersPropertyInfo = (~) () type AttrBaseTypeConstraint MessageResponseHeadersPropertyInfo = MessageK type AttrGetType MessageResponseHeadersPropertyInfo = MessageHeaders type AttrLabel MessageResponseHeadersPropertyInfo = "Message::response-headers" attrGet _ = getMessageResponseHeaders attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "server-side" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getMessageServerSide :: (MonadIO m, MessageK o) => o -> m Bool getMessageServerSide obj = liftIO $ getObjectPropertyBool obj "server-side" constructMessageServerSide :: Bool -> IO ([Char], GValue) constructMessageServerSide val = constructObjectPropertyBool "server-side" val data MessageServerSidePropertyInfo instance AttrInfo MessageServerSidePropertyInfo where type AttrAllowedOps MessageServerSidePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageServerSidePropertyInfo = (~) Bool type AttrBaseTypeConstraint MessageServerSidePropertyInfo = MessageK type AttrGetType MessageServerSidePropertyInfo = Bool type AttrLabel MessageServerSidePropertyInfo = "Message::server-side" attrGet _ = getMessageServerSide attrSet _ = undefined attrConstruct _ = constructMessageServerSide -- VVV Prop "status-code" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getMessageStatusCode :: (MonadIO m, MessageK o) => o -> m Word32 getMessageStatusCode obj = liftIO $ getObjectPropertyCUInt obj "status-code" setMessageStatusCode :: (MonadIO m, MessageK o) => o -> Word32 -> m () setMessageStatusCode obj val = liftIO $ setObjectPropertyCUInt obj "status-code" val constructMessageStatusCode :: Word32 -> IO ([Char], GValue) constructMessageStatusCode val = constructObjectPropertyCUInt "status-code" val data MessageStatusCodePropertyInfo instance AttrInfo MessageStatusCodePropertyInfo where type AttrAllowedOps MessageStatusCodePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageStatusCodePropertyInfo = (~) Word32 type AttrBaseTypeConstraint MessageStatusCodePropertyInfo = MessageK type AttrGetType MessageStatusCodePropertyInfo = Word32 type AttrLabel MessageStatusCodePropertyInfo = "Message::status-code" attrGet _ = getMessageStatusCode attrSet _ = setMessageStatusCode attrConstruct _ = constructMessageStatusCode -- VVV Prop "tls-certificate" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable,PropertyWritable] getMessageTlsCertificate :: (MonadIO m, MessageK o) => o -> m Gio.TlsCertificate getMessageTlsCertificate obj = liftIO $ getObjectPropertyObject obj "tls-certificate" Gio.TlsCertificate setMessageTlsCertificate :: (MonadIO m, MessageK o, Gio.TlsCertificateK a) => o -> a -> m () setMessageTlsCertificate obj val = liftIO $ setObjectPropertyObject obj "tls-certificate" val constructMessageTlsCertificate :: (Gio.TlsCertificateK a) => a -> IO ([Char], GValue) constructMessageTlsCertificate val = constructObjectPropertyObject "tls-certificate" val data MessageTlsCertificatePropertyInfo instance AttrInfo MessageTlsCertificatePropertyInfo where type AttrAllowedOps MessageTlsCertificatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageTlsCertificatePropertyInfo = Gio.TlsCertificateK type AttrBaseTypeConstraint MessageTlsCertificatePropertyInfo = MessageK type AttrGetType MessageTlsCertificatePropertyInfo = Gio.TlsCertificate type AttrLabel MessageTlsCertificatePropertyInfo = "Message::tls-certificate" attrGet _ = getMessageTlsCertificate attrSet _ = setMessageTlsCertificate attrConstruct _ = constructMessageTlsCertificate -- VVV Prop "tls-errors" -- Type: TInterface "Gio" "TlsCertificateFlags" -- Flags: [PropertyReadable,PropertyWritable] getMessageTlsErrors :: (MonadIO m, MessageK o) => o -> m [Gio.TlsCertificateFlags] getMessageTlsErrors obj = liftIO $ getObjectPropertyFlags obj "tls-errors" setMessageTlsErrors :: (MonadIO m, MessageK o) => o -> [Gio.TlsCertificateFlags] -> m () setMessageTlsErrors obj val = liftIO $ setObjectPropertyFlags obj "tls-errors" val constructMessageTlsErrors :: [Gio.TlsCertificateFlags] -> IO ([Char], GValue) constructMessageTlsErrors val = constructObjectPropertyFlags "tls-errors" val data MessageTlsErrorsPropertyInfo instance AttrInfo MessageTlsErrorsPropertyInfo where type AttrAllowedOps MessageTlsErrorsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageTlsErrorsPropertyInfo = (~) [Gio.TlsCertificateFlags] type AttrBaseTypeConstraint MessageTlsErrorsPropertyInfo = MessageK type AttrGetType MessageTlsErrorsPropertyInfo = [Gio.TlsCertificateFlags] type AttrLabel MessageTlsErrorsPropertyInfo = "Message::tls-errors" attrGet _ = getMessageTlsErrors attrSet _ = setMessageTlsErrors attrConstruct _ = constructMessageTlsErrors -- VVV Prop "uri" -- Type: TInterface "Soup" "URI" -- Flags: [PropertyReadable,PropertyWritable] getMessageUri :: (MonadIO m, MessageK o) => o -> m URI getMessageUri obj = liftIO $ getObjectPropertyBoxed obj "uri" URI setMessageUri :: (MonadIO m, MessageK o) => o -> URI -> m () setMessageUri obj val = liftIO $ setObjectPropertyBoxed obj "uri" val constructMessageUri :: URI -> IO ([Char], GValue) constructMessageUri val = constructObjectPropertyBoxed "uri" val data MessageUriPropertyInfo instance AttrInfo MessageUriPropertyInfo where type AttrAllowedOps MessageUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MessageUriPropertyInfo = (~) URI type AttrBaseTypeConstraint MessageUriPropertyInfo = MessageK type AttrGetType MessageUriPropertyInfo = URI type AttrLabel MessageUriPropertyInfo = "Message::uri" attrGet _ = getMessageUri attrSet _ = setMessageUri attrConstruct _ = constructMessageUri type instance AttributeList Message = '[ '("first-party", MessageFirstPartyPropertyInfo), '("flags", MessageFlagsPropertyInfo), '("http-version", MessageHttpVersionPropertyInfo), '("method", MessageMethodPropertyInfo), '("priority", MessagePriorityPropertyInfo), '("reason-phrase", MessageReasonPhrasePropertyInfo), '("request-body", MessageRequestBodyPropertyInfo), '("request-body-data", MessageRequestBodyDataPropertyInfo), '("request-headers", MessageRequestHeadersPropertyInfo), '("response-body", MessageResponseBodyPropertyInfo), '("response-body-data", MessageResponseBodyDataPropertyInfo), '("response-headers", MessageResponseHeadersPropertyInfo), '("server-side", MessageServerSidePropertyInfo), '("status-code", MessageStatusCodePropertyInfo), '("tls-certificate", MessageTlsCertificatePropertyInfo), '("tls-errors", MessageTlsErrorsPropertyInfo), '("uri", MessageUriPropertyInfo)] -- VVV Prop "message" -- Type: TInterface "Soup" "Message" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getMultipartInputStreamMessage :: (MonadIO m, MultipartInputStreamK o) => o -> m Message getMultipartInputStreamMessage obj = liftIO $ getObjectPropertyObject obj "message" Message constructMultipartInputStreamMessage :: (MessageK a) => a -> IO ([Char], GValue) constructMultipartInputStreamMessage val = constructObjectPropertyObject "message" val data MultipartInputStreamMessagePropertyInfo instance AttrInfo MultipartInputStreamMessagePropertyInfo where type AttrAllowedOps MultipartInputStreamMessagePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MultipartInputStreamMessagePropertyInfo = MessageK type AttrBaseTypeConstraint MultipartInputStreamMessagePropertyInfo = MultipartInputStreamK type AttrGetType MultipartInputStreamMessagePropertyInfo = Message type AttrLabel MultipartInputStreamMessagePropertyInfo = "MultipartInputStream::message" attrGet _ = getMultipartInputStreamMessage attrSet _ = undefined attrConstruct _ = constructMultipartInputStreamMessage type instance AttributeList MultipartInputStream = '[ '("base-stream", GioA.FilterInputStreamBaseStreamPropertyInfo), '("close-base-stream", GioA.FilterInputStreamCloseBaseStreamPropertyInfo), '("message", MultipartInputStreamMessagePropertyInfo)] type instance AttributeList PasswordManager = '[ ] -- VVV Prop "gproxy-resolver" -- Type: TInterface "Gio" "ProxyResolver" -- Flags: [PropertyWritable] setProxyResolverDefaultGproxyResolver :: (MonadIO m, ProxyResolverDefaultK o, Gio.ProxyResolverK a) => o -> a -> m () setProxyResolverDefaultGproxyResolver obj val = liftIO $ setObjectPropertyObject obj "gproxy-resolver" val constructProxyResolverDefaultGproxyResolver :: (Gio.ProxyResolverK a) => a -> IO ([Char], GValue) constructProxyResolverDefaultGproxyResolver val = constructObjectPropertyObject "gproxy-resolver" val data ProxyResolverDefaultGproxyResolverPropertyInfo instance AttrInfo ProxyResolverDefaultGproxyResolverPropertyInfo where type AttrAllowedOps ProxyResolverDefaultGproxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint ProxyResolverDefaultGproxyResolverPropertyInfo = Gio.ProxyResolverK type AttrBaseTypeConstraint ProxyResolverDefaultGproxyResolverPropertyInfo = ProxyResolverDefaultK type AttrGetType ProxyResolverDefaultGproxyResolverPropertyInfo = () type AttrLabel ProxyResolverDefaultGproxyResolverPropertyInfo = "ProxyResolverDefault::gproxy-resolver" attrGet _ = undefined attrSet _ = setProxyResolverDefaultGproxyResolver attrConstruct _ = constructProxyResolverDefaultGproxyResolver type instance AttributeList ProxyResolverDefault = '[ '("gproxy-resolver", ProxyResolverDefaultGproxyResolverPropertyInfo)] type instance AttributeList ProxyURIResolver = '[ ] -- VVV Prop "session" -- Type: TInterface "Soup" "Session" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getRequestSession :: (MonadIO m, RequestK o) => o -> m Session getRequestSession obj = liftIO $ getObjectPropertyObject obj "session" Session constructRequestSession :: (SessionK a) => a -> IO ([Char], GValue) constructRequestSession val = constructObjectPropertyObject "session" val data RequestSessionPropertyInfo instance AttrInfo RequestSessionPropertyInfo where type AttrAllowedOps RequestSessionPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RequestSessionPropertyInfo = SessionK type AttrBaseTypeConstraint RequestSessionPropertyInfo = RequestK type AttrGetType RequestSessionPropertyInfo = Session type AttrLabel RequestSessionPropertyInfo = "Request::session" attrGet _ = getRequestSession attrSet _ = undefined attrConstruct _ = constructRequestSession -- VVV Prop "uri" -- Type: TInterface "Soup" "URI" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getRequestUri :: (MonadIO m, RequestK o) => o -> m URI getRequestUri obj = liftIO $ getObjectPropertyBoxed obj "uri" URI constructRequestUri :: URI -> IO ([Char], GValue) constructRequestUri val = constructObjectPropertyBoxed "uri" val data RequestUriPropertyInfo instance AttrInfo RequestUriPropertyInfo where type AttrAllowedOps RequestUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint RequestUriPropertyInfo = (~) URI type AttrBaseTypeConstraint RequestUriPropertyInfo = RequestK type AttrGetType RequestUriPropertyInfo = URI type AttrLabel RequestUriPropertyInfo = "Request::uri" attrGet _ = getRequestUri attrSet _ = undefined attrConstruct _ = constructRequestUri type instance AttributeList Request = '[ '("session", RequestSessionPropertyInfo), '("uri", RequestUriPropertyInfo)] type instance AttributeList RequestData = '[ '("session", RequestSessionPropertyInfo), '("uri", RequestUriPropertyInfo)] type instance AttributeList RequestFile = '[ '("session", RequestSessionPropertyInfo), '("uri", RequestUriPropertyInfo)] type instance AttributeList RequestHTTP = '[ '("session", RequestSessionPropertyInfo), '("uri", RequestUriPropertyInfo)] type instance AttributeList Requester = '[ ] -- VVV Prop "async-context" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerAsyncContext :: (MonadIO m, ServerK o) => o -> m (Ptr ()) getServerAsyncContext obj = liftIO $ getObjectPropertyPtr obj "async-context" constructServerAsyncContext :: (Ptr ()) -> IO ([Char], GValue) constructServerAsyncContext val = constructObjectPropertyPtr "async-context" val data ServerAsyncContextPropertyInfo instance AttrInfo ServerAsyncContextPropertyInfo where type AttrAllowedOps ServerAsyncContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerAsyncContextPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint ServerAsyncContextPropertyInfo = ServerK type AttrGetType ServerAsyncContextPropertyInfo = (Ptr ()) type AttrLabel ServerAsyncContextPropertyInfo = "Server::async-context" attrGet _ = getServerAsyncContext attrSet _ = undefined attrConstruct _ = constructServerAsyncContext -- VVV Prop "http-aliases" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getServerHttpAliases :: (MonadIO m, ServerK o) => o -> m [T.Text] getServerHttpAliases obj = liftIO $ getObjectPropertyStringArray obj "http-aliases" setServerHttpAliases :: (MonadIO m, ServerK o) => o -> [T.Text] -> m () setServerHttpAliases obj val = liftIO $ setObjectPropertyStringArray obj "http-aliases" val constructServerHttpAliases :: [T.Text] -> IO ([Char], GValue) constructServerHttpAliases val = constructObjectPropertyStringArray "http-aliases" val data ServerHttpAliasesPropertyInfo instance AttrInfo ServerHttpAliasesPropertyInfo where type AttrAllowedOps ServerHttpAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerHttpAliasesPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint ServerHttpAliasesPropertyInfo = ServerK type AttrGetType ServerHttpAliasesPropertyInfo = [T.Text] type AttrLabel ServerHttpAliasesPropertyInfo = "Server::http-aliases" attrGet _ = getServerHttpAliases attrSet _ = setServerHttpAliases attrConstruct _ = constructServerHttpAliases -- VVV Prop "https-aliases" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getServerHttpsAliases :: (MonadIO m, ServerK o) => o -> m [T.Text] getServerHttpsAliases obj = liftIO $ getObjectPropertyStringArray obj "https-aliases" setServerHttpsAliases :: (MonadIO m, ServerK o) => o -> [T.Text] -> m () setServerHttpsAliases obj val = liftIO $ setObjectPropertyStringArray obj "https-aliases" val constructServerHttpsAliases :: [T.Text] -> IO ([Char], GValue) constructServerHttpsAliases val = constructObjectPropertyStringArray "https-aliases" val data ServerHttpsAliasesPropertyInfo instance AttrInfo ServerHttpsAliasesPropertyInfo where type AttrAllowedOps ServerHttpsAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerHttpsAliasesPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint ServerHttpsAliasesPropertyInfo = ServerK type AttrGetType ServerHttpsAliasesPropertyInfo = [T.Text] type AttrLabel ServerHttpsAliasesPropertyInfo = "Server::https-aliases" attrGet _ = getServerHttpsAliases attrSet _ = setServerHttpsAliases attrConstruct _ = constructServerHttpsAliases -- VVV Prop "interface" -- Type: TInterface "Soup" "Address" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerInterface :: (MonadIO m, ServerK o) => o -> m Address getServerInterface obj = liftIO $ getObjectPropertyObject obj "interface" Address constructServerInterface :: (AddressK a) => a -> IO ([Char], GValue) constructServerInterface val = constructObjectPropertyObject "interface" val data ServerInterfacePropertyInfo instance AttrInfo ServerInterfacePropertyInfo where type AttrAllowedOps ServerInterfacePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerInterfacePropertyInfo = AddressK type AttrBaseTypeConstraint ServerInterfacePropertyInfo = ServerK type AttrGetType ServerInterfacePropertyInfo = Address type AttrLabel ServerInterfacePropertyInfo = "Server::interface" attrGet _ = getServerInterface attrSet _ = undefined attrConstruct _ = constructServerInterface -- VVV Prop "port" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerPort :: (MonadIO m, ServerK o) => o -> m Word32 getServerPort obj = liftIO $ getObjectPropertyCUInt obj "port" constructServerPort :: Word32 -> IO ([Char], GValue) constructServerPort val = constructObjectPropertyCUInt "port" val data ServerPortPropertyInfo instance AttrInfo ServerPortPropertyInfo where type AttrAllowedOps ServerPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerPortPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ServerPortPropertyInfo = ServerK type AttrGetType ServerPortPropertyInfo = Word32 type AttrLabel ServerPortPropertyInfo = "Server::port" attrGet _ = getServerPort attrSet _ = undefined attrConstruct _ = constructServerPort -- VVV Prop "raw-paths" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerRawPaths :: (MonadIO m, ServerK o) => o -> m Bool getServerRawPaths obj = liftIO $ getObjectPropertyBool obj "raw-paths" constructServerRawPaths :: Bool -> IO ([Char], GValue) constructServerRawPaths val = constructObjectPropertyBool "raw-paths" val data ServerRawPathsPropertyInfo instance AttrInfo ServerRawPathsPropertyInfo where type AttrAllowedOps ServerRawPathsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerRawPathsPropertyInfo = (~) Bool type AttrBaseTypeConstraint ServerRawPathsPropertyInfo = ServerK type AttrGetType ServerRawPathsPropertyInfo = Bool type AttrLabel ServerRawPathsPropertyInfo = "Server::raw-paths" attrGet _ = getServerRawPaths attrSet _ = undefined attrConstruct _ = constructServerRawPaths -- VVV Prop "server-header" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getServerServerHeader :: (MonadIO m, ServerK o) => o -> m T.Text getServerServerHeader obj = liftIO $ getObjectPropertyString obj "server-header" setServerServerHeader :: (MonadIO m, ServerK o) => o -> T.Text -> m () setServerServerHeader obj val = liftIO $ setObjectPropertyString obj "server-header" val constructServerServerHeader :: T.Text -> IO ([Char], GValue) constructServerServerHeader val = constructObjectPropertyString "server-header" val data ServerServerHeaderPropertyInfo instance AttrInfo ServerServerHeaderPropertyInfo where type AttrAllowedOps ServerServerHeaderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerServerHeaderPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ServerServerHeaderPropertyInfo = ServerK type AttrGetType ServerServerHeaderPropertyInfo = T.Text type AttrLabel ServerServerHeaderPropertyInfo = "Server::server-header" attrGet _ = getServerServerHeader attrSet _ = setServerServerHeader attrConstruct _ = constructServerServerHeader -- VVV Prop "ssl-cert-file" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerSslCertFile :: (MonadIO m, ServerK o) => o -> m T.Text getServerSslCertFile obj = liftIO $ getObjectPropertyString obj "ssl-cert-file" constructServerSslCertFile :: T.Text -> IO ([Char], GValue) constructServerSslCertFile val = constructObjectPropertyString "ssl-cert-file" val data ServerSslCertFilePropertyInfo instance AttrInfo ServerSslCertFilePropertyInfo where type AttrAllowedOps ServerSslCertFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerSslCertFilePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ServerSslCertFilePropertyInfo = ServerK type AttrGetType ServerSslCertFilePropertyInfo = T.Text type AttrLabel ServerSslCertFilePropertyInfo = "Server::ssl-cert-file" attrGet _ = getServerSslCertFile attrSet _ = undefined attrConstruct _ = constructServerSslCertFile -- VVV Prop "ssl-key-file" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerSslKeyFile :: (MonadIO m, ServerK o) => o -> m T.Text getServerSslKeyFile obj = liftIO $ getObjectPropertyString obj "ssl-key-file" constructServerSslKeyFile :: T.Text -> IO ([Char], GValue) constructServerSslKeyFile val = constructObjectPropertyString "ssl-key-file" val data ServerSslKeyFilePropertyInfo instance AttrInfo ServerSslKeyFilePropertyInfo where type AttrAllowedOps ServerSslKeyFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerSslKeyFilePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ServerSslKeyFilePropertyInfo = ServerK type AttrGetType ServerSslKeyFilePropertyInfo = T.Text type AttrLabel ServerSslKeyFilePropertyInfo = "Server::ssl-key-file" attrGet _ = getServerSslKeyFile attrSet _ = undefined attrConstruct _ = constructServerSslKeyFile -- VVV Prop "tls-certificate" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getServerTlsCertificate :: (MonadIO m, ServerK o) => o -> m Gio.TlsCertificate getServerTlsCertificate obj = liftIO $ getObjectPropertyObject obj "tls-certificate" Gio.TlsCertificate constructServerTlsCertificate :: (Gio.TlsCertificateK a) => a -> IO ([Char], GValue) constructServerTlsCertificate val = constructObjectPropertyObject "tls-certificate" val data ServerTlsCertificatePropertyInfo instance AttrInfo ServerTlsCertificatePropertyInfo where type AttrAllowedOps ServerTlsCertificatePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ServerTlsCertificatePropertyInfo = Gio.TlsCertificateK type AttrBaseTypeConstraint ServerTlsCertificatePropertyInfo = ServerK type AttrGetType ServerTlsCertificatePropertyInfo = Gio.TlsCertificate type AttrLabel ServerTlsCertificatePropertyInfo = "Server::tls-certificate" attrGet _ = getServerTlsCertificate attrSet _ = undefined attrConstruct _ = constructServerTlsCertificate type instance AttributeList Server = '[ '("async-context", ServerAsyncContextPropertyInfo), '("http-aliases", ServerHttpAliasesPropertyInfo), '("https-aliases", ServerHttpsAliasesPropertyInfo), '("interface", ServerInterfacePropertyInfo), '("port", ServerPortPropertyInfo), '("raw-paths", ServerRawPathsPropertyInfo), '("server-header", ServerServerHeaderPropertyInfo), '("ssl-cert-file", ServerSslCertFilePropertyInfo), '("ssl-key-file", ServerSslKeyFilePropertyInfo), '("tls-certificate", ServerTlsCertificatePropertyInfo)] -- VVV Prop "accept-language" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSessionAcceptLanguage :: (MonadIO m, SessionK o) => o -> m T.Text getSessionAcceptLanguage obj = liftIO $ getObjectPropertyString obj "accept-language" setSessionAcceptLanguage :: (MonadIO m, SessionK o) => o -> T.Text -> m () setSessionAcceptLanguage obj val = liftIO $ setObjectPropertyString obj "accept-language" val constructSessionAcceptLanguage :: T.Text -> IO ([Char], GValue) constructSessionAcceptLanguage val = constructObjectPropertyString "accept-language" val data SessionAcceptLanguagePropertyInfo instance AttrInfo SessionAcceptLanguagePropertyInfo where type AttrAllowedOps SessionAcceptLanguagePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionAcceptLanguagePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SessionAcceptLanguagePropertyInfo = SessionK type AttrGetType SessionAcceptLanguagePropertyInfo = T.Text type AttrLabel SessionAcceptLanguagePropertyInfo = "Session::accept-language" attrGet _ = getSessionAcceptLanguage attrSet _ = setSessionAcceptLanguage attrConstruct _ = constructSessionAcceptLanguage -- VVV Prop "accept-language-auto" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSessionAcceptLanguageAuto :: (MonadIO m, SessionK o) => o -> m Bool getSessionAcceptLanguageAuto obj = liftIO $ getObjectPropertyBool obj "accept-language-auto" setSessionAcceptLanguageAuto :: (MonadIO m, SessionK o) => o -> Bool -> m () setSessionAcceptLanguageAuto obj val = liftIO $ setObjectPropertyBool obj "accept-language-auto" val constructSessionAcceptLanguageAuto :: Bool -> IO ([Char], GValue) constructSessionAcceptLanguageAuto val = constructObjectPropertyBool "accept-language-auto" val data SessionAcceptLanguageAutoPropertyInfo instance AttrInfo SessionAcceptLanguageAutoPropertyInfo where type AttrAllowedOps SessionAcceptLanguageAutoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionAcceptLanguageAutoPropertyInfo = (~) Bool type AttrBaseTypeConstraint SessionAcceptLanguageAutoPropertyInfo = SessionK type AttrGetType SessionAcceptLanguageAutoPropertyInfo = Bool type AttrLabel SessionAcceptLanguageAutoPropertyInfo = "Session::accept-language-auto" attrGet _ = getSessionAcceptLanguageAuto attrSet _ = setSessionAcceptLanguageAuto attrConstruct _ = constructSessionAcceptLanguageAuto -- VVV Prop "async-context" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSessionAsyncContext :: (MonadIO m, SessionK o) => o -> m (Ptr ()) getSessionAsyncContext obj = liftIO $ getObjectPropertyPtr obj "async-context" constructSessionAsyncContext :: (Ptr ()) -> IO ([Char], GValue) constructSessionAsyncContext val = constructObjectPropertyPtr "async-context" val data SessionAsyncContextPropertyInfo instance AttrInfo SessionAsyncContextPropertyInfo where type AttrAllowedOps SessionAsyncContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionAsyncContextPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint SessionAsyncContextPropertyInfo = SessionK type AttrGetType SessionAsyncContextPropertyInfo = (Ptr ()) type AttrLabel SessionAsyncContextPropertyInfo = "Session::async-context" attrGet _ = getSessionAsyncContext attrSet _ = undefined attrConstruct _ = constructSessionAsyncContext -- VVV Prop "http-aliases" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getSessionHttpAliases :: (MonadIO m, SessionK o) => o -> m [T.Text] getSessionHttpAliases obj = liftIO $ getObjectPropertyStringArray obj "http-aliases" setSessionHttpAliases :: (MonadIO m, SessionK o) => o -> [T.Text] -> m () setSessionHttpAliases obj val = liftIO $ setObjectPropertyStringArray obj "http-aliases" val constructSessionHttpAliases :: [T.Text] -> IO ([Char], GValue) constructSessionHttpAliases val = constructObjectPropertyStringArray "http-aliases" val data SessionHttpAliasesPropertyInfo instance AttrInfo SessionHttpAliasesPropertyInfo where type AttrAllowedOps SessionHttpAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionHttpAliasesPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint SessionHttpAliasesPropertyInfo = SessionK type AttrGetType SessionHttpAliasesPropertyInfo = [T.Text] type AttrLabel SessionHttpAliasesPropertyInfo = "Session::http-aliases" attrGet _ = getSessionHttpAliases attrSet _ = setSessionHttpAliases attrConstruct _ = constructSessionHttpAliases -- VVV Prop "https-aliases" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getSessionHttpsAliases :: (MonadIO m, SessionK o) => o -> m [T.Text] getSessionHttpsAliases obj = liftIO $ getObjectPropertyStringArray obj "https-aliases" setSessionHttpsAliases :: (MonadIO m, SessionK o) => o -> [T.Text] -> m () setSessionHttpsAliases obj val = liftIO $ setObjectPropertyStringArray obj "https-aliases" val constructSessionHttpsAliases :: [T.Text] -> IO ([Char], GValue) constructSessionHttpsAliases val = constructObjectPropertyStringArray "https-aliases" val data SessionHttpsAliasesPropertyInfo instance AttrInfo SessionHttpsAliasesPropertyInfo where type AttrAllowedOps SessionHttpsAliasesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionHttpsAliasesPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint SessionHttpsAliasesPropertyInfo = SessionK type AttrGetType SessionHttpsAliasesPropertyInfo = [T.Text] type AttrLabel SessionHttpsAliasesPropertyInfo = "Session::https-aliases" attrGet _ = getSessionHttpsAliases attrSet _ = setSessionHttpsAliases attrConstruct _ = constructSessionHttpsAliases -- VVV Prop "idle-timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSessionIdleTimeout :: (MonadIO m, SessionK o) => o -> m Word32 getSessionIdleTimeout obj = liftIO $ getObjectPropertyCUInt obj "idle-timeout" setSessionIdleTimeout :: (MonadIO m, SessionK o) => o -> Word32 -> m () setSessionIdleTimeout obj val = liftIO $ setObjectPropertyCUInt obj "idle-timeout" val constructSessionIdleTimeout :: Word32 -> IO ([Char], GValue) constructSessionIdleTimeout val = constructObjectPropertyCUInt "idle-timeout" val data SessionIdleTimeoutPropertyInfo instance AttrInfo SessionIdleTimeoutPropertyInfo where type AttrAllowedOps SessionIdleTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionIdleTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SessionIdleTimeoutPropertyInfo = SessionK type AttrGetType SessionIdleTimeoutPropertyInfo = Word32 type AttrLabel SessionIdleTimeoutPropertyInfo = "Session::idle-timeout" attrGet _ = getSessionIdleTimeout attrSet _ = setSessionIdleTimeout attrConstruct _ = constructSessionIdleTimeout -- VVV Prop "local-address" -- Type: TInterface "Soup" "Address" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSessionLocalAddress :: (MonadIO m, SessionK o) => o -> m Address getSessionLocalAddress obj = liftIO $ getObjectPropertyObject obj "local-address" Address constructSessionLocalAddress :: (AddressK a) => a -> IO ([Char], GValue) constructSessionLocalAddress val = constructObjectPropertyObject "local-address" val data SessionLocalAddressPropertyInfo instance AttrInfo SessionLocalAddressPropertyInfo where type AttrAllowedOps SessionLocalAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionLocalAddressPropertyInfo = AddressK type AttrBaseTypeConstraint SessionLocalAddressPropertyInfo = SessionK type AttrGetType SessionLocalAddressPropertyInfo = Address type AttrLabel SessionLocalAddressPropertyInfo = "Session::local-address" attrGet _ = getSessionLocalAddress attrSet _ = undefined attrConstruct _ = constructSessionLocalAddress -- VVV Prop "max-conns" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSessionMaxConns :: (MonadIO m, SessionK o) => o -> m Int32 getSessionMaxConns obj = liftIO $ getObjectPropertyCInt obj "max-conns" setSessionMaxConns :: (MonadIO m, SessionK o) => o -> Int32 -> m () setSessionMaxConns obj val = liftIO $ setObjectPropertyCInt obj "max-conns" val constructSessionMaxConns :: Int32 -> IO ([Char], GValue) constructSessionMaxConns val = constructObjectPropertyCInt "max-conns" val data SessionMaxConnsPropertyInfo instance AttrInfo SessionMaxConnsPropertyInfo where type AttrAllowedOps SessionMaxConnsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionMaxConnsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SessionMaxConnsPropertyInfo = SessionK type AttrGetType SessionMaxConnsPropertyInfo = Int32 type AttrLabel SessionMaxConnsPropertyInfo = "Session::max-conns" attrGet _ = getSessionMaxConns attrSet _ = setSessionMaxConns attrConstruct _ = constructSessionMaxConns -- VVV Prop "max-conns-per-host" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSessionMaxConnsPerHost :: (MonadIO m, SessionK o) => o -> m Int32 getSessionMaxConnsPerHost obj = liftIO $ getObjectPropertyCInt obj "max-conns-per-host" setSessionMaxConnsPerHost :: (MonadIO m, SessionK o) => o -> Int32 -> m () setSessionMaxConnsPerHost obj val = liftIO $ setObjectPropertyCInt obj "max-conns-per-host" val constructSessionMaxConnsPerHost :: Int32 -> IO ([Char], GValue) constructSessionMaxConnsPerHost val = constructObjectPropertyCInt "max-conns-per-host" val data SessionMaxConnsPerHostPropertyInfo instance AttrInfo SessionMaxConnsPerHostPropertyInfo where type AttrAllowedOps SessionMaxConnsPerHostPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionMaxConnsPerHostPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SessionMaxConnsPerHostPropertyInfo = SessionK type AttrGetType SessionMaxConnsPerHostPropertyInfo = Int32 type AttrLabel SessionMaxConnsPerHostPropertyInfo = "Session::max-conns-per-host" attrGet _ = getSessionMaxConnsPerHost attrSet _ = setSessionMaxConnsPerHost attrConstruct _ = constructSessionMaxConnsPerHost -- VVV Prop "proxy-resolver" -- Type: TInterface "Gio" "ProxyResolver" -- Flags: [PropertyReadable,PropertyWritable] getSessionProxyResolver :: (MonadIO m, SessionK o) => o -> m Gio.ProxyResolver getSessionProxyResolver obj = liftIO $ getObjectPropertyObject obj "proxy-resolver" Gio.ProxyResolver setSessionProxyResolver :: (MonadIO m, SessionK o, Gio.ProxyResolverK a) => o -> a -> m () setSessionProxyResolver obj val = liftIO $ setObjectPropertyObject obj "proxy-resolver" val constructSessionProxyResolver :: (Gio.ProxyResolverK a) => a -> IO ([Char], GValue) constructSessionProxyResolver val = constructObjectPropertyObject "proxy-resolver" val data SessionProxyResolverPropertyInfo instance AttrInfo SessionProxyResolverPropertyInfo where type AttrAllowedOps SessionProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionProxyResolverPropertyInfo = Gio.ProxyResolverK type AttrBaseTypeConstraint SessionProxyResolverPropertyInfo = SessionK type AttrGetType SessionProxyResolverPropertyInfo = Gio.ProxyResolver type AttrLabel SessionProxyResolverPropertyInfo = "Session::proxy-resolver" attrGet _ = getSessionProxyResolver attrSet _ = setSessionProxyResolver attrConstruct _ = constructSessionProxyResolver -- VVV Prop "proxy-uri" -- Type: TInterface "Soup" "URI" -- Flags: [PropertyReadable,PropertyWritable] getSessionProxyUri :: (MonadIO m, SessionK o) => o -> m URI getSessionProxyUri obj = liftIO $ getObjectPropertyBoxed obj "proxy-uri" URI setSessionProxyUri :: (MonadIO m, SessionK o) => o -> URI -> m () setSessionProxyUri obj val = liftIO $ setObjectPropertyBoxed obj "proxy-uri" val constructSessionProxyUri :: URI -> IO ([Char], GValue) constructSessionProxyUri val = constructObjectPropertyBoxed "proxy-uri" val data SessionProxyUriPropertyInfo instance AttrInfo SessionProxyUriPropertyInfo where type AttrAllowedOps SessionProxyUriPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionProxyUriPropertyInfo = (~) URI type AttrBaseTypeConstraint SessionProxyUriPropertyInfo = SessionK type AttrGetType SessionProxyUriPropertyInfo = URI type AttrLabel SessionProxyUriPropertyInfo = "Session::proxy-uri" attrGet _ = getSessionProxyUri attrSet _ = setSessionProxyUri attrConstruct _ = constructSessionProxyUri -- VVV Prop "ssl-ca-file" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSessionSslCaFile :: (MonadIO m, SessionK o) => o -> m T.Text getSessionSslCaFile obj = liftIO $ getObjectPropertyString obj "ssl-ca-file" setSessionSslCaFile :: (MonadIO m, SessionK o) => o -> T.Text -> m () setSessionSslCaFile obj val = liftIO $ setObjectPropertyString obj "ssl-ca-file" val constructSessionSslCaFile :: T.Text -> IO ([Char], GValue) constructSessionSslCaFile val = constructObjectPropertyString "ssl-ca-file" val data SessionSslCaFilePropertyInfo instance AttrInfo SessionSslCaFilePropertyInfo where type AttrAllowedOps SessionSslCaFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionSslCaFilePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SessionSslCaFilePropertyInfo = SessionK type AttrGetType SessionSslCaFilePropertyInfo = T.Text type AttrLabel SessionSslCaFilePropertyInfo = "Session::ssl-ca-file" attrGet _ = getSessionSslCaFile attrSet _ = setSessionSslCaFile attrConstruct _ = constructSessionSslCaFile -- VVV Prop "ssl-strict" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSessionSslStrict :: (MonadIO m, SessionK o) => o -> m Bool getSessionSslStrict obj = liftIO $ getObjectPropertyBool obj "ssl-strict" setSessionSslStrict :: (MonadIO m, SessionK o) => o -> Bool -> m () setSessionSslStrict obj val = liftIO $ setObjectPropertyBool obj "ssl-strict" val constructSessionSslStrict :: Bool -> IO ([Char], GValue) constructSessionSslStrict val = constructObjectPropertyBool "ssl-strict" val data SessionSslStrictPropertyInfo instance AttrInfo SessionSslStrictPropertyInfo where type AttrAllowedOps SessionSslStrictPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionSslStrictPropertyInfo = (~) Bool type AttrBaseTypeConstraint SessionSslStrictPropertyInfo = SessionK type AttrGetType SessionSslStrictPropertyInfo = Bool type AttrLabel SessionSslStrictPropertyInfo = "Session::ssl-strict" attrGet _ = getSessionSslStrict attrSet _ = setSessionSslStrict attrConstruct _ = constructSessionSslStrict -- VVV Prop "ssl-use-system-ca-file" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSessionSslUseSystemCaFile :: (MonadIO m, SessionK o) => o -> m Bool getSessionSslUseSystemCaFile obj = liftIO $ getObjectPropertyBool obj "ssl-use-system-ca-file" setSessionSslUseSystemCaFile :: (MonadIO m, SessionK o) => o -> Bool -> m () setSessionSslUseSystemCaFile obj val = liftIO $ setObjectPropertyBool obj "ssl-use-system-ca-file" val constructSessionSslUseSystemCaFile :: Bool -> IO ([Char], GValue) constructSessionSslUseSystemCaFile val = constructObjectPropertyBool "ssl-use-system-ca-file" val data SessionSslUseSystemCaFilePropertyInfo instance AttrInfo SessionSslUseSystemCaFilePropertyInfo where type AttrAllowedOps SessionSslUseSystemCaFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionSslUseSystemCaFilePropertyInfo = (~) Bool type AttrBaseTypeConstraint SessionSslUseSystemCaFilePropertyInfo = SessionK type AttrGetType SessionSslUseSystemCaFilePropertyInfo = Bool type AttrLabel SessionSslUseSystemCaFilePropertyInfo = "Session::ssl-use-system-ca-file" attrGet _ = getSessionSslUseSystemCaFile attrSet _ = setSessionSslUseSystemCaFile attrConstruct _ = constructSessionSslUseSystemCaFile -- VVV Prop "timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSessionTimeout :: (MonadIO m, SessionK o) => o -> m Word32 getSessionTimeout obj = liftIO $ getObjectPropertyCUInt obj "timeout" setSessionTimeout :: (MonadIO m, SessionK o) => o -> Word32 -> m () setSessionTimeout obj val = liftIO $ setObjectPropertyCUInt obj "timeout" val constructSessionTimeout :: Word32 -> IO ([Char], GValue) constructSessionTimeout val = constructObjectPropertyCUInt "timeout" val data SessionTimeoutPropertyInfo instance AttrInfo SessionTimeoutPropertyInfo where type AttrAllowedOps SessionTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SessionTimeoutPropertyInfo = SessionK type AttrGetType SessionTimeoutPropertyInfo = Word32 type AttrLabel SessionTimeoutPropertyInfo = "Session::timeout" attrGet _ = getSessionTimeout attrSet _ = setSessionTimeout attrConstruct _ = constructSessionTimeout -- VVV Prop "tls-database" -- Type: TInterface "Gio" "TlsDatabase" -- Flags: [PropertyReadable,PropertyWritable] getSessionTlsDatabase :: (MonadIO m, SessionK o) => o -> m Gio.TlsDatabase getSessionTlsDatabase obj = liftIO $ getObjectPropertyObject obj "tls-database" Gio.TlsDatabase setSessionTlsDatabase :: (MonadIO m, SessionK o, Gio.TlsDatabaseK a) => o -> a -> m () setSessionTlsDatabase obj val = liftIO $ setObjectPropertyObject obj "tls-database" val constructSessionTlsDatabase :: (Gio.TlsDatabaseK a) => a -> IO ([Char], GValue) constructSessionTlsDatabase val = constructObjectPropertyObject "tls-database" val data SessionTlsDatabasePropertyInfo instance AttrInfo SessionTlsDatabasePropertyInfo where type AttrAllowedOps SessionTlsDatabasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionTlsDatabasePropertyInfo = Gio.TlsDatabaseK type AttrBaseTypeConstraint SessionTlsDatabasePropertyInfo = SessionK type AttrGetType SessionTlsDatabasePropertyInfo = Gio.TlsDatabase type AttrLabel SessionTlsDatabasePropertyInfo = "Session::tls-database" attrGet _ = getSessionTlsDatabase attrSet _ = setSessionTlsDatabase attrConstruct _ = constructSessionTlsDatabase -- VVV Prop "tls-interaction" -- Type: TInterface "Gio" "TlsInteraction" -- Flags: [PropertyReadable,PropertyWritable] getSessionTlsInteraction :: (MonadIO m, SessionK o) => o -> m Gio.TlsInteraction getSessionTlsInteraction obj = liftIO $ getObjectPropertyObject obj "tls-interaction" Gio.TlsInteraction setSessionTlsInteraction :: (MonadIO m, SessionK o, Gio.TlsInteractionK a) => o -> a -> m () setSessionTlsInteraction obj val = liftIO $ setObjectPropertyObject obj "tls-interaction" val constructSessionTlsInteraction :: (Gio.TlsInteractionK a) => a -> IO ([Char], GValue) constructSessionTlsInteraction val = constructObjectPropertyObject "tls-interaction" val data SessionTlsInteractionPropertyInfo instance AttrInfo SessionTlsInteractionPropertyInfo where type AttrAllowedOps SessionTlsInteractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionTlsInteractionPropertyInfo = Gio.TlsInteractionK type AttrBaseTypeConstraint SessionTlsInteractionPropertyInfo = SessionK type AttrGetType SessionTlsInteractionPropertyInfo = Gio.TlsInteraction type AttrLabel SessionTlsInteractionPropertyInfo = "Session::tls-interaction" attrGet _ = getSessionTlsInteraction attrSet _ = setSessionTlsInteraction attrConstruct _ = constructSessionTlsInteraction -- VVV Prop "use-ntlm" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSessionUseNtlm :: (MonadIO m, SessionK o) => o -> m Bool getSessionUseNtlm obj = liftIO $ getObjectPropertyBool obj "use-ntlm" setSessionUseNtlm :: (MonadIO m, SessionK o) => o -> Bool -> m () setSessionUseNtlm obj val = liftIO $ setObjectPropertyBool obj "use-ntlm" val constructSessionUseNtlm :: Bool -> IO ([Char], GValue) constructSessionUseNtlm val = constructObjectPropertyBool "use-ntlm" val data SessionUseNtlmPropertyInfo instance AttrInfo SessionUseNtlmPropertyInfo where type AttrAllowedOps SessionUseNtlmPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionUseNtlmPropertyInfo = (~) Bool type AttrBaseTypeConstraint SessionUseNtlmPropertyInfo = SessionK type AttrGetType SessionUseNtlmPropertyInfo = Bool type AttrLabel SessionUseNtlmPropertyInfo = "Session::use-ntlm" attrGet _ = getSessionUseNtlm attrSet _ = setSessionUseNtlm attrConstruct _ = constructSessionUseNtlm -- VVV Prop "use-thread-context" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSessionUseThreadContext :: (MonadIO m, SessionK o) => o -> m Bool getSessionUseThreadContext obj = liftIO $ getObjectPropertyBool obj "use-thread-context" setSessionUseThreadContext :: (MonadIO m, SessionK o) => o -> Bool -> m () setSessionUseThreadContext obj val = liftIO $ setObjectPropertyBool obj "use-thread-context" val constructSessionUseThreadContext :: Bool -> IO ([Char], GValue) constructSessionUseThreadContext val = constructObjectPropertyBool "use-thread-context" val data SessionUseThreadContextPropertyInfo instance AttrInfo SessionUseThreadContextPropertyInfo where type AttrAllowedOps SessionUseThreadContextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionUseThreadContextPropertyInfo = (~) Bool type AttrBaseTypeConstraint SessionUseThreadContextPropertyInfo = SessionK type AttrGetType SessionUseThreadContextPropertyInfo = Bool type AttrLabel SessionUseThreadContextPropertyInfo = "Session::use-thread-context" attrGet _ = getSessionUseThreadContext attrSet _ = setSessionUseThreadContext attrConstruct _ = constructSessionUseThreadContext -- VVV Prop "user-agent" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSessionUserAgent :: (MonadIO m, SessionK o) => o -> m T.Text getSessionUserAgent obj = liftIO $ getObjectPropertyString obj "user-agent" setSessionUserAgent :: (MonadIO m, SessionK o) => o -> T.Text -> m () setSessionUserAgent obj val = liftIO $ setObjectPropertyString obj "user-agent" val constructSessionUserAgent :: T.Text -> IO ([Char], GValue) constructSessionUserAgent val = constructObjectPropertyString "user-agent" val data SessionUserAgentPropertyInfo instance AttrInfo SessionUserAgentPropertyInfo where type AttrAllowedOps SessionUserAgentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SessionUserAgentPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SessionUserAgentPropertyInfo = SessionK type AttrGetType SessionUserAgentPropertyInfo = T.Text type AttrLabel SessionUserAgentPropertyInfo = "Session::user-agent" attrGet _ = getSessionUserAgent attrSet _ = setSessionUserAgent attrConstruct _ = constructSessionUserAgent type instance AttributeList Session = '[ '("accept-language", SessionAcceptLanguagePropertyInfo), '("accept-language-auto", SessionAcceptLanguageAutoPropertyInfo), '("async-context", SessionAsyncContextPropertyInfo), '("http-aliases", SessionHttpAliasesPropertyInfo), '("https-aliases", SessionHttpsAliasesPropertyInfo), '("idle-timeout", SessionIdleTimeoutPropertyInfo), '("local-address", SessionLocalAddressPropertyInfo), '("max-conns", SessionMaxConnsPropertyInfo), '("max-conns-per-host", SessionMaxConnsPerHostPropertyInfo), '("proxy-resolver", SessionProxyResolverPropertyInfo), '("proxy-uri", SessionProxyUriPropertyInfo), '("ssl-ca-file", SessionSslCaFilePropertyInfo), '("ssl-strict", SessionSslStrictPropertyInfo), '("ssl-use-system-ca-file", SessionSslUseSystemCaFilePropertyInfo), '("timeout", SessionTimeoutPropertyInfo), '("tls-database", SessionTlsDatabasePropertyInfo), '("tls-interaction", SessionTlsInteractionPropertyInfo), '("use-ntlm", SessionUseNtlmPropertyInfo), '("use-thread-context", SessionUseThreadContextPropertyInfo), '("user-agent", SessionUserAgentPropertyInfo)] type instance AttributeList SessionAsync = '[ '("accept-language", SessionAcceptLanguagePropertyInfo), '("accept-language-auto", SessionAcceptLanguageAutoPropertyInfo), '("async-context", SessionAsyncContextPropertyInfo), '("http-aliases", SessionHttpAliasesPropertyInfo), '("https-aliases", SessionHttpsAliasesPropertyInfo), '("idle-timeout", SessionIdleTimeoutPropertyInfo), '("local-address", SessionLocalAddressPropertyInfo), '("max-conns", SessionMaxConnsPropertyInfo), '("max-conns-per-host", SessionMaxConnsPerHostPropertyInfo), '("proxy-resolver", SessionProxyResolverPropertyInfo), '("proxy-uri", SessionProxyUriPropertyInfo), '("ssl-ca-file", SessionSslCaFilePropertyInfo), '("ssl-strict", SessionSslStrictPropertyInfo), '("ssl-use-system-ca-file", SessionSslUseSystemCaFilePropertyInfo), '("timeout", SessionTimeoutPropertyInfo), '("tls-database", SessionTlsDatabasePropertyInfo), '("tls-interaction", SessionTlsInteractionPropertyInfo), '("use-ntlm", SessionUseNtlmPropertyInfo), '("use-thread-context", SessionUseThreadContextPropertyInfo), '("user-agent", SessionUserAgentPropertyInfo)] type instance AttributeList SessionFeature = '[ ] type instance AttributeList SessionSync = '[ '("accept-language", SessionAcceptLanguagePropertyInfo), '("accept-language-auto", SessionAcceptLanguageAutoPropertyInfo), '("async-context", SessionAsyncContextPropertyInfo), '("http-aliases", SessionHttpAliasesPropertyInfo), '("https-aliases", SessionHttpsAliasesPropertyInfo), '("idle-timeout", SessionIdleTimeoutPropertyInfo), '("local-address", SessionLocalAddressPropertyInfo), '("max-conns", SessionMaxConnsPropertyInfo), '("max-conns-per-host", SessionMaxConnsPerHostPropertyInfo), '("proxy-resolver", SessionProxyResolverPropertyInfo), '("proxy-uri", SessionProxyUriPropertyInfo), '("ssl-ca-file", SessionSslCaFilePropertyInfo), '("ssl-strict", SessionSslStrictPropertyInfo), '("ssl-use-system-ca-file", SessionSslUseSystemCaFilePropertyInfo), '("timeout", SessionTimeoutPropertyInfo), '("tls-database", SessionTlsDatabasePropertyInfo), '("tls-interaction", SessionTlsInteractionPropertyInfo), '("use-ntlm", SessionUseNtlmPropertyInfo), '("use-thread-context", SessionUseThreadContextPropertyInfo), '("user-agent", SessionUserAgentPropertyInfo)] -- VVV Prop "async-context" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketAsyncContext :: (MonadIO m, SocketK o) => o -> m (Ptr ()) getSocketAsyncContext obj = liftIO $ getObjectPropertyPtr obj "async-context" constructSocketAsyncContext :: (Ptr ()) -> IO ([Char], GValue) constructSocketAsyncContext val = constructObjectPropertyPtr "async-context" val data SocketAsyncContextPropertyInfo instance AttrInfo SocketAsyncContextPropertyInfo where type AttrAllowedOps SocketAsyncContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketAsyncContextPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint SocketAsyncContextPropertyInfo = SocketK type AttrGetType SocketAsyncContextPropertyInfo = (Ptr ()) type AttrLabel SocketAsyncContextPropertyInfo = "Socket::async-context" attrGet _ = getSocketAsyncContext attrSet _ = undefined attrConstruct _ = constructSocketAsyncContext -- VVV Prop "fd" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketFd :: (MonadIO m, SocketK o) => o -> m Int32 getSocketFd obj = liftIO $ getObjectPropertyCInt obj "fd" constructSocketFd :: Int32 -> IO ([Char], GValue) constructSocketFd val = constructObjectPropertyCInt "fd" val data SocketFdPropertyInfo instance AttrInfo SocketFdPropertyInfo where type AttrAllowedOps SocketFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketFdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SocketFdPropertyInfo = SocketK type AttrGetType SocketFdPropertyInfo = Int32 type AttrLabel SocketFdPropertyInfo = "Socket::fd" attrGet _ = getSocketFd attrSet _ = undefined attrConstruct _ = constructSocketFd -- VVV Prop "gsocket" -- Type: TInterface "Gio" "Socket" -- Flags: [PropertyWritable,PropertyConstructOnly] constructSocketGsocket :: (Gio.SocketK a) => a -> IO ([Char], GValue) constructSocketGsocket val = constructObjectPropertyObject "gsocket" val data SocketGsocketPropertyInfo instance AttrInfo SocketGsocketPropertyInfo where type AttrAllowedOps SocketGsocketPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint SocketGsocketPropertyInfo = Gio.SocketK type AttrBaseTypeConstraint SocketGsocketPropertyInfo = SocketK type AttrGetType SocketGsocketPropertyInfo = () type AttrLabel SocketGsocketPropertyInfo = "Socket::gsocket" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructSocketGsocket -- VVV Prop "iostream" -- Type: TInterface "Gio" "IOStream" -- Flags: [PropertyWritable,PropertyConstructOnly] constructSocketIostream :: (Gio.IOStreamK a) => a -> IO ([Char], GValue) constructSocketIostream val = constructObjectPropertyObject "iostream" val data SocketIostreamPropertyInfo instance AttrInfo SocketIostreamPropertyInfo where type AttrAllowedOps SocketIostreamPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint SocketIostreamPropertyInfo = Gio.IOStreamK type AttrBaseTypeConstraint SocketIostreamPropertyInfo = SocketK type AttrGetType SocketIostreamPropertyInfo = () type AttrLabel SocketIostreamPropertyInfo = "Socket::iostream" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructSocketIostream -- VVV Prop "ipv6-only" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketIpv6Only :: (MonadIO m, SocketK o) => o -> m Bool getSocketIpv6Only obj = liftIO $ getObjectPropertyBool obj "ipv6-only" setSocketIpv6Only :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketIpv6Only obj val = liftIO $ setObjectPropertyBool obj "ipv6-only" val constructSocketIpv6Only :: Bool -> IO ([Char], GValue) constructSocketIpv6Only val = constructObjectPropertyBool "ipv6-only" val data SocketIpv6OnlyPropertyInfo instance AttrInfo SocketIpv6OnlyPropertyInfo where type AttrAllowedOps SocketIpv6OnlyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketIpv6OnlyPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketIpv6OnlyPropertyInfo = SocketK type AttrGetType SocketIpv6OnlyPropertyInfo = Bool type AttrLabel SocketIpv6OnlyPropertyInfo = "Socket::ipv6-only" attrGet _ = getSocketIpv6Only attrSet _ = setSocketIpv6Only attrConstruct _ = constructSocketIpv6Only -- VVV Prop "is-server" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getSocketIsServer :: (MonadIO m, SocketK o) => o -> m Bool getSocketIsServer obj = liftIO $ getObjectPropertyBool obj "is-server" data SocketIsServerPropertyInfo instance AttrInfo SocketIsServerPropertyInfo where type AttrAllowedOps SocketIsServerPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketIsServerPropertyInfo = (~) () type AttrBaseTypeConstraint SocketIsServerPropertyInfo = SocketK type AttrGetType SocketIsServerPropertyInfo = Bool type AttrLabel SocketIsServerPropertyInfo = "Socket::is-server" attrGet _ = getSocketIsServer attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "local-address" -- Type: TInterface "Soup" "Address" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketLocalAddress :: (MonadIO m, SocketK o) => o -> m Address getSocketLocalAddress obj = liftIO $ getObjectPropertyObject obj "local-address" Address constructSocketLocalAddress :: (AddressK a) => a -> IO ([Char], GValue) constructSocketLocalAddress val = constructObjectPropertyObject "local-address" val data SocketLocalAddressPropertyInfo instance AttrInfo SocketLocalAddressPropertyInfo where type AttrAllowedOps SocketLocalAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketLocalAddressPropertyInfo = AddressK type AttrBaseTypeConstraint SocketLocalAddressPropertyInfo = SocketK type AttrGetType SocketLocalAddressPropertyInfo = Address type AttrLabel SocketLocalAddressPropertyInfo = "Socket::local-address" attrGet _ = getSocketLocalAddress attrSet _ = undefined attrConstruct _ = constructSocketLocalAddress -- VVV Prop "non-blocking" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketNonBlocking :: (MonadIO m, SocketK o) => o -> m Bool getSocketNonBlocking obj = liftIO $ getObjectPropertyBool obj "non-blocking" setSocketNonBlocking :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketNonBlocking obj val = liftIO $ setObjectPropertyBool obj "non-blocking" val constructSocketNonBlocking :: Bool -> IO ([Char], GValue) constructSocketNonBlocking val = constructObjectPropertyBool "non-blocking" val data SocketNonBlockingPropertyInfo instance AttrInfo SocketNonBlockingPropertyInfo where type AttrAllowedOps SocketNonBlockingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketNonBlockingPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketNonBlockingPropertyInfo = SocketK type AttrGetType SocketNonBlockingPropertyInfo = Bool type AttrLabel SocketNonBlockingPropertyInfo = "Socket::non-blocking" attrGet _ = getSocketNonBlocking attrSet _ = setSocketNonBlocking attrConstruct _ = constructSocketNonBlocking -- VVV Prop "remote-address" -- Type: TInterface "Soup" "Address" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketRemoteAddress :: (MonadIO m, SocketK o) => o -> m Address getSocketRemoteAddress obj = liftIO $ getObjectPropertyObject obj "remote-address" Address constructSocketRemoteAddress :: (AddressK a) => a -> IO ([Char], GValue) constructSocketRemoteAddress val = constructObjectPropertyObject "remote-address" val data SocketRemoteAddressPropertyInfo instance AttrInfo SocketRemoteAddressPropertyInfo where type AttrAllowedOps SocketRemoteAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketRemoteAddressPropertyInfo = AddressK type AttrBaseTypeConstraint SocketRemoteAddressPropertyInfo = SocketK type AttrGetType SocketRemoteAddressPropertyInfo = Address type AttrLabel SocketRemoteAddressPropertyInfo = "Socket::remote-address" attrGet _ = getSocketRemoteAddress attrSet _ = undefined attrConstruct _ = constructSocketRemoteAddress -- VVV Prop "ssl-creds" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable] getSocketSslCreds :: (MonadIO m, SocketK o) => o -> m (Ptr ()) getSocketSslCreds obj = liftIO $ getObjectPropertyPtr obj "ssl-creds" setSocketSslCreds :: (MonadIO m, SocketK o) => o -> (Ptr ()) -> m () setSocketSslCreds obj val = liftIO $ setObjectPropertyPtr obj "ssl-creds" val constructSocketSslCreds :: (Ptr ()) -> IO ([Char], GValue) constructSocketSslCreds val = constructObjectPropertyPtr "ssl-creds" val data SocketSslCredsPropertyInfo instance AttrInfo SocketSslCredsPropertyInfo where type AttrAllowedOps SocketSslCredsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketSslCredsPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint SocketSslCredsPropertyInfo = SocketK type AttrGetType SocketSslCredsPropertyInfo = (Ptr ()) type AttrLabel SocketSslCredsPropertyInfo = "Socket::ssl-creds" attrGet _ = getSocketSslCreds attrSet _ = setSocketSslCreds attrConstruct _ = constructSocketSslCreds -- VVV Prop "ssl-fallback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketSslFallback :: (MonadIO m, SocketK o) => o -> m Bool getSocketSslFallback obj = liftIO $ getObjectPropertyBool obj "ssl-fallback" constructSocketSslFallback :: Bool -> IO ([Char], GValue) constructSocketSslFallback val = constructObjectPropertyBool "ssl-fallback" val data SocketSslFallbackPropertyInfo instance AttrInfo SocketSslFallbackPropertyInfo where type AttrAllowedOps SocketSslFallbackPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketSslFallbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketSslFallbackPropertyInfo = SocketK type AttrGetType SocketSslFallbackPropertyInfo = Bool type AttrLabel SocketSslFallbackPropertyInfo = "Socket::ssl-fallback" attrGet _ = getSocketSslFallback attrSet _ = undefined attrConstruct _ = constructSocketSslFallback -- VVV Prop "ssl-strict" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketSslStrict :: (MonadIO m, SocketK o) => o -> m Bool getSocketSslStrict obj = liftIO $ getObjectPropertyBool obj "ssl-strict" constructSocketSslStrict :: Bool -> IO ([Char], GValue) constructSocketSslStrict val = constructObjectPropertyBool "ssl-strict" val data SocketSslStrictPropertyInfo instance AttrInfo SocketSslStrictPropertyInfo where type AttrAllowedOps SocketSslStrictPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketSslStrictPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketSslStrictPropertyInfo = SocketK type AttrGetType SocketSslStrictPropertyInfo = Bool type AttrLabel SocketSslStrictPropertyInfo = "Socket::ssl-strict" attrGet _ = getSocketSslStrict attrSet _ = undefined attrConstruct _ = constructSocketSslStrict -- VVV Prop "timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSocketTimeout :: (MonadIO m, SocketK o) => o -> m Word32 getSocketTimeout obj = liftIO $ getObjectPropertyCUInt obj "timeout" setSocketTimeout :: (MonadIO m, SocketK o) => o -> Word32 -> m () setSocketTimeout obj val = liftIO $ setObjectPropertyCUInt obj "timeout" val constructSocketTimeout :: Word32 -> IO ([Char], GValue) constructSocketTimeout val = constructObjectPropertyCUInt "timeout" val data SocketTimeoutPropertyInfo instance AttrInfo SocketTimeoutPropertyInfo where type AttrAllowedOps SocketTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SocketTimeoutPropertyInfo = SocketK type AttrGetType SocketTimeoutPropertyInfo = Word32 type AttrLabel SocketTimeoutPropertyInfo = "Socket::timeout" attrGet _ = getSocketTimeout attrSet _ = setSocketTimeout attrConstruct _ = constructSocketTimeout -- VVV Prop "tls-certificate" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable] getSocketTlsCertificate :: (MonadIO m, SocketK o) => o -> m Gio.TlsCertificate getSocketTlsCertificate obj = liftIO $ getObjectPropertyObject obj "tls-certificate" Gio.TlsCertificate data SocketTlsCertificatePropertyInfo instance AttrInfo SocketTlsCertificatePropertyInfo where type AttrAllowedOps SocketTlsCertificatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketTlsCertificatePropertyInfo = (~) () type AttrBaseTypeConstraint SocketTlsCertificatePropertyInfo = SocketK type AttrGetType SocketTlsCertificatePropertyInfo = Gio.TlsCertificate type AttrLabel SocketTlsCertificatePropertyInfo = "Socket::tls-certificate" attrGet _ = getSocketTlsCertificate attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "tls-errors" -- Type: TInterface "Gio" "TlsCertificateFlags" -- Flags: [PropertyReadable] getSocketTlsErrors :: (MonadIO m, SocketK o) => o -> m [Gio.TlsCertificateFlags] getSocketTlsErrors obj = liftIO $ getObjectPropertyFlags obj "tls-errors" data SocketTlsErrorsPropertyInfo instance AttrInfo SocketTlsErrorsPropertyInfo where type AttrAllowedOps SocketTlsErrorsPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketTlsErrorsPropertyInfo = (~) () type AttrBaseTypeConstraint SocketTlsErrorsPropertyInfo = SocketK type AttrGetType SocketTlsErrorsPropertyInfo = [Gio.TlsCertificateFlags] type AttrLabel SocketTlsErrorsPropertyInfo = "Socket::tls-errors" attrGet _ = getSocketTlsErrors attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "trusted-certificate" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getSocketTrustedCertificate :: (MonadIO m, SocketK o) => o -> m Bool getSocketTrustedCertificate obj = liftIO $ getObjectPropertyBool obj "trusted-certificate" data SocketTrustedCertificatePropertyInfo instance AttrInfo SocketTrustedCertificatePropertyInfo where type AttrAllowedOps SocketTrustedCertificatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketTrustedCertificatePropertyInfo = (~) () type AttrBaseTypeConstraint SocketTrustedCertificatePropertyInfo = SocketK type AttrGetType SocketTrustedCertificatePropertyInfo = Bool type AttrLabel SocketTrustedCertificatePropertyInfo = "Socket::trusted-certificate" attrGet _ = getSocketTrustedCertificate attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "use-thread-context" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketUseThreadContext :: (MonadIO m, SocketK o) => o -> m Bool getSocketUseThreadContext obj = liftIO $ getObjectPropertyBool obj "use-thread-context" constructSocketUseThreadContext :: Bool -> IO ([Char], GValue) constructSocketUseThreadContext val = constructObjectPropertyBool "use-thread-context" val data SocketUseThreadContextPropertyInfo instance AttrInfo SocketUseThreadContextPropertyInfo where type AttrAllowedOps SocketUseThreadContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketUseThreadContextPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketUseThreadContextPropertyInfo = SocketK type AttrGetType SocketUseThreadContextPropertyInfo = Bool type AttrLabel SocketUseThreadContextPropertyInfo = "Socket::use-thread-context" attrGet _ = getSocketUseThreadContext attrSet _ = undefined attrConstruct _ = constructSocketUseThreadContext type instance AttributeList Socket = '[ '("async-context", SocketAsyncContextPropertyInfo), '("fd", SocketFdPropertyInfo), '("gsocket", SocketGsocketPropertyInfo), '("iostream", SocketIostreamPropertyInfo), '("ipv6-only", SocketIpv6OnlyPropertyInfo), '("is-server", SocketIsServerPropertyInfo), '("local-address", SocketLocalAddressPropertyInfo), '("non-blocking", SocketNonBlockingPropertyInfo), '("remote-address", SocketRemoteAddressPropertyInfo), '("ssl-creds", SocketSslCredsPropertyInfo), '("ssl-fallback", SocketSslFallbackPropertyInfo), '("ssl-strict", SocketSslStrictPropertyInfo), '("timeout", SocketTimeoutPropertyInfo), '("tls-certificate", SocketTlsCertificatePropertyInfo), '("tls-errors", SocketTlsErrorsPropertyInfo), '("trusted-certificate", SocketTrustedCertificatePropertyInfo), '("use-thread-context", SocketUseThreadContextPropertyInfo)] -- VVV Prop "connection-type" -- Type: TInterface "Soup" "WebsocketConnectionType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWebsocketConnectionConnectionType :: (MonadIO m, WebsocketConnectionK o) => o -> m WebsocketConnectionType getWebsocketConnectionConnectionType obj = liftIO $ getObjectPropertyEnum obj "connection-type" constructWebsocketConnectionConnectionType :: WebsocketConnectionType -> IO ([Char], GValue) constructWebsocketConnectionConnectionType val = constructObjectPropertyEnum "connection-type" val data WebsocketConnectionConnectionTypePropertyInfo instance AttrInfo WebsocketConnectionConnectionTypePropertyInfo where type AttrAllowedOps WebsocketConnectionConnectionTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = (~) WebsocketConnectionType type AttrBaseTypeConstraint WebsocketConnectionConnectionTypePropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionConnectionTypePropertyInfo = WebsocketConnectionType type AttrLabel WebsocketConnectionConnectionTypePropertyInfo = "WebsocketConnection::connection-type" attrGet _ = getWebsocketConnectionConnectionType attrSet _ = undefined attrConstruct _ = constructWebsocketConnectionConnectionType -- VVV Prop "io-stream" -- Type: TInterface "Gio" "IOStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWebsocketConnectionIoStream :: (MonadIO m, WebsocketConnectionK o) => o -> m Gio.IOStream getWebsocketConnectionIoStream obj = liftIO $ getObjectPropertyObject obj "io-stream" Gio.IOStream constructWebsocketConnectionIoStream :: (Gio.IOStreamK a) => a -> IO ([Char], GValue) constructWebsocketConnectionIoStream val = constructObjectPropertyObject "io-stream" val data WebsocketConnectionIoStreamPropertyInfo instance AttrInfo WebsocketConnectionIoStreamPropertyInfo where type AttrAllowedOps WebsocketConnectionIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionIoStreamPropertyInfo = Gio.IOStreamK type AttrBaseTypeConstraint WebsocketConnectionIoStreamPropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionIoStreamPropertyInfo = Gio.IOStream type AttrLabel WebsocketConnectionIoStreamPropertyInfo = "WebsocketConnection::io-stream" attrGet _ = getWebsocketConnectionIoStream attrSet _ = undefined attrConstruct _ = constructWebsocketConnectionIoStream -- VVV Prop "origin" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWebsocketConnectionOrigin :: (MonadIO m, WebsocketConnectionK o) => o -> m T.Text getWebsocketConnectionOrigin obj = liftIO $ getObjectPropertyString obj "origin" constructWebsocketConnectionOrigin :: T.Text -> IO ([Char], GValue) constructWebsocketConnectionOrigin val = constructObjectPropertyString "origin" val data WebsocketConnectionOriginPropertyInfo instance AttrInfo WebsocketConnectionOriginPropertyInfo where type AttrAllowedOps WebsocketConnectionOriginPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionOriginPropertyInfo = (~) T.Text type AttrBaseTypeConstraint WebsocketConnectionOriginPropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionOriginPropertyInfo = T.Text type AttrLabel WebsocketConnectionOriginPropertyInfo = "WebsocketConnection::origin" attrGet _ = getWebsocketConnectionOrigin attrSet _ = undefined attrConstruct _ = constructWebsocketConnectionOrigin -- VVV Prop "protocol" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWebsocketConnectionProtocol :: (MonadIO m, WebsocketConnectionK o) => o -> m T.Text getWebsocketConnectionProtocol obj = liftIO $ getObjectPropertyString obj "protocol" constructWebsocketConnectionProtocol :: T.Text -> IO ([Char], GValue) constructWebsocketConnectionProtocol val = constructObjectPropertyString "protocol" val data WebsocketConnectionProtocolPropertyInfo instance AttrInfo WebsocketConnectionProtocolPropertyInfo where type AttrAllowedOps WebsocketConnectionProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionProtocolPropertyInfo = (~) T.Text type AttrBaseTypeConstraint WebsocketConnectionProtocolPropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionProtocolPropertyInfo = T.Text type AttrLabel WebsocketConnectionProtocolPropertyInfo = "WebsocketConnection::protocol" attrGet _ = getWebsocketConnectionProtocol attrSet _ = undefined attrConstruct _ = constructWebsocketConnectionProtocol -- VVV Prop "state" -- Type: TInterface "Soup" "WebsocketState" -- Flags: [PropertyReadable] getWebsocketConnectionState :: (MonadIO m, WebsocketConnectionK o) => o -> m WebsocketState getWebsocketConnectionState obj = liftIO $ getObjectPropertyEnum obj "state" data WebsocketConnectionStatePropertyInfo instance AttrInfo WebsocketConnectionStatePropertyInfo where type AttrAllowedOps WebsocketConnectionStatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionStatePropertyInfo = (~) () type AttrBaseTypeConstraint WebsocketConnectionStatePropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionStatePropertyInfo = WebsocketState type AttrLabel WebsocketConnectionStatePropertyInfo = "WebsocketConnection::state" attrGet _ = getWebsocketConnectionState attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "uri" -- Type: TInterface "Soup" "URI" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getWebsocketConnectionUri :: (MonadIO m, WebsocketConnectionK o) => o -> m URI getWebsocketConnectionUri obj = liftIO $ getObjectPropertyBoxed obj "uri" URI constructWebsocketConnectionUri :: URI -> IO ([Char], GValue) constructWebsocketConnectionUri val = constructObjectPropertyBoxed "uri" val data WebsocketConnectionUriPropertyInfo instance AttrInfo WebsocketConnectionUriPropertyInfo where type AttrAllowedOps WebsocketConnectionUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint WebsocketConnectionUriPropertyInfo = (~) URI type AttrBaseTypeConstraint WebsocketConnectionUriPropertyInfo = WebsocketConnectionK type AttrGetType WebsocketConnectionUriPropertyInfo = URI type AttrLabel WebsocketConnectionUriPropertyInfo = "WebsocketConnection::uri" attrGet _ = getWebsocketConnectionUri attrSet _ = undefined attrConstruct _ = constructWebsocketConnectionUri type instance AttributeList WebsocketConnection = '[ '("connection-type", WebsocketConnectionConnectionTypePropertyInfo), '("io-stream", WebsocketConnectionIoStreamPropertyInfo), '("origin", WebsocketConnectionOriginPropertyInfo), '("protocol", WebsocketConnectionProtocolPropertyInfo), '("state", WebsocketConnectionStatePropertyInfo), '("uri", WebsocketConnectionUriPropertyInfo)]