httpalso: Support being used with special remotes that use chunking.

Sponsored-by: k0ld on Patreon

Annex/SpecialRemote/Config.hs

@@ -137,8 +137,12 @@ sameasInherits = S.fromList
 	, pubkeysField
 	-- legacy chunking was either enabled or not, so has to be the same
 	-- across configs for remotes that access the same data
-	-- (new-style chunking does not have that limitation)
 	, chunksizeField
+	-- (new-style chunking does not have that limitation)
+	-- but there is no benefit to picking a different chunk size
+	-- for the sameas remote, since it's reading whatever chunks were
+	-- stored
+	, chunkField
 	]
 
 {- Each RemoteConfig that has a sameas-uuid inherits some fields

CHANGELOG

@@ -94,6 +94,7 @@ git-annex (10.20230408) UNRELEASED; urgency=medium
   * assistant: Fix a crash when a small file is deleted immediately after
     being created.
   * Improve resuming interrupted download when using yt-dlp or youtube-dl.
+  * httpalso: Support being used with special remotes that use chunking.
 
  -- Joey Hess <id@joeyh.name>  Sat, 08 Apr 2023 13:57:18 -0400
 

Remote/HttpAlso.hs

@@ -1,10 +1,12 @@
 {- HttpAlso remote (readonly).
  -
- - Copyright 2020-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2020-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE RankNTypes #-}
+
 module Remote.HttpAlso (remote) where
 
 import Annex.Common
@@ -30,7 +32,7 @@ import System.FilePath.Posix as P
 import Control.Concurrent.STM
 
 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "httpalso"
 	, enumerate = const (findSpecialRemotes "httpalso")
 	, generate = gen
@@ -53,21 +55,26 @@ gen r u rc gc rs = do
 	cst <- remoteCost gc c expensiveRemoteCost
 	let url = getRemoteConfigValue urlField c
 	ll <- liftIO newLearnedLayout
-	return $ Just $ this url ll c cst
+	return $ Just $ specialRemote c
+		cannotModify
+		(downloadKey url ll)
+		cannotModify
+		(checkKey url ll)
+		(this url c cst)
   where
-	this url ll c cst = Remote
+	this url c cst = Remote
 		{ uuid = u
 		, cost = cst
 		, name = Git.repoDescribe r
 		, storeKey = cannotModify
-		, retrieveKeyFile = downloadKey url ll
+		, retrieveKeyFile = retrieveKeyFileDummy
 		, retrieveKeyFileCheap = Nothing
 		-- HttpManagerRestricted is used here, so this is
 		-- secure.
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = cannotModify
 		, lockContent = Nothing
-		, checkPresent = checkKey url ll
+		, checkPresent = checkPresentDummy
 		, checkPresentCheap = False
 		, exportActions = ExportActions
 			{ storeExport = cannotModify
@@ -114,10 +121,9 @@ httpAlsoSetup _ (Just u) _ c gc = do
 	gitConfigSpecialRemote u c' [("httpalso", "true")]
 	return (c', u)
 
-downloadKey :: Maybe URLString -> LearnedLayout -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+downloadKey :: Maybe URLString -> LearnedLayout -> Retriever
-downloadKey baseurl ll key _af dest p vc = do
+downloadKey baseurl ll = fileRetriever' $ \dest key p iv ->
-	verifyKeyContentIncrementally vc key $ \iv ->
+	downloadAction (fromRawFilePath dest) p iv key (keyUrlAction baseurl ll key)
-		downloadAction dest p iv key (keyUrlAction baseurl ll key)
 
 retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
 retriveExportHttpAlso baseurl key loc dest p = do
@@ -127,11 +133,10 @@ retriveExportHttpAlso baseurl key loc dest p = do
 downloadAction :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Key -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()
 downloadAction dest p iv key run =
 	Url.withUrlOptions $ \uo ->
-		meteredFile dest (Just p) key $
+		run (\url -> Url.download' p iv url dest uo)
-			run (\url -> Url.download' p iv url dest uo)
+			>>= either giveup (const (return ()))
-				>>= either giveup (const (return ()))
 
-checkKey :: Maybe URLString -> LearnedLayout -> Key -> Annex Bool
+checkKey :: Maybe URLString -> LearnedLayout -> CheckPresent
 checkKey baseurl ll key =
 	isRight <$> keyUrlAction baseurl ll key (checkKey' key)
 
@@ -150,9 +155,9 @@ type LearnedLayout = TVar (Maybe [Key -> URLString])
 newLearnedLayout :: IO LearnedLayout
 newLearnedLayout = newTVarIO Nothing
 
--- Learns which layout the special remote uses, so the once any
+-- Learns which layout the special remote uses, so once any action on an
--- action on an url succeeds, subsequent calls will continue to use that
+-- url succeeds, subsequent calls will continue to use that layout
--- layout (or related layouts).
+-- (or related layouts).
 keyUrlAction
 	:: Maybe URLString
 	-> LearnedLayout

doc/special_remotes/httpalso.mdwn

@@ -32,3 +32,7 @@ for a list of known working combinations.
   Setting this does not allow trees to be exported to the httpalso remote,
   because it's read-only. But it does let exported files be downloaded
   from it.
+
+Configuration of encryption and chunking is inherited from the other
+special remote, and does not need to be specified when initializing the
+httpalso remote.

doc/special_remotes/httpalso/comment_5_ee2c2a34e11bbbac835be7660830e298._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 5"""
+ date="2023-06-20T17:24:43Z"
+ content="""
+I've made it support chunking.
+
+(Please in the future post to [[todo]] rather than making a comment when
+you have a new feature to suggest.)
+"""]]

doc/special_remotes/webdav/comment_23_6c16a7c9abb257be4d046e27e11bacdf._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 23"""
+ date="2023-06-20T17:25:27Z"
+ content="""
+httpalso now supports chunking. So I think there's no need to add readonly
+support to webdav, probably. But if you disagree, I do think it would be
+possible to add. Just probably not useful.. after all webdav minus writing
+is little different than http. If you disagree, open a [[todo]].
+"""]]