-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.Soup.Callbacks
    ( 

 -- * Signals


-- ** AuthDomainBasicAuthCallback #signal:AuthDomainBasicAuthCallback#

    AuthDomainBasicAuthCallback             ,
    AuthDomainBasicAuthCallback_WithClosures,
    C_AuthDomainBasicAuthCallback           ,
    drop_closures_AuthDomainBasicAuthCallback,
    dynamic_AuthDomainBasicAuthCallback     ,
    genClosure_AuthDomainBasicAuthCallback  ,
    mk_AuthDomainBasicAuthCallback          ,
    noAuthDomainBasicAuthCallback           ,
    noAuthDomainBasicAuthCallback_WithClosures,
    wrap_AuthDomainBasicAuthCallback        ,


-- ** AuthDomainDigestAuthCallback #signal:AuthDomainDigestAuthCallback#

    AuthDomainDigestAuthCallback            ,
    AuthDomainDigestAuthCallback_WithClosures,
    C_AuthDomainDigestAuthCallback          ,
    drop_closures_AuthDomainDigestAuthCallback,
    dynamic_AuthDomainDigestAuthCallback    ,
    genClosure_AuthDomainDigestAuthCallback ,
    mk_AuthDomainDigestAuthCallback         ,
    noAuthDomainDigestAuthCallback          ,
    noAuthDomainDigestAuthCallback_WithClosures,
    wrap_AuthDomainDigestAuthCallback       ,


-- ** AuthDomainFilter #signal:AuthDomainFilter#

    AuthDomainFilter                        ,
    AuthDomainFilter_WithClosures           ,
    C_AuthDomainFilter                      ,
    drop_closures_AuthDomainFilter          ,
    dynamic_AuthDomainFilter                ,
    genClosure_AuthDomainFilter             ,
    mk_AuthDomainFilter                     ,
    noAuthDomainFilter                      ,
    noAuthDomainFilter_WithClosures         ,
    wrap_AuthDomainFilter                   ,


-- ** AuthDomainGenericAuthCallback #signal:AuthDomainGenericAuthCallback#

    AuthDomainGenericAuthCallback           ,
    AuthDomainGenericAuthCallback_WithClosures,
    C_AuthDomainGenericAuthCallback         ,
    drop_closures_AuthDomainGenericAuthCallback,
    dynamic_AuthDomainGenericAuthCallback   ,
    genClosure_AuthDomainGenericAuthCallback,
    mk_AuthDomainGenericAuthCallback        ,
    noAuthDomainGenericAuthCallback         ,
    noAuthDomainGenericAuthCallback_WithClosures,
    wrap_AuthDomainGenericAuthCallback      ,


-- ** LoggerFilter #signal:LoggerFilter#

    C_LoggerFilter                          ,
    LoggerFilter                            ,
    LoggerFilter_WithClosures               ,
    drop_closures_LoggerFilter              ,
    dynamic_LoggerFilter                    ,
    genClosure_LoggerFilter                 ,
    mk_LoggerFilter                         ,
    noLoggerFilter                          ,
    noLoggerFilter_WithClosures             ,
    wrap_LoggerFilter                       ,


-- ** LoggerPrinter #signal:LoggerPrinter#

    C_LoggerPrinter                         ,
    LoggerPrinter                           ,
    LoggerPrinter_WithClosures              ,
    drop_closures_LoggerPrinter             ,
    dynamic_LoggerPrinter                   ,
    genClosure_LoggerPrinter                ,
    mk_LoggerPrinter                        ,
    noLoggerPrinter                         ,
    noLoggerPrinter_WithClosures            ,
    wrap_LoggerPrinter                      ,


-- ** MessageHeadersForeachFunc #signal:MessageHeadersForeachFunc#

    C_MessageHeadersForeachFunc             ,
    MessageHeadersForeachFunc               ,
    MessageHeadersForeachFunc_WithClosures  ,
    drop_closures_MessageHeadersForeachFunc ,
    dynamic_MessageHeadersForeachFunc       ,
    genClosure_MessageHeadersForeachFunc    ,
    mk_MessageHeadersForeachFunc            ,
    noMessageHeadersForeachFunc             ,
    noMessageHeadersForeachFunc_WithClosures,
    wrap_MessageHeadersForeachFunc          ,


-- ** ServerCallback #signal:ServerCallback#

    C_ServerCallback                        ,
    ServerCallback                          ,
    ServerCallback_WithClosures             ,
    drop_closures_ServerCallback            ,
    dynamic_ServerCallback                  ,
    genClosure_ServerCallback               ,
    mk_ServerCallback                       ,
    noServerCallback                        ,
    noServerCallback_WithClosures           ,
    wrap_ServerCallback                     ,


-- ** ServerWebsocketCallback #signal:ServerWebsocketCallback#

    C_ServerWebsocketCallback               ,
    ServerWebsocketCallback                 ,
    ServerWebsocketCallback_WithClosures    ,
    drop_closures_ServerWebsocketCallback   ,
    dynamic_ServerWebsocketCallback         ,
    genClosure_ServerWebsocketCallback      ,
    mk_ServerWebsocketCallback              ,
    noServerWebsocketCallback               ,
    noServerWebsocketCallback_WithClosures  ,
    wrap_ServerWebsocketCallback            ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Soup.Enums as Soup.Enums
import {-# SOURCE #-} qualified GI.Soup.Objects.AuthDomain as Soup.AuthDomain
import {-# SOURCE #-} qualified GI.Soup.Objects.AuthDomainBasic as Soup.AuthDomainBasic
import {-# SOURCE #-} qualified GI.Soup.Objects.AuthDomainDigest as Soup.AuthDomainDigest
import {-# SOURCE #-} qualified GI.Soup.Objects.Logger as Soup.Logger
import {-# SOURCE #-} qualified GI.Soup.Objects.Message as Soup.Message
import {-# SOURCE #-} qualified GI.Soup.Objects.Server as Soup.Server
import {-# SOURCE #-} qualified GI.Soup.Objects.ServerMessage as Soup.ServerMessage
import {-# SOURCE #-} qualified GI.Soup.Objects.WebsocketConnection as Soup.WebsocketConnection

-- callback ServerWebsocketCallback
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "server"
          , argType =
              TInterface Name { namespace = "Soup" , name = "Server" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupServer" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupServerMessage"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "path"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the path component of @msg's Request-URI"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "connection"
          , argType =
              TInterface
                Name { namespace = "Soup" , name = "WebsocketConnection" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the newly created WebSocket connection"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "the data passed to @soup_server_add_handler"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 4
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "A callback used to handle WebSocket requests to a #SoupServer.\n\nThe callback will be invoked after sending the handshake response back to the\nclient (and is only invoked if the handshake was successful).\n\n@path contains the path of the Request-URI, subject to the same\nrules as [callback@ServerCallback] `(qv)`."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ServerWebsocketCallback =
    Ptr Soup.Server.Server ->
    Ptr Soup.ServerMessage.ServerMessage ->
    CString ->
    Ptr Soup.WebsocketConnection.WebsocketConnection ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupServerMessage"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path component of @msg's Request-URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "WebsocketConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the newly created WebSocket connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data passed to @soup_server_add_handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ServerWebsocketCallback :: FunPtr C_ServerWebsocketCallback -> C_ServerWebsocketCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ServerWebsocketCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.Server.IsServer a, Soup.ServerMessage.IsServerMessage b, Soup.WebsocketConnection.IsWebsocketConnection c) =>
    FunPtr C_ServerWebsocketCallback
    -> a
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> c
    -- ^ /@connection@/: the newly created WebSocket connection
    -> Ptr ()
    -- ^ /@userData@/: the data passed to /@soupServerAddHandler@/
    -> m ()
dynamic_ServerWebsocketCallback :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsServer a, IsServerMessage b,
 IsWebsocketConnection c) =>
FunPtr C_ServerWebsocketCallback
-> a -> b -> Text -> c -> Ptr () -> m ()
dynamic_ServerWebsocketCallback FunPtr C_ServerWebsocketCallback
__funPtr a
server b
msg Text
path c
connection Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr WebsocketConnection
connection' <- c -> IO (Ptr WebsocketConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
connection
    (FunPtr C_ServerWebsocketCallback -> C_ServerWebsocketCallback
__dynamic_C_ServerWebsocketCallback FunPtr C_ServerWebsocketCallback
__funPtr) Ptr Server
server' Ptr ServerMessage
msg' CString
path' Ptr WebsocketConnection
connection' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
connection
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | A callback used to handle WebSocket requests to a t'GI.Soup.Objects.Server.Server'.
-- 
-- The callback will be invoked after sending the handshake response back to the
-- client (and is only invoked if the handshake was successful).
-- 
-- /@path@/ contains the path of the Request-URI, subject to the same
-- rules as [callback/@serverCallback@/] @(qv)@.
type ServerWebsocketCallback =
    Soup.Server.Server
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> Soup.WebsocketConnection.WebsocketConnection
    -- ^ /@connection@/: the newly created WebSocket connection
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ServerWebsocketCallback`@.
noServerWebsocketCallback :: Maybe ServerWebsocketCallback
noServerWebsocketCallback :: Maybe ServerWebsocketCallback
noServerWebsocketCallback = Maybe ServerWebsocketCallback
forall a. Maybe a
Nothing

-- | A callback used to handle WebSocket requests to a t'GI.Soup.Objects.Server.Server'.
-- 
-- The callback will be invoked after sending the handshake response back to the
-- client (and is only invoked if the handshake was successful).
-- 
-- /@path@/ contains the path of the Request-URI, subject to the same
-- rules as [callback/@serverCallback@/] @(qv)@.
type ServerWebsocketCallback_WithClosures =
    Soup.Server.Server
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> Soup.WebsocketConnection.WebsocketConnection
    -- ^ /@connection@/: the newly created WebSocket connection
    -> Ptr ()
    -- ^ /@userData@/: the data passed to /@soupServerAddHandler@/
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ServerWebsocketCallback_WithClosures`@.
noServerWebsocketCallback_WithClosures :: Maybe ServerWebsocketCallback_WithClosures
noServerWebsocketCallback_WithClosures :: Maybe ServerWebsocketCallback_WithClosures
noServerWebsocketCallback_WithClosures = Maybe ServerWebsocketCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ServerWebsocketCallback :: ServerWebsocketCallback -> ServerWebsocketCallback_WithClosures
drop_closures_ServerWebsocketCallback :: ServerWebsocketCallback -> ServerWebsocketCallback_WithClosures
drop_closures_ServerWebsocketCallback ServerWebsocketCallback
_f Server
server ServerMessage
msg Text
path WebsocketConnection
connection Ptr ()
_ = ServerWebsocketCallback
_f Server
server ServerMessage
msg Text
path WebsocketConnection
connection

-- | Wrap the callback into a `GClosure`.
genClosure_ServerWebsocketCallback :: MonadIO m => ServerWebsocketCallback -> m (GClosure C_ServerWebsocketCallback)
genClosure_ServerWebsocketCallback :: forall (m :: * -> *).
MonadIO m =>
ServerWebsocketCallback -> m (GClosure C_ServerWebsocketCallback)
genClosure_ServerWebsocketCallback ServerWebsocketCallback
cb = IO (GClosure C_ServerWebsocketCallback)
-> m (GClosure C_ServerWebsocketCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ServerWebsocketCallback)
 -> m (GClosure C_ServerWebsocketCallback))
-> IO (GClosure C_ServerWebsocketCallback)
-> m (GClosure C_ServerWebsocketCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ServerWebsocketCallback_WithClosures
cb' = ServerWebsocketCallback -> ServerWebsocketCallback_WithClosures
drop_closures_ServerWebsocketCallback ServerWebsocketCallback
cb
    let cb'' :: C_ServerWebsocketCallback
cb'' = Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
-> ServerWebsocketCallback_WithClosures
-> C_ServerWebsocketCallback
wrap_ServerWebsocketCallback Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
forall a. Maybe a
Nothing ServerWebsocketCallback_WithClosures
cb'
    C_ServerWebsocketCallback -> IO (FunPtr C_ServerWebsocketCallback)
mk_ServerWebsocketCallback C_ServerWebsocketCallback
cb'' IO (FunPtr C_ServerWebsocketCallback)
-> (FunPtr C_ServerWebsocketCallback
    -> IO (GClosure C_ServerWebsocketCallback))
-> IO (GClosure C_ServerWebsocketCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ServerWebsocketCallback
-> IO (GClosure C_ServerWebsocketCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ServerWebsocketCallback` into a `C_ServerWebsocketCallback`.
wrap_ServerWebsocketCallback :: 
    Maybe (Ptr (FunPtr C_ServerWebsocketCallback)) ->
    ServerWebsocketCallback_WithClosures ->
    C_ServerWebsocketCallback
wrap_ServerWebsocketCallback :: Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
-> ServerWebsocketCallback_WithClosures
-> C_ServerWebsocketCallback
wrap_ServerWebsocketCallback Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
gi'funptrptr ServerWebsocketCallback_WithClosures
gi'cb Ptr Server
server Ptr ServerMessage
msg CString
path Ptr WebsocketConnection
connection Ptr ()
userData = do
    Server
server' <- ((ManagedPtr Server -> Server) -> Ptr Server -> IO Server
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Server -> Server
Soup.Server.Server) Ptr Server
server
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Text
path' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
path
    WebsocketConnection
connection' <- ((ManagedPtr WebsocketConnection -> WebsocketConnection)
-> Ptr WebsocketConnection -> IO WebsocketConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr WebsocketConnection -> WebsocketConnection
Soup.WebsocketConnection.WebsocketConnection) Ptr WebsocketConnection
connection
    ServerWebsocketCallback_WithClosures
gi'cb  Server
server' ServerMessage
msg' Text
path' WebsocketConnection
connection' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ServerWebsocketCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ServerWebsocketCallback))
gi'funptrptr


-- callback ServerCallback
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "server"
          , argType =
              TInterface Name { namespace = "Soup" , name = "Server" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupServer" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the message being processed"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "path"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the path component of @msg's Request-URI"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "query"
          , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the parsed query\n  component of @msg's Request-URI"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the data passed to [method@Server.add_handler] or\n  [method@Server.add_early_handler]."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 4
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "A callback used to handle requests to a [class@Server].\n\n@path and @query contain the likewise-named components of the\nRequest-URI, subject to certain assumptions. By default,\n[class@Server] decodes all percent-encoding in the URI path, such that\n`\"/foo%2Fbar\"` is treated the same as `\"/foo/bar\"`. If your\nserver is serving resources in some non-POSIX-filesystem namespace,\nyou may want to distinguish those as two distinct paths. In that\ncase, you can set the [property@Server:raw-paths] property when creating\nthe [class@Server], and it will leave those characters undecoded.\n\n@query contains the query component of the Request-URI parsed according to\nthe rules for HTML form handling. Although this is the only commonly-used\nquery string format in HTTP, there is nothing that actually requires that\nHTTP URIs use that format; if your server needs to use some other format, you\ncan just ignore @query, and call [method@Message.get_uri] and parse the URI's\nquery field yourself.\n\nSee [method@Server.add_handler] and [method@Server.add_early_handler]\nfor details of what handlers can/should do."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ServerCallback =
    Ptr Soup.Server.Server ->
    Ptr Soup.ServerMessage.ServerMessage ->
    CString ->
    Ptr (GHashTable CString CString) ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupServer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message being processed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path component of @msg's Request-URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "query"
--           , argType = TGHash (TBasicType TUTF8) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the parsed query\n  component of @msg's Request-URI"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the data passed to [method@Server.add_handler] or\n  [method@Server.add_early_handler]."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ServerCallback :: FunPtr C_ServerCallback -> C_ServerCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ServerCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.Server.IsServer a, Soup.ServerMessage.IsServerMessage b) =>
    FunPtr C_ServerCallback
    -> a
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> b
    -- ^ /@msg@/: the message being processed
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> Maybe (Map.Map T.Text T.Text)
    -- ^ /@query@/: the parsed query
    --   component of /@msg@/\'s Request-URI
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@server@/.add_handler] or
    --   [method/@server@/.add_early_handler].
    -> m ()
dynamic_ServerCallback :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsServerMessage b) =>
FunPtr C_ServerCallback
-> a -> b -> Text -> Maybe (Map Text Text) -> Ptr () -> m ()
dynamic_ServerCallback FunPtr C_ServerCallback
__funPtr a
server b
msg Text
path Maybe (Map Text Text)
query Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr (GHashTable CString CString)
maybeQuery <- case Maybe (Map Text Text)
query of
        Maybe (Map Text Text)
Nothing -> Ptr (GHashTable CString CString)
-> IO (Ptr (GHashTable CString CString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable CString CString)
forall a. Ptr a
nullPtr
        Just Map Text Text
jQuery -> do
            let jQuery' :: [(Text, Text)]
jQuery' = Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
jQuery
            [(CString, Text)]
jQuery'' <- (Text -> IO CString) -> [(Text, Text)] -> IO [(CString, Text)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA Text -> IO CString
textToCString [(Text, Text)]
jQuery'
            [(CString, CString)]
jQuery''' <- (Text -> IO CString)
-> [(CString, Text)] -> IO [(CString, CString)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA Text -> IO CString
textToCString [(CString, Text)]
jQuery''
            let jQuery'''' :: [(PtrWrapped CString, CString)]
jQuery'''' = (CString -> PtrWrapped CString)
-> [(CString, CString)] -> [(PtrWrapped CString, CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(CString, CString)]
jQuery'''
            let jQuery''''' :: [(PtrWrapped CString, PtrWrapped CString)]
jQuery''''' = (CString -> PtrWrapped CString)
-> [(PtrWrapped CString, CString)]
-> [(PtrWrapped CString, PtrWrapped CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond CString -> PtrWrapped CString
B.GHT.cstringPackPtr [(PtrWrapped CString, CString)]
jQuery''''
            Ptr (GHashTable CString CString)
jQuery'''''' <- GHashFunc CString
-> GEqualFunc CString
-> Maybe (GDestroyNotify CString)
-> Maybe (GDestroyNotify CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> IO (Ptr (GHashTable CString CString))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc CString
gStrHash GEqualFunc CString
gStrEqual (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) (GDestroyNotify CString -> Maybe (GDestroyNotify CString)
forall a. a -> Maybe a
Just GDestroyNotify CString
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free) [(PtrWrapped CString, PtrWrapped CString)]
jQuery'''''
            Ptr (GHashTable CString CString)
-> IO (Ptr (GHashTable CString CString))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GHashTable CString CString)
jQuery''''''
    (FunPtr C_ServerCallback -> C_ServerCallback
__dynamic_C_ServerCallback FunPtr C_ServerCallback
__funPtr) Ptr Server
server' Ptr ServerMessage
msg' CString
path' Ptr (GHashTable CString CString)
maybeQuery Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    Ptr (GHashTable CString CString) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable CString CString)
maybeQuery
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | A callback used to handle requests to a [class/@server@/].
-- 
-- /@path@/ and /@query@/ contain the likewise-named components of the
-- Request-URI, subject to certain assumptions. By default,
-- [class/@server@/] decodes all percent-encoding in the URI path, such that
-- @\"\/foo%2Fbar\"@ is treated the same as @\"\/foo\/bar\"@. If your
-- server is serving resources in some non-POSIX-filesystem namespace,
-- you may want to distinguish those as two distinct paths. In that
-- case, you can set the [property/@server@/:raw-paths] property when creating
-- the [class/@server@/], and it will leave those characters undecoded.
-- 
-- /@query@/ contains the query component of the Request-URI parsed according to
-- the rules for HTML form handling. Although this is the only commonly-used
-- query string format in HTTP, there is nothing that actually requires that
-- HTTP URIs use that format; if your server needs to use some other format, you
-- can just ignore /@query@/, and call [method/@message@/.get_uri] and parse the URI\'s
-- query field yourself.
-- 
-- See [method/@server@/.add_handler] and [method/@server@/.add_early_handler]
-- for details of what handlers can\/should do.
type ServerCallback =
    Soup.Server.Server
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being processed
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> Maybe (Map.Map T.Text T.Text)
    -- ^ /@query@/: the parsed query
    --   component of /@msg@/\'s Request-URI
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ServerCallback`@.
noServerCallback :: Maybe ServerCallback
noServerCallback :: Maybe ServerCallback
noServerCallback = Maybe ServerCallback
forall a. Maybe a
Nothing

-- | A callback used to handle requests to a [class/@server@/].
-- 
-- /@path@/ and /@query@/ contain the likewise-named components of the
-- Request-URI, subject to certain assumptions. By default,
-- [class/@server@/] decodes all percent-encoding in the URI path, such that
-- @\"\/foo%2Fbar\"@ is treated the same as @\"\/foo\/bar\"@. If your
-- server is serving resources in some non-POSIX-filesystem namespace,
-- you may want to distinguish those as two distinct paths. In that
-- case, you can set the [property/@server@/:raw-paths] property when creating
-- the [class/@server@/], and it will leave those characters undecoded.
-- 
-- /@query@/ contains the query component of the Request-URI parsed according to
-- the rules for HTML form handling. Although this is the only commonly-used
-- query string format in HTTP, there is nothing that actually requires that
-- HTTP URIs use that format; if your server needs to use some other format, you
-- can just ignore /@query@/, and call [method/@message@/.get_uri] and parse the URI\'s
-- query field yourself.
-- 
-- See [method/@server@/.add_handler] and [method/@server@/.add_early_handler]
-- for details of what handlers can\/should do.
type ServerCallback_WithClosures =
    Soup.Server.Server
    -- ^ /@server@/: the t'GI.Soup.Objects.Server.Server'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being processed
    -> T.Text
    -- ^ /@path@/: the path component of /@msg@/\'s Request-URI
    -> Maybe (Map.Map T.Text T.Text)
    -- ^ /@query@/: the parsed query
    --   component of /@msg@/\'s Request-URI
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@server@/.add_handler] or
    --   [method/@server@/.add_early_handler].
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ServerCallback_WithClosures`@.
noServerCallback_WithClosures :: Maybe ServerCallback_WithClosures
noServerCallback_WithClosures :: Maybe ServerCallback_WithClosures
noServerCallback_WithClosures = Maybe ServerCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ServerCallback :: ServerCallback -> ServerCallback_WithClosures
drop_closures_ServerCallback :: ServerCallback -> ServerCallback_WithClosures
drop_closures_ServerCallback ServerCallback
_f Server
server ServerMessage
msg Text
path Maybe (Map Text Text)
query Ptr ()
_ = ServerCallback
_f Server
server ServerMessage
msg Text
path Maybe (Map Text Text)
query

-- | Wrap the callback into a `GClosure`.
genClosure_ServerCallback :: MonadIO m => ServerCallback -> m (GClosure C_ServerCallback)
genClosure_ServerCallback :: forall (m :: * -> *).
MonadIO m =>
ServerCallback -> m (GClosure C_ServerCallback)
genClosure_ServerCallback ServerCallback
cb = IO (GClosure C_ServerCallback) -> m (GClosure C_ServerCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ServerCallback) -> m (GClosure C_ServerCallback))
-> IO (GClosure C_ServerCallback) -> m (GClosure C_ServerCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ServerCallback_WithClosures
cb' = ServerCallback -> ServerCallback_WithClosures
drop_closures_ServerCallback ServerCallback
cb
    let cb'' :: C_ServerCallback
cb'' = Maybe (Ptr (FunPtr C_ServerCallback))
-> ServerCallback_WithClosures -> C_ServerCallback
wrap_ServerCallback Maybe (Ptr (FunPtr C_ServerCallback))
forall a. Maybe a
Nothing ServerCallback_WithClosures
cb'
    C_ServerCallback -> IO (FunPtr C_ServerCallback)
mk_ServerCallback C_ServerCallback
cb'' IO (FunPtr C_ServerCallback)
-> (FunPtr C_ServerCallback -> IO (GClosure C_ServerCallback))
-> IO (GClosure C_ServerCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ServerCallback -> IO (GClosure C_ServerCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ServerCallback` into a `C_ServerCallback`.
wrap_ServerCallback :: 
    Maybe (Ptr (FunPtr C_ServerCallback)) ->
    ServerCallback_WithClosures ->
    C_ServerCallback
wrap_ServerCallback :: Maybe (Ptr (FunPtr C_ServerCallback))
-> ServerCallback_WithClosures -> C_ServerCallback
wrap_ServerCallback Maybe (Ptr (FunPtr C_ServerCallback))
gi'funptrptr ServerCallback_WithClosures
gi'cb Ptr Server
server Ptr ServerMessage
msg CString
path Ptr (GHashTable CString CString)
query Ptr ()
userData = do
    Server
server' <- ((ManagedPtr Server -> Server) -> Ptr Server -> IO Server
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Server -> Server
Soup.Server.Server) Ptr Server
server
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Text
path' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
path
    Maybe (Map Text Text)
maybeQuery <-
        if Ptr (GHashTable CString CString)
query Ptr (GHashTable CString CString)
-> Ptr (GHashTable CString CString) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (GHashTable CString CString)
forall a. Ptr a
nullPtr
        then Maybe (Map Text Text) -> IO (Maybe (Map Text Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map Text Text)
forall a. Maybe a
Nothing
        else do
            [(PtrWrapped CString, PtrWrapped CString)]
query' <- Ptr (GHashTable CString CString)
-> IO [(PtrWrapped CString, PtrWrapped CString)]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable CString CString)
query
            let query'' :: [(CString, PtrWrapped CString)]
query'' = (PtrWrapped CString -> CString)
-> [(PtrWrapped CString, PtrWrapped CString)]
-> [(CString, PtrWrapped CString)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(PtrWrapped CString, PtrWrapped CString)]
query'
            [(Text, PtrWrapped CString)]
query''' <- (CString -> IO Text)
-> [(CString, PtrWrapped CString)]
-> IO [(Text, PtrWrapped CString)]
forall (f :: * -> *) a c b.
Applicative f =>
(a -> f c) -> [(a, b)] -> f [(c, b)]
mapFirstA HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [(CString, PtrWrapped CString)]
query''
            let query'''' :: [(Text, CString)]
query'''' = (PtrWrapped CString -> CString)
-> [(Text, PtrWrapped CString)] -> [(Text, CString)]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped CString -> CString
B.GHT.cstringUnpackPtr [(Text, PtrWrapped CString)]
query'''
            [(Text, Text)]
query''''' <- (CString -> IO Text) -> [(Text, CString)] -> IO [(Text, Text)]
forall (f :: * -> *) b c a.
Applicative f =>
(b -> f c) -> [(a, b)] -> f [(a, c)]
mapSecondA HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [(Text, CString)]
query''''
            let query'''''' :: Map Text Text
query'''''' = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
query'''''
            Maybe (Map Text Text) -> IO (Maybe (Map Text Text))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map Text Text) -> IO (Maybe (Map Text Text)))
-> Maybe (Map Text Text) -> IO (Maybe (Map Text Text))
forall a b. (a -> b) -> a -> b
$ Map Text Text -> Maybe (Map Text Text)
forall a. a -> Maybe a
Just Map Text Text
query''''''
    ServerCallback_WithClosures
gi'cb  Server
server' ServerMessage
msg' Text
path' Maybe (Map Text Text)
maybeQuery Ptr ()
userData
    Maybe (Ptr (FunPtr C_ServerCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ServerCallback))
gi'funptrptr


-- callback MessageHeadersForeachFunc
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "name"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the header name" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "value"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the header value" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the data passed to [method@MessageHeaders.foreach]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just "The callback passed to [method@MessageHeaders.foreach]."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_MessageHeadersForeachFunc =
    CString ->
    CString ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the header name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the header value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the data passed to [method@MessageHeaders.foreach]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_MessageHeadersForeachFunc :: FunPtr C_MessageHeadersForeachFunc -> C_MessageHeadersForeachFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_MessageHeadersForeachFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_MessageHeadersForeachFunc
    -> T.Text
    -- ^ /@name@/: the header name
    -> T.Text
    -- ^ /@value@/: the header value
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@messageHeaders@/.foreach]
    -> m ()
dynamic_MessageHeadersForeachFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr C_MessageHeadersForeachFunc
-> Text -> Text -> Ptr () -> m ()
dynamic_MessageHeadersForeachFunc FunPtr C_MessageHeadersForeachFunc
__funPtr Text
name Text
value Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
value' <- Text -> IO CString
textToCString Text
value
    (FunPtr C_MessageHeadersForeachFunc -> C_MessageHeadersForeachFunc
__dynamic_C_MessageHeadersForeachFunc FunPtr C_MessageHeadersForeachFunc
__funPtr) CString
name' CString
value' Ptr ()
userData
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | The callback passed to [method/@messageHeaders@/.foreach].
type MessageHeadersForeachFunc =
    T.Text
    -- ^ /@name@/: the header name
    -> T.Text
    -- ^ /@value@/: the header value
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MessageHeadersForeachFunc`@.
noMessageHeadersForeachFunc :: Maybe MessageHeadersForeachFunc
noMessageHeadersForeachFunc :: Maybe MessageHeadersForeachFunc
noMessageHeadersForeachFunc = Maybe MessageHeadersForeachFunc
forall a. Maybe a
Nothing

-- | The callback passed to [method/@messageHeaders@/.foreach].
type MessageHeadersForeachFunc_WithClosures =
    T.Text
    -- ^ /@name@/: the header name
    -> T.Text
    -- ^ /@value@/: the header value
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@messageHeaders@/.foreach]
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `MessageHeadersForeachFunc_WithClosures`@.
noMessageHeadersForeachFunc_WithClosures :: Maybe MessageHeadersForeachFunc_WithClosures
noMessageHeadersForeachFunc_WithClosures :: Maybe MessageHeadersForeachFunc_WithClosures
noMessageHeadersForeachFunc_WithClosures = Maybe MessageHeadersForeachFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_MessageHeadersForeachFunc :: MessageHeadersForeachFunc -> MessageHeadersForeachFunc_WithClosures
drop_closures_MessageHeadersForeachFunc :: MessageHeadersForeachFunc -> MessageHeadersForeachFunc_WithClosures
drop_closures_MessageHeadersForeachFunc MessageHeadersForeachFunc
_f Text
name Text
value Ptr ()
_ = MessageHeadersForeachFunc
_f Text
name Text
value

-- | Wrap the callback into a `GClosure`.
genClosure_MessageHeadersForeachFunc :: MonadIO m => MessageHeadersForeachFunc -> m (GClosure C_MessageHeadersForeachFunc)
genClosure_MessageHeadersForeachFunc :: forall (m :: * -> *).
MonadIO m =>
MessageHeadersForeachFunc
-> m (GClosure C_MessageHeadersForeachFunc)
genClosure_MessageHeadersForeachFunc MessageHeadersForeachFunc
cb = IO (GClosure C_MessageHeadersForeachFunc)
-> m (GClosure C_MessageHeadersForeachFunc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_MessageHeadersForeachFunc)
 -> m (GClosure C_MessageHeadersForeachFunc))
-> IO (GClosure C_MessageHeadersForeachFunc)
-> m (GClosure C_MessageHeadersForeachFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: MessageHeadersForeachFunc_WithClosures
cb' = MessageHeadersForeachFunc -> MessageHeadersForeachFunc_WithClosures
drop_closures_MessageHeadersForeachFunc MessageHeadersForeachFunc
cb
    let cb'' :: C_MessageHeadersForeachFunc
cb'' = Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc))
-> MessageHeadersForeachFunc_WithClosures
-> C_MessageHeadersForeachFunc
wrap_MessageHeadersForeachFunc Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc))
forall a. Maybe a
Nothing MessageHeadersForeachFunc_WithClosures
cb'
    C_MessageHeadersForeachFunc
-> IO (FunPtr C_MessageHeadersForeachFunc)
mk_MessageHeadersForeachFunc C_MessageHeadersForeachFunc
cb'' IO (FunPtr C_MessageHeadersForeachFunc)
-> (FunPtr C_MessageHeadersForeachFunc
    -> IO (GClosure C_MessageHeadersForeachFunc))
-> IO (GClosure C_MessageHeadersForeachFunc)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_MessageHeadersForeachFunc
-> IO (GClosure C_MessageHeadersForeachFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `MessageHeadersForeachFunc` into a `C_MessageHeadersForeachFunc`.
wrap_MessageHeadersForeachFunc :: 
    Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc)) ->
    MessageHeadersForeachFunc_WithClosures ->
    C_MessageHeadersForeachFunc
wrap_MessageHeadersForeachFunc :: Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc))
-> MessageHeadersForeachFunc_WithClosures
-> C_MessageHeadersForeachFunc
wrap_MessageHeadersForeachFunc Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc))
gi'funptrptr MessageHeadersForeachFunc_WithClosures
gi'cb CString
name CString
value Ptr ()
userData = do
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Text
value' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
value
    MessageHeadersForeachFunc_WithClosures
gi'cb  Text
name' Text
value' Ptr ()
userData
    Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_MessageHeadersForeachFunc))
gi'funptrptr


-- callback LoggerPrinter
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , args =
      [ Arg
          { argCName = "logger"
          , argType =
              TInterface Name { namespace = "Soup" , name = "Logger" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupLogger" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "level"
          , argType =
              TInterface Name { namespace = "Soup" , name = "LoggerLogLevel" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the level of the information being printed."
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "direction"
          , argType = TBasicType TInt8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a single-character prefix to @data"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "data"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "data to print" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the data passed to [method@Logger.set_printer]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 4
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The prototype for a custom printing callback.\n\n@level indicates what kind of information is being printed. Eg, it\nwill be %SOUP_LOGGER_LOG_HEADERS if @data is header data.\n\n@direction is either '<', '>', or ' ', and @data is the single line\nto print; the printer is expected to add a terminating newline.\n\nTo get the effect of the default printer, you would do:\n\n```c\nprintf (\"%c %s\\n\", direction, data);\n```"
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_LoggerPrinter =
    Ptr Soup.Logger.Logger ->
    CUInt ->
    Int8 ->
    CString ->
    Ptr () ->
    IO ()

-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "LoggerLogLevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the level of the information being printed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "direction"
--           , argType = TBasicType TInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a single-character prefix to @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to print" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the data passed to [method@Logger.set_printer]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_LoggerPrinter :: FunPtr C_LoggerPrinter -> C_LoggerPrinter

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_LoggerPrinter ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.Logger.IsLogger a) =>
    FunPtr C_LoggerPrinter
    -> a
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Enums.LoggerLogLevel
    -- ^ /@level@/: the level of the information being printed.
    -> Int8
    -- ^ /@direction@/: a single-character prefix to /@data@/
    -> T.Text
    -- ^ /@data@/: data to print
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@logger@/.set_printer]
    -> m ()
dynamic_LoggerPrinter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLogger a) =>
FunPtr C_LoggerPrinter
-> a -> LoggerLogLevel -> Int8 -> Text -> Ptr () -> m ()
dynamic_LoggerPrinter FunPtr C_LoggerPrinter
__funPtr a
logger LoggerLogLevel
level Int8
direction Text
data_ Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    let level' :: CUInt
level' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (LoggerLogLevel -> Int) -> LoggerLogLevel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerLogLevel -> Int
forall a. Enum a => a -> Int
fromEnum) LoggerLogLevel
level
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    (FunPtr C_LoggerPrinter -> C_LoggerPrinter
__dynamic_C_LoggerPrinter FunPtr C_LoggerPrinter
__funPtr) Ptr Logger
logger' CUInt
level' Int8
direction CString
data_' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | The prototype for a custom printing callback.
-- 
-- /@level@/ indicates what kind of information is being printed. Eg, it
-- will be 'GI.Soup.Enums.LoggerLogLevelHeaders' if /@data@/ is header data.
-- 
-- /@direction@/ is either \'\<\', \'>\', or \' \', and /@data@/ is the single line
-- to print; the printer is expected to add a terminating newline.
-- 
-- To get the effect of the default printer, you would do:
-- 
-- 
-- === /c code/
-- >printf ("%c %s\n", direction, data);
type LoggerPrinter =
    Soup.Logger.Logger
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Enums.LoggerLogLevel
    -- ^ /@level@/: the level of the information being printed.
    -> Int8
    -- ^ /@direction@/: a single-character prefix to /@data@/
    -> T.Text
    -- ^ /@data@/: data to print
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `LoggerPrinter`@.
noLoggerPrinter :: Maybe LoggerPrinter
noLoggerPrinter :: Maybe LoggerPrinter
noLoggerPrinter = Maybe LoggerPrinter
forall a. Maybe a
Nothing

-- | The prototype for a custom printing callback.
-- 
-- /@level@/ indicates what kind of information is being printed. Eg, it
-- will be 'GI.Soup.Enums.LoggerLogLevelHeaders' if /@data@/ is header data.
-- 
-- /@direction@/ is either \'\<\', \'>\', or \' \', and /@data@/ is the single line
-- to print; the printer is expected to add a terminating newline.
-- 
-- To get the effect of the default printer, you would do:
-- 
-- 
-- === /c code/
-- >printf ("%c %s\n", direction, data);
type LoggerPrinter_WithClosures =
    Soup.Logger.Logger
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Enums.LoggerLogLevel
    -- ^ /@level@/: the level of the information being printed.
    -> Int8
    -- ^ /@direction@/: a single-character prefix to /@data@/
    -> T.Text
    -- ^ /@data@/: data to print
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@logger@/.set_printer]
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `LoggerPrinter_WithClosures`@.
noLoggerPrinter_WithClosures :: Maybe LoggerPrinter_WithClosures
noLoggerPrinter_WithClosures :: Maybe LoggerPrinter_WithClosures
noLoggerPrinter_WithClosures = Maybe LoggerPrinter_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_LoggerPrinter :: LoggerPrinter -> LoggerPrinter_WithClosures
drop_closures_LoggerPrinter :: LoggerPrinter -> LoggerPrinter_WithClosures
drop_closures_LoggerPrinter LoggerPrinter
_f Logger
logger LoggerLogLevel
level Int8
direction Text
data_ Ptr ()
_ = LoggerPrinter
_f Logger
logger LoggerLogLevel
level Int8
direction Text
data_

