blob: da17d8984f76a9dfffea1bc80b982c86e211ec27 (
plain)
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
module buildclient.tasks.Executor where
import buildclient.config.BuildConfig
import frege.java.Net
import frege.java.IO
import Data.Array
data HttpURLConnection = native java.net.HttpURLConnection where
-- Unchecked cast, but who cares
native fromUrlConnection "(java.net.HttpURLConnection)" :: MutableIO URLConnection -> IOMutable HttpURLConnection
native setRequestProperty :: MutableIO HttpURLConnection -> String -> String -> IO ()
native getHeaderField :: MutableIO HttpURLConnection -> String -> IO (Maybe String)
native getResponseCode :: MutableIO HttpURLConnection -> IO Int throws IOException
data ZipEntry = native java.util.zip.ZipEntry where
native getName :: Mutable s ZipEntry -> ST s String
native isDirectory :: Mutable s ZipEntry -> ST s Bool
data ZipInputStream = native java.util.zip.ZipInputStream where
native new :: MutableIO InputStream -> IOMutable ZipInputStream
native getNextEntry :: MutableIO ZipInputStream -> IO (Maybe (MutableIO ZipEntry)) throws IOException
native closeEntry :: MutableIO ZipInputStream -> IO () throws IOException
bcDownloadSync :: File -> BuildSource -> IO ()
bcDownloadSync targetDirectory (HttpSource url format archiveRoot skipDirs) = do
File.mkdirs targetDirectory
let etagFile = File.new targetDirectory "etag.txt"
oldEtagExists <- File.exists etagFile
oldEtag <- if oldEtagExists then readFileStr etagFile else pure ""
parsedUrl <- URL.new url
conn <- URL.openConnection parsedUrl >>= (HttpURLConnection.fromUrlConnection)
HttpURLConnection.setRequestProperty conn "If-None-Match" oldEtag
-- Get InputStream early to trigger communication with server -> load response headers
inputStream <- URLConnection.getInputStream conn
newEtag <- HttpURLConnection.getHeaderField conn "etag"
maybe (return ()) (writeFileStr etagFile) newEtag
resp <- HttpURLConnection.getResponseCode conn
case resp of
304 = return () -- 304 indicated etag hit
200 = do
let archiveFile = File.new targetDirectory "archive.zip"
saveInputStreamTo inputStream $ archiveFile
extractZip skipDirs archiveFile $ File.new targetDirectory "archive-extracted"
otherwise = fail ("Server replied with unexpected http code " ++ show resp)
return ()
extractZip :: Int -> File -> File -> IO ()
extractZip skipDirs archiveFile targetDirectory =
do
File.mkdirs targetDirectory
fis <- FileInputStream.new archiveFile
zis <- ZipInputStream.new fis
extractFiles zis
return ()
where
extractFiles zis = do
entry <- ZipInputStream.getNextEntry zis
case entry of
Just n -> extractFile zis n >> extractFiles zis
Nothing -> return ()
extractFile zis zentry = do
isdir <- ZipEntry.isDirectory zentry
if isdir
then return ()
else do
name <- ZipEntry.getName zentry
let (Right pattern) = Regex.compile "[/\\\\]"
let parts = drop skipDirs $ toList $ Regex.split (pattern) name
let targetFile = fold File.new targetDirectory parts
maybe (return false) File.mkdirs $ File.getParentFile targetFile
saveInputStreamTo zis targetFile
return ()
writeFileStr :: File -> String -> IO ()
writeFileStr file text = do
fos <- FileOutputStream.new file
osw <- OutputStreamWriter.new fos "UTF-8"
osw.write text
osw.close
readFileStr :: File -> IO String
readFileStr file = do
fis <- FileInputStream.new file
isr <- InputStreamReader.new fis "UTF-8"
getContentsOf isr
saveInputStreamTo :: MutableIO InputStream -> File -> IO ()
saveInputStreamTo is file =
do maybe (return false) File.mkdirs $ File.getParentFile file
fos <- FileOutputStream.new file
arr <- newArray 4096
copyloop arr fos
fos.close
return ()
where
copyloop :: ArrayOf RealWorld Byte -> MutableIO FileOutputStream -> IO ()
copyloop buf to = do
rc <- InputStream.read is buf
if rc < 0
then return ()
else do
OutputStream.write to buf 0 rc
copyloop buf to
|
