merging sqlite and bs branches

Since the sqlite branch uses blobs extensively, there are some
performance benefits, ByteStrings now get stored and retrieved w/o
conversion in some cases like in Database.Export.

Utility/Applicative.hs

@@ -5,6 +5,8 @@
  - License: BSD-2-clause
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Utility.Applicative (
 	(<$$>),
 ) where

Utility/Attoparsec.hs

@@ -0,0 +1,21 @@
+{- attoparsec utility functions
+ -
+ - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2007-2015 Bryan O'Sullivan
+ -
+ - License: BSD-3-clause
+ -}
+
+module Utility.Attoparsec where
+
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.ByteString as B
+
+-- | Parse and decode an unsigned octal number.
+--
+-- This parser does not accept a leading @\"0o\"@ string.
+octal :: Integral a => A.Parser a
+octal = B.foldl' step 0 `fmap` A.takeWhile1 isOctDigit
+  where
+	isOctDigit w = w >= 48 && w <= 55
+	step a w = a * 8 + fromIntegral (w - 48)

Utility/FileSize.hs

@@ -4,6 +4,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.FileSize (
 	FileSize,
@@ -32,7 +33,10 @@ getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
 getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
 #endif
 
-{- Gets the size of the file, when its FileStatus is already known. -}
+{- Gets the size of the file, when its FileStatus is already known.
+ -
+ - On windows, uses getFileSize. Otherwise, the FileStatus contains the
+ - size, so this does not do any work. -}
 getFileSize' :: FilePath -> FileStatus -> IO FileSize
 #ifndef mingw32_HOST_OS
 getFileSize' _ s = return $ fromIntegral $ fileSize s

Utility/Hash.hs

@@ -24,6 +24,7 @@ module Utility.Hash (
 	blake2b_512,
 	blake2bp_512,
 	md5,
+	md5s,
 	prop_hashes_stable,
 	Mac(..),
 	calcMac,
@@ -106,6 +107,9 @@ blake2bp_512 = hashlazy
 md5 ::  L.ByteString -> Digest MD5
 md5 = hashlazy
 
+md5s ::  S.ByteString -> Digest MD5
+md5s = hash
+
 {- Check that all the hashes continue to hash the same. -}
 prop_hashes_stable :: Bool
 prop_hashes_stable = all (\(hasher, result) -> hasher foo == result)

Utility/InodeCache.hs

@@ -23,6 +23,7 @@ module Utility.InodeCache (
 	readInodeCache,
 	showInodeCache,
 	genInodeCache,
+	genInodeCache',
 	toInodeCache,
 
 	InodeCacheKey,
@@ -46,6 +47,7 @@ module Utility.InodeCache (
 import Common
 import Utility.TimeStamp
 import Utility.QuickCheck
+import qualified Utility.RawFilePath as R
 
 import System.PosixCompat.Types
 import Data.Time.Clock.POSIX
@@ -187,6 +189,10 @@ genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
 	toInodeCache delta f =<< getFileStatus f
 
+genInodeCache' :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
+genInodeCache' f delta = catchDefaultIO Nothing $
+	toInodeCache delta (fromRawFilePath f) =<< R.getFileStatus f
+
 toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache (TSDelta getdelta) f s
 	| isRegularFile s = do

Utility/Misc.hs

@@ -12,6 +12,7 @@ module Utility.Misc (
 	readFileStrict,
 	separate,
 	firstLine,
+	firstLine',
 	segment,
 	segmentDelim,
 	massReplace,
@@ -28,6 +29,7 @@ import Data.Char
 import Data.List
 import System.Exit
 import Control.Applicative
+import qualified Data.ByteString as S
 import Prelude
 
 {- A version of hgetContents that is not lazy. Ensures file is 
@@ -56,6 +58,11 @@ separate c l = unbreak $ break c l
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
 
+firstLine' :: S.ByteString -> S.ByteString
+firstLine' = S.takeWhile (/= nl)
+  where
+	nl = fromIntegral (ord '\n')
+
 {- Splits a list into segments that are delimited by items matching
  - a predicate. (The delimiters are not included in the segments.)
  - Segments may be empty. -}

Utility/Path.hs

@@ -43,6 +43,7 @@ import Utility.Monad
 import Utility.UserInfo
 import Utility.Directory
 import Utility.Split
+import Utility.FileSystemEncoding
 
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
@@ -200,20 +201,21 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
  - we stop preserving ordering at that point. Presumably a user passing
  - that many paths in doesn't care too much about order of the later ones.
  -}
-segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
+segmentPaths :: [RawFilePath] -> [RawFilePath] -> [[RawFilePath]]
 segmentPaths [] new = [new]
 segmentPaths [_] new = [new] -- optimisation
 segmentPaths (l:ls) new = found : segmentPaths ls rest
   where
 	(found, rest) = if length ls < 100
-		then partition (l `dirContains`) new
-		else break (\p -> not (l `dirContains` p)) new
+		then partition inl new
+		else break (not . inl) new
+	inl f = fromRawFilePath l `dirContains` fromRawFilePath f
 
 {- This assumes that it's cheaper to call segmentPaths on the result,
  - than it would be to run the action separately with each path. In
  - the case of git file list commands, that assumption tends to hold.
  -}
-runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
+runSegmentPaths :: ([RawFilePath] -> IO [RawFilePath]) -> [RawFilePath] -> IO [[RawFilePath]]
 runSegmentPaths a paths = segmentPaths paths <$> a paths
 
 {- Converts paths in the home directory to use ~/ -}

Utility/RawFilePath.hs

@@ -1,4 +1,11 @@
 {- Portability shim around System.Posix.Files.ByteString
+ -
+ - On unix, this makes syscalls using RawFilesPaths as efficiently as
+ - possible.
+ -
+ - On Windows, filenames are in unicode, so RawFilePaths have to be
+ - decoded. So this library will work, but less efficiently than using
+ - FilePath would.
  -
  - Copyright 2019 Joey Hess <id@joeyh.name>
  -
@@ -10,19 +17,20 @@
 module Utility.RawFilePath (
 	RawFilePath,
 	readSymbolicLink,
+	getFileStatus,
 ) where
 
 #ifndef mingw32_HOST_OS
+import Utility.FileSystemEncoding (RawFilePath)
 import System.Posix.Files.ByteString
-import System.Posix.ByteString.FilePath
 #else
 import qualified Data.ByteString as B
-import System.IO.Error
-
-type RawFilePath = B.ByteString
+import qualified System.PosixCompat as P
+import Utility.FileSystemEncoding
 
 readSymbolicLink :: RawFilePath -> IO RawFilePath
-readSymbolicLink _ = ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
-  where
-	x = "Utility.RawFilePath.readSymbolicLink: not supported"
+readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
+
+getFileStatus :: RawFilePath -> IO FileStatus
+getFileStatus = P.getFileStatus . fromRawFilePath
 #endif

Utility/SafeCommand.hs

@@ -7,7 +7,23 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.SafeCommand where
+module Utility.SafeCommand (
+	CommandParam(..),
+	toCommand,
+	boolSystem,
+	boolSystem',
+	boolSystemEnv,
+	safeSystem,
+	safeSystem',
+	safeSystemEnv,
+	shellWrap,
+	shellEscape,
+	shellUnEscape,
+	segmentXargsOrdered,
+	segmentXargsUnordered,
+	prop_isomorphic_shellEscape,
+	prop_isomorphic_shellEscape_multiword,
+) where
 
 import System.Exit
 import Utility.Process

Utility/Scheduled/QuickCheck.hs

@@ -7,7 +7,7 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Utility.Scheduled.QuickCheck where
+module Utility.Scheduled.QuickCheck (prop_schedule_roundtrips) where
 
 import Utility.Scheduled
 import Utility.QuickCheck

Utility/Shell.hs

@@ -7,7 +7,11 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.Shell where
+module Utility.Shell (
+	shellPath,
+	shebang,
+	findShellCommand,
+) where
 
 import Utility.SafeCommand
 #ifdef mingw32_HOST_OS

Utility/Split.hs

@@ -7,7 +7,12 @@
 
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Split where
+module Utility.Split (
+	split,
+	splitc,
+	replace,
+	dropFromEnd,
+) where
 
 import Data.List (intercalate)
 import Data.List.Split (splitOn)
@@ -29,6 +34,6 @@ splitc c s = case break (== c) s of
 replace :: Eq a => [a] -> [a] -> [a] -> [a] 
 replace old new = intercalate new . split old
 
--- | Only traverses the list once while dropping the last n characters.
+-- | Only traverses the list once while dropping the last n items.
 dropFromEnd :: Int -> [a] -> [a]
 dropFromEnd n l = zipWith const l (drop n l)

Utility/SshConfig.hs

@@ -5,7 +5,24 @@
  - License: BSD-2-clause
  -}
 
-module Utility.SshConfig where
+module Utility.SshConfig (
+	SshConfig(..),
+	Comment(..),
+	SshSetting(..),
+	Indent,
+	Host,
+	Key,
+	Value,
+	parseSshConfig,
+	genSshConfig,
+	findHostConfigKey,
+	addToHostConfig,
+	modifyUserSshConfig,
+	changeUserSshConfig,
+	writeSshConfig,
+	setSshConfigMode,
+	sshDir,
+) where
 
 import Common
 import Utility.UserInfo

Utility/TList.hs

@@ -11,7 +11,17 @@
 
 {-# LANGUAGE BangPatterns #-}
 
-module Utility.TList where
+module Utility.TList (
+	TList,
+	newTList,
+	getTList,
+	setTList,
+	takeTList,
+	readTList,
+	consTList,
+	snocTList,
+	appendTList,
+) where
 
 import Common
 

Utility/Tense.hs

@@ -7,7 +7,13 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Utility.Tense where
+module Utility.Tense (
+	Tense(..),
+	TenseChunk(..),
+	TenseText,
+	renderTense,
+	tenseWords,
+) where
 
 import qualified Data.Text as T
 import Data.Text (Text)
@@ -52,6 +58,3 @@ tenseWords = TenseText . go []
 	go c ((Tensed w1 w2):ws) =
 		go (Tensed (addspace w1) (addspace w2) : c) ws
 	addspace w = T.append w " "
-
-unTensed :: Text -> TenseText
-unTensed t = TenseText [UnTensed t]

Utility/ThreadLock.hs

@@ -5,7 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.ThreadLock where
+module Utility.ThreadLock (
+	Lock,
+	newLock,
+	withLock,
+) where
 
 import Control.Concurrent.MVar
 

Utility/ThreadScheduler.hs

@@ -8,7 +8,14 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.ThreadScheduler where
+module Utility.ThreadScheduler (
+	Seconds(..),
+	Microseconds,
+	runEvery,
+	threadDelaySeconds,
+	waitForTermination,
+	oneSecond,
+) where
 
 import Control.Monad
 import Control.Concurrent

Utility/TimeStamp.hs

@@ -5,7 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.TimeStamp where
+module Utility.TimeStamp (
+	parserPOSIXTime,
+	parsePOSIXTime,
+	formatPOSIXTime,
+) where
 
 import Utility.Data
 

Utility/Tmp.hs

@@ -8,7 +8,13 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Tmp where
+module Utility.Tmp (
+	Template,
+	viaTmp,
+	withTmpFile,
+	withTmpFileIn,
+	relatedTemplate,
+) where
 
 import System.IO
 import System.FilePath

Utility/Tmp/Dir.hs

@@ -8,7 +8,10 @@
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.Tmp.Dir where
+module Utility.Tmp.Dir (
+	withTmpDir,
+	withTmpDirIn,
+) where
 
 import Control.Monad.IfElse
 import System.FilePath

Utility/Tor.hs

@@ -7,7 +7,17 @@
 
 {-# LANGUAGE CPP #-}
 
-module Utility.Tor where
+module Utility.Tor (
+	OnionPort,
+	OnionAddress(..),
+	OnionSocket,
+	UniqueIdent,
+	AppName,
+	connectHiddenService,
+	addHiddenService,
+	getHiddenServiceSocketFile,
+	torIsInstalled,
+) where
 
 import Common
 import Utility.ThreadScheduler

Utility/Tuple.hs

@@ -5,7 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.Tuple where
+module Utility.Tuple (
+	fst3,
+	snd3,
+	thd3,
+) where
 
 fst3 :: (a,b,c) -> a
 fst3 (a,_,_) = a

Utility/Verifiable.hs

@@ -5,7 +5,14 @@
  - License: BSD-2-clause
  -}
 
-module Utility.Verifiable where
+module Utility.Verifiable (
+	Secret,
+	HMACDigest,
+	Verifiable(..),
+	mkVerifiable,
+	verify,
+	prop_verifiable_sane,
+) where
 
 import Data.ByteString.UTF8 (fromString)
 import qualified Data.ByteString as S

Utility/WebApp.hs

@@ -7,7 +7,14 @@
 
 {-# LANGUAGE OverloadedStrings, CPP, RankNTypes #-}
 
-module Utility.WebApp where
+module Utility.WebApp (
+	browserProc,
+	runWebApp,
+	webAppSessionBackend,
+	checkAuthToken,
+	insertAuthToken,
+	writeHtmlShim,
+) where
 
 import Common
 import Utility.Tmp
@@ -19,11 +26,9 @@ import qualified Network.Wai as Wai
 import Network.Wai.Handler.Warp
 import Network.Wai.Handler.WarpTLS
 import Network.HTTP.Types
-import qualified Data.CaseInsensitive as CI
 import Network.Socket
 import "crypto-api" Crypto.Random
 import qualified Web.ClientSession as CS
-import qualified Data.ByteString as B
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Blaze.ByteString.Builder.Char.Utf8 (fromText)
@@ -119,9 +124,6 @@ getSocket h = do
 		listen sock maxListenQueue
 		return sock
 
-lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
-lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
-
 {- Rather than storing a session key on disk, use a random key
  - that will only be valid for this run of the webapp. -}
 webAppSessionBackend :: Yesod.Yesod y => y -> IO (Maybe Yesod.SessionBackend)
@@ -188,7 +190,6 @@ insertAuthToken extractAuthToken predicate webapp root pathbits params =
 writeHtmlShim :: String -> String -> FilePath -> IO ()
 writeHtmlShim title url file = viaTmp writeFileProtected file $ genHtmlShim title url
 
-{- TODO: generate this static file using Yesod. -}
 genHtmlShim :: String -> String -> String
 genHtmlShim title url = unlines
 	[ "<html>"