{-# LANGUAGE DataKinds #-} module Yore.Download (downloadInto) where import Control.Exception (Exception, IOException, catch) import Control.Monad.Trans.Except (ExceptT (..)) 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 import Yore.Error (Error (..)) -- | 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. -> ExceptT Error IO FilePath downloadInto downloadDir textUrl = download >>= save where download :: ExceptT Error IO LBS.ByteString download = toExceptT (handle @HttpException) $ do uri <- URI.mkURI textUrl let (url, opts) = fromJust $ useHttpsURI uri res <- runReq defaultHttpConfig $ req GET url NoReqBody lbsResponse opts pure $ responseBody res save :: LBS.ByteString -> ExceptT Error IO FilePath save contents = toExceptT (handle @IOException) $ 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 toExceptT :: (Exception e) => (e -> Error) -> IO a -> ExceptT Error IO a toExceptT showException f = ExceptT $ (Right <$> f) `catch` (pure . Left . showException) handle :: (Show e) => e -> Error handle = GenericError . Text.pack . show