-- | Wrap the callback into a `GClosure`.
genClosure_LoggerPrinter :: MonadIO m => LoggerPrinter -> m (GClosure C_LoggerPrinter)
genClosure_LoggerPrinter :: forall (m :: * -> *).
MonadIO m =>
LoggerPrinter -> m (GClosure C_LoggerPrinter)
genClosure_LoggerPrinter LoggerPrinter
cb = IO (GClosure C_LoggerPrinter) -> m (GClosure C_LoggerPrinter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_LoggerPrinter) -> m (GClosure C_LoggerPrinter))
-> IO (GClosure C_LoggerPrinter) -> m (GClosure C_LoggerPrinter)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: LoggerPrinter_WithClosures
cb' = LoggerPrinter -> LoggerPrinter_WithClosures
drop_closures_LoggerPrinter LoggerPrinter
cb
    let cb'' :: C_LoggerPrinter
cb'' = Maybe (Ptr (FunPtr C_LoggerPrinter))
-> LoggerPrinter_WithClosures -> C_LoggerPrinter
wrap_LoggerPrinter Maybe (Ptr (FunPtr C_LoggerPrinter))
forall a. Maybe a
Nothing LoggerPrinter_WithClosures
cb'
    C_LoggerPrinter -> IO (FunPtr C_LoggerPrinter)
