diff options
Diffstat (limited to 'src/main/frege/buildclient/tasks/Executor.fr')
-rw-r--r-- | src/main/frege/buildclient/tasks/Executor.fr | 111 |
1 files changed, 111 insertions, 0 deletions
diff --git a/src/main/frege/buildclient/tasks/Executor.fr b/src/main/frege/buildclient/tasks/Executor.fr new file mode 100644 index 0000000..da17d89 --- /dev/null +++ b/src/main/frege/buildclient/tasks/Executor.fr @@ -0,0 +1,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 |