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

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.
-}

module GI.Secret.Structs.Schema
    ( 

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


 -- * Methods
-- ** ref #method:ref#
    SchemaRefMethodInfo                     ,
    schemaRef                               ,


-- ** unref #method:unref#
    SchemaUnrefMethodInfo                   ,
    schemaUnref                             ,




 -- * Properties
-- ** flags #attr:flags#
    getSchemaFlags                          ,
    schema_flags                            ,
    setSchemaFlags                          ,


-- ** name #attr:name#
    clearSchemaName                         ,
    getSchemaName                           ,
    schema_name                             ,
    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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 {-# SOURCE #-} qualified GI.Secret.Flags as Secret.Flags

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


noSchema :: Maybe Schema
noSchema = Nothing

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

setSchemaName :: MonadIO m => Schema -> CString -> m ()
setSchemaName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

clearSchemaName :: MonadIO m => Schema -> m ()
clearSchemaName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

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


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'

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)

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


-- 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\"}))"

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

-- 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'

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

-- 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 ()

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

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) => O.IsLabelProxy t (Schema -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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