remove many old version ifdefs
Drop support for building with ghc older than 8.4.4, and with older versions of serveral haskell libraries than will be included in Debian 10. The only remaining version ifdefs in the entire code base are now a couple for aws! This commit should only be merged after the Debian 10 release. And perhaps it will need to wait longer than that; it would make backporting new versions of git-annex to Debian 9 (stretch) which has been actively happening as recently as this year. This commit was sponsored by Ilya Shlyakhter.
This commit is contained in:
Joey Hess
parent
b8ef1bf3be
commit
9a5ddda511
29 changed files with 42 additions and 319 deletions
|
|
@ -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 Utility.PartialPrelude
|
|||
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 @@ multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE"
|
|||
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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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 @@ sshAuthTranscript sshinput opts sshhost cmd input = case inputAuthMethod sshinpu
|
|||
- 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
|
||||
|
|
|
|||
|
|
@ -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 @@ withExpandableNote field (toggle, note) = withNote field $ [whamlet|
|
|||
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)]
|
||||
|
|
|
|||
|
|
@ -95,11 +95,7 @@ instance LiftAnnex Handler where
|
|||
, 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 @@ instance LiftAssistant Handler where
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Backend.Hash (
|
||||
|
|
@ -34,11 +33,9 @@ data Hash
|
|||
| SHA2Hash HashSize
|
||||
| SHA3Hash HashSize
|
||||
| SkeinHash HashSize
|
||||
#if MIN_VERSION_cryptonite(0,23,0)
|
||||
| Blake2bHash HashSize
|
||||
| Blake2sHash HashSize
|
||||
| Blake2spHash HashSize
|
||||
#endif
|
||||
|
||||
{- Order is slightly significant; want SHA256 first, and more general
|
||||
- sizes earlier. -}
|
||||
|
|
@ -47,11 +44,9 @@ hashes = concat
|
|||
[ 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 (Blake2sHash . HashSize) [256, 160, 224]
|
||||
, map (Blake2spHash . HashSize) [256, 224]
|
||||
#endif
|
||||
, [SHA1Hash]
|
||||
, [MD5Hash]
|
||||
]
|
||||
|
|
@ -82,11 +77,9 @@ hashKeyVariety SHA1Hash he = SHA1Key he
|
|||
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 (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 +216,9 @@ hashFile hash file meterupdate =
|
|||
SHA2Hash hashsize -> sha2Hasher hashsize
|
||||
SHA3Hash hashsize -> sha3Hasher hashsize
|
||||
SkeinHash hashsize -> skeinHasher hashsize
|
||||
#if MIN_VERSION_cryptonite(0,23,0)
|
||||
Blake2bHash hashsize -> blake2bHasher hashsize
|
||||
Blake2sHash hashsize -> blake2sHasher hashsize
|
||||
Blake2spHash hashsize -> blake2spHasher hashsize
|
||||
#endif
|
||||
|
||||
sha2Hasher :: HashSize -> (L.ByteString -> String)
|
||||
sha2Hasher (HashSize hashsize)
|
||||
|
|
@ -253,7 +244,6 @@ skeinHasher (HashSize hashsize)
|
|||
| 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
|
||||
|
|
@ -275,7 +265,6 @@ blake2spHasher (HashSize hashsize)
|
|||
| 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
|
||||
|
|
|
|||
|
|
@ -1,3 +1,6 @@
|
|||
* Drop support for building with ghc older than 8.4.4,
|
||||
and with older versions of serveral haskell libraries.
|
||||
|
||||
git-annex (7.20190627) UNRELEASED; urgency=medium
|
||||
|
||||
* Fix find --json to output json once more.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.Set as S
|
|||
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 @@ findDownloads u f = catMaybes $ map mk (feedItems f)
|
|||
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 @@ performDownload opts cache todownload = case location todownload of
|
|||
|
||||
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 @@ feedFile tmpl i extension = Utility.Format.format tmpl $
|
|||
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 :: ToDownload -> MetaData
|
|||
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 @@ extractFields i = map (uncurry extractField)
|
|||
, ("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 @@ clearFeedProblem url = void $ liftIO . tryIO . removeFile =<< feedState url
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 Sem.Semigroup KeyData where
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 qualified Data.Map as M
|
|||
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 @@ parseRawChangeLine = go . words
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@
|
|||
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Database.Export (
|
||||
ExportHandle,
|
||||
|
|
@ -130,11 +129,7 @@ addExportedLocation h k el = queueDb h $ do
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -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 Utility.FileMode
|
|||
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 @@ initDb db migration = do
|
|||
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 @@ initDb db migration = do
|
|||
-
|
||||
- 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
|
||||
|
|
|
|||
|
|
@ -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 Sem.Semigroup FsckOutput where
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -119,12 +119,8 @@ concurrentOutputSupported = return True -- Windows is always unicode
|
|||
#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 @@ hideRegionsWhile s a
|
|||
go _ = do
|
||||
liftIO $ hFlush stdout
|
||||
a
|
||||
#else
|
||||
hideRegionsWhile _ = id
|
||||
#endif
|
||||
|
|
|
|||
10
Remote/S3.hs
10
Remote/S3.hs
|
|
@ -247,7 +247,6 @@ storeHelper info h magic f object p = liftIO $ case partSize info of
|
|||
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 @@ storeHelper info h magic f object p = liftIO $ case partSize info of
|
|||
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 @@ mkS3HandleVar c gc u = liftIO $ newTVarIO $ Left $ do
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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.Lazy as L
|
|||
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 Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionConte
|
|||
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 @@ goDAV (DavHandle ctx user pass _) a = choke $ run $ prettifyExceptions $ do
|
|||
{- 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 @@ prettifyExceptions a = catchJust (matchStatusCodeException (const True)) a go
|
|||
, 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
|
||||
|
|
|
|||
|
|
@ -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 Sem.Semigroup DesktopNotify where
|
|||
|
||||
instance Monoid DesktopNotify where
|
||||
mempty = DesktopNotify False False
|
||||
#if ! MIN_VERSION_base(4,11,0)
|
||||
mappend = (Sem.<>)
|
||||
#endif
|
||||
|
||||
mkNotifyStart :: DesktopNotify
|
||||
mkNotifyStart = DesktopNotify True False
|
||||
|
|
|
|||
|
|
@ -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 Sem.Semigroup Differences where
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Types.Key where
|
||||
|
|
@ -155,7 +154,6 @@ parseKeyVariety "SKEIN512" = SKEINKey (HashSize 512) (HasExt False)
|
|||
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)
|
||||
|
|
@ -176,7 +174,6 @@ parseKeyVariety "BLAKE2SP224" = Blake2spKey (HashSize 224) (HasExt False)
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -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 Sem.Semigroup TestOptions where
|
|||
|
||||
instance Monoid TestOptions where
|
||||
mempty = TestOptions mempty False False mempty
|
||||
#if ! MIN_VERSION_base(4,11,0)
|
||||
mappend = (Sem.<>)
|
||||
#endif
|
||||
|
||||
type TestRunner = TestOptions -> IO ()
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Bloom (
|
||||
Bloom,
|
||||
safeSuggestSizing,
|
||||
|
|
@ -20,18 +18,12 @@ module Utility.Bloom (
|
|||
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 @@ insertMB = MBloom.insert
|
|||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
|
||||
{- higher-level inotify interface
|
||||
-
|
||||
- Copyright 2012 Joey Hess <id@joeyh.name>
|
||||
|
|
@ -199,14 +197,8 @@ querySysctl ps = getM go ["sysctl", "/sbin/sysctl", "/usr/sbin/sysctl"]
|
|||
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
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
{- Convenience wrapper around cryptonite's hashing. -}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.Hash (
|
||||
sha1,
|
||||
sha2_224,
|
||||
|
|
@ -14,7 +12,6 @@ module Utility.Hash (
|
|||
sha3_512,
|
||||
skein256,
|
||||
skein512,
|
||||
#if MIN_VERSION_cryptonite(0,23,0)
|
||||
blake2s_160,
|
||||
blake2s_224,
|
||||
blake2s_256,
|
||||
|
|
@ -25,7 +22,6 @@ module Utility.Hash (
|
|||
blake2b_256,
|
||||
blake2b_384,
|
||||
blake2b_512,
|
||||
#endif
|
||||
md5,
|
||||
prop_hashes_stable,
|
||||
Mac(..),
|
||||
|
|
@ -73,7 +69,6 @@ skein256 = hashlazy
|
|||
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,7 +98,6 @@ blake2b_384 = hashlazy
|
|||
|
||||
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
|
||||
|
|
@ -126,7 +120,6 @@ prop_hashes_stable = all (\(hasher, result) -> hasher foo == result)
|
|||
, (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")
|
||||
|
|
@ -138,7 +131,6 @@ prop_hashes_stable = all (\(hasher, result) -> hasher foo == result)
|
|||
, (show . blake2b_384, "e629ee880953d32c8877e479e3b4cb0a4c9d5805e2b34c675b5a5863c4ad7d64bb2a9b8257fac9d82d289b3d39eb9cc2")
|
||||
, (show . blake2b_512, "ca002330e69d3e6b84a46a56a6533fd79d51d97a3bb7cad6c2ff43b354185d6dc1e723fb3db4ae0737e120378424c714bb982d9dc5bbd7a0ab318240ddd18f8d")
|
||||
--, (show . blake2bp_512, "")
|
||||
#endif
|
||||
, (show . md5, "acbd18db4cc2f85cedef654fccc4a4d8")
|
||||
]
|
||||
where
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@
|
|||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Utility.HttpManagerRestricted (
|
||||
restrictManagerSettings,
|
||||
|
|
@ -30,9 +29,7 @@ import qualified Data.ByteString.UTF8 as BU
|
|||
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 Prelude
|
||||
|
||||
|
|
@ -51,17 +48,9 @@ instance Monoid Restriction where
|
|||
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.
|
||||
data ConnectionRestricted = ConnectionRestricted String
|
||||
|
|
@ -93,11 +82,7 @@ restrictManagerSettings
|
|||
restrictManagerSettings cfg base = restrictProxy cfg $ base
|
||||
{ managerRawConnection = restrictedRawConnection cfg
|
||||
, managerTlsConnection = restrictedTlsConnection cfg
|
||||
#if MIN_VERSION_http_client(0,5,0)
|
||||
, managerWrapException = wrapOurExceptions base
|
||||
#else
|
||||
, managerWrapIOException = wrapOurExceptions base
|
||||
#endif
|
||||
}
|
||||
|
||||
restrictProxy
|
||||
|
|
@ -159,7 +144,6 @@ restrictProxy cfg base = do
|
|||
, 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,18 +152,6 @@ wrapOurExceptions base req a =
|
|||
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
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
||||
|
|
@ -18,9 +17,7 @@ import Test.QuickCheck as X
|
|||
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 FileID where
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -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 as B
|
|||
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.)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@
|
|||
- License: BSD-2-clause
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
|
@ -63,17 +62,8 @@ import Data.Conduit
|
|||
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
|
||||
|
|
@ -298,13 +288,8 @@ getUrlInfo url uo = case parseURIRelaxed url of
|
|||
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 +412,6 @@ download' noerror meterupdate url file uo =
|
|||
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 +421,6 @@ download' noerror meterupdate url file uo =
|
|||
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 +458,8 @@ download' noerror meterupdate url file uo =
|
|||
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 +479,11 @@ sinkResponseFile
|
|||
-> 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 +555,11 @@ resumeFromHeader sz = (hRange, renderByteRanges [ByteRangeFrom sz])
|
|||
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 +568,11 @@ matchStatusCodeHeadersException _ _ = Nothing
|
|||
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,
|
||||
|
|
|
|||
|
|
@ -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 :: FilePath -> FilePath
|
|||
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
|
||||
|
|
|
|||
|
|
@ -294,22 +294,22 @@ source-repository head
|
|||
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 @@ Executable git-annex
|
|||
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 @@ Executable git-annex
|
|||
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 @@ Executable git-annex
|
|||
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 @@ Executable git-annex
|
|||
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),
|
||||
|
|
|
|||
Loading…
Reference in a new issue