module Desktop.Portal.Documents
(
ApplicationId (..),
DocumentId (..),
AddFlag (..),
GrantPermission (..),
ExtraResults (..),
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.Map (Map)
import Data.Map qualified as Map
import Data.String (IsString)
import Data.Text (Text, unpack)
import Data.Word (Word32)
import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds)
import Desktop.Portal.Util (decodeNullTerminatedUtf8, encodeNullTerminatedUtf8)
newtype ApplicationId = ApplicationId Text
deriving newtype (ApplicationId -> ApplicationId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationId -> ApplicationId -> Bool
$c/= :: ApplicationId -> ApplicationId -> Bool
== :: ApplicationId -> ApplicationId -> Bool
$c== :: ApplicationId -> ApplicationId -> Bool
Eq, Eq 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
min :: ApplicationId -> ApplicationId -> ApplicationId
$cmin :: ApplicationId -> ApplicationId -> ApplicationId
max :: ApplicationId -> ApplicationId -> ApplicationId
$cmax :: ApplicationId -> ApplicationId -> ApplicationId
>= :: ApplicationId -> ApplicationId -> Bool
$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
compare :: ApplicationId -> ApplicationId -> Ordering
$ccompare :: ApplicationId -> ApplicationId -> Ordering
Ord, Int -> ApplicationId -> ShowS
[ApplicationId] -> ShowS
ApplicationId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationId] -> ShowS
$cshowList :: [ApplicationId] -> ShowS
show :: ApplicationId -> String
$cshow :: ApplicationId -> String
showsPrec :: Int -> ApplicationId -> ShowS
$cshowsPrec :: Int -> ApplicationId -> ShowS
Show, String -> ApplicationId
forall a. (String -> a) -> IsString a
fromString :: String -> ApplicationId
$cfromString :: String -> ApplicationId
IsString)
newtype DocumentId = DocumentId Text
deriving newtype (DocumentId -> DocumentId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentId -> DocumentId -> Bool
$c/= :: DocumentId -> DocumentId -> Bool
== :: DocumentId -> DocumentId -> Bool
$c== :: DocumentId -> DocumentId -> Bool
Eq, Eq 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
min :: DocumentId -> DocumentId -> DocumentId
$cmin :: DocumentId -> DocumentId -> DocumentId
max :: DocumentId -> DocumentId -> DocumentId
$cmax :: DocumentId -> DocumentId -> DocumentId
>= :: DocumentId -> DocumentId -> Bool
$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
compare :: DocumentId -> DocumentId -> Ordering
$ccompare :: DocumentId -> DocumentId -> Ordering
Ord, Int -> DocumentId -> ShowS
[DocumentId] -> ShowS
DocumentId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentId] -> ShowS
$cshowList :: [DocumentId] -> ShowS
show :: DocumentId -> String
$cshow :: DocumentId -> String
showsPrec :: Int -> DocumentId -> ShowS
$cshowsPrec :: Int -> DocumentId -> ShowS
Show, String -> DocumentId
forall a. (String -> a) -> IsString a
fromString :: String -> DocumentId
$cfromString :: String -> DocumentId
IsString)
data AddFlag
= AddReuseExisting
| AddPersistent
| AddAsNeededByApp
| AddExportDirectory
deriving (AddFlag -> AddFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddFlag -> AddFlag -> Bool
$c/= :: AddFlag -> AddFlag -> Bool
== :: AddFlag -> AddFlag -> Bool
$c== :: AddFlag -> AddFlag -> Bool
Eq, Int -> AddFlag -> ShowS
[AddFlag] -> ShowS
AddFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddFlag] -> ShowS
$cshowList :: [AddFlag] -> ShowS
show :: AddFlag -> String
$cshow :: AddFlag -> String
showsPrec :: Int -> AddFlag -> ShowS
$cshowsPrec :: Int -> AddFlag -> ShowS
Show)
data GrantPermission
= GrantRead
| GrantWrite
| GrantGrantPermissions
| GrantDelete
deriving (GrantPermission -> GrantPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantPermission -> GrantPermission -> Bool
$c/= :: GrantPermission -> GrantPermission -> Bool
== :: GrantPermission -> GrantPermission -> Bool
$c== :: GrantPermission -> GrantPermission -> Bool
Eq, Int -> GrantPermission -> ShowS
[GrantPermission] -> ShowS
GrantPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantPermission] -> ShowS
$cshowList :: [GrantPermission] -> ShowS
show :: GrantPermission -> String
$cshow :: GrantPermission -> String
showsPrec :: Int -> GrantPermission -> ShowS
$cshowsPrec :: Int -> GrantPermission -> ShowS
Show)
newtype = { :: FilePath}
deriving (ExtraResults -> ExtraResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtraResults -> ExtraResults -> Bool
$c/= :: ExtraResults -> ExtraResults -> Bool
== :: ExtraResults -> ExtraResults -> Bool
$c== :: ExtraResults -> ExtraResults -> Bool
Eq, Int -> ExtraResults -> ShowS
[ExtraResults] -> ShowS
ExtraResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtraResults] -> ShowS
$cshowList :: [ExtraResults] -> ShowS
show :: ExtraResults -> String
$cshow :: ExtraResults -> String
showsPrec :: Int -> ExtraResults -> ShowS
$cshowsPrec :: Int -> 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 FilePath
getMountPoint :: Client -> IO String
getMountPoint Client
client = do
Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"GetMountPoint" [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Variant -> Maybe String
toFilePath -> Just String
path] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
path
[Variant]
res ->
forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"getMountPoint: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
res
add ::
Client ->
FileSpec ->
Bool ->
Bool ->
IO DocumentId
add :: Client -> FileSpec -> Bool -> Bool -> IO DocumentId
add Client
client FileSpec
file Bool
reuseExisting Bool
persistent =
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
file forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"Add" (forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId)
[Variant]
res ->
forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"add: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
res
where
args :: a -> [Variant]
args a
fd =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
reuseExisting,
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
persistent
]
addFull ::
Client ->
[FileSpec] ->
[AddFlag] ->
Maybe ApplicationId ->
[GrantPermission] ->
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 =
forall a. [FileSpec] -> ([Fd] -> IO a) -> IO a
withFds [FileSpec]
files forall a b. (a -> b) -> a -> b
$ \[Fd]
fds -> do
Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddFull" (forall {a}. IsVariant a => a -> [Variant]
args [Fd]
fds) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just [Text]
docIds, Variant -> Maybe ExtraResults
toExtraResults -> Just ExtraResults
extra] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
docIds, ExtraResults
extra)
[Variant]
res ->
forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"addFull: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
res
where
args :: a -> [Variant]
args a
fds =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant a
fds,
forall a. IsVariant a => a -> Variant
DBus.toVariant ([AddFlag] -> Word32
encodeAddFlags [AddFlag]
flags),
forall a. IsVariant a => a -> Variant
DBus.toVariant (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(ApplicationId Text
ai) -> Text
ai) Maybe ApplicationId
appId),
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GrantPermission]
permissions)
]
addNamed ::
Client ->
FileSpec ->
Text ->
Bool ->
Bool ->
IO DocumentId
addNamed :: Client -> FileSpec -> Text -> Bool -> Bool -> IO DocumentId
addNamed Client
client FileSpec
parentDir Text
basename Bool
reuseExisting Bool
persistent =
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
parentDir forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddNamed" (forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId)
[Variant]
res ->
forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"addNamed: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
res
where
args :: a -> [Variant]
args a
fd =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
forall a. IsVariant a => a -> Variant
DBus.toVariant (Text -> ByteString
encodeNullTerminatedUtf8 Text
basename),
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
reuseExisting,
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
persistent
]
addNamedFull ::
Client ->
FileSpec ->
Text ->
[AddFlag] ->
Maybe ApplicationId ->
[GrantPermission] ->
IO (DocumentId, ExtraResults)
addNamedFull :: Client
-> FileSpec
-> Text
-> [AddFlag]
-> Maybe ApplicationId
-> [GrantPermission]
-> IO (DocumentId, ExtraResults)
addNamedFull Client
client FileSpec
parentDir Text
basename [AddFlag]
flags Maybe ApplicationId
appId [GrantPermission]
permissions =
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd FileSpec
parentDir forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"AddNamedFull" (forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant -> Just Text
docId, Variant -> Maybe ExtraResults
toExtraResults -> Just ExtraResults
extra] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DocumentId
DocumentId Text
docId, ExtraResults
extra)
[Variant]
res ->
forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"addNamedFull: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Variant]
res
where
args :: a -> [Variant]
args a
fd =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd,
forall a. IsVariant a => a -> Variant
DBus.toVariant (Text -> ByteString
encodeNullTerminatedUtf8 Text
basename),
forall a. IsVariant a => a -> Variant
DBus.toVariant ([AddFlag] -> Word32
encodeAddFlags [AddFlag]
flags),
forall a. IsVariant a => a -> Variant
DBus.toVariant (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(ApplicationId Text
ai) -> Text
ai) Maybe ApplicationId
appId),
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission 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 =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"GrantPermissions" [Variant]
args
where
args :: [Variant]
args =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant Text
docId,
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
appId,
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission 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 =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"RevokePermissions" [Variant]
args
where
args :: [Variant]
args =
[ forall a. IsVariant a => a -> Variant
DBus.toVariant Text
docId,
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
appId,
forall a. IsVariant a => a -> Variant
DBus.toVariant (GrantPermission -> Text
encodeGrantPermission 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) =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Client -> MemberName -> [Variant] -> IO [Variant]
callDocumentsMethod Client
client MemberName
"Delete" [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 =
forall a. Ior a -> a
getIor (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. a -> Ior a
Ior 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
Variant
v = case forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
v of
Just (Map Text Variant
extraMap :: Map Text Variant)
| Just String
mountpoint <- Variant -> Maybe String
toFilePath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"mountpoint" Map Text Variant
extraMap ->
forall a. a -> Maybe a
Just ExtraResults {String
mountpoint :: String
$sel:mountpoint:ExtraResults :: String
mountpoint}
Maybe (Map Text Variant)
_ ->
forall a. Maybe a
Nothing
toFilePath :: Variant -> Maybe FilePath
toFilePath :: Variant -> Maybe String
toFilePath Variant
v =
Text -> String
unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe Text
decodeNullTerminatedUtf8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
v)