desktop-portal 0.7.0.0 → 0.8.0.0
raw patch · 7 files changed
+94/−75 lines, 7 filesdep +os-stringdep ~bytestringdep ~containersdep ~data-defaultPVP ok
version bump matches the API change (PVP)
Dependencies added: os-string
Dependency ranges changed: bytestring, containers, data-default, dbus, directory, filepath, network, process, random, text, unix
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- README.md +3/−3
- desktop-portal.cabal +28/−24
- src/Desktop/Portal/Documents.hs +2/−2
- src/Desktop/Portal/Util.hs +3/−3
- test/Desktop/Portal/DocumentsSpec.hs +49/−40
- test/Desktop/Portal/TestUtil.hs +5/−3
ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.8.0.0+### Changed+- Move to os-string 2+ and filepath 1.5++ ## 0.7.0.0 ### Changed - Switch from data-default-class to data-default. This is recommended by https://github.com/mauke/data-default/blob/ba1596728252c8f640d21225e728f508f2f3233c/Changes.pod#user-content-pod0.8.0.0
README.md view
@@ -31,8 +31,8 @@ - Record fields should not have unique prefixes. - API methods that return URIs that are known to always be `file:` URIs should be wrapped with functions returning [`System.OsPath`](https://hackage.haskell.org/package/filepath-1.4.100.3/docs/System-OsPath.html#t:OsPath). If they are not known to be file URIs, then [`Text.URI.URI`](https://hackage.haskell.org/package/modern-uri-0.3.6.0/docs/Text-URI.html#t:URI) should be returned. -### To format the source code+### Scripts ```bash-# Should use Ormolu 0.7.3.0-ormolu --mode inplace $(find . -name '*.hs')+./scripts/format.sh # format the source code+./scripts/publish.sh # publish to hackage ```
desktop-portal.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: desktop-portal-version: 0.7.0.0+version: 0.8.0.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com@@ -42,7 +42,8 @@ DuplicateRecordFields FlexibleContexts GeneralizedNewtypeDeriving ImportQualifiedPost LambdaCase NamedFieldPuns NoFieldSelectors NumericUnderscores OverloadedRecordDot OverloadedStrings- RecordWildCards ScopedTypeVariables TupleSections ViewPatterns+ PackageImports RecordWildCards ScopedTypeVariables TupleSections+ ViewPatterns ghc-options: -Wall -Wcompat -Wincomplete-record-updates@@ -51,17 +52,18 @@ build-depends: base >=4.7 && <5, binary >=0.8.9.1 && <0.9,- bytestring >=0.11.5.3 && <0.12,- containers >=0.6.7 && <0.7,- data-default >=0.7.1.1 && <0.8,- dbus >=1.3.0 && <2,- directory >=1.3.8.5 && <1.4,- filepath >=1.4.300.1 && <1.5,+ bytestring >=0.12.1.0 && <0.13,+ containers >=0.6.8 && <0.7,+ data-default >=0.7.1.3 && <0.8,+ dbus >=1.3.9 && <1.4,+ directory >=1.3.9.0 && <1.4,+ filepath >=1.5.0.0 && <1.6, modern-uri >=0.3.6.1 && <0.4,- network >=3.1.4.0 && <3.3,- random >=1.2.1.2 && <1.3,- text >=2.0.2 && <2.1,- unix >=2.8.4.0 && <2.9+ network >=3.2.7.0 && <3.3,+ os-string >=2.0.0 && <2.1,+ random >=1.2.1.3 && <1.3,+ text >=2.1.1 && <2.2,+ unix >=2.8.6.0 && <2.9 test-suite spec type: exitcode-stdio-1.0@@ -86,7 +88,8 @@ DuplicateRecordFields FlexibleContexts GeneralizedNewtypeDeriving ImportQualifiedPost LambdaCase NamedFieldPuns NoFieldSelectors NumericUnderscores OverloadedRecordDot OverloadedStrings- RecordWildCards ScopedTypeVariables TupleSections ViewPatterns+ PackageImports RecordWildCards ScopedTypeVariables TupleSections+ ViewPatterns ghc-options: -Wall -Wcompat -Wincomplete-record-updates@@ -96,19 +99,20 @@ build-depends: base >=4.7 && <5, binary >=0.8.9.1 && <0.9,- bytestring >=0.11.5.3 && <0.12,- containers >=0.6.7 && <0.7,- data-default >=0.7.1.1 && <0.8,- dbus >=1.3.0 && <2,+ bytestring >=0.12.1.0 && <0.13,+ containers >=0.6.8 && <0.7,+ data-default >=0.7.1.3 && <0.8,+ dbus >=1.3.9 && <1.4, desktop-portal,- directory >=1.3.8.5 && <1.4,- filepath >=1.4.300.1 && <1.5,+ directory >=1.3.9.0 && <1.4,+ filepath >=1.5.0.0 && <1.6, hspec >=2 && <3, hspec-expectations >=0.8.4 && <0.9, modern-uri >=0.3.6.1 && <0.4,- network >=3.1.4.0 && <3.3,- process >=1.6.20.0 && <1.7,- random >=1.2.1.2 && <1.3,+ network >=3.2.7.0 && <3.3,+ os-string >=2.0.0 && <2.1,+ process >=1.6.25.0 && <1.7,+ random >=1.2.1.3 && <1.3, temporary >=1.3 && <1.4,- text >=2.0.2 && <2.1,- unix >=2.8.4.0 && <2.9+ text >=2.1.1 && <2.2,+ unix >=2.8.6.0 && <2.9
src/Desktop/Portal/Documents.hs view
@@ -33,8 +33,8 @@ 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 (..))+import "os-string" System.OsString.Data.ByteString.Short qualified as ShortByteString+import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..)) newtype ApplicationId = ApplicationId Text deriving newtype (Eq, Ord, Show, IsString)
src/Desktop/Portal/Util.hs view
@@ -17,12 +17,12 @@ import Data.Map (Map) import Data.Map qualified as Map import Data.Text (Text, unpack)-import System.OsPath (OsPath, OsString)+import System.OsPath (OsPath) import System.OsPath qualified as OsPath-import System.OsPath.Data.ByteString.Short qualified as ShortByteString-import System.OsString.Internal.Types (OsString (..), PosixString (..))+import System.OsString.Data.ByteString.Short qualified as ShortByteString import Text.URI (Authority (..), URI (..)) import Text.URI qualified as URI+import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..)) -- | Returns @Just Nothing@ if the field does not exist, @Just (Just x)@ if it does exist and -- can be turned into the expected type, or @Nothing@ if the field exists with the wrong type.
test/Desktop/Portal/DocumentsSpec.hs view
@@ -13,7 +13,7 @@ import Desktop.Portal.TestUtil import Desktop.Portal.TestUtil qualified as DBus import System.OsPath (osp)-import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldSatisfy)+import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn) documentsInterface :: InterfaceName documentsInterface = "org.freedesktop.portal.Documents"@@ -45,16 +45,22 @@ withTempFd $ \fd -> do body <- savingDocumentsMethodArguments handle "Add" responseBody $ do void $ Documents.add (client handle) (FileSpecFd fd) False True- head body `shouldSatisfy` isDifferentUnixFd fd- tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True]+ body+ `shouldSatisfyList` [ isDifferentUnixFd fd,+ (== DBus.toVariant False),+ (== DBus.toVariant True)+ ] it "should encode request with file path" $ \handle -> do let responseBody = [toVariantText "docId"] withTempFilePath $ \path -> do body <- savingDocumentsMethodArguments handle "Add" responseBody $ do void $ Documents.add (client handle) (FileSpecPath path) False True- head body `shouldSatisfy` isUnixFd- tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True]+ body+ `shouldSatisfyList` [ isUnixFd,+ (== DBus.toVariant False),+ (== DBus.toVariant True)+ ] it "should decode response" $ \handle -> do let responseBody = [toVariantText "docId"]@@ -78,12 +84,12 @@ [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory] (Just "appId") [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete]- head body `shouldSatisfy` isDifferentUnixFds fds- tail body- `shouldBe` [ DBus.toVariant (0b1111 :: Word32),- toVariantText "appId",- DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"]- ]+ body+ `shouldSatisfyList` [ isDifferentUnixFds fds,+ (== DBus.toVariant (0b1111 :: Word32)),+ (== toVariantText "appId"),+ (== DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"])+ ] it "should encode request with file paths" $ \handle -> do withTempFilePaths 8 $ \paths -> do@@ -94,9 +100,12 @@ body <- savingDocumentsMethodArguments handle "AddFull" responseBody $ do void $ Documents.addFull (client handle) (FileSpecPath <$> paths) [] Nothing []- head body `shouldSatisfy` isUnixFds 8- tail body- `shouldBe` [DBus.toVariant (0 :: Word32), toVariantText "", DBus.toVariant ([] :: [Text])]+ body+ `shouldSatisfyList` [ isUnixFds 8,+ (== DBus.toVariant (0 :: Word32)),+ (== toVariantText ""),+ (== DBus.toVariant ([] :: [Text]))+ ] it "should decode response" $ \handle -> do let responseBody =@@ -113,24 +122,24 @@ let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do void $ Documents.addNamed (client handle) (FileSpecFd fd) [osp|filename|] False True- head body `shouldSatisfy` isDifferentUnixFd fd- tail body- `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),- DBus.toVariant False,- DBus.toVariant True- ]+ body+ `shouldSatisfyList` [ isDifferentUnixFd fd,+ (== DBus.toVariant ("filename\0" :: ByteString)),+ (== DBus.toVariant False),+ (== DBus.toVariant True)+ ] it "should encode request with file path" $ \handle -> do withTempDirectoryFilePath $ \path -> do let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do void $ Documents.addNamed (client handle) (FileSpecPath path) [osp|filename|] False True- head body `shouldSatisfy` isUnixFd- tail body- `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),- DBus.toVariant False,- DBus.toVariant True- ]+ body+ `shouldSatisfyList` [ isUnixFd,+ (== DBus.toVariant ("filename\0" :: ByteString)),+ (== DBus.toVariant False),+ (== DBus.toVariant True)+ ] it "should decode response" $ \handle -> do withTempDirectoryFd $ \fd -> do@@ -155,13 +164,13 @@ [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory] (Just "appId") [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete]- head body `shouldSatisfy` isDifferentUnixFd fd- tail body- `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),- DBus.toVariant (0b1111 :: Word32),- toVariantText "appId",- DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"]- ]+ body+ `shouldSatisfyList` [ isDifferentUnixFd fd,+ (== DBus.toVariant ("filename\0" :: ByteString)),+ (== DBus.toVariant (0b1111 :: Word32)),+ (== toVariantText "appId"),+ (== DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"])+ ] it "should encode request with file path" $ \handle -> do withTempDirectoryFilePath $ \path -> do@@ -172,13 +181,13 @@ body <- savingDocumentsMethodArguments handle "AddNamedFull" responseBody $ do void $ Documents.addNamedFull (client handle) (FileSpecPath path) [osp|filename|] [] Nothing []- head body `shouldSatisfy` isUnixFd- tail body- `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString),- DBus.toVariant (0 :: Word32),- toVariantText "",- DBus.toVariant ([] :: [Text])- ]+ body+ `shouldSatisfyList` [ isUnixFd,+ (== DBus.toVariant ("filename\0" :: ByteString)),+ (== DBus.toVariant (0 :: Word32)),+ (== toVariantText ""),+ (== DBus.toVariant ([] :: [Text]))+ ] it "should decode response" $ \handle -> do withTempDirectoryFd $ \fd -> do
test/Desktop/Portal/TestUtil.hs view
@@ -42,6 +42,7 @@ import DBus.Socket (SocketOptions (..), authenticatorWithUnixFds, defaultSocketOptions) import Data.Map (Map) import Data.Map qualified as Map+import Data.Maybe (fromJust) import Data.Text (Text) import Data.Word (Word32) import Desktop.Portal qualified as Portal@@ -234,9 +235,10 @@ <> handleToken where args = methodCallBody methodCall- Just (optionsArg :: Map Text Variant) = fromVariant (args !! (length args - 1))- Just (handleToken :: String) = Map.lookup "handle_token" optionsArg >>= fromVariant- Just senderClientName = methodCall.methodCallSender+ handleToken = fromJust $ do+ (optionsArg :: Map Text Variant) <- fromVariant (args !! (length args - 1))+ Map.lookup "handle_token" optionsArg >>= fromVariant+ senderClientName = fromJust methodCall.methodCallSender escapeClientName = map (\case '.' -> '_'; c -> c) . drop 1 . formatBusName