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.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
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 = { :: OsPath}
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 OsPath
getMountPoint :: Client -> IO OsPath
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 OsPath
toOsPath -> Just OsPath
path] ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsPath
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 ->
OsString ->
Bool ->
Bool ->
IO DocumentId
addNamed :: Client -> FileSpec -> OsPath -> Bool -> Bool -> IO DocumentId
addNamed Client
client FileSpec
parentDir OsPath
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 (OsPath -> ByteString
encodeNullTerminated OsPath
basename),
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
reuseExisting,
forall a. IsVariant a => a -> Variant
DBus.toVariant Bool
persistent
]
addNamedFull ::
Client ->
FileSpec ->
OsString ->
[AddFlag] ->
Maybe ApplicationId ->
[GrantPermission] ->
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 =
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 (OsPath -> ByteString
encodeNullTerminated OsPath
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 OsPath
mountpoint <- Variant -> Maybe OsPath
toOsPath 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 {OsPath
mountpoint :: OsPath
$sel:mountpoint:ExtraResults :: OsPath
mountpoint}
Maybe (Map Text Variant)
_ ->
forall a. Maybe a
Nothing
toOsPath :: Variant -> Maybe OsPath
toOsPath :: Variant -> Maybe OsPath
toOsPath Variant
v = ByteString -> OsPath
bytesToOsPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
v
where
bytesToOsPath :: ByteString -> OsPath
bytesToOsPath =
PlatformString -> OsPath
OsString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PlatformString
PosixString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
ShortByteString.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Bytes.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Word8
0)