more OsPath conversion (464/749)
Sponsored-by: unqueued
This commit is contained in:
parent
cf986bc7e2
commit
54f0710fd2
17 changed files with 164 additions and 165 deletions
|
@ -33,7 +33,6 @@ import Crypto
|
|||
import Backend (isStableKey)
|
||||
import Annex.SpecialRemote.Config
|
||||
import Annex.Verify
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
|
@ -584,4 +583,4 @@ ensureChunksAreLogged _ _ (ChunkKeys _) = return ()
|
|||
|
||||
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
|
||||
withBytes (ByteContent b) a = a b
|
||||
withBytes (FileContent f) a = a =<< liftIO (L.readFile (fromOsPath f))
|
||||
withBytes (FileContent f) a = a =<< liftIO (F.readFile f)
|
||||
|
|
|
@ -14,6 +14,7 @@ import Types.StoreRetrieve
|
|||
import Remote.Helper.Special
|
||||
import Utility.Metered
|
||||
import Utility.Hash (IncrementalVerifier(..))
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString as S
|
||||
|
@ -31,14 +32,14 @@ httpStorer a = fileStorer $ \k f m -> a k =<< liftIO (httpBodyStorer f m)
|
|||
|
||||
-- Reads the file and generates a streaming request body, that will update
|
||||
-- the meter as it's sent.
|
||||
httpBodyStorer :: FilePath -> MeterUpdate -> IO RequestBody
|
||||
httpBodyStorer :: OsPath -> MeterUpdate -> IO RequestBody
|
||||
httpBodyStorer src m = do
|
||||
size <- getFileSize (toRawFilePath src)
|
||||
size <- getFileSize src
|
||||
let streamer sink = withMeteredFile src m $ \b -> byteStringPopper b sink
|
||||
return $ RequestBodyStream (fromInteger size) streamer
|
||||
|
||||
-- Like httpBodyStorer, but generates a chunked request body.
|
||||
httpBodyStorerChunked :: FilePath -> MeterUpdate -> RequestBody
|
||||
httpBodyStorerChunked :: OsPath -> MeterUpdate -> RequestBody
|
||||
httpBodyStorerChunked src m =
|
||||
let streamer sink = withMeteredFile src m $ \b -> byteStringPopper b sink
|
||||
in RequestBodyStreamChunked streamer
|
||||
|
@ -75,10 +76,10 @@ handlePopper numchunks chunksize meterupdate h sink = do
|
|||
|
||||
-- Reads the http body and stores it to the specified file, updating the
|
||||
-- meter and incremental verifier as it goes.
|
||||
httpBodyRetriever :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO ()
|
||||
httpBodyRetriever :: OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO ()
|
||||
httpBodyRetriever dest meterupdate iv resp
|
||||
| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp
|
||||
| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
|
||||
| otherwise = bracket (F.openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)
|
||||
where
|
||||
reader = responseBody resp
|
||||
go sofar h = do
|
||||
|
|
|
@ -36,9 +36,9 @@ type ProtoConnRunner c = forall a. P2P.Proto a -> ClosableConnection c -> Annex
|
|||
-- the pool when done.
|
||||
type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a
|
||||
|
||||
store :: UUID -> RemoteGitConfig -> ProtoRunner (Maybe [UUID]) -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
||||
store :: UUID -> RemoteGitConfig -> ProtoRunner (Maybe [UUID]) -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||
store remoteuuid gc runner k af o p = do
|
||||
let sizer = KeySizer k (fmap (toRawFilePath . fst3) <$> prepSendAnnex k o)
|
||||
let sizer = KeySizer k (fmap fst3 <$> prepSendAnnex k o)
|
||||
let bwlimit = remoteAnnexBwLimitUpload gc <|> remoteAnnexBwLimit gc
|
||||
metered (Just p) sizer bwlimit $ \_ p' ->
|
||||
runner (P2P.put k af p') >>= \case
|
||||
|
|
|
@ -44,7 +44,7 @@ adjustReadOnly r
|
|||
}
|
||||
| otherwise = r
|
||||
|
||||
readonlyStoreKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
||||
readonlyStoreKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||
readonlyStoreKey _ _ _ _ = readonlyFail
|
||||
|
||||
readonlyRemoveKey :: Maybe SafeDropProof -> Key -> Annex ()
|
||||
|
@ -53,7 +53,7 @@ readonlyRemoveKey _ _ = readonlyFail
|
|||
readonlyStorer :: Storer
|
||||
readonlyStorer _ _ _ = readonlyFail
|
||||
|
||||
readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
|
||||
readonlyStoreExport :: OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()
|
||||
readonlyStoreExport _ _ _ _ = readonlyFail
|
||||
|
||||
readonlyRemoveExport :: Key -> ExportLocation -> Annex ()
|
||||
|
@ -62,7 +62,7 @@ readonlyRemoveExport _ _ = readonlyFail
|
|||
readonlyRemoveExportDirectory :: ExportDirectory -> Annex ()
|
||||
readonlyRemoveExportDirectory _ = readonlyFail
|
||||
|
||||
readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
||||
readonlyStoreExportWithContentIdentifier :: OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
||||
readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail
|
||||
|
||||
readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex ()
|
||||
|
|
|
@ -53,6 +53,7 @@ import Messages.Progress
|
|||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
import Git.Types
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
|
@ -92,12 +93,11 @@ mkRetrievalVerifiableKeysSecure gc
|
|||
|
||||
-- A Storer that expects to be provided with a file containing
|
||||
-- the content of the key to store.
|
||||
fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex ()) -> Storer
|
||||
fileStorer :: (Key -> OsPath -> MeterUpdate -> Annex ()) -> Storer
|
||||
fileStorer a k (FileContent f) m = a k f m
|
||||
fileStorer a k (ByteContent b) m = withTmp k $ \f -> do
|
||||
let f' = fromRawFilePath f
|
||||
liftIO $ L.writeFile f' b
|
||||
a k f' m
|
||||
liftIO $ L.writeFile (fromOsPath f) b
|
||||
a k f m
|
||||
|
||||
-- A Storer that expects to be provided with a L.ByteString of
|
||||
-- the content to store.
|
||||
|
@ -107,7 +107,7 @@ byteStorer a k c m = withBytes c $ \b -> a k b m
|
|||
-- A Retriever that generates a lazy ByteString containing the Key's
|
||||
-- content, and passes it to a callback action which will fully consume it
|
||||
-- before returning.
|
||||
byteRetriever :: (Key -> (L.ByteString -> Annex a) -> Annex a) -> Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a
|
||||
byteRetriever :: (Key -> (L.ByteString -> Annex a) -> Annex a) -> Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a
|
||||
byteRetriever a k _m _dest _miv callback = a k (callback . ByteContent)
|
||||
|
||||
-- A Retriever that writes the content of a Key to a file.
|
||||
|
@ -115,7 +115,7 @@ byteRetriever a k _m _dest _miv callback = a k (callback . ByteContent)
|
|||
-- retrieves data. The incremental verifier is updated in the background as
|
||||
-- the action writes to the file, but may not be updated with the entire
|
||||
-- content of the file.
|
||||
fileRetriever :: (RawFilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever
|
||||
fileRetriever :: (OsPath -> Key -> MeterUpdate -> Annex ()) -> Retriever
|
||||
fileRetriever a = fileRetriever' $ \f k m miv ->
|
||||
let retrieve = a f k m
|
||||
in tailVerify miv f retrieve
|
||||
|
@ -124,20 +124,20 @@ fileRetriever a = fileRetriever' $ \f k m miv ->
|
|||
- The action is responsible for updating the progress meter and the
|
||||
- incremental verifier as it retrieves data.
|
||||
-}
|
||||
fileRetriever' :: (RawFilePath -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()) -> Retriever
|
||||
fileRetriever' :: (OsPath -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()) -> Retriever
|
||||
fileRetriever' a k m dest miv callback = do
|
||||
createAnnexDirectory (parentDir dest)
|
||||
a dest k m miv
|
||||
pruneTmpWorkDirBefore dest (callback . FileContent . fromRawFilePath)
|
||||
pruneTmpWorkDirBefore dest (callback . FileContent)
|
||||
|
||||
{- The base Remote that is provided to specialRemote needs to have
|
||||
- storeKey, retrieveKeyFile, removeKey, and checkPresent methods,
|
||||
- but they are never actually used (since specialRemote replaces them).
|
||||
- Here are some dummy ones.
|
||||
-}
|
||||
storeKeyDummy :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()
|
||||
storeKeyDummy :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()
|
||||
storeKeyDummy _ _ _ _ = error "missing storeKey implementation"
|
||||
retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
retrieveKeyFileDummy :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification
|
||||
retrieveKeyFileDummy _ _ _ _ _ = error "missing retrieveKeyFile implementation"
|
||||
removeKeyDummy :: Maybe SafeDropProof -> Key -> Annex ()
|
||||
removeKeyDummy _ _ = error "missing removeKey implementation"
|
||||
|
@ -258,9 +258,9 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
|
|||
|
||||
displayprogress bwlimit p k srcfile a
|
||||
| displayProgress cfg = do
|
||||
metered (Just p) (KeySizer k (pure (fmap toRawFilePath srcfile))) bwlimit (const a)
|
||||
metered (Just p) (KeySizer k (pure srcfile)) bwlimit (const a)
|
||||
| otherwise = a p
|
||||
|
||||
withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
|
||||
withBytes (ByteContent b) a = a b
|
||||
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
|
||||
withBytes (FileContent f) a = a =<< liftIO (F.readFile f)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue