Support HTTP and HTTPS URLs
This commit is contained in:
@@ -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
|
||||
|
Reference in New Issue
Block a user