mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add downloadRequests

Browse source
This commit is contained in:
Joey Hess 2019-07-31 12:27:27 -04:00
parent 909952d8e5
commit b4d2fc6219
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 16 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

18
Lfs.hs
View file

@ -6,7 +6,11 @@ import Data.Aeson.Types
import GHC.Generics import GHC.Generics
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import Data.Maybe
import Network.HTTP.Types
import Network.HTTP.Client import Network.HTTP.Client
-- | Adds necessary headers to a Request and makes it post the -- | Adds necessary headers to a Request and makes it post the
@ -45,6 +49,18 @@ parseResponseBody resp = case eitherDecode resp of
Left _ -> Left $ Left err Left _ -> Left $ Left err
Right resp -> Right resp Right resp -> Right resp
-- | Builds http requests that can be used to download the objects that
-- were requested using a TransferRequest.
downloadRequests :: TransferResponse DownloadOperation -> ([(TransferResponseOperation DownloadOperation, Maybe Request)])
downloadRequests = map mkreq . objects
where
mkreq op = (op, mkreq' (download (resp_actions op)))
mkreq' ps = do
r <- parseRequest (T.unpack (href ps))
let headers = map convheader $ maybe [] M.toList (header ps)
return $ r { requestHeaders = headers }
convheader (k, v) = (CI.mk (E.encodeUtf8 k), E.encodeUtf8 v)
data TransferRequest = TransferRequest data TransferRequest = TransferRequest
{ req_operation :: TransferRequestOperation { req_operation :: TransferRequestOperation
, req_transfers :: [TransferAdapter] , req_transfers :: [TransferAdapter]
@ -195,5 +211,3 @@ type HTTPHeaderValue = T.Text
-- Prevent Nothing from serializing to null. -- Prevent Nothing from serializing to null.
nonNullOptions :: Options nonNullOptions :: Options
nonNullOptions = defaultOptions { omitNothingFields = True } nonNullOptions = defaultOptions { omitNothingFields = True }