module Desktop.Portal.Documents
  ( -- * Common Types
    ApplicationId (..),
    DocumentId (..),
    AddFlag (..),
    GrantPermission (..),
    ExtraResults (..),

    -- * Documents Portal Methods
    getMountPoint,
    add,
    addFull,
    addNamed,
    addNamedFull,
    grantPermissions,
    revokePermissions,
    delete,
  )
where

import Control.Exception (throwIO)
import Control.Monad (void)
import DBus (BusName, InterfaceName, MemberName, ObjectPath, Variant)
import DBus qualified
import DBus.Client qualified as DBus
import Data.Bits (Ior (..))
import Data.ByteString.Lazy qualified as Bytes
import Data.Map (Map)
import Data.Map qualified as Map
import Data.String (IsString)
import Data.Text (Text)
import Data.Word (Word32)
import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds)
import Desktop.Portal.Util (encodeNullTerminated)
import System.OsPath (OsPath)
import System.OsPath.Data.ByteString.Short qualified as ShortByteString
import System.OsString.Internal.Types (OsString (..), PosixString (..))

newtype ApplicationId = ApplicationId Text
  deriving newtype (ApplicationId -> ApplicationId -> Bool
(ApplicationId -> ApplicationId -> Bool)
-> (ApplicationId -> ApplicationId -> Bool) -> Eq ApplicationId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationId -> ApplicationId -> Bool
== :: ApplicationId -> ApplicationId -> Bool
$c/= :: ApplicationId -> ApplicationId -> Bool
/= :: ApplicationId -> ApplicationId -> Bool
Eq, Eq ApplicationId
Eq ApplicationId =>
(ApplicationId -> ApplicationId -> Ordering)
-> (ApplicationId -> ApplicationId -> Bool)
-> (ApplicationId -> ApplicationId -> Bool)
-> (ApplicationId -> ApplicationId -> Bool)
-> (ApplicationId -> ApplicationId -> Bool)
-> (ApplicationId -> ApplicationId -> ApplicationId)
-> (ApplicationId -> ApplicationId -> ApplicationId)
-> Ord ApplicationId
ApplicationId -> ApplicationId -> Bool
ApplicationId -> ApplicationId -> Ordering
ApplicationId -> ApplicationId -> ApplicationId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ApplicationId -> ApplicationId -> Ordering
compare :: ApplicationId -> ApplicationId -> Ordering
$c< :: ApplicationId -> ApplicationId -> Bool
< :: ApplicationId -> ApplicationId -> Bool
$c<= :: ApplicationId -> ApplicationId -> Bool
<= :: ApplicationId -> ApplicationId -> Bool
$c> :: ApplicationId -> ApplicationId -> Bool
> :: ApplicationId -> ApplicationId -> Bool
$c>= :: ApplicationId -> ApplicationId -> Bool
>= :: ApplicationId -> ApplicationId -> Bool
$cmax :: ApplicationId -> ApplicationId -> ApplicationId
max :: ApplicationId -> ApplicationId -> ApplicationId
$cmin :: ApplicationId -> ApplicationId -> ApplicationId
min :: ApplicationId -> ApplicationId -> ApplicationId
Ord, Int -> ApplicationId -> ShowS
[ApplicationId] -> ShowS
ApplicationId -> String
(Int -> ApplicationId -> ShowS)
-> (ApplicationId -> String)
-> ([ApplicationId] -> ShowS)
-> Show ApplicationId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationId -> ShowS
showsPrec :: Int -> ApplicationId -> ShowS
$cshow :: ApplicationId -> String
show :: ApplicationId -> String
$cshowList :: [ApplicationId] -> ShowS
showList :: [ApplicationId] -> ShowS
Show, String -> ApplicationId
(String -> ApplicationId) -> IsString ApplicationId
forall a. (String -> a) -> IsString a
$cfromString :: String -> ApplicationId
fromString :: String -> ApplicationId
IsString)

