desktop-portal 0.5.0.0 → 0.6.0.0
raw patch · 11 files changed
+103/−87 lines, 11 filesdep ~binarydep ~bytestringdep ~containers
Dependency ranges changed: binary, bytestring, containers, data-default-class, directory, filepath, hspec-expectations, modern-uri, network, process, random, temporary, text, unix
Files
- ChangeLog.md +4/−0
- desktop-portal.cabal +26/−26
- src/Desktop/Portal/Account.hs +2/−1
- src/Desktop/Portal/Documents.hs +5/−5
- src/Desktop/Portal/FileChooser.hs +9/−8
- src/Desktop/Portal/Internal.hs +8/−5
- src/Desktop/Portal/Util.hs +15/−15
- test/Desktop/Portal/AccountSpec.hs +4/−1
- test/Desktop/Portal/DocumentsSpec.hs +12/−13
- test/Desktop/Portal/FileChooserSpec.hs +9/−6
- test/Desktop/Portal/TestUtil.hs +9/−7
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.6.0.0+### Changed+- Convert more APIs from `FilePath` to `OsPath`.+ ## 0.5.0.0 ### Changed - Switch from `FilePath` to the new `OsPath`.
desktop-portal.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: desktop-portal-version: 0.5.0.0+version: 0.6.0.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com@@ -50,18 +50,18 @@ build-depends: base >=4.7 && <5,- binary <0.9,- bytestring <0.12,- containers <0.7,- data-default-class <0.2,+ binary >=0.8.9.1 && <0.9,+ bytestring >=0.11.5.2 && <0.12,+ containers >=0.6.7 && <0.7,+ data-default-class >=0.1.2.0 && <0.2, dbus >=1.3.0 && <2,- directory <1.4,- filepath <1.5,- modern-uri <0.4,- network <3.2,- random <1.3,- text <2.1,- unix <2.9+ directory >=1.3.8.1 && <1.4,+ filepath >=1.4.100.4 && <1.5,+ modern-uri >=0.3.6.1 && <0.4,+ network >=3.1.4.0 && <3.2,+ random >=1.2.1.1 && <1.3,+ text >=2.0.2 && <2.1,+ unix >=2.8.1.0 && <2.9 test-suite spec type: exitcode-stdio-1.0@@ -95,20 +95,20 @@ build-depends: base >=4.7 && <5,- binary <0.9,- bytestring <0.12,- containers <0.7,- data-default-class <0.2,+ binary >=0.8.9.1 && <0.9,+ bytestring >=0.11.5.2 && <0.12,+ containers >=0.6.7 && <0.7,+ data-default-class >=0.1.2.0 && <0.2, dbus >=1.3.0 && <2, desktop-portal,- directory <1.4,- filepath <1.5,+ directory >=1.3.8.1 && <1.4,+ filepath >=1.4.100.4 && <1.5, hspec >=2 && <3,- hspec-expectations <0.9,- modern-uri <0.4,- network <3.2,- process <1.7,- random <1.3,- temporary <1.4,- text <2.1,- unix <2.9+ hspec-expectations >=0.8.4 && <0.9,+ modern-uri >=0.3.6.1 && <0.4,+ network >=3.1.4.0 && <3.2,+ process >=1.6.17.0 && <1.7,+ random >=1.2.1.1 && <1.3,+ temporary >=1.3 && <1.4,+ text >=2.0.2 && <2.1,+ unix >=2.8.1.0 && <2.9
src/Desktop/Portal/Account.hs view
@@ -16,6 +16,7 @@ import Data.Text (Text) import Desktop.Portal.Internal (Client, Request, sendRequest) import Desktop.Portal.Util (decodeFileUri, mapJust, optionalFromVariant, toVariantPair)+import System.OsPath (OsPath) data GetUserInformationOptions = GetUserInformationOptions { window :: Maybe Text,@@ -33,7 +34,7 @@ data GetUserInformationResults = GetUserInformationResults { id :: Text, name :: Text,- image :: Maybe FilePath+ image :: Maybe OsPath } deriving (Eq, Show)
src/Desktop/Portal/Documents.hs view
@@ -31,7 +31,7 @@ import Data.Text (Text) import Data.Word (Word32) import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds)-import Desktop.Portal.Util (encodeNullTerminatedUtf8)+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 (..))@@ -135,7 +135,7 @@ -- | The parent directory of the file to add to the documents store. FileSpec -> -- | The basename of the file.- Text ->+ 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.@@ -152,7 +152,7 @@ where args fd = [ DBus.toVariant fd,- DBus.toVariant (encodeNullTerminatedUtf8 basename),+ DBus.toVariant (encodeNullTerminated basename), DBus.toVariant reuseExisting, DBus.toVariant persistent ]@@ -163,7 +163,7 @@ -- | The parent directory of the file to add to the documents store. FileSpec -> -- | The basename of the file.- Text ->+ OsString -> -- | The flags to apply to the file. [AddFlag] -> -- | The id of another application that will be granted access to the file.@@ -182,7 +182,7 @@ where args fd = [ DBus.toVariant fd,- DBus.toVariant (encodeNullTerminatedUtf8 basename),+ DBus.toVariant (encodeNullTerminated basename), DBus.toVariant (encodeAddFlags flags), DBus.toVariant (maybe "" (\(ApplicationId ai) -> ai) appId), DBus.toVariant (encodeGrantPermission <$> permissions)
src/Desktop/Portal/FileChooser.hs view
@@ -26,10 +26,11 @@ import Data.Map (Map) import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes, fromMaybe)-import Data.Text (Text, pack)+import Data.Text (Text) import Data.Word (Word32) import Desktop.Portal.Internal (Client, Request, sendRequest)-import Desktop.Portal.Util (decodeFileUris, encodeNullTerminatedUtf8, mapJust, optionalFromVariant, toVariantPair, toVariantPair')+import Desktop.Portal.Util (decodeFileUris, encodeNullTerminated, mapJust, optionalFromVariant, toVariantPair, toVariantPair')+import System.OsPath (OsPath) data Filter = Filter { name :: Text,@@ -90,7 +91,7 @@ } data OpenFileResults = OpenFileResults- { uris :: [FilePath],+ { uris :: [OsPath], choices :: Maybe [ChoiceComboSelection], currentFilter :: Maybe Filter }@@ -105,8 +106,8 @@ currentFilter :: Maybe Filter, choices :: Maybe [ChoiceCombo], currentName :: Maybe Text,- currentFolder :: Maybe FilePath,- currentFile :: Maybe FilePath+ currentFolder :: Maybe OsPath,+ currentFile :: Maybe OsPath } deriving (Eq, Show) @@ -126,7 +127,7 @@ } data SaveFileResults = SaveFileResults- { uris :: [FilePath],+ { uris :: [OsPath], choices :: Maybe [ChoiceComboSelection], currentFilter :: Maybe Filter }@@ -168,8 +169,8 @@ toVariantPair' encodeFilter "current_filter" options.currentFilter, toVariantPair' (fmap encodeCombo) "choices" options.choices, toVariantPair "current_name" options.currentName,- toVariantPair "current_folder" (encodeNullTerminatedUtf8 . pack <$> options.currentFolder),- toVariantPair "current_file" (encodeNullTerminatedUtf8 . pack <$> options.currentFile)+ toVariantPair "current_folder" (encodeNullTerminated <$> options.currentFolder),+ toVariantPair "current_file" (encodeNullTerminated <$> options.currentFile) ] parseResponse resMap = do
src/Desktop/Portal/Internal.hs view
@@ -34,6 +34,8 @@ import Data.Map.Strict qualified as Map import Data.Text (Text, pack, unpack) import Data.Word (Word32, Word64)+import System.OsPath (OsPath)+import System.OsPath qualified as OsPath import System.Posix (Fd, OpenMode (..), closeFd, defaultFileFlags, openFd) import System.Random.Stateful qualified as R @@ -278,16 +280,17 @@ -- resolved to a file descriptor before passing it to the portals API, since -- the API typically requires file descriptors). data FileSpec- = FileSpecPath FilePath+ = FileSpecPath OsPath | FileSpecFd Fd deriving (Eq, Show) withFd :: FileSpec -> (Fd -> IO a) -> IO a-withFd = \case+withFd spec cmd = case spec of FileSpecFd fd ->- ($ fd)- FileSpecPath path ->- bracket (openFd path ReadOnly defaultFileFlags) closeFd+ cmd fd+ FileSpecPath path -> do+ filePath <- OsPath.decodeUtf path+ bracket (openFd filePath ReadOnly defaultFileFlags) closeFd cmd withFds :: forall a. [FileSpec] -> ([Fd] -> IO a) -> IO a withFds files cmd = withFdsRec [] files
src/Desktop/Portal/Util.hs view
@@ -3,8 +3,8 @@ mapJust, toVariantPair, toVariantPair',- encodeNullTerminatedUtf8,- decodeNullTerminatedUtf8,+ encodeNullTerminated,+ decodeNullTerminated, decodeFileUri, decodeFileUris, )@@ -12,13 +12,15 @@ import DBus (IsVariant, Variant) import DBus qualified-import Data.Binary.Builder qualified as Binary import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as Bytes import Data.Map (Map) import Data.Map qualified as Map import Data.Text (Text, unpack)-import Data.Text.Encoding qualified as Encoding+import System.OsPath (OsPath, OsString)+import System.OsPath qualified as OsPath+import System.OsPath.Data.ByteString.Short qualified as ShortByteString+import System.OsString.Internal.Types (OsString (..), PosixString (..)) import Text.URI (Authority (..), URI (..)) import Text.URI qualified as URI @@ -41,17 +43,15 @@ Nothing -> Nothing Just x -> Just (key, DBus.toVariant (f x)) -encodeNullTerminatedUtf8 :: Text -> ByteString-encodeNullTerminatedUtf8 txt =- Binary.toLazyByteString (Encoding.encodeUtf8Builder txt <> Binary.singleton 0)+encodeNullTerminated :: OsString -> ByteString+encodeNullTerminated (OsString (PosixString txt)) =+ Bytes.fromStrict (ShortByteString.fromShort (txt <> ShortByteString.singleton 0)) -decodeNullTerminatedUtf8 :: ByteString -> Maybe Text-decodeNullTerminatedUtf8 bytes =- case Encoding.decodeUtf8' (Bytes.toStrict (Bytes.dropWhileEnd (== 0) bytes)) of- Left _err -> Nothing- Right t -> Just t+decodeNullTerminated :: ByteString -> OsString+decodeNullTerminated =+ OsString . PosixString . ShortByteString.toShort . Bytes.toStrict . Bytes.dropWhileEnd (== 0) -decodeFileUri :: Text -> Maybe FilePath+decodeFileUri :: Text -> Maybe OsPath decodeFileUri uri = case URI.mkURI uri of Just@@ -61,7 +61,7 @@ uriPath = Just (_trailingSlash, parts), uriQuery = [], uriFragment = Nothing- } -> Just . unpack $ foldMap (("/" <>) . URI.unRText) parts+ } -> OsPath.encodeUtf . unpack $ foldMap (("/" <>) . URI.unRText) parts _ -> Nothing where@@ -75,5 +75,5 @@ } -> True _ -> False -decodeFileUris :: [Text] -> Maybe [FilePath]+decodeFileUris :: [Text] -> Maybe [OsPath] decodeFileUris = traverse decodeFileUri
test/Desktop/Portal/AccountSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE QuasiQuotes #-}+ module Desktop.Portal.AccountSpec (spec) where import Control.Monad (void)@@ -6,6 +8,7 @@ import Desktop.Portal (GetUserInformationOptions (..), GetUserInformationResults (..)) import Desktop.Portal qualified as Portal import Desktop.Portal.TestUtil+import System.OsPath (osp) import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldThrow) accountInterface :: InterfaceName@@ -40,7 +43,7 @@ ] withRequestResponse handle accountInterface "GetUserInformation" responseBody $ do (Portal.getUserInformation (client handle) def >>= Portal.await)- `shouldReturn` Just (GetUserInformationResults "_id" "_name" (Just "/some/path"))+ `shouldReturn` Just (GetUserInformationResults "_id" "_name" (Just [osp|/some/path|])) it "should decode response without image" $ \handle -> do let responseBody =
test/Desktop/Portal/DocumentsSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE QuasiQuotes #-}+ module Desktop.Portal.DocumentsSpec (spec) where import Control.Monad (void)@@ -10,7 +12,7 @@ import Desktop.Portal.Documents qualified as Documents import Desktop.Portal.TestUtil import Desktop.Portal.TestUtil qualified as DBus-import System.OsPath qualified as OsPath+import System.OsPath (osp) import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldSatisfy) documentsInterface :: InterfaceName@@ -35,8 +37,7 @@ it "should decode response" $ \handle -> do let responseBody = [toVariant ("/a/b/c\0" :: ByteString)] withDocumentsMethodResponse handle "GetMountPoint" responseBody $ do- path <- OsPath.encodeUtf "/a/b/c"- Documents.getMountPoint (client handle) `shouldReturn` path+ Documents.getMountPoint (client handle) `shouldReturn` [osp|/a/b/c|] describe "add" $ do it "should encode request with file descriptor" $ \handle -> do@@ -103,16 +104,15 @@ toVariantMap [("mountpoint", DBus.toVariant ("/a/b/c\0" :: ByteString))] ] withDocumentsMethodResponse handle "AddFull" responseBody $ do- path <- OsPath.encodeUtf "/a/b/c" Documents.addFull (client handle) [] [] Nothing []- `shouldReturn` (["docId"], ExtraResults path)+ `shouldReturn` (["docId"], ExtraResults [osp|/a/b/c|]) describe "addNamed" $ do it "should encode request with file descriptor" $ \handle -> do withTempDirectoryFd $ \fd -> do let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do- void $ Documents.addNamed (client handle) (FileSpecFd fd) "filename" False True+ void $ Documents.addNamed (client handle) (FileSpecFd fd) [osp|filename|] False True head body `shouldSatisfy` isDifferentUnixFd fd tail body `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -124,7 +124,7 @@ withTempDirectoryFilePath $ \path -> do let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do- void $ Documents.addNamed (client handle) (FileSpecPath path) "filename" False True+ void $ Documents.addNamed (client handle) (FileSpecPath path) [osp|filename|] False True head body `shouldSatisfy` isUnixFd tail body `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -136,7 +136,7 @@ withTempDirectoryFd $ \fd -> do let responseBody = [DBus.toVariantText "docId"] withDocumentsMethodResponse handle "AddNamed" responseBody $ do- Documents.addNamed (client handle) (FileSpecFd fd) "filename\0" False False+ Documents.addNamed (client handle) (FileSpecFd fd) [osp|filename|] False False `shouldReturn` "docId" describe "addNamedFull" $ do@@ -151,7 +151,7 @@ Documents.addNamedFull (client handle) (FileSpecFd fd)- "filename"+ [osp|filename|] [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory] (Just "appId") [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete]@@ -171,7 +171,7 @@ ] body <- savingDocumentsMethodArguments handle "AddNamedFull" responseBody $ do void $- Documents.addNamedFull (client handle) (FileSpecPath path) "filename" [] Nothing []+ Documents.addNamedFull (client handle) (FileSpecPath path) [osp|filename|] [] Nothing [] head body `shouldSatisfy` isUnixFd tail body `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),@@ -187,9 +187,8 @@ toVariantMap [("mountpoint", DBus.toVariant ("/a/b/c\0" :: ByteString))] ] withDocumentsMethodResponse handle "AddNamedFull" responseBody $ do- path <- OsPath.encodeUtf "/a/b/c"- Documents.addNamedFull (client handle) (FileSpecFd fd) "filename\0" [] Nothing []- `shouldReturn` ("docId", ExtraResults path)+ Documents.addNamedFull (client handle) (FileSpecFd fd) [osp|filename|] [] Nothing []+ `shouldReturn` ("docId", ExtraResults [osp|/a/b/c|]) describe "grantPermissions" $ do it "should encode request" $ \handle -> do
test/Desktop/Portal/FileChooserSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE QuasiQuotes #-}+ module Desktop.Portal.FileChooserSpec (spec) where import Control.Monad (void)@@ -9,6 +11,7 @@ import Desktop.Portal (ChoiceCombo (..), ChoiceComboOption (..), ChoiceComboSelection (..), Filter (..), FilterFileType (..), OpenFileOptions (..), OpenFileResults (..), SaveFileOptions (..), SaveFileResults (..)) import Desktop.Portal qualified as Portal import Desktop.Portal.TestUtil+import System.OsPath (osp) import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldThrow) fileChooserInterface :: InterfaceName@@ -103,7 +106,7 @@ withRequestResponse handle fileChooserInterface "OpenFile" responseBody $ do (Portal.openFile (client handle) def >>= Portal.await) `shouldReturn` Just- (OpenFileResults {uris = ["/a/b/c"], choices = Nothing, currentFilter = Nothing})+ (OpenFileResults {uris = [[osp|/a/b/c|]], choices = Nothing, currentFilter = Nothing}) it "should decode response with all Justs" $ \handle -> do let responseBody =@@ -116,7 +119,7 @@ (Portal.openFile (client handle) def >>= Portal.await) `shouldReturn` Just ( OpenFileResults- { uris = ["/a/b/c"],+ { uris = [[osp|/a/b/c|]], choices = Just [ChoiceComboSelection {comboId = "_comboId", optionId = "_optionId"}], currentFilter = Just Filter {name = "_filterId", fileTypes = [GlobFilter "*.md"]} }@@ -168,8 +171,8 @@ } ], currentName = Just "some_name",- currentFolder = Just "/some/folder",- currentFile = Just "/some/file"+ currentFolder = Just [osp|/some/folder|],+ currentFile = Just [osp|/some/file|] } body `shouldBe` [ toVariantText "_parentWindow",@@ -214,7 +217,7 @@ withRequestResponse handle fileChooserInterface "SaveFile" responseBody $ do (Portal.saveFile (client handle) def >>= Portal.await) `shouldReturn` Just- (SaveFileResults {uris = ["/a/b/c"], choices = Nothing, currentFilter = Nothing})+ (SaveFileResults {uris = [[osp|/a/b/c|]], choices = Nothing, currentFilter = Nothing}) it "should decode response with all Justs" $ \handle -> do let responseBody =@@ -227,7 +230,7 @@ (Portal.saveFile (client handle) def >>= Portal.await) `shouldReturn` Just ( SaveFileResults- { uris = ["/a/b/c"],+ { uris = [[osp|/a/b/c|]], choices = Just [ChoiceComboSelection {comboId = "_comboId", optionId = "_optionId"}], currentFilter = Just Filter {name = "_filterId", fileTypes = [GlobFilter "*.md"]} }
test/Desktop/Portal/TestUtil.hs view
@@ -33,7 +33,7 @@ import Control.Concurrent (newEmptyMVar, tryPutMVar, tryReadMVar) import Control.Exception (bracket, finally, throwIO)-import Control.Monad (unless, void)+import Control.Monad (unless, void, (>=>)) import Control.Monad.IO.Class (MonadIO (..)) import DBus (BusName, InterfaceName, IsValue, IsVariant (fromVariant), MemberName, MethodCall (..), ObjectPath, Type (..), Variant, formatBusName, getSessionAddress, objectPath_, toVariant, variantType) import DBus.Client (Client, ClientError, ClientOptions (..), Interface (..), Reply (..), RequestNameReply (..), clientError, connectWith, defaultClientOptions, defaultInterface, disconnect, emit, export, makeMethod, nameDoNotQueue, readOnlyProperty, requestName, unexport)@@ -48,6 +48,8 @@ import GHC.IO.Handle (hGetLine) import System.Environment (lookupEnv, setEnv) import System.IO.Temp (withSystemTempDirectory, withSystemTempFile)+import System.OsPath (OsPath)+import System.OsPath qualified as OsPath import System.Posix (Fd, OpenMode (..), closeFd, defaultFileFlags, handleToFd, openFd) import System.Process (StdStream (..), createProcess, proc, std_out, terminateProcess) import Test.Hspec.Expectations (Expectation, HasCallStack, Selector, shouldSatisfy)@@ -277,11 +279,11 @@ clientOptions = defaultClientOptions {clientSocketOptions} connectWith clientOptions addr -withTempFilePath :: (FilePath -> IO ()) -> IO ()+withTempFilePath :: (OsPath -> IO ()) -> IO () withTempFilePath cmd =- withSystemTempFile "haskell-desktop-portal" $ \path _handle -> cmd path+ withSystemTempFile "haskell-desktop-portal" $ \path _handle -> OsPath.encodeUtf path >>= cmd -withTempFilePaths :: Int -> ([FilePath] -> IO ()) -> IO ()+withTempFilePaths :: Int -> ([OsPath] -> IO ()) -> IO () withTempFilePaths n cmd = go [] n where go acc = \case@@ -305,9 +307,9 @@ withSystemTempDirectory "haskell-desktop-portal" $ \path -> do bracket (openFd path ReadOnly defaultFileFlags) closeFd cmd -withTempDirectoryFilePath :: (FilePath -> IO ()) -> IO ()-withTempDirectoryFilePath =- withSystemTempDirectory "haskell-desktop-portal"+withTempDirectoryFilePath :: (OsPath -> IO ()) -> IO ()+withTempDirectoryFilePath cmd =+ withSystemTempDirectory "haskell-desktop-portal" (OsPath.encodeUtf >=> cmd) shouldSatisfyList :: (HasCallStack, Show a) => [a] -> [a -> Bool] -> Expectation shouldSatisfyList xs predicates = shouldSatisfy xs predicate