41 lines
1.4 KiB
Haskell
41 lines
1.4 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
|
|
module Yore.Download (downloadInto) where
|
|
|
|
import Control.Monad (guard)
|
|
import Data.Maybe (fromJust)
|
|
import Data.Text (Text)
|
|
import Network.HTTP.Req hiding (queryParam)
|
|
import System.Directory (createDirectoryIfMissing)
|
|
import System.FilePath (makeRelative, takeExtension, (<.>), (</>))
|
|
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import qualified Data.Text as Text
|
|
import qualified Data.UUID.V4 as UUID
|
|
import qualified Text.URI as URI
|
|
|
|
-- | Download a URL and save it to a directory.
|
|
-- Returns the path of the downloaded file relative to the directory.
|
|
downloadInto
|
|
:: FilePath -- ^ Directory where to store the file.
|
|
-> Text -- ^ The URL to download.
|
|
-> IO FilePath
|
|
downloadInto downloadDir textUrl = download >>= save
|
|
where
|
|
download :: IO LBS.ByteString
|
|
download = do
|
|
uri <- URI.mkURI textUrl
|
|
let (url, opts) = fromJust $ useHttpsURI uri
|
|
res <- runReq defaultHttpConfig $ req GET url NoReqBody lbsResponse opts
|
|
guard $ responseStatusCode res == 200
|
|
pure $ responseBody res
|
|
|
|
save :: LBS.ByteString -> IO FilePath
|
|
save contents = do
|
|
let suffix = takeExtension $ Text.unpack textUrl
|
|
uuid <- UUID.nextRandom
|
|
let fullPath = downloadDir </> show uuid <.> suffix
|
|
createDirectoryIfMissing True downloadDir
|
|
LBS.writeFile fullPath contents
|
|
pure $ makeRelative downloadDir fullPath
|