newtype DocumentId = DocumentId Text
  deriving newtype (DocumentId -> DocumentId -> Bool
(DocumentId -> DocumentId -> Bool)
-> (DocumentId -> DocumentId -> Bool) -> Eq DocumentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocumentId -> DocumentId -> Bool
== :: DocumentId -> DocumentId -> Bool
$c/= :: DocumentId -> DocumentId -> Bool
/= :: DocumentId -> DocumentId -> Bool
Eq, Eq DocumentId
Eq DocumentId =>
(DocumentId -> DocumentId -> Ordering)
-> (DocumentId -> DocumentId -> Bool)
-> (DocumentId -> DocumentId -> Bool)
-> (DocumentId -> DocumentId -> Bool)
-> (DocumentId -> DocumentId -> Bool)
-> (DocumentId -> DocumentId -> DocumentId)
-> (DocumentId -> DocumentId -> DocumentId)
-> Ord DocumentId
DocumentId -> DocumentId -> Bool
DocumentId -> DocumentId -> Ordering
DocumentId -> DocumentId -> DocumentId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DocumentId -> DocumentId -> Ordering
compare :: DocumentId -> DocumentId -> Ordering
$c< :: DocumentId -> DocumentId -> Bool
< :: DocumentId -> DocumentId -> Bool
$c<= :: DocumentId -> DocumentId -> Bool
<= :: DocumentId -> DocumentId -> Bool
$c> :: DocumentId -> DocumentId -> Bool
> :: DocumentId -> DocumentId -> Bool
$c>= :: DocumentId -> DocumentId -> Bool
>= :: DocumentId -> DocumentId -> Bool
$cmax :: DocumentId -> DocumentId -> DocumentId
max :: DocumentId -> DocumentId -> DocumentId
$cmin :: DocumentId -> DocumentId -> DocumentId
min :: DocumentId -> DocumentId -> DocumentId
Ord, Int -> DocumentId -> ShowS
[DocumentId] -> ShowS
DocumentId -> String
(Int -> DocumentId -> ShowS)
-> (DocumentId -> String)
-> ([DocumentId] -> ShowS)
-> Show DocumentId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocumentId -> ShowS
showsPrec :: Int -> DocumentId -> ShowS
$cshow :: DocumentId -> String
show :: DocumentId -> String
$cshowList :: [DocumentId] -> ShowS
showList :: [DocumentId] -> ShowS
Show, String -> DocumentId
(String -> DocumentId) -> IsString DocumentId
forall a. (String -> a) -> IsString a
$cfromString :: String -> DocumentId
fromString :: String -> DocumentId
IsString)

data AddFlag
  = AddReuseExisting
  | AddPersistent
  | AddAsNeededByApp
  | AddExportDirectory
  deriving (AddFlag -> AddFlag -> Bool
(AddFlag -> AddFlag -> Bool)
-> (AddFlag -> AddFlag -> Bool) -> Eq AddFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddFlag -> AddFlag -> Bool
== :: AddFlag -> AddFlag -> Bool
$c/= :: AddFlag -> AddFlag -> Bool
/= :: AddFlag -> AddFlag -> Bool
Eq, Int -> AddFlag -> ShowS
[AddFlag] -> ShowS
AddFlag -> String
(Int -> AddFlag -> ShowS)
-> (AddFlag -> String) -> ([AddFlag] -> ShowS) -> Show AddFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddFlag -> ShowS
showsPrec :: Int -> AddFlag -> ShowS
$cshow :: AddFlag -> String
show :: AddFlag -> String
$cshowList :: [AddFlag] -> ShowS
showList :: [AddFlag] -> ShowS
Show)

