1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
-- | HttpLib bridge to the in-memory repository
module TestSuite.HttpMem (
httpMem
) where
-- stdlib
import Network.URI (URI)
import qualified Data.ByteString.Lazy as BS.L
-- hackage-security
import Hackage.Security.Client
import Hackage.Security.Client.Repository.HttpLib
import Hackage.Security.Util.Checked
import Hackage.Security.Util.Path
import Hackage.Security.Util.Some
-- TestSuite
import TestSuite.InMemRepo
httpMem :: InMemRepo -> HttpLib
httpMem inMemRepo = HttpLib {
httpGet = get inMemRepo
, httpGetRange = getRange inMemRepo
}
{-------------------------------------------------------------------------------
Individual methods
-------------------------------------------------------------------------------}
-- | Download a file
--
-- Since we don't (yet?) make any attempt to simulate a cache, we ignore
-- caching headers.
get :: forall a. Throws SomeRemoteError
=> InMemRepo
-> [HttpRequestHeader]
-> URI
-> ([HttpResponseHeader] -> BodyReader -> IO a)
-> IO a
get InMemRepo{..} _requestHeaders uri callback = do
Some inMemFile <- inMemRepoGetPath $ castRoot (uriPath uri)
br <- bodyReaderFromBS $ inMemFileRender inMemFile
callback [HttpResponseAcceptRangesBytes] br
-- | Download a byte range
--
-- Range is starting and (exclusive) end offset in bytes.
--
-- We ignore requests for compression; different servers deal with compression
-- for byte range requests differently; in particular, Apache returns the range
-- of the _compressed_ file, which is pretty useless for our purposes. For now
-- we ignore this issue completely here.
getRange :: forall a. Throws SomeRemoteError
=> InMemRepo
-> [HttpRequestHeader]
-> URI
-> (Int, Int)
-> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a)
-> IO a
getRange InMemRepo{..} _requestHeaders uri (fr, to) callback = do
Some inMemFile <- inMemRepoGetPath $ castRoot (uriPath uri)
br <- bodyReaderFromBS $ substr (inMemFileRender inMemFile)
let responseHeaders = concat [
[ HttpResponseAcceptRangesBytes ]
]
callback HttpStatus206PartialContent responseHeaders br
where
substr :: BS.L.ByteString -> BS.L.ByteString
substr = BS.L.take (fromIntegral (to - fr)) . BS.L.drop (fromIntegral fr)
|