mk_LoggerPrinter C_LoggerPrinter
cb'' IO (FunPtr C_LoggerPrinter)
-> (FunPtr C_LoggerPrinter -> IO (GClosure C_LoggerPrinter))
-> IO (GClosure C_LoggerPrinter)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_LoggerPrinter -> IO (GClosure C_LoggerPrinter)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `LoggerPrinter` into a `C_LoggerPrinter`.
wrap_LoggerPrinter :: 
    Maybe (Ptr (FunPtr C_LoggerPrinter)) ->
    LoggerPrinter_WithClosures ->
    C_LoggerPrinter
wrap_LoggerPrinter :: Maybe (Ptr (FunPtr C_LoggerPrinter))
-> LoggerPrinter_WithClosures -> C_LoggerPrinter
wrap_LoggerPrinter Maybe (Ptr (FunPtr C_LoggerPrinter))
gi'funptrptr LoggerPrinter_WithClosures
gi'cb Ptr Logger
logger CUInt
level Int8
direction CString
data_ Ptr ()
userData = do
    Logger
logger' <- ((ManagedPtr Logger -> Logger) -> Ptr Logger -> IO Logger
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Logger -> Logger
Soup.Logger.Logger) Ptr Logger
logger
    let level' :: LoggerLogLevel
level' = (Int -> LoggerLogLevel
forall a. Enum a => Int -> a
toEnum (Int -> LoggerLogLevel)
-> (CUInt -> Int) -> CUInt -> LoggerLogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
level
    Text