data GrantPermission
  = GrantRead
  | GrantWrite
  | GrantGrantPermissions
  | GrantDelete
  deriving (GrantPermission -> GrantPermission -> Bool
(GrantPermission -> GrantPermission -> Bool)
-> (GrantPermission -> GrantPermission -> Bool)
-> Eq GrantPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrantPermission -> GrantPermission -> Bool
== :: GrantPermission -> GrantPermission -> Bool
$c/= :: GrantPermission -> GrantPermission -> Bool
/= :: GrantPermission -> GrantPermission -> Bool
Eq, Int -> GrantPermission -> ShowS
[GrantPermission] -> ShowS
GrantPermission -> String
(Int -> GrantPermission -> ShowS)
-> (GrantPermission -> String)
-> ([GrantPermission] -> ShowS)
-> Show GrantPermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GrantPermission -> ShowS
showsPrec :: Int -> GrantPermission -> ShowS
$cshow :: GrantPermission -> String
show :: GrantPermission -> String
$cshowList :: [GrantPermission] -> ShowS
showList :: [GrantPermission] -> ShowS
Show)

newtype ExtraResults = ExtraResults {ExtraResults -> OsPath
mountpoint :: OsPath}
  deriving (ExtraResults -> ExtraResults -> Bool
(ExtraResults -> ExtraResults -> Bool)
-> (ExtraResults -> ExtraResults -> Bool) -> Eq ExtraResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraResults -> ExtraResults -> Bool
== :: ExtraResults -> ExtraResults -> Bool
$c/= :: ExtraResults -> ExtraResults -> Bool
/= :: ExtraResults -> ExtraResults -> Bool
Eq, Int -> ExtraResults -> ShowS
[ExtraResults] -> ShowS
ExtraResults -> String
(Int -> ExtraResults -> ShowS)
-> (ExtraResults -> String)
-> ([ExtraResults] -> ShowS)
-> Show ExtraResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraResults -> ShowS
showsPrec :: Int -> ExtraResults -> ShowS
$cshow :: ExtraResults -> String
show :: ExtraResults -> String
$cshowList :: [ExtraResults] -> ShowS
showList :: [ExtraResults] -> ShowS
Show)

documentsInterface :: InterfaceName
documentsInterface :: InterfaceName
documentsInterface = InterfaceName
"org.freedesktop.portal.Documents"

documentsBusName :: BusName
documentsBusName :: BusName
documentsBusName = BusName
"org.freedesktop.portal.Documents"

documentsObject :: ObjectPath
documentsObject :: ObjectPath
documentsObject = ObjectPath
"/org/freedesktop/portal/documents"

getMountPoint :: Client -> IO OsPath
getMountPoint :: Client -> IO OsPath
getMountPoint Client
client = do
  Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"GetMountPoint" [] IO [Variant] -> ([Variant] -> IO OsPath) -> IO OsPath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [Variant -> Maybe OsPath
toOsPath -> Just OsPath
path] ->
      OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsPath
path
    [Variant]
res ->
      ClientError -> IO OsPath
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO OsPath)
-> (String -> ClientError) -> String -> IO OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO OsPath) -> String -> IO OsPath
forall a b. (a -> b) -> a -> b
$ String
"getMountPoint: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res

-- | Add a file to the documents store, with basic configuration options.
add ::
  Client ->
  -- | The file to add to the documents store.
  FileSpec ->
  -- | Whether to re-use the existing entry in the documents store, if this file is already there.
  Bool ->
  -- | Whether this file should stay in the documents store after this app shuts down.
  Bool ->
  -- | The id (folder name) of the file in the store.
  IO DocumentId
add :: Client -> FileSpec -> Bool -> Bool -> IO DocumentId
add Client
client FileSpec
file Bool
reuseExisting Bool
persistent =
  FileSpec -> (Fd -> IO DocumentId) -> IO DocumentId
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
file ((Fd -> IO DocumentId) -> IO DocumentId)
-> (Fd -> IO DocumentId) -> IO DocumentId
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
    Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"Add" (Fd -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) IO [Variant] -> ([Variant] -> IO DocumentId) -> IO DocumentId
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Variant -> Maybe Text
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId] ->
        DocumentId -> IO DocumentId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId)
      [Variant]
res ->
        ClientError -> IO DocumentId
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO DocumentId)
-> (String -> ClientError) -> String -> IO DocumentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO DocumentId) -> String -> IO DocumentId
forall a b. (a -> b) -> a -> b
$ String
"add: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res
  where
    args :: a -> [Variant]
