Download and determine the digest

1 files changed, 48 insertions, 3 deletions

diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs
index cbdcbb8..842f4ae 100644
--- a/app/SlackBuilder/Download.hs
+++ b/app/SlackBuilder/Download.hs
@@ -1,11 +1,14 @@
 module SlackBuilder.Download
     ( cloneAndArchive
     , commit
+    , download
     , hostedSources
     , remoteFileExists
     , updateSlackBuildVersion
     ) where
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
@@ -15,7 +18,13 @@ import Control.Monad.Trans.Reader (asks)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import System.IO (IOMode(..), withFile)
 import System.FilePath ((</>), (<.>))
-import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess)
+import System.Process
+    ( CreateProcess(..)
+    , StdStream(..)
+    , proc
+    , readCreateProcessWithExitCode
+    , callProcess
+    )
 import System.Exit (ExitCode(..))
 import Control.Monad (unless)
 import Text.URI (URI(..), mkURI)
@@ -27,10 +36,24 @@ import Network.HTTP.Req
     , runReq
     , defaultHttpConfig
     , ignoreResponse
-    , responseStatusCode, HttpConfig (..)
+    , responseStatusCode
+    , HttpConfig(..)
+    , GET(..)
+    , reqBr
     )
-import Data.Maybe (fromMaybe)
 import Data.Functor ((<&>))
+import Network.HTTP.Client (BodyReader, Response(..), brRead)
+import Conduit
+    ( ConduitT
+    , yield
+    , runConduitRes
+    , sinkFile
+    , (.|)
+    , ZipSink(..)
+    , await
+    )
+import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
+import Data.Void (Void)
 
 updateSlackBuildVersion :: Text -> Text -> SlackBuilderT ()
 updateSlackBuildVersion packagePath version = do
@@ -123,3 +146,25 @@ cloneAndArchive repo nameVersion tarball tagPrefix = do
         , nameVersion'
         ]
     liftIO $ callProcess "rm" ["-rf", nameVersion']
+
+responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m ()
+responseBodySource = bodyReaderSource . responseBody
+  where
+    bodyReaderSource br = liftIO (brRead br) >>= go br
+    go br bs = unless (ByteString.null bs) $ yield bs >> bodyReaderSource br
+
+sinkHash :: Monad m => ConduitT ByteString Void m (Digest MD5)
+sinkHash = sink hashInit
+  where
+    sink ctx = await
+        >>= maybe (pure $ hashFinalize ctx) (sink . hashUpdate ctx)
+
+download :: Text -> FilePath -> SlackBuilderT (Maybe (Digest MD5))
+download uri target = SlackBuilderT (liftIO $ mkURI uri)
+    >>= traverse (runReq defaultHttpConfig . go . fst) . useHttpsURI
+  where
+    go uri' = reqBr GET uri' NoReqBody mempty readResponse
+    readResponse :: Response BodyReader -> IO (Digest MD5)
+    readResponse response = runConduitRes
+        $ responseBodySource response
+        .| getZipSink (ZipSink (sinkFile target) *> ZipSink sinkHash)