add newtypes for QuickCheck to avoid LANG=C issues

All properties changed to use them, except for
prop_encode_c_decode_c_roundtrip, which already filtered to ascii
for other reasons.

A few modules had to be split out, because Setup does not build-depend
on QuickCheck.

Annex.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE GeneralizedNewtypeDeriving, PackageImports, BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, BangPatterns #-}
 
 module Annex (
 	Annex,

Annex/View/ViewedFile.hs

@@ -17,6 +17,7 @@ module Annex.View.ViewedFile (
 ) where
 
 import Annex.Common
+import Utility.QuickCheck
 
 import qualified Data.ByteString as S
 
@@ -78,11 +79,12 @@ dirFromViewedFile = joinPath . drop 1 . sep [] ""
 			[] -> sep l curr cs
 		| otherwise = sep l (c:curr) cs
 
-prop_viewedFile_roundtrips :: FilePath -> Bool
-prop_viewedFile_roundtrips f
+prop_viewedFile_roundtrips :: TestableFilePath -> Bool
+prop_viewedFile_roundtrips tf
 	-- Relative filenames wanted, not directories.
 	| any (isPathSeparator) (end f ++ beginning f) = True
 	| isAbsolute f = True
 	| otherwise = dir == dirFromViewedFile (viewedFileFromReference f)
   where
+	f = fromTestableFilePath tf
 	dir = joinPath $ beginning $ splitDirectories f

Common.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE PackageImports #-}
-
 module Common (module X) where
 
 import Control.Monad as X
@@ -21,6 +19,7 @@ import Utility.Misc as X
 import Utility.Exception as X
 import Utility.DebugLocks as X
 import Utility.SafeCommand as X
+import Utility.ShellEscape as X
 import Utility.Process as X
 import Utility.Path as X
 import Utility.Path.AbsRel as X

Git/Filename.hs

@@ -10,6 +10,7 @@ module Git.Filename where
 
 import Common
 import Utility.Format (decode_c, encode_c)
+import Utility.QuickCheck
 
 import Data.Char
 import Data.Word
@@ -35,21 +36,14 @@ decode b = case S.uncons b of
 encode :: RawFilePath -> S.ByteString
 encode s = encodeBS $ "\"" ++ encode_c (decodeBS s) ++ "\""
 
-prop_encode_decode_roundtrip :: FilePath -> Bool
-prop_encode_decode_roundtrip s = s' ==
-	fromRawFilePath (decode (encode (toRawFilePath s')))
+-- Encoding and then decoding roundtrips only when the string does not
+-- contain high unicode, because eg,  both "\12345" and "\227\128\185"
+-- are encoded to "\343\200\271".
+--
+-- That is not a real-world problem, and using TestableFilePath
+-- limits what's tested to ascii, so avoids running into it.
+prop_encode_decode_roundtrip :: TestableFilePath -> Bool
+prop_encode_decode_roundtrip ts = 
+	s == fromRawFilePath (decode (encode (toRawFilePath s)))
   where
-	s' = nonul (nohigh s)
-	-- Encoding and then decoding roundtrips only when
-	-- the string does not contain high unicode, because eg, 
-	-- both "\12345" and "\227\128\185" are encoded to
-	-- "\343\200\271".
-	--
-	-- This property papers over the problem, by only
-	-- testing ascii
-	nohigh = filter isAscii
-	-- A String can contain a NUL, but toRawFilePath
-	-- truncates on the NUL, which is generally fine
-	-- because unix filenames cannot contain NUL.
-	-- So the encoding only roundtrips when there is no nul.
-	nonul = filter (/= '\NUL')
+	s = fromTestableFilePath ts

Key.hs

@@ -31,7 +31,6 @@ module Key (
 	prop_isomorphic_key_encode
 ) where
 
-import Data.Char
 import qualified Data.Text as T
 import qualified Data.ByteString as S
 import qualified Data.Attoparsec.ByteString as A
@@ -100,16 +99,10 @@ instance Arbitrary KeyData where
 		<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
 		<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
 
--- AssociatedFile cannot be empty, and cannot contain a NUL
--- (but can be Nothing). 
 instance Arbitrary AssociatedFile where
-  	arbitrary = (AssociatedFile . fmap conv <$> arbitrary)
-		`suchThat` (/= AssociatedFile (Just S.empty))
-		`suchThat` (\(AssociatedFile f) -> maybe True (S.notElem 0) f)
-	  where
-		-- Generating arbitrary unicode leads to encoding errors
-		-- when LANG=C, so limit to ascii.
-		conv = toRawFilePath . filter isAscii
+  	arbitrary = AssociatedFile
+		. fmap (toRawFilePath . fromTestableFilePath)
+		<$> arbitrary
 
 instance Arbitrary Key where
 	arbitrary = mkKey . const <$> arbitrary

Logs/Remote/Pure.hs

@@ -22,6 +22,7 @@ import Types.Remote
 import Types.ProposedAccepted
 import Logs.UUIDBased
 import Annex.SpecialRemote.Config
+import Utility.QuickCheck
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
@@ -85,8 +86,10 @@ configUnEscape = unescape
 		rest = drop 1 r
 
 {- for quickcheck -}
-prop_isomorphic_configEscape :: String -> Bool
-prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s
+prop_isomorphic_configEscape :: TestableString -> Bool
+prop_isomorphic_configEscape ts = s == (configUnEscape . configEscape) s
+  where
+	s = fromTestableString ts
 
 prop_parse_show_Config :: RemoteConfig -> Bool
 prop_parse_show_Config c

Remote/Rsync/RsyncUrl.hs

@@ -13,6 +13,7 @@ import Types
 import Annex.Locations
 import Utility.Rsync
 import Utility.SafeCommand
+import Utility.ShellEscape
 import Utility.FileSystemEncoding
 import Annex.DirHashes
 #ifdef mingw32_HOST_OS

Test.hs

@@ -30,7 +30,7 @@ import Control.Concurrent.STM hiding (check)
 import Common
 import CmdLine.GitAnnex.Options
 
-import qualified Utility.SafeCommand
+import qualified Utility.ShellEscape
 import qualified Utility.RawFilePath as R
 import qualified Annex
 import qualified Git.Filename
@@ -69,7 +69,7 @@ import qualified Annex.View
 import qualified Annex.View.ViewedFile
 import qualified Logs.View
 import qualified Command.TestRemote
-import qualified Utility.Path
+import qualified Utility.Path.Tests
 import qualified Utility.FileMode
 import qualified BuildInfo
 import qualified Utility.Format
@@ -184,13 +184,13 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
 	[ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip
 	, testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip
 	, testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode
-	, testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape
-	, testProperty "prop_isomorphic_shellEscape_multiword" Utility.SafeCommand.prop_isomorphic_shellEscape_multiword
+	, testProperty "prop_isomorphic_shellEscape" Utility.ShellEscape.prop_isomorphic_shellEscape
+	, testProperty "prop_isomorphic_shellEscape_multiword" Utility.ShellEscape.prop_isomorphic_shellEscape_multiword
 	, testProperty "prop_isomorphic_configEscape" Logs.Remote.prop_isomorphic_configEscape
 	, testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
-	, testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics
-	, testProperty "prop_relPathDirToFileAbs_basics" Utility.Path.prop_relPathDirToFileAbs_basics
-	, testProperty "prop_relPathDirToFileAbs_regressionTest" Utility.Path.prop_relPathDirToFileAbs_regressionTest
+	, testProperty "prop_upFrom_basics" Utility.Path.Tests.prop_upFrom_basics
+	, testProperty "prop_relPathDirToFileAbs_basics" Utility.Path.Tests.prop_relPathDirToFileAbs_basics
+	, testProperty "prop_relPathDirToFileAbs_regressionTest" Utility.Path.Tests.prop_relPathDirToFileAbs_regressionTest
 	, testProperty "prop_cost_sane" Config.Cost.prop_cost_sane
 	, testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane
 	, testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane

Utility/Base64.hs

@@ -8,6 +8,7 @@
 module Utility.Base64 where
 
 import Utility.FileSystemEncoding
+import Utility.QuickCheck
 
 import qualified "sandi" Codec.Binary.Base64 as B64
 import Data.Maybe
@@ -43,7 +44,9 @@ fromB64' = fromMaybe bad . fromB64Maybe'
 -- Only ascii strings are tested, because an arbitrary string may contain
 -- characters not encoded using the FileSystemEncoding, which would thus
 -- not roundtrip, as decodeBS always generates an output encoded that way.
-prop_b64_roundtrips :: String -> Bool
-prop_b64_roundtrips s
+prop_b64_roundtrips :: TestableString -> Bool
+prop_b64_roundtrips ts
 	| all (isAscii) s = s == decodeBS (fromB64' (toB64' (encodeBS s)))
 	| otherwise = True
+  where
+	s = fromTestableString ts

Utility/Path.hs

@@ -23,10 +23,6 @@ module Utility.Path (
 	dotfile,
 	splitShortExtensions,
 	relPathDirToFileAbs,
-
-	prop_upFrom_basics,
-	prop_relPathDirToFileAbs_basics,
-	prop_relPathDirToFileAbs_regressionTest,
 ) where
 
 import System.FilePath.ByteString
@@ -39,7 +35,6 @@ import Prelude
 
 import Utility.Monad
 import Utility.SystemDirectory
-import Utility.FileSystemEncoding
 
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
@@ -85,15 +80,6 @@ upFrom dir
 	(drive, path) = splitDrive dir
 	dirs = filter (not . B.null) $ B.splitWith isPathSeparator path
 
-prop_upFrom_basics :: FilePath -> Bool
-prop_upFrom_basics dir
-	| null dir = True
-	| '\NUL' `elem` dir = True -- not a legal filename
-	| dir == "/" = p == Nothing
-	| otherwise = p /= Just dir
-  where
-	p = fromRawFilePath <$> upFrom (toRawFilePath dir)
-
 {- Checks if the first RawFilePath is, or could be said to contain the second.
  - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
  - are all equivilant.
@@ -223,25 +209,3 @@ relPathDirToFileAbs from to
 #ifdef mingw32_HOST_OS
 	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive
 #endif
-
-prop_relPathDirToFileAbs_basics :: FilePath -> FilePath -> Bool
-prop_relPathDirToFileAbs_basics from to
-	| null from || null to = True
-	| '\NUL' `elem` from || '\NUL' `elem` to = True -- not a legal filename
-	| from == to = null r
-	| otherwise = not (null r)
-  where
-	r = fromRawFilePath $ relPathDirToFileAbs
-		(toRawFilePath from)
-		(toRawFilePath to)
-
-prop_relPathDirToFileAbs_regressionTest :: Bool
-prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference
-  where
-	{- Two paths have the same directory component at the same
-	 - location, but it's not really the same directory.
-	 - Code used to get this wrong. -}
-	same_dir_shortcurcuits_at_difference =
-		relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"])
-			(joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
-				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]

Utility/Path/Tests.hs

@@ -0,0 +1,58 @@
+{- Tests for Utility.Path. Split into a separate module to avoid it needing
+ - QuickCheck.
+ -
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Path.Tests (
+	prop_upFrom_basics,
+	prop_relPathDirToFileAbs_basics,
+	prop_relPathDirToFileAbs_regressionTest,
+) where
+
+import System.FilePath.ByteString
+import qualified Data.ByteString as B
+import Data.List
+import Data.Maybe
+import Control.Applicative
+import Prelude
+
+import Utility.Path
+import Utility.FileSystemEncoding
+import Utility.QuickCheck
+
+prop_upFrom_basics :: TestableFilePath -> Bool
+prop_upFrom_basics tdir
+	| dir == "/" = p == Nothing
+	| otherwise = p /= Just dir
+  where
+	p = fromRawFilePath <$> upFrom (toRawFilePath dir)
+	dir = fromTestableFilePath tdir
+
+prop_relPathDirToFileAbs_basics :: TestableFilePath -> TestableFilePath -> Bool
+prop_relPathDirToFileAbs_basics fromt tot
+	| from == to = null r
+	| otherwise = not (null r)
+  where
+	from = fromTestableFilePath fromt
+	to = fromTestableFilePath tot
+	r = fromRawFilePath $ relPathDirToFileAbs
+		(toRawFilePath from)
+		(toRawFilePath to)
+
+prop_relPathDirToFileAbs_regressionTest :: Bool
+prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference
+  where
+	{- Two paths have the same directory component at the same
+	 - location, but it's not really the same directory.
+	 - Code used to get this wrong. -}
+	same_dir_shortcurcuits_at_difference =
+		relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"])
+			(joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
+				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]

Utility/QuickCheck.hs

@@ -1,6 +1,6 @@
 {- QuickCheck with additional instances
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -10,16 +10,53 @@
 
 module Utility.QuickCheck
 	( module X
-	, module Utility.QuickCheck
+	, TestableString
+	, fromTestableString
+	, TestableFilePath
+	, fromTestableFilePath
+	, nonNegative
+	, positive
 	) where
 
 import Test.QuickCheck as X
 import Data.Time.Clock.POSIX
 import Data.Ratio
+import Data.Char
 import System.Posix.Types
 import Data.List.NonEmpty (NonEmpty(..))
 import Prelude
 
+{- A String, but Arbitrary is limited to ascii.
+ -
+ - When in a non-utf8 locale, String does not normally contain any non-ascii
+ - characters, except for ones in surrogate plane. Converting a string that
+ - does contain other unicode characters to a ByteString using the
+ - filesystem encoding (see GHC.IO.Encoding) will throw an exception,
+ - so use this instead to avoid quickcheck tests breaking unncessarily.
+ -} 
+newtype TestableString = TestableString
+	{ fromTestableString :: String }
+	deriving (Show)
+
+instance Arbitrary TestableString where
+	arbitrary = TestableString . filter isAscii <$> arbitrary
+
+{- FilePath constrained to not be the empty string, not contain a NUL, 
+ - and contain only ascii.
+ -
+ - No real-world filename can be empty or contain a NUL. So code can
+ - well be written that assumes that and using this avoids quickcheck
+ - tests breaking unncessarily.
+ -} 
+newtype TestableFilePath = TestableFilePath
+	{ fromTestableFilePath :: FilePath }
+	deriving (Show)
+
+instance Arbitrary TestableFilePath where
+	arbitrary = (TestableFilePath . fromTestableString <$> arbitrary)
+		`suchThat` (not . null . fromTestableFilePath)
+		`suchThat` (not . any (== '\NUL') . fromTestableFilePath)
+
 {- Times before the epoch are excluded. Half with decimal and half without. -}
 instance Arbitrary POSIXTime where
 	arbitrary = do

Utility/SafeCommand.hs

@@ -16,18 +16,13 @@ module Utility.SafeCommand (
 	safeSystem,
 	safeSystem',
 	safeSystemEnv,
-	shellWrap,
-	shellEscape,
-	shellUnEscape,
 	segmentXargsOrdered,
 	segmentXargsUnordered,
-	prop_isomorphic_shellEscape,
-	prop_isomorphic_shellEscape_multiword,
 ) where
 
-import System.Exit
 import Utility.Process
-import Utility.Split
+
+import System.Exit
 import System.FilePath
 import Data.Char
 import Data.List
@@ -93,44 +88,6 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex
 safeSystemEnv command params environ = safeSystem' command params $ 
 	\p -> p { env = environ }
 
--- | Wraps a shell command line inside sh -c, allowing it to be run in a
--- login shell that may not support POSIX shell, eg csh.
-shellWrap :: String -> String
-shellWrap cmdline = "sh -c " ++ shellEscape cmdline
-
--- | Escapes a filename or other parameter to be safely able to be exposed to
--- the shell.
---
--- This method works for POSIX shells, as well as other shells like csh.
-shellEscape :: String -> String
-shellEscape f = "'" ++ escaped ++ "'"
-  where
-	-- replace ' with '"'"'
-	escaped = intercalate "'\"'\"'" $ splitc '\'' f
-
--- | Unescapes a set of shellEscaped words or filenames.
-shellUnEscape :: String -> [String]
-shellUnEscape [] = []
-shellUnEscape s = word : shellUnEscape rest
-  where
-	(word, rest) = findword "" s
-	findword w [] = (w, "")
-	findword w (c:cs)
-		| c == ' ' = (w, cs)
-		| c == '\'' = inquote c w cs
-		| c == '"' = inquote c w cs
-		| otherwise = findword (w++[c]) cs
-	inquote _ w [] = (w, "")
-	inquote q w (c:cs)
-		| c == q = findword w cs
-		| otherwise = inquote q (w++[c]) cs
-
--- | For quickcheck.
-prop_isomorphic_shellEscape :: String -> Bool
-prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_isomorphic_shellEscape_multiword :: [String] -> Bool
-prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
-
 -- | Segments a list of filenames into groups that are all below the maximum
 --  command-line length limit.
 segmentXargsOrdered :: [FilePath] -> [[FilePath]]

Utility/ShellEscape.hs

@@ -0,0 +1,65 @@
+{- shell escaping
+ -
+ - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.ShellEscape (
+	shellWrap,
+	shellEscape,
+	shellUnEscape,
+	prop_isomorphic_shellEscape,
+	prop_isomorphic_shellEscape_multiword,
+) where
+
+import Utility.QuickCheck
+import Utility.Split
+
+import Data.List
+import Prelude
+
+-- | Wraps a shell command line inside sh -c, allowing it to be run in a
+-- login shell that may not support POSIX shell, eg csh.
+shellWrap :: String -> String
+shellWrap cmdline = "sh -c " ++ shellEscape cmdline
+
+-- | Escapes a filename or other parameter to be safely able to be exposed to
+-- the shell.
+--
+-- This method works for POSIX shells, as well as other shells like csh.
+shellEscape :: String -> String
+shellEscape f = "'" ++ escaped ++ "'"
+  where
+	-- replace ' with '"'"'
+	escaped = intercalate "'\"'\"'" $ splitc '\'' f
+
+-- | Unescapes a set of shellEscaped words or filenames.
+shellUnEscape :: String -> [String]
+shellUnEscape [] = []
+shellUnEscape s = word : shellUnEscape rest
+  where
+	(word, rest) = findword "" s
+	findword w [] = (w, "")
+	findword w (c:cs)
+		| c == ' ' = (w, cs)
+		| c == '\'' = inquote c w cs
+		| c == '"' = inquote c w cs
+		| otherwise = findword (w++[c]) cs
+	inquote _ w [] = (w, "")
+	inquote q w (c:cs)
+		| c == q = findword w cs
+		| otherwise = inquote q (w++[c]) cs
+
+prop_isomorphic_shellEscape :: TestableString -> Bool
+prop_isomorphic_shellEscape ts = [s] == (shellUnEscape . shellEscape) s
+  where
+	s = fromTestableString ts
+
+prop_isomorphic_shellEscape_multiword :: [TestableString] -> Bool
+prop_isomorphic_shellEscape_multiword ts =
+	l == (shellUnEscape . unwords . map shellEscape) l
+  where
+	l = map fromTestableString ts

Utility/Verifiable.hs

@@ -18,6 +18,7 @@ import Data.ByteString.UTF8 (fromString)
 import qualified Data.ByteString as S
 
 import Utility.Hash
+import Utility.QuickCheck
 
 type Secret = S.ByteString
 type HMACDigest = String
@@ -38,8 +39,8 @@ verify v secret = v == mkVerifiable (verifiableVal v) secret
 calcDigest :: String -> Secret -> HMACDigest
 calcDigest v secret = calcMac HmacSha1 secret (fromString v)
 
-{- for quickcheck -}
-prop_verifiable_sane :: String -> String -> Bool
-prop_verifiable_sane a s = verify (mkVerifiable a secret) secret
+prop_verifiable_sane :: TestableString -> TestableString -> Bool
+prop_verifiable_sane v ts = 
+	verify (mkVerifiable (fromTestableString v) secret) secret
   where
-	secret = fromString s
+	secret = fromString (fromTestableString ts)

doc/bugs/tests_fail_on_Linux_build.mdwn

@@ -23,3 +23,5 @@ OSX and Windows [still FTBFS differently](https://github.com/datalad/git-annex/p
 
 [[!meta author=yoh]]
 [[!tag projects/datalad]]
+
+[[!fixed|done]] --[[Joey]]

git-annex.cabal

@@ -1099,6 +1099,7 @@ Executable git-annex
     Utility.Path
     Utility.Path.AbsRel
     Utility.Path.Max
+    Utility.Path.Tests
     Utility.Percentage
     Utility.Process
     Utility.Process.Shim
@@ -1111,6 +1112,7 @@ Executable git-annex
     Utility.Scheduled
     Utility.Scheduled.QuickCheck
     Utility.Shell
+    Utility.ShellEscape
     Utility.SimpleProtocol
     Utility.Split
     Utility.SshConfig