Schema.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc)

Represents a set of attributes that are stored with an item. These schemas
are used for interoperability between various services storing the same types
of items.

Each schema has a name like \"org.gnome.keyring.NetworkPassword\", and defines
a set of attributes, and types (string, integer, boolean) for those attributes.

Attributes are stored as strings in the Secret Service, and the attribute
types simply define standard ways to store integer and boolean values as strings.
Attributes are represented in libsecret via a 'GI.GLib.Structs.HashTable.HashTable' with string keys and
values. Even for values that defined as an integer or boolean in the schema,
the attribute values in the 'GI.GLib.Structs.HashTable.HashTable' are strings. Boolean values are stored
as the strings \'true\' and \'false\'. Integer values are stored in decimal, with
a preceding negative sign for negative integers.

Schemas are handled entirely on the client side by this library. The name of the
schema is automatically stored as an attribute on the item.

Normally when looking up passwords only those with matching schema names are
returned. If the schema /@flags@/ contain the 'GI.Secret.Flags.SchemaFlagsDontMatchName' flag,
then lookups will not check that the schema name matches that on the item, only
the schema\'s attributes are matched. This is useful when you are looking up items
that are not stored by the libsecret library. Other libraries such as libgnome-keyring
don\'t store the schema name.
-}

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

module GI.Secret.Structs.Schema
    ( 

-- * Exported types
    Schema(..)                              ,
    newZeroSchema                           ,
    noSchema                                ,


 -- * Methods
-- ** ref #method:ref#

#if ENABLE_OVERLOADING
    SchemaRefMethodInfo                     ,
#endif
    schemaRef                               ,


-- ** unref #method:unref#

#if ENABLE_OVERLOADING
    SchemaUnrefMethodInfo                   ,
#endif
    schemaUnref                             ,




 -- * Properties
-- ** flags #attr:flags#
{- | flags for the schema
-}
    getSchemaFlags                          ,
#if ENABLE_OVERLOADING
    schema_flags                            ,
#endif
    setSchemaFlags                          ,


-- ** name #attr:name#
{- | the dotted name of the schema
-}
    clearSchemaName                         ,
    getSchemaName                           ,
#if ENABLE_OVERLOADING
    schema_name                             ,
#endif
    setSchemaName                           ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags

-- | Memory-managed wrapper type.
newtype Schema = Schema (ManagedPtr Schema)
foreign import ccall "secret_schema_get_type" c_secret_schema_get_type :: 
    IO GType

instance BoxedObject Schema where
    boxedType _ = c_secret_schema_get_type

-- | Construct a `Schema` struct initialized to zero.
newZeroSchema :: MonadIO m => m Schema
newZeroSchema = liftIO $ callocBoxedBytes 592 >>= wrapBoxed Schema

instance tag ~ 'AttrSet => Constructible Schema tag where
    new _ attrs = do
        o <- newZeroSchema
        GI.Attributes.set o attrs
        return o


-- | A convenience alias for `Nothing` :: `Maybe` `Schema`.
noSchema :: Maybe Schema
noSchema = Nothing

{- |
Get the value of the “@name@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' schema #name
@
-}
getSchemaName :: MonadIO m => Schema -> m (Maybe T.Text)
getSchemaName s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

{- |
Set the value of the “@name@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' schema [ #name 'Data.GI.Base.Attributes.:=' value ]
@
-}
setSchemaName :: MonadIO m => Schema -> CString -> m ()
setSchemaName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

{- |
Set the value of the “@name@” field to `Nothing`.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.clear' #name
@
-}
clearSchemaName :: MonadIO m => Schema -> m ()
clearSchemaName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

#if ENABLE_OVERLOADING
data SchemaNameFieldInfo
instance AttrInfo SchemaNameFieldInfo where
    type AttrAllowedOps SchemaNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint SchemaNameFieldInfo = (~) CString
    type AttrBaseTypeConstraint SchemaNameFieldInfo = (~) Schema
    type AttrGetType SchemaNameFieldInfo = Maybe T.Text
    type AttrLabel SchemaNameFieldInfo = "name"
    type AttrOrigin SchemaNameFieldInfo = Schema
    attrGet _ = getSchemaName
    attrSet _ = setSchemaName
    attrConstruct = undefined
    attrClear _ = clearSchemaName

schema_name :: AttrLabelProxy "name"
schema_name = AttrLabelProxy

#endif


{- |
Get the value of the “@flags@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' schema #flags
@
-}
getSchemaFlags :: MonadIO m => Schema -> m [Secret.Flags.SchemaFlags]
getSchemaFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CUInt
    let val' = wordToGFlags val
    return val'

{- |
Set the value of the “@flags@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' schema [ #flags 'Data.GI.Base.Attributes.:=' value ]
@
-}
setSchemaFlags :: MonadIO m => Schema -> [Secret.Flags.SchemaFlags] -> m ()
setSchemaFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 8) (val' :: CUInt)

#if ENABLE_OVERLOADING
data SchemaFlagsFieldInfo
instance AttrInfo SchemaFlagsFieldInfo where
    type AttrAllowedOps SchemaFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint SchemaFlagsFieldInfo = (~) [Secret.Flags.SchemaFlags]
    type AttrBaseTypeConstraint SchemaFlagsFieldInfo = (~) Schema
    type AttrGetType SchemaFlagsFieldInfo = [Secret.Flags.SchemaFlags]
    type AttrLabel SchemaFlagsFieldInfo = "flags"
    type AttrOrigin SchemaFlagsFieldInfo = Schema
    attrGet _ = getSchemaFlags
    attrSet _ = setSchemaFlags
    attrConstruct = undefined
    attrClear _ = undefined

schema_flags :: AttrLabelProxy "flags"
schema_flags = AttrLabelProxy

#endif


-- XXX Skipped attribute for "Schema:attributes" :: Not implemented: "Don't know how to unpack C array of type TCArray False 32 (-1) (TInterface (Name {namespace = \"Secret\", name = \"SchemaAttribute\"}))"

#if ENABLE_OVERLOADING
instance O.HasAttributeList Schema
type instance O.AttributeList Schema = SchemaAttributeList
type SchemaAttributeList = ('[ '("name", SchemaNameFieldInfo), '("flags", SchemaFlagsFieldInfo)] :: [(Symbol, *)])
#endif

-- XXX Could not generate method Schema::new
-- Error was : Not implemented: "GHashTable element of type TInterface (Name {namespace = \"Secret\", name = \"SchemaAttributeType\"}) unsupported."
-- method Schema::ref
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "schema", argType = TInterface (Name {namespace = "Secret", name = "Schema"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the schema to reference", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Secret", name = "Schema"}))
-- throws : False
-- Skip return : False

foreign import ccall "secret_schema_ref" secret_schema_ref :: 
    Ptr Schema ->                           -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    IO (Ptr Schema)

{- |
Adds a reference to the 'GI.Secret.Structs.Schema.Schema'.

It is not normally necessary to call this function from C code, and is
mainly present for the sake of bindings. If the /@schema@/ was statically
allocated, then this function will copy the schema.
-}
schemaRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Schema
    {- ^ /@schema@/: the schema to reference -}
    -> m Schema
    {- ^ __Returns:__ the referenced schema, which should be later
         unreferenced with 'GI.Secret.Structs.Schema.schemaUnref' -}
schemaRef schema = liftIO $ do
    schema' <- unsafeManagedPtrGetPtr schema
    result <- secret_schema_ref schema'
    checkUnexpectedReturnNULL "schemaRef" result
    result' <- (wrapBoxed Schema) result
    touchManagedPtr schema
    return result'

#if ENABLE_OVERLOADING
data SchemaRefMethodInfo
instance (signature ~ (m Schema), MonadIO m) => O.MethodInfo SchemaRefMethodInfo Schema signature where
    overloadedMethod _ = schemaRef

#endif

-- method Schema::unref
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "schema", argType = TInterface (Name {namespace = "Secret", name = "Schema"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the schema to reference", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_schema_unref" secret_schema_unref :: 
    Ptr Schema ->                           -- schema : TInterface (Name {namespace = "Secret", name = "Schema"})
    IO ()

{- |
Releases a reference to the 'GI.Secret.Structs.Schema.Schema'. If the last reference is
released then the schema will be freed.

It is not normally necessary to call this function from C code, and is
mainly present for the sake of bindings. It is an error to call this for
a /@schema@/ that was statically allocated.
-}
schemaUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Schema
    {- ^ /@schema@/: the schema to reference -}
    -> m ()
schemaUnref schema = liftIO $ do
    schema' <- unsafeManagedPtrGetPtr schema
    secret_schema_unref schema'
    touchManagedPtr schema
    return ()

#if ENABLE_OVERLOADING
data SchemaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo SchemaUnrefMethodInfo Schema signature where
    overloadedMethod _ = schemaUnref

#endif

#if ENABLE_OVERLOADING
type family ResolveSchemaMethod (t :: Symbol) (o :: *) :: * where
    ResolveSchemaMethod "ref" o = SchemaRefMethodInfo
    ResolveSchemaMethod "unref" o = SchemaUnrefMethodInfo
    ResolveSchemaMethod l o = O.MethodResolutionFailed l o

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

#endif