diff options
| author | Eugen Wissner <belka@caraus.de> | 2024-09-20 17:52:09 +0200 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2024-09-20 17:52:09 +0200 |
| commit | ae63ff0cc007c9680e18717381c3a000d26275f4 (patch) | |
| tree | f8e5663e47caf3b2385ab2ea56d0c633112bd832 /lib/SlackBuilder/Download.hs | |
| parent | 5b4caa8ff75ab50b673e5d5b9ae37eb73fb21c2a (diff) | |
| download | slackbuilder-ae63ff0cc007c9680e18717381c3a000d26275f4.tar.gz | |
Support HTTP and HTTPS URLs
Diffstat (limited to 'lib/SlackBuilder/Download.hs')
| -rw-r--r-- | lib/SlackBuilder/Download.hs | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs index cf8b496..37f0eed 100644 --- a/lib/SlackBuilder/Download.hs +++ b/lib/SlackBuilder/Download.hs @@ -51,6 +51,7 @@ import Text.URI (URI(..)) import qualified Text.URI as URI import Network.HTTP.Req ( useHttpsURI + , useURI , HEAD(..) , NoReqBody(..) , req @@ -258,7 +259,7 @@ download uri packagePath = runReq defaultHttpConfig go $ URI.unRText $ NonEmpty.last $ snd uriPath - | otherwise = throwM $ HttpsUrlExpected uri + | otherwise = throwM $ UnsupportedUrlType uri readResponse :: FilePath -> Response BodyReader -> IO (FilePath, Digest MD5) readResponse downloadFileName response = do let attachmentName = dispositionAttachment response @@ -347,7 +348,11 @@ reqGet :: (MonadThrow m, MonadHttp m) => URI -> (Response BodyReader -> IO a) -> m a -reqGet uri bodyReader - | Just (httpsURI, httpsOptions) <- useHttpsURI uri = - reqBr GET httpsURI NoReqBody httpsOptions bodyReader - | otherwise = throwM $ HttpsUrlExpected uri +reqGet uri bodyReader = + case useURI uri of + Just urlWithOptions + | Left (httpsURI, httpsOptions) <- urlWithOptions -> + reqBr GET httpsURI NoReqBody httpsOptions bodyReader + | Right (httpsURI, httpsOptions) <- urlWithOptions -> + reqBr GET httpsURI NoReqBody httpsOptions bodyReader + _ -> throwM $ UnsupportedUrlType uri |