args a
fd =
      [ a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
        Bool -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
reuseExisting,
        Bool -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
persistent
      ]

-- | Add multiple files to the document store, with full configuration options.
addFull ::
  Client ->
  -- | The files to add to the documents store.
  [FileSpec] ->
  -- | The flags to apply to the files.
  [AddFlag] ->
  -- | The id of another application that will be granted access to the files.
  Maybe ApplicationId ->
  -- | The permissions to grant to the other application.
  [GrantPermission] ->
  -- | The id (folder name) of each file in the store.
  IO ([DocumentId], ExtraResults)
addFull :: Client
-> [FileSpec]
-> [AddFlag]
-> Maybe ApplicationId
-> [GrantPermission]
-> IO ([DocumentId], ExtraResults)
addFull Client
client [FileSpec]
files [AddFlag]
flags Maybe ApplicationId
appId [GrantPermission]
permissions =
  [FileSpec]
-> ([Fd] -> IO ([DocumentId], ExtraResults))
-> IO ([DocumentId], ExtraResults)
forall a. [FileSpec] -> ([Fd] -> IO a) -> IO a
withFds [FileSpec]
files (([Fd] -> IO ([DocumentId], ExtraResults))
 -> IO ([DocumentId], ExtraResults))
-> ([Fd] -> IO ([DocumentId], ExtraResults))
-> IO ([DocumentId], ExtraResults)
forall a b. (a -> b) -> a -> b
$ \[Fd]
fds -> do
    Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddFull" ([Fd] -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args [Fd]
fds) IO [Variant]
-> ([Variant] -> IO ([DocumentId], ExtraResults))
-> IO ([DocumentId], ExtraResults)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Variant -> Maybe [Text]
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just [Text]
docIds, Variant -> Maybe ExtraResults
toExtraResults -> Just ExtraResults
extra] ->
        ([DocumentId], ExtraResults) -> IO ([DocumentId], ExtraResults)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId (Text -> DocumentId) -> [Text] -> [DocumentId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
docIds, ExtraResults
extra)
      [Variant]
res ->
        ClientError -> IO ([DocumentId], ExtraResults)
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ([DocumentId], ExtraResults))
-> (String -> ClientError)
-> String
-> IO ([DocumentId], ExtraResults)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO ([DocumentId], ExtraResults))
-> String -> IO ([DocumentId], ExtraResults)
forall a b. (a -> b) -> a -> b
$ String
"addFull: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res
  where
    args :: a -> [Variant]
args a
fds =
      [ a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fds,
        Word32 -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ([AddFlag] -> Word32
encodeAddFlags [AddFlag]
flags),
        Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (Text -> (ApplicationId -> Text) -> Maybe ApplicationId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(ApplicationId Text
ai) -> Text
ai) Maybe ApplicationId
appId),
        [Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission (GrantPermission -> Text) -> [GrantPermission] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrantPermission]
permissions)
      ]

-- | Add a file to the document store with a specified name, with basic configuration options.
addNamed ::
  Client ->
  -- | The parent directory of the file to add to the documents store.
  FileSpec ->
  -- | The basename of the file.
  OsString ->
  -- | Whether to re-use the existing entry in the documents store, if this file is already there.
  Bool ->
  -- | Whether this file should stay in the documents store after this app shuts down.
  Bool ->
  -- | The id (folder name) of the file in the store.
  IO DocumentId
addNamed :: Client -> FileSpec -> OsPath -> Bool -> Bool -> IO DocumentId
addNamed Client
client FileSpec
parentDir OsPath
basename Bool
reuseExisting Bool
persistent =
  FileSpec -> (Fd -> IO DocumentId) -> IO DocumentId
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
parentDir ((Fd -> IO DocumentId) -> IO DocumentId)
-> (Fd -> IO DocumentId) -> IO DocumentId
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
    Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddNamed" (Fd -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) IO [Variant] -> ([Variant] -> IO DocumentId) -> IO DocumentId
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Variant -> Maybe Text
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId] ->
        DocumentId -> IO DocumentId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId)
      [Variant]