data_' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
data_
    LoggerPrinter_WithClosures
gi'cb  Logger
logger' LoggerLogLevel
level' Int8
direction Text
data_' Ptr ()
userData
    Maybe (Ptr (FunPtr C_LoggerPrinter)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_LoggerPrinter))
gi'funptrptr


-- callback LoggerFilter
{- Callable
  { returnType =
      Just
        (TInterface Name { namespace = "Soup" , name = "LoggerLogLevel" })
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "a [enum@LoggerLogLevel] value indicating how much of the message to\n  log"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "logger"
          , argType =
              TInterface Name { namespace = "Soup" , name = "Logger" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupLogger" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "Message" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the message being logged"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the data passed to [method@Logger.set_request_filter]\n  or [method@Logger.set_response_filter]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The prototype for a logging filter.\n\nThe filter callback will be invoked for each request or response, and should\nanalyze it and return a [enum@LoggerLogLevel] value indicating how much of\nthe message to log."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_LoggerFilter =
    Ptr Soup.Logger.Logger ->
    Ptr Soup.Message.Message ->
    Ptr () ->
    IO CUInt

-- Args: [ Arg
--           { argCName = "logger"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Logger" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupLogger" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message being logged"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the data passed to [method@Logger.set_request_filter]\n  or [method@Logger.set_response_filter]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Soup" , name = "LoggerLogLevel" })
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_LoggerFilter :: FunPtr C_LoggerFilter -> C_LoggerFilter

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_LoggerFilter ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.Logger.IsLogger a, Soup.Message.IsMessage b) =>
    FunPtr C_LoggerFilter
    -> a
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> b
    -- ^ /@msg@/: the message being logged
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@logger@/.set_request_filter]
    --   or [method/@logger@/.set_response_filter]
    -> m Soup.Enums.LoggerLogLevel
    -- ^ __Returns:__ a [enum/@loggerLogLevel@/] value indicating how much of the message to
    --   log
dynamic_LoggerFilter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLogger a, IsMessage b) =>
FunPtr C_LoggerFilter -> a -> b -> Ptr () -> m LoggerLogLevel
dynamic_LoggerFilter FunPtr C_LoggerFilter
__funPtr a
logger b
msg Ptr ()
userData = IO LoggerLogLevel -> m LoggerLogLevel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LoggerLogLevel -> m LoggerLogLevel)
-> IO LoggerLogLevel -> m LoggerLogLevel
forall a b. (a -> b) -> a -> b
$ do
    Ptr Logger
