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.

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)