download from LFS working

including resuming
This commit is contained in:
Joey Hess 2019-08-04 12:32:36 -04:00
parent 4af55c42bf
commit 7269851550
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -23,16 +23,19 @@ import Remote.Helper.Git
import Remote.Helper.Http import Remote.Helper.Http
import Annex.Ssh import Annex.Ssh
import Annex.UUID import Annex.UUID
import Utility.SshHost import Crypto
import qualified Utility.GitLFS as LFS
import Backend.Hash import Backend.Hash
import Utility.Hash import Utility.Hash
import Crypto import Utility.Metered
import Utility.SshHost
import qualified Utility.GitLFS as LFS
import Control.Concurrent.STM import Control.Concurrent.STM
import Data.String import Data.String
import Network.HTTP.Client hiding (port)
import Network.HTTP.Types import Network.HTTP.Types
import Network.HTTP.Client hiding (port)
import Network.HTTP.Conduit (http)
import Control.Monad.Trans.Resource (runResourceT)
import System.Log.Logger import System.Log.Logger
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -332,18 +335,17 @@ retrieve h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >
(tro:_) (tro:_)
| LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size -> | LFS.resp_oid tro /= sha256 || LFS.resp_size tro /= size ->
giveup "git-lfs server replied with other object than the one we requested" giveup "git-lfs server replied with other object than the one we requested"
| otherwise -> receive dest p tro | otherwise -> go dest p tro
where where
receive dest p tro = case LFS.resp_error tro of go dest p tro = case LFS.resp_error tro of
Just err -> giveup $ T.unpack $ LFS.respobjerr_message err Just err -> giveup $ T.unpack $ LFS.respobjerr_message err
Nothing -> case LFS.resp_actions tro of Nothing -> case LFS.resp_actions tro of
Nothing -> giveup "git-lfs server did not provide a way to download this object" Nothing -> giveup "git-lfs server did not provide a way to download this object"
Just op -> case LFS.downloadOperationRequest op of Just op -> case LFS.downloadOperationRequest op of
Nothing -> giveup "unable to parse git-lfs server download url" Nothing -> giveup "unable to parse git-lfs server download url"
Just req -> Just req -> do
-- TODO stream to file uo <- getUrlOptions
-- TODO resume and append if the file already exists liftIO $ downloadConduit p req dest uo
giveup "TODO"
checkKey :: TVar LFSHandle -> CheckPresent checkKey :: TVar LFSHandle -> CheckPresent
checkKey h key = getLFSEndpoint LFS.RequestDownload h >>= \case checkKey h key = getLFSEndpoint LFS.RequestDownload h >>= \case