logger' <- a -> IO (Ptr Logger)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
logger
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CUInt
result <- (FunPtr C_LoggerFilter -> C_LoggerFilter
__dynamic_C_LoggerFilter FunPtr C_LoggerFilter
__funPtr) Ptr Logger
logger' Ptr Message
msg' Ptr ()
userData
    let result' :: LoggerLogLevel
result' = (Int -> LoggerLogLevel
forall a. Enum a => Int -> a
toEnum (Int -> LoggerLogLevel)
-> (CUInt -> Int) -> CUInt -> LoggerLogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
logger
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    LoggerLogLevel -> IO LoggerLogLevel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LoggerLogLevel
result'

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

-- | The prototype for a logging filter.
-- 
-- The filter callback will be invoked for each request or response, and should
-- analyze it and return a [enum/@loggerLogLevel@/] value indicating how much of
-- the message to log.
type LoggerFilter =
    Soup.Logger.Logger
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Message.Message
    -- ^ /@msg@/: the message being logged
    -> IO Soup.Enums.LoggerLogLevel
    -- ^ __Returns:__ a [enum/@loggerLogLevel@/] value indicating how much of the message to
    --   log

-- | A convenience synonym for @`Nothing` :: `Maybe` `LoggerFilter`@.
noLoggerFilter :: Maybe LoggerFilter
noLoggerFilter :: Maybe LoggerFilter
noLoggerFilter = Maybe LoggerFilter
forall a. Maybe a
Nothing

-- | The prototype for a logging filter.
-- 
-- The filter callback will be invoked for each request or response, and should
-- analyze it and return a [enum/@loggerLogLevel@/] value indicating how much of
-- the message to log.
type LoggerFilter_WithClosures =
    Soup.Logger.Logger
    -- ^ /@logger@/: the t'GI.Soup.Objects.Logger.Logger'
    -> Soup.Message.Message
    -- ^ /@msg@/: the message being logged
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@logger@/.set_request_filter]
    --   or [method/@logger@/.set_response_filter]
    -> IO Soup.Enums.LoggerLogLevel
    -- ^ __Returns:__ a [enum/@loggerLogLevel@/] value indicating how much of the message to
    --   log

-- | A convenience synonym for @`Nothing` :: `Maybe` `LoggerFilter_WithClosures`@.
noLoggerFilter_WithClosures :: Maybe LoggerFilter_WithClosures
noLoggerFilter_WithClosures :: Maybe LoggerFilter_WithClosures
noLoggerFilter_WithClosures = Maybe LoggerFilter_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_LoggerFilter :: LoggerFilter -> LoggerFilter_WithClosures
drop_closures_LoggerFilter :: LoggerFilter -> LoggerFilter_WithClosures
drop_closures_LoggerFilter LoggerFilter
_f Logger
logger Message
msg Ptr ()
_ = LoggerFilter
_f Logger
logger Message
msg

-- | Wrap the callback into a `GClosure`.
genClosure_LoggerFilter :: MonadIO m => LoggerFilter -> m (GClosure C_LoggerFilter)
genClosure_LoggerFilter :: forall (m :: * -> *).
MonadIO m =>
LoggerFilter -> m (GClosure C_LoggerFilter)
genClosure_LoggerFilter LoggerFilter
cb = IO (GClosure C_LoggerFilter) -> m (GClosure C_LoggerFilter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_LoggerFilter) -> m (GClosure C_LoggerFilter))
-> IO (GClosure C_LoggerFilter) -> m (GClosure C_LoggerFilter)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: LoggerFilter_WithClosures
cb' = LoggerFilter -> LoggerFilter_WithClosures
drop_closures_LoggerFilter LoggerFilter
cb
    let cb'' :: C_LoggerFilter
cb'' = Maybe (Ptr (FunPtr C_LoggerFilter))
-> LoggerFilter_WithClosures -> C_LoggerFilter
wrap_LoggerFilter Maybe (Ptr (FunPtr C_LoggerFilter))
forall a. Maybe a
Nothing LoggerFilter_WithClosures
cb'
    C_LoggerFilter -> IO (FunPtr C_LoggerFilter)
mk_LoggerFilter C_LoggerFilter
cb'' IO (FunPtr C_LoggerFilter)
-> (FunPtr C_LoggerFilter -> IO (GClosure C_LoggerFilter))
-> IO (GClosure C_LoggerFilter)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_LoggerFilter -> IO (GClosure C_LoggerFilter)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `LoggerFilter` into a `C_LoggerFilter`.
wrap_LoggerFilter :: 
    Maybe (Ptr (FunPtr C_LoggerFilter)) ->
    LoggerFilter_WithClosures ->
    C_LoggerFilter
wrap_LoggerFilter :: Maybe (Ptr (FunPtr C_LoggerFilter))
-> LoggerFilter_WithClosures -> C_LoggerFilter
wrap_LoggerFilter Maybe (Ptr (FunPtr C_LoggerFilter))
gi'funptrptr LoggerFilter_WithClosures
gi'cb Ptr Logger
logger Ptr Message
msg Ptr ()
userData = do
    Logger
logger' <- ((ManagedPtr Logger -> Logger) -> Ptr Logger -> IO Logger
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Logger -> Logger
Soup.Logger.Logger) Ptr Logger
logger
    Message
msg' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
msg
    LoggerLogLevel
result <- LoggerFilter_WithClosures
gi'cb  Logger
logger' Message
msg' Ptr ()
userData
    Maybe (Ptr (FunPtr C_LoggerFilter)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_LoggerFilter))
gi'funptrptr
    let result' :: CUInt
result' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (LoggerLogLevel -> Int) -> LoggerLogLevel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerLogLevel -> Int
forall a. Enum a => a -> Int
fromEnum) LoggerLogLevel
result
    CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
result'


-- callback AuthDomainGenericAuthCallback
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE if @msg is authenticated, %FALSE if not."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "domain"
          , argType =
              TInterface Name { namespace = "Soup" , name = "AuthDomain" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the #SoupServerMessage being authenticated"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "username"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the username from @msg"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the data passed to [method@AuthDomain.set_generic_auth_callback]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The prototype for a #SoupAuthDomain generic authentication callback.\n\nThe callback should look up the user's password, call\n[method@AuthDomain.check_password], and use the return value from that method\nas its own return value.\n\nIn general, for security reasons, it is preferable to use the\nauth-domain-specific auth callbacks (eg,\n[callback@AuthDomainBasicAuthCallback] and\n[callback@AuthDomainDigestAuthCallback]), because they don't require\nkeeping a cleartext password database. Most users will use the same\npassword for many different sites, meaning if any site with a\ncleartext password database is compromised, accounts on other\nservers might be compromised as well. For many of the cases where\n[class@Server] is used, this is not really relevant, but it may still\nbe worth considering."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AuthDomainGenericAuthCallback =
    Ptr Soup.AuthDomain.AuthDomain ->
    Ptr Soup.ServerMessage.ServerMessage ->
    CString ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomain" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupServerMessage being authenticated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the username from @msg"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the data passed to [method@AuthDomain.set_generic_auth_callback]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AuthDomainGenericAuthCallback :: FunPtr C_AuthDomainGenericAuthCallback -> C_AuthDomainGenericAuthCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AuthDomainGenericAuthCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.AuthDomain.IsAuthDomain a, Soup.ServerMessage.IsServerMessage b) =>
    FunPtr C_AuthDomainGenericAuthCallback
    -> a
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> b
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage' being authenticated
    -> T.Text
    -- ^ /@username@/: the username from /@msg@/
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomain@/.set_generic_auth_callback]
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ is authenticated, 'P.False' if not.
dynamic_AuthDomainGenericAuthCallback :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomain a, IsServerMessage b) =>
FunPtr C_AuthDomainGenericAuthCallback
-> a -> b -> Text -> Ptr () -> m Bool
dynamic_AuthDomainGenericAuthCallback FunPtr C_AuthDomainGenericAuthCallback
__funPtr a
domain b
msg Text
username Ptr ()
userData = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthDomain
domain' <- a -> IO (Ptr AuthDomain)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
username' <- Text -> IO CString
textToCString Text
username
    CInt