res ->
        ClientError -> IO DocumentId
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO DocumentId)
-> (String -> ClientError) -> String -> IO DocumentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO DocumentId) -> String -> IO DocumentId
forall a b. (a -> b) -> a -> b
$ String
"addNamed: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res
  where
    args :: a -> [Variant]
args a
fd =
      [ a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
        ByteString -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (OsPath -> ByteString
encodeNullTerminated OsPath
basename),
        Bool -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
reuseExisting,
        Bool -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
persistent
      ]

-- | Add a file to the document store with a specified name, with full configuration options.
addNamedFull ::
  Client ->
  -- | The parent directory of the file to add to the documents store.
  FileSpec ->
  -- | The basename of the file.
  OsString ->
  -- | The flags to apply to the file.
  [AddFlag] ->
  -- | The id of another application that will be granted access to the file.
  Maybe ApplicationId ->
  -- | The permissions to grant to the other application.
  [GrantPermission] ->
  -- | The id (folder name) of the file in the store.
  IO (DocumentId, ExtraResults)
addNamedFull :: Client
-> FileSpec
-> OsPath
-> [AddFlag]
-> Maybe ApplicationId
-> [GrantPermission]
-> IO (DocumentId, ExtraResults)
addNamedFull Client
client FileSpec
parentDir OsPath
basename [AddFlag]
flags Maybe ApplicationId
appId [GrantPermission]
permissions =
  FileSpec
-> (Fd -> IO (DocumentId, ExtraResults))
-> IO (DocumentId, ExtraResults)
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
parentDir ((Fd -> IO (DocumentId, ExtraResults))
 -> IO (DocumentId, ExtraResults))
-> (Fd -> IO (DocumentId, ExtraResults))
-> IO (DocumentId, ExtraResults)
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
    Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddNamedFull" (Fd -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) IO [Variant]
-> ([Variant] -> IO (DocumentId, ExtraResults))
-> IO (DocumentId, ExtraResults)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [Variant -> Maybe Text
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId, Variant -> Maybe ExtraResults
toExtraResults -> Just ExtraResults
extra] ->
        (DocumentId, ExtraResults) -> IO (DocumentId, ExtraResults)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId, ExtraResults
extra)
      [Variant]
res ->
        ClientError -> IO (DocumentId, ExtraResults)
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO (DocumentId, ExtraResults))
-> (String -> ClientError)
-> String
-> IO (DocumentId, ExtraResults)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO (DocumentId, ExtraResults))
-> String -> IO (DocumentId, ExtraResults)
forall a b. (a -> b) -> a -> b
$ String
"addNamedFull: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res
  where
    args :: a -> [Variant]
args a
fd =
      [ a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
        ByteString -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (OsPath -> ByteString
encodeNullTerminated OsPath
basename),
        Word32 -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ([AddFlag] -> Word32
encodeAddFlags [AddFlag]
flags),
        Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (Text -> (ApplicationId -> Text) -> Maybe ApplicationId -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(ApplicationId Text
ai) -> Text
ai) Maybe ApplicationId
appId),
        [Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission (GrantPermission -> Text) -> [GrantPermission] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrantPermission]
permissions)
      ]

grantPermissions :: Client -> DocumentId -> ApplicationId -> [GrantPermission] -> IO ()
grantPermissions :: Client -> DocumentId -> ApplicationId -> [GrantPermission] -> IO ()
grantPermissions Client
client (DocumentId Text
docId) (ApplicationId Text
appId) [GrantPermission]
permissions =
  IO [Variant] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Variant] -> IO ()) -> IO [Variant] -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"GrantPermissions" [Variant]
args
  where
    args :: [Variant]
args =
      [ Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
docId,
        Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
appId,
        [Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission (GrantPermission -> Text) -> [GrantPermission] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrantPermission]
permissions)
      ]

