packages feed

git-annex 7.20190708 → 7.20190730

raw patch · 50 files changed

+355/−469 lines, 50 filesdep ~QuickCheckdep ~awsdep ~base

Dependency ranges changed: QuickCheck, aws, base, bloomfilter, concurrent-output, cryptonite, feed, hinotify, http-client, http-conduit, optparse-applicative, persistent, persistent-sqlite, process, time, yesod-core

Files

Annex/DirHashes.hs view
@@ -2,7 +2,7 @@  -  - Copyright 2010-2017 Joey Hess <id@joeyh.name>  -- - Licensed under the GNU AGPL version 3 or higher.+ - Licensed under the GNU GPL version 3 or higher.  -}  module Annex.DirHashes (@@ -17,9 +17,8 @@ 	display_32bits_as_dir ) where -import Data.Bits-import Data.Word import Data.Default+import Data.Bits import qualified Data.ByteArray  import Common@@ -27,6 +26,7 @@ import Types.GitConfig import Types.Difference import Utility.Hash+import Utility.MD5  type Hasher = Key -> FilePath @@ -78,21 +78,3 @@ 		(shiftL b4 24 .|. shiftL b3 16 .|. shiftL b2 8 .|. b1) 		: encodeWord32 rest 	encodeWord32 _ = []--{- modified version of display_32bits_as_hex from Data.Hash.MD5- - in MissingH- -   Copyright (C) 2001 Ian Lynagh - -   License: Either BSD or GPL- -}-display_32bits_as_dir :: Word32 -> String-display_32bits_as_dir w = trim $ swap_pairs cs-  where-	-- Need 32 characters to use. To avoid inaverdently making-	-- a real word, use letters that appear less frequently.-	chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF"-	cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7]-	getc n = chars !! fromIntegral n-	swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs-	swap_pairs _ = []-	-- Last 2 will always be 00, so omit.-	trim = take 6
Annex/FileMatcher.hs view
@@ -173,8 +173,8 @@  mkLargeFilesParser :: Annex (String -> [ParseResult (MatchFiles Annex)]) mkLargeFilesParser = do-	magicmime <- liftIO initMagicMime #ifdef WITH_MAGICMIME+	magicmime <- liftIO initMagicMime 	let mimer n f = ValueToken n (usev $ f magicmime) #else 	let mimer n = ValueToken n $ 
Annex/Multicast.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Annex.Multicast where  import Config.Files@@ -16,9 +14,6 @@ import System.Process import System.IO import GHC.IO.Handle.FD-#if ! MIN_VERSION_process(1,4,2)-import System.Posix.IO (handleToFd)-#endif import Control.Applicative import Prelude @@ -28,14 +23,9 @@ multicastCallbackEnv :: IO (FilePath, [(String, String)], Handle) multicastCallbackEnv = do 	gitannex <- readProgramFile-#if MIN_VERSION_process(1,4,2) 	-- This will even work on Windows 	(rfd, wfd) <- createPipeFd 	rh <- fdToHandle rfd-#else-	(rh, wh) <- createPipe-	wfd <- handleToFd wh-#endif 	environ <- addEntry multicastReceiveEnv (show wfd) <$> getEnvironment 	return (gitannex, environ, rh) 
Annex/Url.hs view
@@ -22,6 +22,8 @@ import qualified BuildInfo  import Network.Socket+import Network.HTTP.Client+import Network.HTTP.Client.TLS  defaultUserAgent :: U.UserAgent defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion@@ -62,7 +64,8 @@ 				then U.DownloadWithConduit $ 					U.DownloadWithCurlRestricted mempty 				else U.DownloadWithCurl curlopts-			manager <- liftIO $ U.newManager U.managerSettings+			manager <- liftIO $ U.newManager $ +				avoidtimeout $ tlsManagerSettings 			return (urldownloader, manager) 		allowedaddrs -> do 			addrmatcher <- liftIO $ @@ -76,24 +79,28 @@ 				| isLoopbackAddress addr = False 				| isPrivateAddress addr = False 				| otherwise = True-			let connectionrestricted = addrConnectionRestricted +			let connectionrestricted = connectionRestricted  				("Configuration of annex.security.allowed-ip-addresses does not allow accessing address " ++)-			let r = Restriction-				{ checkAddressRestriction = \addr ->-					if isallowed (addrAddress addr)-						then Nothing-						else Just (connectionrestricted addr)-				}+			let r = addressRestriction $ \addr ->+				if isallowed (addrAddress addr)+					then Nothing+					else Just (connectionrestricted addr) 			(settings, pr) <- liftIO $ -				restrictManagerSettings r U.managerSettings+				mkRestrictedManagerSettings r Nothing Nothing 			case pr of 				Nothing -> return () 				Just ProxyRestricted -> toplevelWarning True 					"http proxy settings not used due to annex.security.allowed-ip-addresses configuration"-			manager <- liftIO $ U.newManager settings+			manager <- liftIO $ U.newManager $ +				avoidtimeout settings 			let urldownloader = U.DownloadWithConduit $ 				U.DownloadWithCurlRestricted r 			return (urldownloader, manager)+	+	-- http-client defailts to timing out a request after 30 seconds+	-- or so, but some web servers are slower and git-annex has its own+	-- separate timeout controls, so disable that.+	avoidtimeout s = s { managerResponseTimeout = responseTimeoutNone }  ipAddressesUnlimited :: Annex Bool ipAddressesUnlimited = 
Annex/WorkTree.hs view
@@ -19,7 +19,6 @@ import Config import Git.FilePath import qualified Git.Ref-import qualified Git.Branch import qualified Git.LsTree import qualified Git.Types import Database.Types@@ -73,13 +72,13 @@  -   - This is expensive, and so normally the associated files are updated  - incrementally when changes are noticed. So, this only needs to be done- - when initializing/upgrading a v6 mode repository.+ - when initializing/upgrading a v6+ mode repository.  -  - Also, the content for the unlocked file may already be present as  - an annex object. If so, make the unlocked file use that content.  -} scanUnlockedFiles :: Annex ()-scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do+scanUnlockedFiles = whenM (inRepo $ Git.Ref.exists Git.Ref.headRef) $ do 	showSideAction "scanning for unlocked files" 	Database.Keys.runWriter $ 		liftIO . Database.Keys.SQL.dropAllAssociatedFiles
Assistant/WebApp/Configurators/Ssh.hs view
@@ -5,8 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}-{-# LANGUAGE CPP, FlexibleContexts #-}+{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings, FlexibleContexts #-}  module Assistant.WebApp.Configurators.Ssh where @@ -378,10 +377,8 @@ 	 - is no controlling terminal. -} 	askPass environ p = p 		{ env = environ-#if MIN_VERSION_process(1,3,0) 		, detach_console = True 		, new_session = True-#endif 		}  	setupAskPass = do
Assistant/WebApp/Form.hs view
@@ -7,7 +7,6 @@  {-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses, TemplateHaskell #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings, RankNTypes #-}  module Assistant.WebApp.Form where@@ -68,11 +67,7 @@ 	ident = "toggle_" ++ toggle  {- Adds a check box to an AForm to control encryption. -}-#if MIN_VERSION_yesod_core(1,6,0) enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerFor site) EnableEncryption-#else-enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT site IO) EnableEncryption-#endif enableEncryptionField = areq (selectFieldList choices) (bfs "Encryption") (Just SharedEncryption)   where 	choices :: [(Text, EnableEncryption)]
Assistant/WebApp/Types.hs view
@@ -95,11 +95,7 @@ 		, liftAssistant $ liftAnnex a 		) -#if MIN_VERSION_yesod_core(1,6,0) instance LiftAnnex (WidgetFor WebApp) where-#else-instance LiftAnnex (WidgetT WebApp IO) where-#endif 	liftAnnex = liftH . liftAnnex  class LiftAssistant m where@@ -109,11 +105,7 @@ 	liftAssistant a = liftIO . flip runAssistant a 		=<< assistantData <$> getYesod -#if MIN_VERSION_yesod_core(1,6,0) instance LiftAssistant (WidgetFor WebApp) where-#else-instance LiftAssistant (WidgetT WebApp IO) where-#endif 	liftAssistant = liftH . liftAssistant  type MkMForm x = MForm Handler (FormResult x, Widget)
Backend/Hash.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Backend.Hash (@@ -34,11 +33,10 @@ 	| SHA2Hash HashSize 	| SHA3Hash HashSize 	| SkeinHash HashSize-#if MIN_VERSION_cryptonite(0,23,0) 	| Blake2bHash HashSize+	| Blake2bpHash HashSize 	| Blake2sHash HashSize 	| Blake2spHash HashSize-#endif  {- Order is slightly significant; want SHA256 first, and more general  - sizes earlier. -}@@ -47,11 +45,10 @@ 	[ map (SHA2Hash . HashSize) [256, 512, 224, 384] 	, map (SHA3Hash . HashSize) [256, 512, 224, 384] 	, map (SkeinHash . HashSize) [256, 512]-#if MIN_VERSION_cryptonite(0,23,0) 	, map (Blake2bHash . HashSize) [256, 512, 160, 224, 384]+	, map (Blake2bpHash . HashSize) [512] 	, map (Blake2sHash . HashSize) [256, 160, 224] 	, map (Blake2spHash . HashSize) [256, 224]-#endif 	, [SHA1Hash] 	, [MD5Hash] 	]@@ -82,11 +79,10 @@ hashKeyVariety (SHA2Hash size) he = SHA2Key size he hashKeyVariety (SHA3Hash size) he = SHA3Key size he hashKeyVariety (SkeinHash size) he = SKEINKey size he-#if MIN_VERSION_cryptonite(0,23,0) hashKeyVariety (Blake2bHash size) he = Blake2bKey size he+hashKeyVariety (Blake2bpHash size) he = Blake2bpKey size he hashKeyVariety (Blake2sHash size) he = Blake2sKey size he hashKeyVariety (Blake2spHash size) he = Blake2spKey size he-#endif  {- A key is a hash of its contents. -} keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)@@ -223,11 +219,10 @@ 		SHA2Hash hashsize -> sha2Hasher hashsize 		SHA3Hash hashsize -> sha3Hasher hashsize 		SkeinHash hashsize -> skeinHasher hashsize-#if MIN_VERSION_cryptonite(0,23,0) 		Blake2bHash hashsize -> blake2bHasher hashsize+		Blake2bpHash hashsize -> blake2bpHasher hashsize 		Blake2sHash hashsize -> blake2sHasher hashsize 		Blake2spHash hashsize -> blake2spHasher hashsize-#endif  sha2Hasher :: HashSize -> (L.ByteString -> String) sha2Hasher (HashSize hashsize)@@ -253,7 +248,6 @@ 	| hashsize == 512 = show . skein512 	| otherwise = error $ "unsupported SKEIN size " ++ show hashsize -#if MIN_VERSION_cryptonite(0,23,0) blake2bHasher :: HashSize -> (L.ByteString -> String) blake2bHasher (HashSize hashsize) 	| hashsize == 256 = show . blake2b_256@@ -263,6 +257,11 @@ 	| hashsize == 384 = show . blake2b_384 	| otherwise = error $ "unsupported BLAKE2B size " ++ show hashsize +blake2bpHasher :: HashSize -> (L.ByteString -> String)+blake2bpHasher (HashSize hashsize)+	| hashsize == 512 = show . blake2bp_512+	| otherwise = error $ "unsupported BLAKE2BP size " ++ show hashsize+ blake2sHasher :: HashSize -> (L.ByteString -> String) blake2sHasher (HashSize hashsize) 	| hashsize == 256 = show . blake2s_256@@ -275,7 +274,6 @@ 	| hashsize == 256 = show . blake2sp_256 	| hashsize == 224 = show . blake2sp_224 	| otherwise = error $ "unsupported BLAKE2SP size " ++ show hashsize-#endif  sha1Hasher :: L.ByteString -> String sha1Hasher = show . sha1
Build/BundledPrograms.hs view
@@ -54,13 +54,12 @@ 	, Just "git-upload-pack" 	, Just "git-receive-pack" 	, Just "git-shell"-#endif-#ifndef mingw32_HOST_OS 	-- using xargs on windows led to problems, so it's not used there 	, Just "xargs"-#endif+	-- rsync is not a core dependency, but good to have.+	-- On windows, bundling rsync required the build be used with a+	-- particular version of git for windows, so not included there. 	, Just "rsync"-#ifndef mingw32_HOST_OS 	, Just "sh" 	-- used by git-annex when available 	, Just "uname"
Build/Configure.hs view
@@ -23,7 +23,7 @@ 	, testCp "cp_a" "-a" 	, testCp "cp_p" "-p" 	, testCp "cp_preserve_timestamps" "--preserve=timestamps"-	, testCp "cp_reflink_auto" "--reflink=auto"+	, testCp "cp_reflink_supported" "--reflink=auto" 	, TestCase "xargs -0" $ testCmd "xargs_0" "xargs -0 </dev/null" 	, TestCase "rsync" $ testCmd "rsync" "rsync --version >/dev/null" 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"@@ -83,20 +83,6 @@ run ts = do 	setup 	config <- runTests ts-	v <- getEnv "CROSS_COMPILE"-	case v of-		Just "Android" -> writeSysConfig $ androidConfig config-		_ -> writeSysConfig config+	writeSysConfig config 	writeVersion =<< getVersion 	cleanup--{- Hard codes some settings to cross-compile for Android. -}-androidConfig :: [Config] -> [Config]-androidConfig c = overrides ++ filter (not . overridden) c-  where-	overrides = -		[ Config "cp_reflink_auto" $ BoolConfig False-		, Config "curl" $ BoolConfig False-		]-	overridden (Config k _) = k `elem` overridekeys-	overridekeys = map (\(Config k _) -> k) overrides
CHANGELOG view
@@ -1,3 +1,31 @@+git-annex (7.20190730) upstream; urgency=medium++  * Improved probing when CoW copies can be made between files on the same+    drive. Now supports CoW between BTRFS subvolumes. And, falls back to rsync+    instead of using cp when CoW won't work, eg copies between repos on the+    same EXT4 filesystem.+  * Add BLAKE2BP512 and BLAKE2BP512E backends, using a blake2 variant+    optimised for 4-way CPUs.+  * Support running v7 upgrade in a repo where there is no branch checked+    out, but HEAD is set directly to some other ref.+  * Windows build no longer ships with a copy of rsync, since that is only+    used any more to access rsync special remotes or remotes with a very+    old version of git-annex-shell.+  * Windows build is now 64 bit, and using it with the 64 bit git for+    Windows is fully supported.+  * Windows problems with long filenames should be fixed now,+    since the Windows build is made with a newer ghc version that works+    around the problems.+  * stack.yaml: Build with http-client-0.5.14 to get a bug fix to http header+    parsing.+  * Drop support for building with ghc older than 8.4.4,+    and with older versions of serveral haskell libraries.+  * Support building with socks-0.6 and persistant-template-2.7.+  * Corrected some license statements.+    Thanks, Sean Whitton.++ -- Joey Hess <id@joeyh.name>  Tue, 30 Jul 2019 12:22:25 -0400+ git-annex (7.20190708) upstream; urgency=medium    * Fix find --json to output json once more.
@@ -13,7 +13,7 @@ Files: Remote/Ddar.hs Copyright: © 2011 Joey Hess <id@joeyh.name>            © 2014 Robie Basak <robie@justgohome.co.uk>-License: AGPL-3++License: GPL-3+  Files: Utility/ThreadScheduler.hs Copyright: 2011 Bas van Dijk & Roel van Dijk@@ -36,10 +36,11 @@ License: icon-license   Free to modify and redistribute with due credit, and obviously free to use. -Files: Annex/DirHashes.hs+Files: Utility/MD5.hs Copyright: 2001 Ian Lynagh-           2010-2015 Joey Hess <id@joeyh.name>-License: AGPL-3++License: GPL-2+ The full text of version 2 of the GPL is distributed in+ /usr/share/common-licenses/GPL-2 on Debian systems.  Files: doc/tips/automatically_adding_metadata/pre-commit-annex  Copyright: 2014 Joey Hess <id@joeyh.name>
CmdLine/GitAnnex/Options.hs view
@@ -5,14 +5,11 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}  module CmdLine.GitAnnex.Options where  import Options.Applicative-#if ! MIN_VERSION_optparse_applicative(0,14,1)-import Options.Applicative.Builder.Internal-#endif import qualified Data.Map as M  import Annex.Common
Command/ImportFeed.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Command.ImportFeed where@@ -17,9 +16,6 @@ import qualified Data.Map as M import Data.Time.Clock import Data.Time.Format-#if ! MIN_VERSION_time(1,5,0)-import System.Locale-#endif import qualified Data.Text as T import System.Log.Logger @@ -140,10 +136,10 @@ 	mk i = case getItemEnclosure i of 		Just (enclosureurl, _, _) -> 			Just $ ToDownload f u i $ Enclosure $ -				fromFeed enclosureurl+				T.unpack enclosureurl 		Nothing -> case getItemLink i of 			Just link -> Just $ ToDownload f u i $ -				MediaLink $ fromFeed link+				MediaLink $ T.unpack link 			Nothing -> Nothing  {- Feeds change, so a feed download cannot be resumed. -}@@ -218,7 +214,7 @@  	knownitemid = case getItemId (item todownload) of 		Just (_, itemid) ->-			S.member (fromFeed itemid) (knownitems cache)+			S.member (T.unpack itemid) (knownitems cache) 		_ -> False  	rundownload url extension getter = do@@ -319,7 +315,7 @@ 		Just (Just d) -> Just $ 			formatTime defaultTimeLocale "%F" d 		-- if date cannot be parsed, use the raw string-		_ -> replace "/" "-" . fromFeed+		_ -> replace "/" "-" . T.unpack 			<$> getItemPublishDateString itm  extractMetaData :: ToDownload -> MetaData@@ -334,7 +330,7 @@ minimalMetaData i = case getItemId (item i) of 	(Nothing) -> emptyMetaData 	(Just (_, itemid)) -> MetaData $ M.singleton itemIdField -		(S.singleton $ toMetaValue $ encodeBS $ fromFeed itemid)+		(S.singleton $ toMetaValue $ encodeBS $ T.unpack itemid)  {- Extract fields from the feed and item, that are both used as metadata,  - and to generate the filename. -}@@ -344,18 +340,18 @@ 	, ("itemtitle", [itemtitle]) 	, ("feedauthor", [feedauthor]) 	, ("itemauthor", [itemauthor])-	, ("itemsummary", [fromFeed <$> getItemSummary (item i)])-	, ("itemdescription", [fromFeed <$> getItemDescription (item i)])-	, ("itemrights", [fromFeed <$> getItemRights (item i)])-	, ("itemid", [fromFeed . snd <$> getItemId (item i)])+	, ("itemsummary", [T.unpack <$> getItemSummary (item i)])+	, ("itemdescription", [T.unpack <$> getItemDescription (item i)])+	, ("itemrights", [T.unpack <$> getItemRights (item i)])+	, ("itemid", [T.unpack . snd <$> getItemId (item i)]) 	, ("title", [itemtitle, feedtitle]) 	, ("author", [itemauthor, feedauthor]) 	]   where-	feedtitle = Just $ fromFeed $ getFeedTitle $ feed i-	itemtitle = fromFeed <$> getItemTitle (item i)-	feedauthor = fromFeed <$> getFeedAuthor (feed i)-	itemauthor = fromFeed <$> getItemAuthor (item i)+	feedtitle = Just $ T.unpack $ getFeedTitle $ feed i+	itemtitle = T.unpack <$> getItemTitle (item i)+	feedauthor = T.unpack <$> getFeedAuthor (feed i)+	itemauthor = T.unpack <$> getItemAuthor (item i)  itemIdField :: MetaField itemIdField = mkMetaFieldUnchecked "itemid"@@ -408,11 +404,3 @@  feedState :: URLString -> Annex FilePath feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing--#if MIN_VERSION_feed(1,0,0)-fromFeed :: T.Text -> String-fromFeed = T.unpack-#else-fromFeed :: String -> String-fromFeed = id-#endif
Command/Info.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}  module Command.Info where @@ -68,9 +68,6 @@  instance Monoid KeyData where 	mempty = KeyData 0 0 0 M.empty-#if ! MIN_VERSION_base(4,11,0)-	mappend = (Sem.<>)-#endif  data NumCopiesStats = NumCopiesStats 	{ numCopiesVarianceMap :: M.Map Variance Integer
Command/Log.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Command.Log where  import qualified Data.Set as S@@ -14,9 +12,6 @@ import Data.Char import Data.Time.Clock.POSIX import Data.Time-#if ! MIN_VERSION_time(1,5,0)-import System.Locale-#endif  import Command import Logs@@ -273,11 +268,7 @@  parseTimeStamp :: String -> POSIXTime parseTimeStamp = utcTimeToPOSIXSeconds . fromMaybe (error "bad timestamp") .-#if MIN_VERSION_time(1,5,0) 	parseTimeM True defaultTimeLocale "%s"-#else-	parseTime defaultTimeLocale "%s"-#endif  showTimeStamp :: TimeZone -> POSIXTime -> String showTimeStamp zone = formatTime defaultTimeLocale rfc822DateFormat 
Database/ContentIdentifier.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts, EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.ContentIdentifier ( 	ContentIdentifierHandle,
Database/Export.hs view
@@ -9,7 +9,7 @@ {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.Export ( 	ExportHandle,@@ -130,11 +130,7 @@ 	let edirs = map 		(\ed -> ExportedDirectory (toSFilePath (fromExportDirectory ed)) ef) 		(exportDirectories el)-#if MIN_VERSION_persistent(2,8,1) 	putMany edirs-#else-	mapM_ insertUnique edirs-#endif   where 	ik = toIKey k 	ef = toSFilePath (fromExportLocation el)
Database/Fsck.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.Fsck ( 	FsckHandle,
Database/Init.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Database.Init where  import Annex.Common@@ -16,11 +14,7 @@ import Database.Persist.Sqlite import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T-#if MIN_VERSION_persistent_sqlite(2,6,2) import Lens.Micro-#else-import qualified Database.Sqlite as Sqlite-#endif  {- Ensures that the database is freshly initialized. Deletes any  - existing database. Pass the migration action for the database.@@ -38,12 +32,7 @@ 	let tdb = T.pack tmpdb	 	liftIO $ do 		createDirectoryIfMissing True tmpdbdir-#if MIN_VERSION_persistent_sqlite(2,6,2) 		runSqliteInfo (enableWAL tdb) migration-#else-		enableWAL tdb-		runSqlite tdb migration-#endif 	setAnnexDirPerm tmpdbdir 	-- Work around sqlite bug that prevents it from honoring 	-- less restrictive umasks.@@ -61,16 +50,6 @@  -  - Note that once WAL mode is enabled, it will persist whenever the  - database is opened. -}-#if MIN_VERSION_persistent_sqlite(2,6,2) enableWAL :: T.Text -> SqliteConnectionInfo enableWAL db = over walEnabled (const True) $  	mkSqliteConnectionInfo db-#else-enableWAL :: T.Text -> IO ()-enableWAL db = do-	conn <- Sqlite.open db-	stmt <- Sqlite.prepare conn (T.pack "PRAGMA journal_mode=WAL;")-	void $ Sqlite.step stmt-	void $ Sqlite.finalize stmt-	Sqlite.close conn-#endif
Database/Keys/SQL.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}  module Database.Keys.SQL where 
Git/Branch.hs view
@@ -21,7 +21,7 @@  -  - In a just initialized git repo before the first commit,  - symbolic-ref will show the master branch, even though that- - branch is not created yet. So, this also looks at show-ref HEAD+ - branch is not created yet. So, this also looks at show-ref  - to double-check.  -} current :: Repo -> IO (Maybe Branch)
Git/Fsck.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE BangPatterns, CPP #-}+{-# LANGUAGE BangPatterns #-}  module Git.Fsck ( 	FsckResults(..),@@ -61,9 +61,6 @@  instance Monoid FsckOutput where 	mempty = NoFsckOutput-#if ! MIN_VERSION_base(4,11,0)-	mappend = (Sem.<>)-#endif  {- Runs fsck to find some of the broken objects in the repository.  - May not find all broken objects, if fsck fails on bad data in some of
Messages/Concurrent.hs view
@@ -119,12 +119,8 @@ #endif  {- Hide any currently displayed console regions while running the action,- - so that the action can use the console itself.- - This needs a new enough version of concurrent-output; otherwise- - the regions will not be hidden, but the action still runs, garbling the- - display. -}+ - so that the action can use the console itself. -} hideRegionsWhile :: MessageState -> Annex a -> Annex a-#if MIN_VERSION_concurrent_output(1,9,0) hideRegionsWhile s a  	| concurrentOutputEnabled s = bracketIO setup cleanup go 	| otherwise = a@@ -134,6 +130,3 @@ 	go _ = do 		liftIO $ hFlush stdout 		a-#else-hideRegionsWhile _ = id-#endif
Remote/Ddar.hs view
@@ -3,7 +3,7 @@  - Copyright 2011 Joey Hess <id@joeyh.name>  - Copyright 2014 Robie Basak <robie@justgohome.co.uk>  -- - Licensed under the GNU AGPL version 3 or higher.+ - Licensed under the GNU GPL version 3 or higher.  -}  module Remote.Ddar (remote) where
Remote/Git.hs view
@@ -1,6 +1,6 @@ {- Standard git remotes.  -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -335,7 +335,7 @@ 	inAnnex' repo rmt st key  inAnnex' :: Git.Repo -> Remote -> State -> Key -> Annex Bool-inAnnex' repo rmt (State connpool duc _) key+inAnnex' repo rmt (State connpool duc _ _) key 	| Git.repoIsHttp repo = checkhttp 	| Git.repoIsUrl repo = checkremote 	| otherwise = checklocal@@ -382,7 +382,7 @@ 		(\e -> warning (show e) >> return False)  dropKey' :: Git.Repo -> Remote -> State -> Key -> Annex Bool-dropKey' repo r (State connpool duc _) key+dropKey' repo r (State connpool duc _ _) key 	| not $ Git.repoIsUrl repo = ifM duc 		( guardUsable repo (return False) $ 			commitOnCleanup repo r $ onLocalFast repo r $ do@@ -406,7 +406,7 @@ 	lockKey' repo r st key callback  lockKey' :: Git.Repo -> Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r-lockKey' repo r (State connpool duc _) key callback+lockKey' repo r (State connpool duc _ _) key callback 	| not $ Git.repoIsUrl repo = ifM duc 		( guardUsable repo failedlock $ do 			inorigrepo <- Annex.makeRunner@@ -474,7 +474,7 @@ 	copyFromRemote'' repo forcersync r st key file dest meterupdate  copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)-copyFromRemote'' repo forcersync r (State connpool _ _) key file dest meterupdate+copyFromRemote'' repo forcersync r st@(State connpool _ _ _) key file dest meterupdate 	| Git.repoIsHttp repo = unVerified $ do 		gc <- Annex.getGitConfig 		Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest@@ -489,7 +489,7 @@ 			case v of 				Nothing -> return (False, UnVerified) 				Just (object, checksuccess) -> do-					copier <- mkCopier hardlink params+					copier <- mkCopier hardlink st params 					runTransfer (Transfer Download u key) 						file stdRetry 						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess)@@ -600,7 +600,7 @@ 	copyToRemote' repo r st key file meterupdate  copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-copyToRemote' repo r (State connpool duc _) key file meterupdate+copyToRemote' repo r st@(State connpool duc _ _) key file meterupdate 	| not $ Git.repoIsUrl repo = ifM duc 		( guardUsable repo (return False) $ commitOnCleanup repo r $ 			copylocal =<< Annex.Content.prepSendAnnex key@@ -627,7 +627,7 @@ 			( return True 			, do 				ensureInitialized-				copier <- mkCopier hardlink params+				copier <- mkCopier hardlink st params 				let verify = Annex.Content.RemoteVerify r 				let rsp = RetrievalAllKeysSecure 				runTransfer (Transfer Download u key) file stdRetry $ \p ->@@ -704,27 +704,46 @@ onLocalFast :: Git.Repo -> Remote -> Annex a -> Annex a onLocalFast repo r a = onLocal repo r $ Annex.BranchState.disableUpdate >> a -{- Copys a file with rsync unless both locations are on the same- - filesystem. Then cp could be faster. -}-rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool-rsyncOrCopyFile rsyncparams src dest p =+-- To avoid the overhead of trying copy-on-write every time, it's tried+-- once and if it fails, is not tried again.+newtype CopyCoWTried = CopyCoWTried (MVar Bool)++newCopyCoWTried :: IO CopyCoWTried+newCopyCoWTried = CopyCoWTried <$> newEmptyMVar++{- Copys a file. Uses copy-on-write if it is supported. Otherwise,+ - uses rsync, so that interrupted copies can be resumed. -}+rsyncOrCopyFile :: State -> [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool+rsyncOrCopyFile st rsyncparams src dest p = #ifdef mingw32_HOST_OS-	-- rsync is only available on Windows in some inatallation methods,+	-- rsync is only available on Windows in some installation methods, 	-- and is not strictly needed here, so don't use it.-	docopy+	docopywith copyFileExternal   where #else-	ifM (sameDeviceIds src dest) (docopy, dorsync)+	-- If multiple threads reach this at the same time, they+	-- will both try CoW, which is acceptable.+	ifM (liftIO $ isEmptyMVar copycowtried)+		( do+			ok <- docopycow+			void $ liftIO $ tryPutMVar copycowtried ok+			pure ok <||> dorsync+		, ifM (liftIO $ readMVar copycowtried)+			( docopycow <||> dorsync+			, dorsync+			)+		)   where-	sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b-	getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)+	copycowtried = case st of+		State _ _ (CopyCoWTried v) _ -> v 	dorsync = do 		oh <- mkOutputHandler 		Ssh.rsyncHelper oh (Just p) $ 			rsyncparams ++ [File src, File dest]+	docopycow = docopywith copyCoW #endif-	docopy = liftIO $ watchFileSize dest p $-		copyFileExternal CopyTimeStamps src dest+	docopywith a = liftIO $ watchFileSize dest p $+		a CopyTimeStamps src dest  commitOnCleanup :: Git.Repo -> Remote -> Annex a -> Annex a commitOnCleanup repo r a = go `after` a@@ -768,10 +787,10 @@ -- done. type Copier = FilePath -> FilePath -> MeterUpdate -> Annex Bool -> Annex (Bool, Verification) -mkCopier :: Bool -> [CommandParam] -> Annex Copier-mkCopier remotewanthardlink rsyncparams = do+mkCopier :: Bool -> State -> [CommandParam] -> Annex Copier+mkCopier remotewanthardlink st rsyncparams = do 	let copier = \src dest p check -> unVerified $-		rsyncOrCopyFile rsyncparams src dest p <&&> check+		rsyncOrCopyFile st rsyncparams src dest p <&&> check 	localwanthardlink <- wantHardLink 	let linker = \src dest -> createLink src dest >> return True 	ifM (pure (remotewanthardlink || localwanthardlink) <&&> not <$> isDirect)@@ -790,20 +809,21 @@  - This returns False when the repository UUID is not as expected. -} type DeferredUUIDCheck = Annex Bool -data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck (Annex (Git.Repo, GitConfig))+data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck CopyCoWTried (Annex (Git.Repo, GitConfig))  getRepoFromState :: State -> Annex Git.Repo-getRepoFromState (State _ _ a) = fst <$> a+getRepoFromState (State _ _ _ a) = fst <$> a  {- The config of the remote git repository, cached for speed. -} getGitConfigFromState :: State -> Annex GitConfig-getGitConfigFromState (State _ _ a) = snd <$> a+getGitConfigFromState (State _ _ _ a) = snd <$> a  mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State mkState r u gc = do 	pool <- Ssh.mkP2PSshConnectionPool+	copycowtried <- liftIO newCopyCoWTried 	(duc, getrepo) <- go-	return $ State pool duc getrepo+	return $ State pool duc copycowtried getrepo   where 	go 		| remoteAnnexCheckUUID gc = return
Remote/S3.hs view
@@ -247,7 +247,6 @@ 		return (Nothing, vid) #endif 	multipartupload fsz partsz = runResourceT $ do-#if MIN_VERSION_aws(0,16,0) 		contenttype <- liftIO getcontenttype 		let startreq = (S3.postInitiateMultipartUpload (bucket info) object) 				{ S3.imuStorageClass = Just (storageClass info)@@ -287,10 +286,6 @@ 		resp <- sendS3Handle h $ S3.postCompleteMultipartUpload 			(bucket info) object uploadid (zip [1..] etags) 		return (Just (S3.cmurETag resp), mkS3VersionID object (S3.cmurVersionId resp))-#else-		warningIO $ "Cannot do multipart upload (partsize " ++ show partsz ++ ") of large file (" ++ show fsz ++ "); built with too old a version of the aws library."-		singlepartupload-#endif 	getcontenttype = maybe (pure Nothing) (flip getMagicMimeType f) magic  {- Implemented as a fileRetriever, that uses conduit to stream the chunks@@ -735,10 +730,7 @@ 	case mcreds of 		Just creds -> do 			awscreds <- liftIO $ genCredentials creds-			let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper-#if MIN_VERSION_aws(0,17,0)-				Nothing-#endif+			let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper Nothing 			ou <- getUrlOptions 			return $ Just $ S3Handle (httpManager ou) awscfg s3cfg 		Nothing -> return Nothing
Remote/WebDAV.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}  module Remote.WebDAV (remote, davCreds, configUrl) where@@ -16,9 +15,8 @@ import qualified Data.ByteString.UTF8 as B8 import qualified Data.ByteString.Lazy.UTF8 as L8 import Network.HTTP.Client (HttpException(..), RequestBody)-#if MIN_VERSION_http_client(0,5,0) import qualified Network.HTTP.Client as HTTP-#endif+import Network.HTTP.Client (HttpExceptionContent(..), responseStatus) import Network.HTTP.Types import System.IO.Error import Control.Monad.Catch@@ -42,10 +40,6 @@ import Annex.UUID import Remote.WebDAV.DavLocation -#if MIN_VERSION_http_client(0,5,0)-import Network.HTTP.Client (HttpExceptionContent(..), responseStatus)-#endif- remote :: RemoteType remote = RemoteType 	{ typename = "webdav"@@ -415,7 +409,6 @@ {- Catch StatusCodeException and trim it to only the statusMessage part,  - eliminating a lot of noise, which can include the whole request that  - failed. The rethrown exception is no longer a StatusCodeException. -}-#if MIN_VERSION_http_client(0,5,0) prettifyExceptions :: DAVT IO a -> DAVT IO a prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go   where@@ -428,17 +421,6 @@ 		, show (HTTP.path req) 		] 	go e = throwM e-#else-prettifyExceptions :: DAVT IO a -> DAVT IO a-prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go-  where-	go (StatusCodeException status _ _) = giveup $ unwords-		[ "DAV failure:"-		, show (statusCode status)-		, show (statusMessage status)-		]-	go e = throwM e-#endif  prepDAV :: DavUser -> DavPass -> DAVT IO () prepDAV user pass = do
Types/DesktopNotify.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Types.DesktopNotify where  import Data.Monoid@@ -25,9 +23,6 @@  instance Monoid DesktopNotify where 	mempty = DesktopNotify False False-#if ! MIN_VERSION_base(4,11,0)-	mappend = (Sem.<>)-#endif  mkNotifyStart :: DesktopNotify mkNotifyStart = DesktopNotify True False
Types/Difference.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Types.Difference ( 	Difference(..), 	Differences(..),@@ -83,9 +81,6 @@  instance Monoid Differences where 	mempty = Differences False False False-#if ! MIN_VERSION_base(4,11,0)-	mappend = (Sem.<>)-#endif  readDifferences :: String -> Differences readDifferences = maybe UnknownDifferences mkDifferences . readish
Types/Key.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Types.Key where@@ -37,6 +36,7 @@ 	| SHA3Key HashSize HasExt 	| SKEINKey HashSize HasExt 	| Blake2bKey HashSize HasExt+	| Blake2bpKey HashSize HasExt 	| Blake2sKey HashSize HasExt 	| Blake2spKey HashSize HasExt 	| SHA1Key HasExt@@ -61,6 +61,7 @@ hasExt (SHA3Key _ (HasExt b)) = b hasExt (SKEINKey _ (HasExt b)) = b hasExt (Blake2bKey _ (HasExt b)) = b+hasExt (Blake2bpKey _ (HasExt b)) = b hasExt (Blake2sKey _ (HasExt b)) = b hasExt (Blake2spKey _ (HasExt b)) = b hasExt (SHA1Key (HasExt b)) = b@@ -74,6 +75,7 @@ sameExceptExt (SHA3Key sz1 _) (SHA3Key sz2 _) = sz1 == sz2 sameExceptExt (SKEINKey sz1 _) (SKEINKey sz2 _) = sz1 == sz2 sameExceptExt (Blake2bKey sz1 _) (Blake2bKey sz2 _) = sz1 == sz2+sameExceptExt (Blake2bpKey sz1 _) (Blake2bpKey sz2 _) = sz1 == sz2 sameExceptExt (Blake2sKey sz1 _) (Blake2sKey sz2 _) = sz1 == sz2 sameExceptExt (Blake2spKey sz1 _) (Blake2spKey sz2 _) = sz1 == sz2 sameExceptExt (SHA1Key _) (SHA1Key _) = True@@ -87,6 +89,7 @@ cryptographicallySecure (SHA3Key _ _) = True cryptographicallySecure (SKEINKey _ _) = True cryptographicallySecure (Blake2bKey _ _) = True+cryptographicallySecure (Blake2bpKey _ _) = True cryptographicallySecure (Blake2sKey _ _) = True cryptographicallySecure (Blake2spKey _ _) = True cryptographicallySecure _ = False@@ -100,6 +103,7 @@ isVerifiable (SHA3Key _ _) = True isVerifiable (SKEINKey _ _) = True isVerifiable (Blake2bKey _ _) = True+isVerifiable (Blake2bpKey _ _) = True isVerifiable (Blake2sKey _ _) = True isVerifiable (Blake2spKey _ _) = True isVerifiable (SHA1Key _) = True@@ -114,6 +118,7 @@ 	SHA3Key sz e -> adde e (addsz sz "SHA3_") 	SKEINKey sz e -> adde e (addsz sz "SKEIN") 	Blake2bKey sz e -> adde e (addsz sz "BLAKE2B")+	Blake2bpKey sz e -> adde e (addsz sz "BLAKE2BP") 	Blake2sKey sz e -> adde e (addsz sz "BLAKE2S") 	Blake2spKey sz e -> adde e (addsz sz "BLAKE2SP") 	SHA1Key e -> adde e "SHA1"@@ -155,7 +160,6 @@ parseKeyVariety "SKEIN512E"    = SKEINKey (HashSize 512) (HasExt True) parseKeyVariety "SKEIN256"     = SKEINKey (HashSize 256) (HasExt False) parseKeyVariety "SKEIN256E"    = SKEINKey (HashSize 256) (HasExt True)-#if MIN_VERSION_cryptonite(0,23,0) parseKeyVariety "BLAKE2B160"   = Blake2bKey (HashSize 160) (HasExt False) parseKeyVariety "BLAKE2B160E"  = Blake2bKey (HashSize 160) (HasExt True) parseKeyVariety "BLAKE2B224"   = Blake2bKey (HashSize 224) (HasExt False)@@ -166,6 +170,8 @@ parseKeyVariety "BLAKE2B384E"  = Blake2bKey (HashSize 384) (HasExt True) parseKeyVariety "BLAKE2B512"   = Blake2bKey (HashSize 512) (HasExt False) parseKeyVariety "BLAKE2B512E"  = Blake2bKey (HashSize 512) (HasExt True)+parseKeyVariety "BLAKE2BP512"  = Blake2bpKey (HashSize 512) (HasExt False)+parseKeyVariety "BLAKE2BP512E" = Blake2bpKey (HashSize 512) (HasExt True) parseKeyVariety "BLAKE2S160"   = Blake2sKey (HashSize 160) (HasExt False) parseKeyVariety "BLAKE2S160E"  = Blake2sKey (HashSize 160) (HasExt True) parseKeyVariety "BLAKE2S224"   = Blake2sKey (HashSize 224) (HasExt False)@@ -176,7 +182,6 @@ parseKeyVariety "BLAKE2SP224E" = Blake2spKey (HashSize 224) (HasExt True) parseKeyVariety "BLAKE2SP256"  = Blake2spKey (HashSize 256) (HasExt False) parseKeyVariety "BLAKE2SP256E" = Blake2spKey (HashSize 256) (HasExt True)-#endif parseKeyVariety "SHA1"        = SHA1Key (HasExt False) parseKeyVariety "SHA1E"       = SHA1Key (HasExt True) parseKeyVariety "MD5"         = MD5Key (HasExt False)
Types/Test.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Types.Test where  import Test.Tasty.Options@@ -32,8 +30,5 @@  instance Monoid TestOptions where 	mempty = TestOptions mempty False False mempty-#if ! MIN_VERSION_base(4,11,0)-	mappend = (Sem.<>)-#endif  type TestRunner = TestOptions -> IO ()
Utility/Bloom.hs view
@@ -5,8 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-}- module Utility.Bloom ( 	Bloom, 	safeSuggestSizing,@@ -20,18 +18,12 @@ 	unsafeFreezeMB, ) where -#if MIN_VERSION_bloomfilter(2,0,0) import qualified Data.BloomFilter.Mutable as MBloom import qualified Data.BloomFilter as Bloom-#else-import qualified Data.BloomFilter as Bloom-#endif import Data.BloomFilter.Easy (safeSuggestSizing, Bloom) import Data.BloomFilter.Hash (Hashable(..), cheapHashes) import Control.Monad.ST (ST) -#if MIN_VERSION_bloomfilter(2,0,0)- notElemB :: a -> Bloom a -> Bool notElemB = Bloom.notElem @@ -46,22 +38,3 @@  unsafeFreezeMB :: MBloom.MBloom s a -> ST s (Bloom a) unsafeFreezeMB = Bloom.unsafeFreeze--#else--notElemB :: a -> Bloom a -> Bool-notElemB = Bloom.notElemB--elemB :: a -> Bloom a -> Bool-elemB = Bloom.elemB--newMB :: (a -> [Bloom.Hash]) -> Int -> ST s (Bloom.MBloom s a)-newMB = Bloom.newMB--insertMB :: Bloom.MBloom s a -> a -> ST s ()-insertMB = Bloom.insertMB--unsafeFreezeMB :: Bloom.MBloom s a -> ST s (Bloom a)-unsafeFreezeMB = Bloom.unsafeFreezeMB--#endif
Utility/CopyFile.hs view
@@ -1,12 +1,13 @@ {- file copying  -- - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}  module Utility.CopyFile ( 	copyFileExternal,+	copyCoW, 	createLinkOrCopy, 	CopyMetaData(..) ) where@@ -22,23 +23,52 @@ 	| CopyAllMetaData 	deriving (Eq) +copyMetaDataParams :: CopyMetaData -> [CommandParam]+copyMetaDataParams meta = map snd $ filter fst+	[ (allmeta && BuildInfo.cp_a, Param "-a")+	, (allmeta && BuildInfo.cp_p && not BuildInfo.cp_a+		, Param "-p")+	, (not allmeta && BuildInfo.cp_preserve_timestamps+		, Param "--preserve=timestamps")+	]+  where+	allmeta = meta == CopyAllMetaData+ {- The cp command is used, because I hate reinventing the wheel,  - and because this allows easy access to features like cp --reflink. -} copyFileExternal :: CopyMetaData -> FilePath -> FilePath -> IO Bool copyFileExternal meta src dest = do-	whenM (doesFileExist dest) $-		removeFile dest+	-- Delete any existing dest file because an unwritable file+	-- would prevent cp from working.+	void $ tryIO $ removeFile dest 	boolSystem "cp" $ params ++ [File src, File dest]   where-	params = map snd $ filter fst-		[ (BuildInfo.cp_reflink_auto, Param "--reflink=auto")-		, (allmeta && BuildInfo.cp_a, Param "-a")-		, (allmeta && BuildInfo.cp_p && not BuildInfo.cp_a-			, Param "-p")-		, (not allmeta && BuildInfo.cp_preserve_timestamps-			, Param "--preserve=timestamps")-		]-	allmeta = meta == CopyAllMetaData+	params+		| BuildInfo.cp_reflink_supported =+			Param "--reflink=auto" : copyMetaDataParams meta+		| otherwise = copyMetaDataParams meta++{- When a filesystem supports CoW (and cp does), uses it to make+ - an efficient copy of a file. Otherwise, returns False. -}+copyCoW :: CopyMetaData -> FilePath -> FilePath -> IO Bool+copyCoW meta src dest+	| BuildInfo.cp_reflink_supported = do+		void $ tryIO $ removeFile dest+		-- When CoW is not supported, cp will complain to stderr,+		-- so have to discard its stderr.+		ok <- catchBoolIO $ do+			withQuietOutput createProcessSuccess $+				proc "cp" $ toCommand $+					params ++ [File src, File dest]+			return True+		-- When CoW is not supported, cp creates the destination+		-- file but leaves it empty.+		unless ok $+			void $ tryIO $ removeFile dest+		return ok+	| otherwise = return False+  where+	params = Param "--reflink=always" : copyMetaDataParams meta  {- Create a hard link if the filesystem allows it, and fall back to copying  - the file. -}
Utility/DirWatcher/INotify.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {- higher-level inotify interface  -  - Copyright 2012 Joey Hess <id@joeyh.name>@@ -199,14 +197,8 @@ 			Just s -> return $ parsesysctl s 	parsesysctl s = readish =<< lastMaybe (words s) -#if MIN_VERSION_hinotify(0,3,10) toInternalFilePath :: FilePath -> RawFilePath toInternalFilePath = toRawFilePath+ fromInternalFilePath :: RawFilePath -> FilePath fromInternalFilePath = fromRawFilePath-#else-toInternalFilePath :: FilePath -> FilePath-toInternalFilePath = id-fromInternalFilePath :: FilePath -> FilePath-fromInternalFilePath = id-#endif
Utility/Hash.hs view
@@ -1,7 +1,5 @@ {- Convenience wrapper around cryptonite's hashing. -} -{-# LANGUAGE CPP #-}- module Utility.Hash ( 	sha1, 	sha2_224,@@ -14,7 +12,6 @@ 	sha3_512, 	skein256, 	skein512,-#if MIN_VERSION_cryptonite(0,23,0) 	blake2s_160, 	blake2s_224, 	blake2s_256,@@ -25,7 +22,7 @@ 	blake2b_256, 	blake2b_384, 	blake2b_512,-#endif+	blake2bp_512, 	md5, 	prop_hashes_stable, 	Mac(..),@@ -73,7 +70,6 @@ skein512 :: L.ByteString -> Digest Skein512_512 skein512 = hashlazy -#if MIN_VERSION_cryptonite(0,23,0) blake2s_160 :: L.ByteString -> Digest Blake2s_160 blake2s_160 = hashlazy @@ -103,11 +99,9 @@  blake2b_512 :: L.ByteString -> Digest Blake2b_512 blake2b_512 = hashlazy-#endif --- Disabled because it's buggy with some versions of cryptonite.---blake2bp_512 :: L.ByteString -> Digest Blake2bp_512---blake2bp_512 = hashlazy+blake2bp_512 :: L.ByteString -> Digest Blake2bp_512+blake2bp_512 = hashlazy  md5 ::  L.ByteString -> Digest MD5 md5 = hashlazy@@ -126,7 +120,6 @@ 	, (show . sha3_256, "76d3bc41c9f588f7fcd0d5bf4718f8f84b1c41b20882703100b9eb9413807c01") 	, (show . sha3_384, "665551928d13b7d84ee02734502b018d896a0fb87eed5adb4c87ba91bbd6489410e11b0fbcc06ed7d0ebad559e5d3bb5") 	, (show . sha3_512, "4bca2b137edc580fe50a88983ef860ebaca36c857b1f492839d6d7392452a63c82cbebc68e3b70a2a1480b4bb5d437a7cba6ecf9d89f9ff3ccd14cd6146ea7e7")-#if MIN_VERSION_cryptonite(0,23,0) 	, (show . blake2s_160, "52fb63154f958a5c56864597273ea759e52c6f00") 	, (show . blake2s_224, "9466668503ac415d87b8e1dfd7f348ab273ac1d5e4f774fced5fdb55") 	, (show . blake2s_256, "08d6cad88075de8f192db097573d0e829411cd91eb6ec65e8fc16c017edfdb74")@@ -137,8 +130,7 @@ 	, (show . blake2b_256, "b8fe9f7f6255a6fa08f668ab632a8d081ad87983c77cd274e48ce450f0b349fd") 	, (show . blake2b_384, "e629ee880953d32c8877e479e3b4cb0a4c9d5805e2b34c675b5a5863c4ad7d64bb2a9b8257fac9d82d289b3d39eb9cc2") 	, (show . blake2b_512, "ca002330e69d3e6b84a46a56a6533fd79d51d97a3bb7cad6c2ff43b354185d6dc1e723fb3db4ae0737e120378424c714bb982d9dc5bbd7a0ab318240ddd18f8d")-	--, (show . blake2bp_512, "")-#endif+	, (show . blake2bp_512, "8ca9ccee7946afcb686fe7556628b5ba1bf9a691da37ca58cd049354d99f37042c007427e5f219b9ab5063707ec6823872dee413ee014b4d02f2ebb6abb5f643") 	, (show . md5, "acbd18db4cc2f85cedef654fccc4a4d8") 	]   where
Utility/HttpManagerRestricted.hs view
@@ -1,20 +1,21 @@-{- | Restricted Manager for http-client-tls+{- | Restricted `ManagerSettings` for <https://haskell-lang.org/library/http-client>  -  - Copyright 2018 Joey Hess <id@joeyh.name>- - + -  - Portions from http-client-tls Copyright (c) 2013 Michael Snoyman  -  - License: MIT  -}  {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-}-{-# LANGUAGE CPP #-}  module Utility.HttpManagerRestricted (-	restrictManagerSettings,-	Restriction(..),+	Restriction,+	checkAddressRestriction,+	addressRestriction,+	mkRestrictedManagerSettings, 	ConnectionRestricted(..),-	addrConnectionRestricted,+	connectionRestricted, 	ProxyRestricted(..), 	IPAddrString, ) where@@ -22,24 +23,42 @@ import Network.HTTP.Client import Network.HTTP.Client.Internal 	(ManagerSettings(..), Connection, runProxyOverride, makeConnection)+import Network.HTTP.Client.TLS (mkManagerSettingsContext) import Network.Socket import Network.BSD (getProtocolNumber) import Control.Exception import qualified Network.Connection as NC import qualified Data.ByteString.UTF8 as BU+import Data.Maybe import Data.Default import Data.Typeable-import Control.Applicative-#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Sem-#endif import Data.Monoid+import Control.Applicative import Prelude +-- | Configuration of which HTTP connections to allow and which to+-- restrict. data Restriction = Restriction 	{ checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted 	} +-- | Decide if a HTTP connection is allowed based on the IP address+-- of the server.+--+-- After the restriction is checked, the same IP address is used+-- to connect to the server. This avoids DNS rebinding attacks+-- being used to bypass the restriction.+--+-- > myRestriction :: Restriction+-- > myRestriction = addressRestriction $ \addr ->+-- >	if isPrivateAddress addr+-- >		then Just $ connectionRestricted+-- >			("blocked connection to private IP address " ++)+-- > 		else Nothing+addressRestriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction+addressRestriction f = mempty { checkAddressRestriction = f }+ appendRestrictions :: Restriction -> Restriction -> Restriction appendRestrictions a b = Restriction 	{ checkAddressRestriction = \addr ->@@ -51,55 +70,90 @@ 	mempty = Restriction 		{ checkAddressRestriction = \_ -> Nothing 		}-#if MIN_VERSION_base(4,11,0)-#elif MIN_VERSION_base(4,9,0)-	mappend = (Sem.<>)-#else-	mappend = appendRestrictions-#endif -#if MIN_VERSION_base(4,9,0) instance Sem.Semigroup Restriction where 	(<>) = appendRestrictions-#endif --- | An exception used to indicate that the connection was restricted.+-- | Value indicating that a connection was restricted, and giving the+-- reason why. data ConnectionRestricted = ConnectionRestricted String 	deriving (Show, Typeable)  instance Exception ConnectionRestricted +-- | A string containing an IP address, for display to a user. type IPAddrString = String  -- | Constructs a ConnectionRestricted, passing the function a string--- containing the IP address.-addrConnectionRestricted :: (IPAddrString -> String) -> AddrInfo -> ConnectionRestricted-addrConnectionRestricted mkmessage = +-- containing the IP address of the HTTP server.+connectionRestricted :: (IPAddrString -> String) -> AddrInfo -> ConnectionRestricted+connectionRestricted mkmessage =  	ConnectionRestricted . mkmessage . showSockAddress . addrAddress +-- | Value indicating that the http proxy will not be used. data ProxyRestricted = ProxyRestricted 	deriving (Show) --- | Adjusts a ManagerSettings to enforce a Restriction. The restriction+-- Adjusts a ManagerSettings to enforce a Restriction. The restriction -- will be checked each time a Request is made, and for each redirect -- followed. --+-- This overrides the `managerRawConnection`+-- and `managerTlsConnection` with its own implementations that check +-- the Restriction. They should otherwise behave the same as the+-- ones provided by http-client-tls.+--+-- This function is not exported, because using it with a ManagerSettings+-- produced by something other than http-client-tls would result in+-- surprising behavior, since its connection methods would not be used.+-- -- The http proxy is also checked against the Restriction, and if -- access to it is blocked, the http proxy will not be used. restrictManagerSettings-	:: Restriction+	:: Maybe NC.ConnectionContext+	-> Maybe NC.TLSSettings+	-> Restriction 	-> ManagerSettings 	-> IO (ManagerSettings, Maybe ProxyRestricted)-restrictManagerSettings cfg base = restrictProxy cfg $ base+restrictManagerSettings mcontext mtls cfg base = restrictProxy cfg $ base 	{ managerRawConnection = restrictedRawConnection cfg-	, managerTlsConnection = restrictedTlsConnection cfg-#if MIN_VERSION_http_client(0,5,0)+	, managerTlsConnection = restrictedTlsConnection mcontext mtls cfg 	, managerWrapException = wrapOurExceptions base-#else-	, managerWrapIOException = wrapOurExceptions base-#endif 	} +-- | Makes a TLS-capable ManagerSettings with a Restriction applied to it.+--+-- The Restriction will be checked each time a Request is made, and for+-- each redirect followed.+--+-- Aside from checking the Restriction, it should behave the same as+-- `Network.HTTP.Client.TLS.mkManagerSettingsContext`+-- from http-client-tls.+--+-- > main = do+-- > 	manager <- newManager . fst +-- > 		=<< mkRestrictedManagerSettings myRestriction Nothing Nothing+-- >	request <- parseRequest "http://httpbin.org/get"+-- > 	response <- httpLbs request manager+-- > 	print $ responseBody response+--+-- The HTTP proxy is also checked against the Restriction, and will not be+-- used if the Restriction does not allow it. Just ProxyRestricted+-- is returned when the HTTP proxy has been restricted.+-- +-- See `mkManagerSettingsContext` for why+-- it can be useful to provide a `NC.ConnectionContext`.+-- +-- Note that SOCKS is not supported.+mkRestrictedManagerSettings+	:: Restriction+	-> Maybe NC.ConnectionContext+	-> Maybe NC.TLSSettings+	-> IO (ManagerSettings, Maybe ProxyRestricted)+mkRestrictedManagerSettings cfg mcontext mtls =+	restrictManagerSettings mcontext mtls cfg $+		mkManagerSettingsContext mcontext (fromMaybe def mtls) Nothing+ restrictProxy 	:: Restriction 	-> ManagerSettings@@ -159,7 +213,6 @@ 			, proxyPort = fromIntegral pn 			} -#if MIN_VERSION_http_client(0,5,0) wrapOurExceptions :: ManagerSettings -> Request -> IO a -> IO a wrapOurExceptions base req a = 	let wrapper se@@ -168,41 +221,26 @@ 				InternalException se 		| otherwise = se 	 in managerWrapException base req (handle (throwIO . wrapper) a)-#else-wrapOurExceptions :: ManagerSettings -> IO a -> IO a-wrapOurExceptions base a =-	let wrapper se = case fromException se of-		Just (_ :: ConnectionRestricted) ->-			-- Not really a TLS exception, but there is no-			-- way to put SomeException in the -			-- InternalIOException this old version uses.-			toException $ TlsException se-		Nothing -> se-	in managerWrapIOException base (handle (throwIO . wrapper) a)-#endif  restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)-restrictedRawConnection cfg = getConnection cfg Nothing--restrictedTlsConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)-restrictedTlsConnection cfg = getConnection cfg $-	-- It's not possible to access the TLSSettings-	-- used in the base ManagerSettings. So, use the default-	-- value, which is the same thing http-client-tls defaults to.-	-- Since changing from the default settings can only make TLS-	-- less secure, this is not a big problem.-	Just def-+restrictedRawConnection cfg = getConnection cfg Nothing Nothing +restrictedTlsConnection :: Maybe NC.ConnectionContext -> Maybe NC.TLSSettings -> Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)+restrictedTlsConnection mcontext mtls cfg = +	getConnection cfg (Just (fromMaybe def mtls)) mcontext  -- Based on Network.HTTP.Client.TLS.getTlsConnection. -- -- Checks the Restriction -- -- Does not support SOCKS.-getConnection :: Restriction -> Maybe NC.TLSSettings -> IO (Maybe HostAddress -> String -> Int -> IO Connection)-getConnection cfg tls = do-	context <- NC.initConnectionContext+getConnection+	:: Restriction+	-> Maybe NC.TLSSettings+	-> Maybe NC.ConnectionContext+	-> IO (Maybe HostAddress -> String -> Int -> IO Connection)+getConnection cfg tls mcontext = do+	context <- maybe NC.initConnectionContext return mcontext 	return $ \_ha h p -> bracketOnError 		(go context h p) 		NC.connectionClose
+ Utility/MD5.hs view
@@ -0,0 +1,23 @@+{- modified version of MD5 from http://www.cs.ox.ac.uk/people/ian.lynagh/md5+ -+ - Copyright (C) 2001 Ian Lynagh + - License: GPL 2+ -}++module Utility.MD5 where++import Data.Bits+import Data.Word++display_32bits_as_dir :: Word32 -> String+display_32bits_as_dir w = trim $ swap_pairs cs+  where+	-- Need 32 characters to use. To avoid inaverdently making+	-- a real word, use letters that appear less frequently.+	chars = ['0'..'9'] ++ "zqjxkmvwgpfZQJXKMVWGPF"+	cs = map (\x -> getc $ (shiftR w (6*x)) .&. 31) [0..7]+	getc n = chars !! fromIntegral n+	swap_pairs (x1:x2:xs) = x2:x1:swap_pairs xs+	swap_pairs _ = []+	-- Last 2 will always be 00, so omit.+	trim = take 6
Utility/QuickCheck.hs view
@@ -5,7 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -18,9 +17,7 @@ import Data.Time.Clock.POSIX import Data.Ratio import System.Posix.Types-#if MIN_VERSION_QuickCheck(2,10,0) import Data.List.NonEmpty (NonEmpty(..))-#endif import Prelude  {- Times before the epoch are excluded. Half with decimal and half without. -}@@ -45,11 +42,8 @@ instance Arbitrary FileOffset where 	arbitrary = nonNegative arbitrarySizedIntegral -{- Latest Quickcheck lacks this instance. -}-#if MIN_VERSION_QuickCheck(2,10,0) instance Arbitrary l => Arbitrary (NonEmpty l) where 	arbitrary = (:|) <$> arbitrary <*> arbitrary-#endif  nonNegative :: (Num a, Ord a) => Gen a -> Gen a nonNegative g = g `suchThat` (>= 0)
Utility/TimeStamp.hs view
@@ -5,8 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-}- module Utility.TimeStamp where  import Utility.Data@@ -19,9 +17,6 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (char, decimal, signed, isDigit_w8)-#if ! MIN_VERSION_time(1,5,0)-import System.Locale-#endif  {- Parses how POSIXTime shows itself: "1431286201.113452s"  - (The "s" is included for historical reasons and is optional.)
Utility/Tor.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Utility.Tor where  import Common@@ -37,7 +39,12 @@ 	return s   where 	torsocksport = 9050+#if MIN_VERSION_socks(0,6,0)+	torsockconf = defaultSocksConf $ SockAddrInet torsocksport $+		tupleToHostAddress (127,0,0,1)+#else 	torsockconf = defaultSocksConf "127.0.0.1" torsocksport+#endif 	socksdomain = SocksAddrDomainName (BU8.fromString address) 	socksaddr = SocksAddress socksdomain (fromIntegral port) 
Utility/Url.hs view
@@ -5,14 +5,12 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-}  module Utility.Url ( 	newManager,-	managerSettings, 	URLString, 	UserAgent, 	Scheme,@@ -63,19 +61,6 @@ import Text.Read import System.Log.Logger -#if ! MIN_VERSION_http_client(0,5,0)-responseTimeoutNone :: Maybe Int-responseTimeoutNone = Nothing-#endif--managerSettings :: ManagerSettings-#if MIN_VERSION_http_conduit(2,1,7)-managerSettings = tlsManagerSettings-#else-managerSettings = conduitManagerSettings-#endif-	{ managerResponseTimeout = responseTimeoutNone }- type URLString = String  type Headers = [String]@@ -113,7 +98,7 @@ 	<*> pure [] 	<*> pure (DownloadWithConduit (DownloadWithCurlRestricted mempty)) 	<*> pure id-	<*> newManager managerSettings+	<*> newManager tlsManagerSettings 	<*> pure (S.fromList $ map mkScheme ["http", "https", "ftp"])  mkUrlOptions :: Maybe UserAgent -> Headers -> UrlDownloader -> Manager -> S.Set Scheme -> UrlOptions@@ -298,13 +283,8 @@ 				sz <- getFileSize' f stat 				found (Just sz) Nothing 			Nothing -> return dne-#if MIN_VERSION_http_client(0,5,0) 	followredir r (HttpExceptionRequest _ (StatusCodeException resp _)) =  		case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of-#else-	followredir r (StatusCodeException _ respheaders _) =-		case headMaybe $ map (decodeBS . snd) $ filter (\(h, _) -> h == hLocation) respheaders-#endif 			Just url' -> case parseURIRelaxed url' of 				-- only follow http to ftp redirects; 				-- http to file redirect would not be secure,@@ -427,7 +407,6 @@ 	showrespfailure = liftIO . dlfailed . B8.toString  		. statusMessage . responseStatus 	showhttpexception he = do-#if MIN_VERSION_http_client(0,5,0) 		let msg = case he of 			HttpExceptionRequest _ (StatusCodeException r _) -> 				B8.toString $ statusMessage $ responseStatus r@@ -437,12 +416,6 @@ 					Just (ConnectionRestricted why) -> why 			HttpExceptionRequest _ other -> show other 			_ -> show he-#else-		let msg = case he of-			StatusCodeException status _ _ -> -				B8.toString (statusMessage status)-			_ -> show he-#endif 		dlfailed msg 	dlfailed msg 		| noerror = return False@@ -480,13 +453,8 @@ 			L.writeFile file 		return True -#if MIN_VERSION_http_client(0,5,0) 	followredir r ex@(HttpExceptionRequest _ (StatusCodeException resp _)) =  		case headMaybe $ map decodeBS $ getResponseHeader hLocation resp of-#else-	followredir r ex@(StatusCodeException _ respheaders _) =-		case headMaybe $ map (decodeBS . snd) $ filter (\(h, _) -> h == hLocation) respheaders-#endif 			Just url' -> case parseURIRelaxed url' of 				Just u' | isftpurl u' -> 					checkPolicy uo u' False dlfailed $@@ -506,19 +474,11 @@ 	-> BytesProcessed 	-> FilePath 	-> IOMode-#if MIN_VERSION_http_conduit(2,3,0) 	-> Response (ConduitM () B8.ByteString m ())-#else-	-> Response (ResumableSource m B8.ByteString)-#endif 	-> m () sinkResponseFile meterupdate initialp file mode resp = do 	(fr, fh) <- allocate (openBinaryFile file mode) hClose-#if MIN_VERSION_http_conduit(2,3,0) 	runConduit $ responseBody resp .| go initialp fh-#else-	responseBody resp $$+- go initialp fh-#endif 	release fr   where 	go sofar fh = await >>= \case@@ -590,19 +550,11 @@ matchStatusCodeException :: (Status -> Bool) -> HttpException -> Maybe HttpException matchStatusCodeException want = matchStatusCodeHeadersException (\s _h -> want s) -#if MIN_VERSION_http_client(0,5,0) matchStatusCodeHeadersException :: (Status -> ResponseHeaders -> Bool) -> HttpException -> Maybe HttpException matchStatusCodeHeadersException want e@(HttpExceptionRequest _ (StatusCodeException r _)) 	| want (responseStatus r) (responseHeaders r) = Just e 	| otherwise = Nothing matchStatusCodeHeadersException _ _ = Nothing-#else-matchStatusCodeHeadersException :: (Status -> ResponseHeaders -> Bool) -> HttpException -> Maybe HttpException-matchStatusCodeHeadersException want e@(StatusCodeException s r _)-	| want s r = Just e-	| otherwise = Nothing-matchStatusCodeHeadersException _ _ = Nothing-#endif  {- Use with eg:   -@@ -611,18 +563,11 @@ matchHttpException :: HttpException -> Maybe HttpException matchHttpException = Just -#if MIN_VERSION_http_client(0,5,0) matchHttpExceptionContent :: (HttpExceptionContent -> Bool) -> HttpException -> Maybe HttpException matchHttpExceptionContent want e@(HttpExceptionRequest _ hec) 	| want hec = Just e 	| otherwise = Nothing matchHttpExceptionContent _ _ = Nothing-#else-matchHttpExceptionContent :: (HttpException -> Bool) -> HttpException -> Maybe HttpException-matchHttpExceptionContent want e-	| want e = Just e-	| otherwise = Nothing-#endif  {- Constructs parameters that prevent curl from accessing any IP addresses  - blocked by the Restriction. These are added to the input parameters,
Utility/Yesod.hs view
@@ -7,7 +7,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP, RankNTypes, FlexibleContexts #-}+{-# LANGUAGE RankNTypes, FlexibleContexts #-}  module Utility.Yesod  	( module Y@@ -34,9 +34,5 @@ hamletTemplate f = globFile "hamlet" f  {- Lift Handler to Widget -}-#if MIN_VERSION_yesod_core(1,6,0) liftH :: HandlerFor site a -> WidgetFor site a -#else-liftH :: Monad m => HandlerT site m a -> WidgetT site m a-#endif liftH = handlerToWidget
doc/git-annex-adjust.mdwn view
@@ -29,7 +29,7 @@ as necessary (eg for `--hide-missing`), and will also propagate commits back to the original branch. -This command can only be used in a v6 git-annex repository.+This command can only be used in a v7 git-annex repository.  # OPTIONS 
doc/git-annex-direct.mdwn view
@@ -17,7 +17,7 @@ run in direct mode repositories. Use `git annex proxy` to safely run such commands. -Note that the direct mode/indirect mode distinction is removed in v6+Note that the direct mode/indirect mode distinction is removed in v7 git-annex repositories. In such a repository, you can use [[git-annex-unlock]](1) to make a file's content be directly present. You can also use [[git-annex-adjust]](1) to enter a branch where all
doc/git-annex-indirect.mdwn view
@@ -11,7 +11,7 @@ Switches a repository back from direct mode to the default, indirect mode. -Note that the direct mode/indirect mode distinction is removed in v6+Note that the direct mode/indirect mode distinction is removed in v7 git-annex repositories.  # SEE ALSO
doc/git-annex-preferred-content.mdwn view
@@ -36,9 +36,9 @@    Match files to include, or exclude. -  While --include=glob and --exclude=glob match files relative to the current-  directory, preferred content expressions match files relative to the-  top of the git repository.+  While the command-line options --include=glob and --exclude=glob match+  files relative to the current directory, preferred content expressions+  match files relative to the top of the git repository.    For example, suppose you put files into `archive` directories   when you're done with them. Then you could configure your laptop to prefer
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20190708+Version: 7.20190730 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -294,22 +294,22 @@   location: git://git-annex.branchable.com/  custom-setup-  Setup-Depends: base (>= 4.9), hslogger, split, unix-compat, process,+  Setup-Depends: base (>= 4.11.1.0), hslogger, split, unix-compat, process,     filepath, exceptions, bytestring, directory, IfElse, data-default,     utf8-string, transformers, Cabal  Executable git-annex   Main-Is: git-annex.hs   Build-Depends:-   base (>= 4.9 && < 5.0),+   base (>= 4.11.1.0 && < 5.0),    network-uri (>= 2.6),-   optparse-applicative (>= 0.11.0),+   optparse-applicative (>= 0.14.1),    containers (>= 0.5.7.1),    exceptions (>= 0.6),    stm (>= 2.3),    mtl (>= 2),    uuid (>= 1.2.6),-   process,+   process (>= 1.4.2),    data-default,    case-insensitive,    random,@@ -330,39 +330,39 @@    sandi,    monad-control,    transformers,-   bloomfilter,+   bloomfilter (>= 2.0.0),    edit-distance,    resourcet,    connection (>= 0.2.6),-   http-client (>= 0.4.31),+   http-client (>= 0.5.0),    http-client-tls,    http-types (>= 0.7),-   http-conduit (>= 2.0),+   http-conduit (>= 2.3.0),    conduit,-   time,+   time (>= 1.5.0),    old-locale,-   persistent-sqlite (>= 2.1.3),-   persistent,+   persistent-sqlite (>= 2.8.1),+   persistent (>= 2.8.1),    persistent-template,    microlens,    aeson,    vector,    tagsoup,    unordered-containers,-   feed (>= 0.3.9),+   feed (>= 1.0.0),    regex-tdfa,    socks,    byteable,    stm-chans,    securemem,    crypto-api,-   cryptonite,+   cryptonite (>= 0.23),    memory,    deepseq,    split,    attoparsec,-   concurrent-output (>= 1.6),-   QuickCheck (>= 2.8.2),+   concurrent-output (>= 1.10),+   QuickCheck (>= 2.10.0),    tasty (>= 0.7),    tasty-hunit,    tasty-quickcheck,@@ -403,7 +403,7 @@     Build-Depends: network (< 3.0.0.0), network (>= 2.6.3.0)    if flag(S3)-    Build-Depends: aws (>= 0.14)+    Build-Depends: aws (>= 0.20)     CPP-Options: -DWITH_S3     Other-Modules: Remote.S3 @@ -499,7 +499,7 @@       Utility.OSX      if os(linux)-      Build-Depends: hinotify+      Build-Depends: hinotify (>= 0.3.10)       CPP-Options: -DWITH_INOTIFY       Other-Modules: Utility.DirWatcher.INotify     else@@ -531,7 +531,7 @@      yesod (>= 1.4.3),       yesod-static (>= 1.5.1),      yesod-form (>= 1.4.8),-     yesod-core (>= 1.4.25),+     yesod-core (>= 1.6.0),      path-pieces (>= 0.2.1),      warp (>= 3.2.8),      warp-tls (>= 3.2.2),@@ -641,7 +641,6 @@     Annex.Locations     Annex.LockFile     Annex.LockPool-    Annex.LockPool.PosixOrPid     Annex.Magic     Annex.MetaData     Annex.MetaData.StandardFields@@ -1049,18 +1048,15 @@     Utility.HumanTime     Utility.InodeCache     Utility.IPAddress-    Utility.LinuxMkLibs     Utility.LockFile-    Utility.LockFile.LockStatus-    Utility.LockFile.PidLock     Utility.LockPool     Utility.LockPool.LockHandle-    Utility.LockPool.PidLock     Utility.LockPool.STM     Utility.LogFile     Utility.Lsof     Utility.MagicWormhole     Utility.Matcher+    Utility.MD5     Utility.Metered     Utility.Misc     Utility.Monad@@ -1111,3 +1107,8 @@     Other-Modules:       Utility.LockFile.Posix       Utility.LockPool.Posix+      Annex.LockPool.PosixOrPid+      Utility.LockFile.LockStatus+      Utility.LockFile.PidLock+      Utility.LockPool.PidLock+      Utility.LinuxMkLibs
stack.yaml view
@@ -22,6 +22,7 @@ - tasty-rerun-1.1.13 - torrent-10000.1.1 - sandi-0.5+- http-client-0.5.14 explicit-setup-deps:   git-annex: true-resolver: lts-13.6+resolver: lts-13.29