result <- (FunPtr C_AuthDomainGenericAuthCallback
-> C_AuthDomainGenericAuthCallback
__dynamic_C_AuthDomainGenericAuthCallback FunPtr C_AuthDomainGenericAuthCallback
__funPtr) Ptr AuthDomain
domain' Ptr ServerMessage
msg' CString
username' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
domain
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | The prototype for a t'GI.Soup.Objects.AuthDomain.AuthDomain' generic authentication callback.
-- 
-- The callback should look up the user\'s password, call
-- [method/@authDomain@/.check_password], and use the return value from that method
-- as its own return value.
-- 
-- In general, for security reasons, it is preferable to use the
-- auth-domain-specific auth callbacks (eg,
-- [callback/@authDomainBasicAuthCallback@/] and
-- [callback/@authDomainDigestAuthCallback@/]), because they don\'t require
-- keeping a cleartext password database. Most users will use the same
-- password for many different sites, meaning if any site with a
-- cleartext password database is compromised, accounts on other
-- servers might be compromised as well. For many of the cases where
-- [class/@server@/] is used, this is not really relevant, but it may still
-- be worth considering.
type AuthDomainGenericAuthCallback =
    Soup.AuthDomain.AuthDomain
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage' being authenticated
    -> T.Text
    -- ^ /@username@/: the username from /@msg@/
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ is authenticated, 'P.False' if not.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainGenericAuthCallback`@.
noAuthDomainGenericAuthCallback :: Maybe AuthDomainGenericAuthCallback
noAuthDomainGenericAuthCallback :: Maybe AuthDomainGenericAuthCallback
noAuthDomainGenericAuthCallback = Maybe AuthDomainGenericAuthCallback
forall a. Maybe a
Nothing

-- | The prototype for a t'GI.Soup.Objects.AuthDomain.AuthDomain' generic authentication callback.
-- 
-- The callback should look up the user\'s password, call
-- [method/@authDomain@/.check_password], and use the return value from that method
-- as its own return value.
-- 
-- In general, for security reasons, it is preferable to use the
-- auth-domain-specific auth callbacks (eg,
-- [callback/@authDomainBasicAuthCallback@/] and
-- [callback/@authDomainDigestAuthCallback@/]), because they don\'t require
-- keeping a cleartext password database. Most users will use the same
-- password for many different sites, meaning if any site with a
-- cleartext password database is compromised, accounts on other
-- servers might be compromised as well. For many of the cases where
-- [class/@server@/] is used, this is not really relevant, but it may still
-- be worth considering.
type AuthDomainGenericAuthCallback_WithClosures =
    Soup.AuthDomain.AuthDomain
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the t'GI.Soup.Objects.ServerMessage.ServerMessage' being authenticated
    -> T.Text
    -- ^ /@username@/: the username from /@msg@/
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomain@/.set_generic_auth_callback]
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ is authenticated, 'P.False' if not.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainGenericAuthCallback_WithClosures`@.
noAuthDomainGenericAuthCallback_WithClosures :: Maybe AuthDomainGenericAuthCallback_WithClosures
noAuthDomainGenericAuthCallback_WithClosures :: Maybe AuthDomainGenericAuthCallback_WithClosures
noAuthDomainGenericAuthCallback_WithClosures = Maybe AuthDomainGenericAuthCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AuthDomainGenericAuthCallback :: AuthDomainGenericAuthCallback -> AuthDomainGenericAuthCallback_WithClosures
drop_closures_AuthDomainGenericAuthCallback :: AuthDomainGenericAuthCallback
-> AuthDomainGenericAuthCallback_WithClosures
drop_closures_AuthDomainGenericAuthCallback AuthDomainGenericAuthCallback
_f AuthDomain
domain ServerMessage
msg Text
username Ptr ()
_ = AuthDomainGenericAuthCallback
_f AuthDomain
domain ServerMessage
msg Text
username

-- | Wrap the callback into a `GClosure`.
genClosure_AuthDomainGenericAuthCallback :: MonadIO m => AuthDomainGenericAuthCallback -> m (GClosure C_AuthDomainGenericAuthCallback)
genClosure_AuthDomainGenericAuthCallback :: forall (m :: * -> *).
MonadIO m =>
AuthDomainGenericAuthCallback
-> m (GClosure C_AuthDomainGenericAuthCallback)
genClosure_AuthDomainGenericAuthCallback AuthDomainGenericAuthCallback
cb = IO (GClosure C_AuthDomainGenericAuthCallback)
-> m (GClosure C_AuthDomainGenericAuthCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthDomainGenericAuthCallback)
 -> m (GClosure C_AuthDomainGenericAuthCallback))
-> IO (GClosure C_AuthDomainGenericAuthCallback)
-> m (GClosure C_AuthDomainGenericAuthCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AuthDomainGenericAuthCallback_WithClosures
cb' = AuthDomainGenericAuthCallback
-> AuthDomainGenericAuthCallback_WithClosures
drop_closures_AuthDomainGenericAuthCallback AuthDomainGenericAuthCallback
cb
    let cb'' :: C_AuthDomainGenericAuthCallback
cb'' = Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback))
-> AuthDomainGenericAuthCallback_WithClosures
-> C_AuthDomainGenericAuthCallback
wrap_AuthDomainGenericAuthCallback Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback))
forall a. Maybe a
Nothing AuthDomainGenericAuthCallback_WithClosures
cb'
    C_AuthDomainGenericAuthCallback
-> IO (FunPtr C_AuthDomainGenericAuthCallback)
mk_AuthDomainGenericAuthCallback C_AuthDomainGenericAuthCallback
cb'' IO (FunPtr C_AuthDomainGenericAuthCallback)
-> (FunPtr C_AuthDomainGenericAuthCallback
    -> IO (GClosure C_AuthDomainGenericAuthCallback))