revokePermissions :: Client -> DocumentId -> ApplicationId -> [GrantPermission] -> IO ()
revokePermissions :: Client -> DocumentId -> ApplicationId -> [GrantPermission] -> IO ()
revokePermissions Client
client (DocumentId Text
docId) (ApplicationId Text
appId) [GrantPermission]
permissions =
  IO [Variant] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Variant] -> IO ()) -> IO [Variant] -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"RevokePermissions" [Variant]
args
  where
    args :: [Variant]
args =
      [ Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
docId,
        Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
appId,
        [Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission (GrantPermission -> Text) -> [GrantPermission] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrantPermission]
permissions)
      ]

delete :: Client -> DocumentId -> IO ()
delete :: Client -> DocumentId -> IO ()
delete Client
client (DocumentId Text
docId) =
  IO [Variant] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Variant] -> IO ()) -> IO [Variant] -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"Delete" [Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
docId]

callDocumentsMethod :: Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod :: Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client =
  Client
-> BusName
-> ObjectPath
-> InterfaceName
-> MemberName
-> [Variant]
-> IO [Variant]
callMethod_ Client
client BusName
documentsBusName ObjectPath
documentsObject InterfaceName
documentsInterface

encodeAddFlags :: [AddFlag] -> Word32
encodeAddFlags :: [AddFlag] -> Word32
encodeAddFlags [AddFlag]
flags =
  Ior Word32 -> Word32
forall a. Ior a -> a
getIor ((AddFlag -> Ior Word32) -> [AddFlag] -> Ior Word32
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word32 -> Ior Word32
forall a. a -> Ior a
Ior (Word32 -> Ior Word32)
-> (AddFlag -> Word32) -> AddFlag -> Ior Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddFlag -> Word32
encodeAddFlag) [AddFlag]
flags)

encodeAddFlag :: AddFlag -> Word32
encodeAddFlag :: AddFlag -> Word32
encodeAddFlag = \case
  AddFlag
AddReuseExisting -> Word32
1
  AddFlag
AddPersistent -> Word32
2
  AddFlag
AddAsNeededByApp -> Word32
4
  AddFlag
AddExportDirectory -> Word32
8

encodeGrantPermission :: GrantPermission -> Text
encodeGrantPermission :: GrantPermission -> Text
encodeGrantPermission = \case
  GrantPermission
GrantRead -> Text
"read"
  GrantPermission
GrantWrite -> Text
"write"
  GrantPermission
GrantGrantPermissions -> Text
"grant-permissions"
  GrantPermission
GrantDelete -> Text
"delete"

toExtraResults :: Variant -> Maybe ExtraResults
toExtraResults :: Variant -> Maybe ExtraResults
toExtraResults Variant
v = case Variant -> Maybe (Map Text Variant)
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
v of
  Just (Map Text Variant
extraMap :: Map Text Variant)
    | Just OsPath
mountpoint <- Variant -> Maybe OsPath
toOsPath (Variant -> Maybe OsPath) -> Maybe Variant -> Maybe OsPath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Map Text Variant -> Maybe Variant
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"mountpoint" Map Text Variant
extraMap ->
        ExtraResults -> Maybe ExtraResults
forall a. a -> Maybe a
Just ExtraResults {OsPath
$sel:mountpoint:ExtraResults :: OsPath
mountpoint :: OsPath
mountpoint}
  Maybe (Map Text Variant)
_ ->
    Maybe ExtraResults
forall a. Maybe a
Nothing

toOsPath :: Variant -> Maybe OsPath
toOsPath :: Variant -> Maybe OsPath
toOsPath Variant
v = ByteString -> OsPath
bytesToOsPath (ByteString -> OsPath) -> Maybe ByteString -> Maybe OsPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Variant -> Maybe ByteString
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
v
  where
    bytesToOsPath :: ByteString -> OsPath
bytesToOsPath =
      PlatformString -> OsPath
OsString (PlatformString -> OsPath)
-> (ByteString -> PlatformString) -> ByteString -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlatformString
PosixString (ShortByteString -> PlatformString)
-> (ByteString -> ShortByteString) -> ByteString -> PlatformString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
ShortByteString.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Bytes.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhileEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)