-> IO (GClosure C_AuthDomainGenericAuthCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthDomainGenericAuthCallback
-> IO (GClosure C_AuthDomainGenericAuthCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthDomainGenericAuthCallback` into a `C_AuthDomainGenericAuthCallback`.
wrap_AuthDomainGenericAuthCallback :: 
    Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback)) ->
    AuthDomainGenericAuthCallback_WithClosures ->
    C_AuthDomainGenericAuthCallback
wrap_AuthDomainGenericAuthCallback :: Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback))
-> AuthDomainGenericAuthCallback_WithClosures
-> C_AuthDomainGenericAuthCallback
wrap_AuthDomainGenericAuthCallback Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback))
gi'funptrptr AuthDomainGenericAuthCallback_WithClosures
gi'cb Ptr AuthDomain
domain Ptr ServerMessage
msg CString
username Ptr ()
userData = do
    AuthDomain
domain' <- ((ManagedPtr AuthDomain -> AuthDomain)
-> Ptr AuthDomain -> IO AuthDomain
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AuthDomain -> AuthDomain
Soup.AuthDomain.AuthDomain) Ptr AuthDomain
domain
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Text
username' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
username
    Bool
result <- AuthDomainGenericAuthCallback_WithClosures
gi'cb  AuthDomain
domain' ServerMessage
msg' Text
username' Ptr ()
userData
    Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AuthDomainGenericAuthCallback))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback AuthDomainFilter
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE if @msg requires authentication, %FALSE if not."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "domain"
          , argType =
              TInterface Name { namespace = "Soup" , name = "AuthDomain" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #SoupServerMessage"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just "the data passed to [method@AuthDomain.set_filter]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The prototype for a #SoupAuthDomain filter.\n\nSee [method@AuthDomain.set_filter] for details."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AuthDomainFilter =
    Ptr Soup.AuthDomain.AuthDomain ->
    Ptr Soup.ServerMessage.ServerMessage ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomain" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuthDomain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupServerMessage"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the data passed to [method@AuthDomain.set_filter]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AuthDomainFilter :: FunPtr C_AuthDomainFilter -> C_AuthDomainFilter

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AuthDomainFilter ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.AuthDomain.IsAuthDomain a, Soup.ServerMessage.IsServerMessage b) =>
    FunPtr C_AuthDomainFilter
    -> a
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomain@/.set_filter]
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ requires authentication, 'P.False' if not.
dynamic_AuthDomainFilter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomain a, IsServerMessage b) =>
FunPtr C_AuthDomainFilter -> a -> b -> Ptr () -> m Bool
dynamic_AuthDomainFilter FunPtr C_AuthDomainFilter
__funPtr a
domain b
msg Ptr ()
userData = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthDomain
domain' <- a -> IO (Ptr AuthDomain)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CInt
result <- (FunPtr C_AuthDomainFilter -> C_AuthDomainFilter
__dynamic_C_AuthDomainFilter FunPtr C_AuthDomainFilter
__funPtr) Ptr AuthDomain
domain' Ptr ServerMessage
msg' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
domain
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | The prototype for a t'GI.Soup.Objects.AuthDomain.AuthDomain' filter.
-- 
-- See [method/@authDomain@/.set_filter] for details.
type AuthDomainFilter =
    Soup.AuthDomain.AuthDomain
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: a t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ requires authentication, 'P.False' if not.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainFilter`@.
noAuthDomainFilter :: Maybe AuthDomainFilter
noAuthDomainFilter :: Maybe AuthDomainFilter
noAuthDomainFilter = Maybe AuthDomainFilter
forall a. Maybe a
Nothing

-- | The prototype for a t'GI.Soup.Objects.AuthDomain.AuthDomain' filter.
-- 
-- See [method/@authDomain@/.set_filter] for details.
type AuthDomainFilter_WithClosures =
    Soup.AuthDomain.AuthDomain
    -- ^ /@domain@/: a t'GI.Soup.Objects.AuthDomain.AuthDomain'
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: a t'GI.Soup.Objects.ServerMessage.ServerMessage'
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomain@/.set_filter]
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@msg@/ requires authentication, 'P.False' if not.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainFilter_WithClosures`@.
noAuthDomainFilter_WithClosures :: Maybe AuthDomainFilter_WithClosures
noAuthDomainFilter_WithClosures :: Maybe AuthDomainFilter_WithClosures
noAuthDomainFilter_WithClosures = Maybe AuthDomainFilter_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AuthDomainFilter :: AuthDomainFilter -> AuthDomainFilter_WithClosures
drop_closures_AuthDomainFilter :: AuthDomainFilter -> AuthDomainFilter_WithClosures
drop_closures_AuthDomainFilter AuthDomainFilter
_f AuthDomain
domain ServerMessage
msg Ptr ()
_ = AuthDomainFilter
_f AuthDomain
domain ServerMessage
msg

-- | Wrap the callback into a `GClosure`.
genClosure_AuthDomainFilter :: MonadIO m => AuthDomainFilter -> m (GClosure C_AuthDomainFilter)
genClosure_AuthDomainFilter :: forall (m :: * -> *).
MonadIO m =>
AuthDomainFilter -> m (GClosure C_AuthDomainFilter)
genClosure_AuthDomainFilter AuthDomainFilter
cb = IO (GClosure C_AuthDomainFilter) -> m (GClosure C_AuthDomainFilter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthDomainFilter)
 -> m (GClosure C_AuthDomainFilter))
-> IO (GClosure C_AuthDomainFilter)
-> m (GClosure C_AuthDomainFilter)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AuthDomainFilter_WithClosures
cb' = AuthDomainFilter -> AuthDomainFilter_WithClosures
drop_closures_AuthDomainFilter AuthDomainFilter
cb
    let cb'' :: C_AuthDomainFilter
cb'' = Maybe (Ptr (FunPtr C_AuthDomainFilter))
-> AuthDomainFilter_WithClosures -> C_AuthDomainFilter
wrap_AuthDomainFilter Maybe (Ptr (FunPtr C_AuthDomainFilter))
forall a. Maybe a
Nothing AuthDomainFilter_WithClosures
cb'
    C_AuthDomainFilter -> IO (FunPtr C_AuthDomainFilter)
mk_AuthDomainFilter C_AuthDomainFilter
cb'' IO (FunPtr C_AuthDomainFilter)
-> (FunPtr C_AuthDomainFilter -> IO (GClosure C_AuthDomainFilter))
-> IO (GClosure C_AuthDomainFilter)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthDomainFilter -> IO (GClosure C_AuthDomainFilter)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthDomainFilter` into a `C_AuthDomainFilter`.
wrap_AuthDomainFilter :: 
    Maybe (Ptr (FunPtr C_AuthDomainFilter)) ->
    AuthDomainFilter_WithClosures ->
    C_AuthDomainFilter
wrap_AuthDomainFilter :: Maybe (Ptr (FunPtr C_AuthDomainFilter))
-> AuthDomainFilter_WithClosures -> C_AuthDomainFilter
wrap_AuthDomainFilter Maybe (Ptr (FunPtr C_AuthDomainFilter))
gi'funptrptr AuthDomainFilter_WithClosures
gi'cb Ptr AuthDomain
domain Ptr ServerMessage
msg Ptr ()
userData = do
    AuthDomain
domain' <- ((ManagedPtr AuthDomain -> AuthDomain)
-> Ptr AuthDomain -> IO AuthDomain
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AuthDomain -> AuthDomain
Soup.AuthDomain.AuthDomain) Ptr AuthDomain
domain
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Bool
result <- AuthDomainFilter_WithClosures
gi'cb  AuthDomain
domain' ServerMessage
msg' Ptr ()
userData
    Maybe (Ptr (FunPtr C_AuthDomainFilter)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AuthDomainFilter))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback AuthDomainDigestAuthCallback
{- Callable
  { returnType = Just (TBasicType TUTF8)
  , returnMayBeNull = True
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "the encoded password, or %NULL if\n  @username is not a valid user. @domain will free the password when\n  it is done with it."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "domain"
          , argType =
              TInterface Name { namespace = "Soup" , name = "AuthDomainDigest" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the domain" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the message being authenticated"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "username"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the username provided by the client"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the data passed to [method@AuthDomainDigest.set_auth_callback]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Callback used by #SoupAuthDomainDigest for authentication purposes.\n\nThe application should look up @username in its password database,\nand return the corresponding encoded password (see\n[func@AuthDomainDigest.encode_password]."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AuthDomainDigestAuthCallback =
    Ptr Soup.AuthDomainDigest.AuthDomainDigest ->
    Ptr Soup.ServerMessage.ServerMessage ->
    CString ->
    Ptr () ->
    IO CString

-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomainDigest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the domain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message being authenticated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the username provided by the client"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the data passed to [method@AuthDomainDigest.set_auth_callback]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AuthDomainDigestAuthCallback :: FunPtr C_AuthDomainDigestAuthCallback -> C_AuthDomainDigestAuthCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AuthDomainDigestAuthCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.AuthDomainDigest.IsAuthDomainDigest a, Soup.ServerMessage.IsServerMessage b) =>
    FunPtr C_AuthDomainDigestAuthCallback
    -> a
    -- ^ /@domain@/: the domain
    -> b
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomainDigest@/.set_auth_callback]
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the encoded password, or 'P.Nothing' if
    --   /@username@/ is not a valid user. /@domain@/ will free the password when
    --   it is done with it.
dynamic_AuthDomainDigestAuthCallback :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomainDigest a,
 IsServerMessage b) =>
FunPtr C_AuthDomainDigestAuthCallback
-> a -> b -> Text -> Ptr () -> m (Maybe Text)
dynamic_AuthDomainDigestAuthCallback FunPtr C_AuthDomainDigestAuthCallback
__funPtr a
domain b
msg Text
username Ptr ()
userData = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthDomainDigest
domain' <- a -> IO (Ptr AuthDomainDigest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
result <- (FunPtr C_AuthDomainDigestAuthCallback
-> C_AuthDomainDigestAuthCallback
__dynamic_C_AuthDomainDigestAuthCallback FunPtr C_AuthDomainDigestAuthCallback
__funPtr) Ptr AuthDomainDigest
domain' Ptr ServerMessage
msg' CString
username' Ptr ()
userData
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
domain
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

-- | Callback used by t'GI.Soup.Objects.AuthDomainDigest.AuthDomainDigest' for authentication purposes.
-- 
-- The application should look up /@username@/ in its password database,
-- and return the corresponding encoded password (see
-- @/AuthDomainDigest.encode_password/@.
type AuthDomainDigestAuthCallback =
    Soup.AuthDomainDigest.AuthDomainDigest
    -- ^ /@domain@/: the domain
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> IO (Maybe T.Text)
    -- ^ __Returns:__ the encoded password, or 'P.Nothing' if
    --   /@username@/ is not a valid user. /@domain@/ will free the password when
    --   it is done with it.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainDigestAuthCallback`@.
noAuthDomainDigestAuthCallback :: Maybe AuthDomainDigestAuthCallback
noAuthDomainDigestAuthCallback :: Maybe AuthDomainDigestAuthCallback
noAuthDomainDigestAuthCallback = Maybe AuthDomainDigestAuthCallback
forall a. Maybe a
Nothing

-- | Callback used by t'GI.Soup.Objects.AuthDomainDigest.AuthDomainDigest' for authentication purposes.
-- 
-- The application should look up /@username@/ in its password database,
-- and return the corresponding encoded password (see
-- @/AuthDomainDigest.encode_password/@.
type AuthDomainDigestAuthCallback_WithClosures =
    Soup.AuthDomainDigest.AuthDomainDigest
    -- ^ /@domain@/: the domain
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomainDigest@/.set_auth_callback]
    -> IO (Maybe T.Text)
    -- ^ __Returns:__ the encoded password, or 'P.Nothing' if
    --   /@username@/ is not a valid user. /@domain@/ will free the password when
    --   it is done with it.

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainDigestAuthCallback_WithClosures`@.
noAuthDomainDigestAuthCallback_WithClosures :: Maybe AuthDomainDigestAuthCallback_WithClosures
noAuthDomainDigestAuthCallback_WithClosures :: Maybe AuthDomainDigestAuthCallback_WithClosures
noAuthDomainDigestAuthCallback_WithClosures = Maybe AuthDomainDigestAuthCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AuthDomainDigestAuthCallback :: AuthDomainDigestAuthCallback -> AuthDomainDigestAuthCallback_WithClosures
drop_closures_AuthDomainDigestAuthCallback :: AuthDomainDigestAuthCallback
-> AuthDomainDigestAuthCallback_WithClosures
drop_closures_AuthDomainDigestAuthCallback AuthDomainDigestAuthCallback
_f AuthDomainDigest
domain ServerMessage
msg Text
username Ptr ()
_ = AuthDomainDigestAuthCallback
_f AuthDomainDigest
domain ServerMessage
msg Text
username

-- | Wrap the callback into a `GClosure`.
genClosure_AuthDomainDigestAuthCallback :: MonadIO m => AuthDomainDigestAuthCallback -> m (GClosure C_AuthDomainDigestAuthCallback)
genClosure_AuthDomainDigestAuthCallback :: forall (m :: * -> *).
MonadIO m =>
AuthDomainDigestAuthCallback
-> m (GClosure C_AuthDomainDigestAuthCallback)
genClosure_AuthDomainDigestAuthCallback AuthDomainDigestAuthCallback
cb = IO (GClosure C_AuthDomainDigestAuthCallback)
-> m (GClosure C_AuthDomainDigestAuthCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthDomainDigestAuthCallback)
 -> m (GClosure C_AuthDomainDigestAuthCallback))
-> IO (GClosure C_AuthDomainDigestAuthCallback)
-> m (GClosure C_AuthDomainDigestAuthCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AuthDomainDigestAuthCallback_WithClosures
cb' = AuthDomainDigestAuthCallback
-> AuthDomainDigestAuthCallback_WithClosures
drop_closures_AuthDomainDigestAuthCallback AuthDomainDigestAuthCallback
cb
    let cb'' :: C_AuthDomainDigestAuthCallback
cb'' = Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
-> AuthDomainDigestAuthCallback_WithClosures
-> C_AuthDomainDigestAuthCallback
wrap_AuthDomainDigestAuthCallback Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
forall a. Maybe a
Nothing AuthDomainDigestAuthCallback_WithClosures
cb'
    C_AuthDomainDigestAuthCallback
-> IO (FunPtr C_AuthDomainDigestAuthCallback)
mk_AuthDomainDigestAuthCallback C_AuthDomainDigestAuthCallback
cb'' IO (FunPtr C_AuthDomainDigestAuthCallback)
-> (FunPtr C_AuthDomainDigestAuthCallback
    -> IO (GClosure C_AuthDomainDigestAuthCallback))
-> IO (GClosure C_AuthDomainDigestAuthCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthDomainDigestAuthCallback
-> IO (GClosure C_AuthDomainDigestAuthCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthDomainDigestAuthCallback` into a `C_AuthDomainDigestAuthCallback`.
wrap_AuthDomainDigestAuthCallback :: 
    Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback)) ->
    AuthDomainDigestAuthCallback_WithClosures ->
    C_AuthDomainDigestAuthCallback
wrap_AuthDomainDigestAuthCallback :: Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
-> AuthDomainDigestAuthCallback_WithClosures
-> C_AuthDomainDigestAuthCallback
wrap_AuthDomainDigestAuthCallback Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
gi'funptrptr AuthDomainDigestAuthCallback_WithClosures
gi'cb Ptr AuthDomainDigest
domain Ptr ServerMessage
msg CString
username Ptr ()
userData = do
    AuthDomainDigest
domain' <- ((ManagedPtr AuthDomainDigest -> AuthDomainDigest)
-> Ptr AuthDomainDigest -> IO AuthDomainDigest
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AuthDomainDigest -> AuthDomainDigest
Soup.AuthDomainDigest.AuthDomainDigest) Ptr AuthDomainDigest
domain
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Text
username' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
username
    Maybe Text
result <- AuthDomainDigestAuthCallback_WithClosures
gi'cb  AuthDomainDigest
domain' ServerMessage
msg' Text
username' Ptr ()
userData
    Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
gi'funptrptr
    CString -> Maybe Text -> (Text -> IO CString) -> IO CString
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM CString
forall a. Ptr a
FP.nullPtr Maybe Text
result ((Text -> IO CString) -> IO CString)
-> (Text -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Text
result' -> do
        CString
result'' <- Text -> IO CString
textToCString Text
result'
        CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
result''


-- callback AuthDomainBasicAuthCallback
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText = Just "%TRUE if @username and @password are valid"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "domain"
          , argType =
              TInterface Name { namespace = "Soup" , name = "AuthDomainBasic" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the domain" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "msg"
          , argType =
              TInterface Name { namespace = "Soup" , name = "ServerMessage" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the message being authenticated"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "username"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the username provided by the client"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "password"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the password provided by the client"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText =
                    Just
                      "the data passed to [method@AuthDomainBasic.set_auth_callback]"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = 4
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Callback used by #SoupAuthDomainBasic for authentication purposes.\n\nThe application should verify that @username and @password and valid\nand return %TRUE or %FALSE.\n\nIf you are maintaining your own password database (rather than\nusing the password to authenticate against some other system like\nPAM or a remote server), you should make sure you know what you are\ndoing. In particular, don't store cleartext passwords, or\neasily-computed hashes of cleartext passwords, even if you don't\ncare that much about the security of your server, because users\nwill frequently use the same password for multiple sites, and so\ncompromising any site with a cleartext (or easily-cracked) password\ndatabase may give attackers access to other more-interesting sites\nas well."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_AuthDomainBasicAuthCallback =
    Ptr Soup.AuthDomainBasic.AuthDomainBasic ->
    Ptr Soup.ServerMessage.ServerMessage ->
    CString ->
    CString ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomainBasic" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the domain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "ServerMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message being authenticated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the username provided by the client"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the password provided by the client"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the data passed to [method@AuthDomainBasic.set_auth_callback]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_AuthDomainBasicAuthCallback :: FunPtr C_AuthDomainBasicAuthCallback -> C_AuthDomainBasicAuthCallback

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_AuthDomainBasicAuthCallback ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.AuthDomainBasic.IsAuthDomainBasic a, Soup.ServerMessage.IsServerMessage b) =>
    FunPtr C_AuthDomainBasicAuthCallback
    -> a
    -- ^ /@domain@/: the domain
    -> b
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> T.Text
    -- ^ /@password@/: the password provided by the client
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomainBasic@/.set_auth_callback]
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@username@/ and /@password@/ are valid
dynamic_AuthDomainBasicAuthCallback :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomainBasic a,
 IsServerMessage b) =>
FunPtr C_AuthDomainBasicAuthCallback
-> a -> b -> Text -> Text -> Ptr () -> m Bool
dynamic_AuthDomainBasicAuthCallback FunPtr C_AuthDomainBasicAuthCallback
__funPtr a
domain b
msg Text
username Text
password Ptr ()
userData = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthDomainBasic
domain' <- a -> IO (Ptr AuthDomainBasic)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    Ptr ServerMessage
msg' <- b -> IO (Ptr ServerMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
password' <- Text -> IO CString
textToCString Text
password
    CInt
result <- (FunPtr C_AuthDomainBasicAuthCallback
-> C_AuthDomainBasicAuthCallback
__dynamic_C_AuthDomainBasicAuthCallback FunPtr C_AuthDomainBasicAuthCallback
__funPtr) Ptr AuthDomainBasic
domain' Ptr ServerMessage
msg' CString
username' CString
password' Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
domain
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

-- | Callback used by t'GI.Soup.Objects.AuthDomainBasic.AuthDomainBasic' for authentication purposes.
-- 
-- The application should verify that /@username@/ and /@password@/ and valid
-- and return 'P.True' or 'P.False'.
-- 
-- If you are maintaining your own password database (rather than
-- using the password to authenticate against some other system like
-- PAM or a remote server), you should make sure you know what you are
-- doing. In particular, don\'t store cleartext passwords, or
-- easily-computed hashes of cleartext passwords, even if you don\'t
-- care that much about the security of your server, because users
-- will frequently use the same password for multiple sites, and so
-- compromising any site with a cleartext (or easily-cracked) password
-- database may give attackers access to other more-interesting sites
-- as well.
type AuthDomainBasicAuthCallback =
    Soup.AuthDomainBasic.AuthDomainBasic
    -- ^ /@domain@/: the domain
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> T.Text
    -- ^ /@password@/: the password provided by the client
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@username@/ and /@password@/ are valid

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainBasicAuthCallback`@.
noAuthDomainBasicAuthCallback :: Maybe AuthDomainBasicAuthCallback
noAuthDomainBasicAuthCallback :: Maybe AuthDomainBasicAuthCallback
noAuthDomainBasicAuthCallback = Maybe AuthDomainBasicAuthCallback
forall a. Maybe a
Nothing

-- | Callback used by t'GI.Soup.Objects.AuthDomainBasic.AuthDomainBasic' for authentication purposes.
-- 
-- The application should verify that /@username@/ and /@password@/ and valid
-- and return 'P.True' or 'P.False'.
-- 
-- If you are maintaining your own password database (rather than
-- using the password to authenticate against some other system like
-- PAM or a remote server), you should make sure you know what you are
-- doing. In particular, don\'t store cleartext passwords, or
-- easily-computed hashes of cleartext passwords, even if you don\'t
-- care that much about the security of your server, because users
-- will frequently use the same password for multiple sites, and so
-- compromising any site with a cleartext (or easily-cracked) password
-- database may give attackers access to other more-interesting sites
-- as well.
type AuthDomainBasicAuthCallback_WithClosures =
    Soup.AuthDomainBasic.AuthDomainBasic
    -- ^ /@domain@/: the domain
    -> Soup.ServerMessage.ServerMessage
    -- ^ /@msg@/: the message being authenticated
    -> T.Text
    -- ^ /@username@/: the username provided by the client
    -> T.Text
    -- ^ /@password@/: the password provided by the client
    -> Ptr ()
    -- ^ /@userData@/: the data passed to [method/@authDomainBasic@/.set_auth_callback]
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@username@/ and /@password@/ are valid

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthDomainBasicAuthCallback_WithClosures`@.
noAuthDomainBasicAuthCallback_WithClosures :: Maybe AuthDomainBasicAuthCallback_WithClosures
noAuthDomainBasicAuthCallback_WithClosures :: Maybe AuthDomainBasicAuthCallback_WithClosures
noAuthDomainBasicAuthCallback_WithClosures = Maybe AuthDomainBasicAuthCallback_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_AuthDomainBasicAuthCallback :: AuthDomainBasicAuthCallback -> AuthDomainBasicAuthCallback_WithClosures
drop_closures_AuthDomainBasicAuthCallback :: AuthDomainBasicAuthCallback
-> AuthDomainBasicAuthCallback_WithClosures
drop_closures_AuthDomainBasicAuthCallback AuthDomainBasicAuthCallback
_f AuthDomainBasic
domain ServerMessage
msg Text
username Text
password Ptr ()
_ = AuthDomainBasicAuthCallback
_f AuthDomainBasic
domain ServerMessage
msg Text
username Text
password

-- | Wrap the callback into a `GClosure`.
genClosure_AuthDomainBasicAuthCallback :: MonadIO m => AuthDomainBasicAuthCallback -> m (GClosure C_AuthDomainBasicAuthCallback)
genClosure_AuthDomainBasicAuthCallback :: forall (m :: * -> *).
MonadIO m =>
AuthDomainBasicAuthCallback
-> m (GClosure C_AuthDomainBasicAuthCallback)
genClosure_AuthDomainBasicAuthCallback AuthDomainBasicAuthCallback
cb = IO (GClosure C_AuthDomainBasicAuthCallback)
-> m (GClosure C_AuthDomainBasicAuthCallback)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthDomainBasicAuthCallback)
 -> m (GClosure C_AuthDomainBasicAuthCallback))
-> IO (GClosure C_AuthDomainBasicAuthCallback)
-> m (GClosure C_AuthDomainBasicAuthCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: AuthDomainBasicAuthCallback_WithClosures
cb' = AuthDomainBasicAuthCallback
-> AuthDomainBasicAuthCallback_WithClosures
drop_closures_AuthDomainBasicAuthCallback AuthDomainBasicAuthCallback
cb
    let cb'' :: C_AuthDomainBasicAuthCallback
cb'' = Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
-> AuthDomainBasicAuthCallback_WithClosures
-> C_AuthDomainBasicAuthCallback
wrap_AuthDomainBasicAuthCallback Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
forall a. Maybe a
Nothing AuthDomainBasicAuthCallback_WithClosures
cb'
    C_AuthDomainBasicAuthCallback
-> IO (FunPtr C_AuthDomainBasicAuthCallback)
mk_AuthDomainBasicAuthCallback C_AuthDomainBasicAuthCallback
cb'' IO (FunPtr C_AuthDomainBasicAuthCallback)
-> (FunPtr C_AuthDomainBasicAuthCallback
    -> IO (GClosure C_AuthDomainBasicAuthCallback))
-> IO (GClosure C_AuthDomainBasicAuthCallback)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthDomainBasicAuthCallback
-> IO (GClosure C_AuthDomainBasicAuthCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthDomainBasicAuthCallback` into a `C_AuthDomainBasicAuthCallback`.
wrap_AuthDomainBasicAuthCallback :: 
    Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback)) ->
    AuthDomainBasicAuthCallback_WithClosures ->
    C_AuthDomainBasicAuthCallback
wrap_AuthDomainBasicAuthCallback :: Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
-> AuthDomainBasicAuthCallback_WithClosures
-> C_AuthDomainBasicAuthCallback
wrap_AuthDomainBasicAuthCallback Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
gi'funptrptr AuthDomainBasicAuthCallback_WithClosures
gi'cb Ptr AuthDomainBasic
domain Ptr ServerMessage
msg CString
username CString
password Ptr ()
userData = do
    AuthDomainBasic
domain' <- ((ManagedPtr AuthDomainBasic -> AuthDomainBasic)
-> Ptr AuthDomainBasic -> IO AuthDomainBasic
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AuthDomainBasic -> AuthDomainBasic
Soup.AuthDomainBasic.AuthDomainBasic) Ptr AuthDomainBasic
domain
    ServerMessage
msg' <- ((ManagedPtr ServerMessage -> ServerMessage)
-> Ptr ServerMessage -> IO ServerMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ServerMessage -> ServerMessage
Soup.ServerMessage.ServerMessage) Ptr ServerMessage
msg
    Text
username' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
username
    Text
password' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
password
    Bool
result <- AuthDomainBasicAuthCallback_WithClosures
gi'cb  AuthDomainBasic
domain' ServerMessage
msg' Text
username' Text
password' Ptr ()
userData
    Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
gi'funptrptr
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'