Support HTTP and HTTPS URLs
This commit is contained in:
parent
5b4caa8ff7
commit
ae63ff0cc0
@ -51,6 +51,7 @@ import Text.URI (URI(..))
|
|||||||
import qualified Text.URI as URI
|
import qualified Text.URI as URI
|
||||||
import Network.HTTP.Req
|
import Network.HTTP.Req
|
||||||
( useHttpsURI
|
( useHttpsURI
|
||||||
|
, useURI
|
||||||
, HEAD(..)
|
, HEAD(..)
|
||||||
, NoReqBody(..)
|
, NoReqBody(..)
|
||||||
, req
|
, req
|
||||||
@ -258,7 +259,7 @@ download uri packagePath = runReq defaultHttpConfig go
|
|||||||
$ URI.unRText
|
$ URI.unRText
|
||||||
$ NonEmpty.last
|
$ NonEmpty.last
|
||||||
$ snd uriPath
|
$ snd uriPath
|
||||||
| otherwise = throwM $ HttpsUrlExpected uri
|
| otherwise = throwM $ UnsupportedUrlType uri
|
||||||
readResponse :: FilePath -> Response BodyReader -> IO (FilePath, Digest MD5)
|
readResponse :: FilePath -> Response BodyReader -> IO (FilePath, Digest MD5)
|
||||||
readResponse downloadFileName response = do
|
readResponse downloadFileName response = do
|
||||||
let attachmentName = dispositionAttachment response
|
let attachmentName = dispositionAttachment response
|
||||||
@ -347,7 +348,11 @@ reqGet :: (MonadThrow m, MonadHttp m)
|
|||||||
=> URI
|
=> URI
|
||||||
-> (Response BodyReader -> IO a)
|
-> (Response BodyReader -> IO a)
|
||||||
-> m a
|
-> m a
|
||||||
reqGet uri bodyReader
|
reqGet uri bodyReader =
|
||||||
| Just (httpsURI, httpsOptions) <- useHttpsURI uri =
|
case useURI uri of
|
||||||
|
Just urlWithOptions
|
||||||
|
| Left (httpsURI, httpsOptions) <- urlWithOptions ->
|
||||||
reqBr GET httpsURI NoReqBody httpsOptions bodyReader
|
reqBr GET httpsURI NoReqBody httpsOptions bodyReader
|
||||||
| otherwise = throwM $ HttpsUrlExpected uri
|
| Right (httpsURI, httpsOptions) <- urlWithOptions ->
|
||||||
|
reqBr GET httpsURI NoReqBody httpsOptions bodyReader
|
||||||
|
_ -> throwM $ UnsupportedUrlType uri
|
||||||
|
@ -23,7 +23,7 @@ import qualified Codec.Compression.Lzma as Lzma
|
|||||||
|
|
||||||
data SlackBuilderException
|
data SlackBuilderException
|
||||||
= UpdaterNotFound Text
|
= UpdaterNotFound Text
|
||||||
| HttpsUrlExpected URI
|
| UnsupportedUrlType URI
|
||||||
| LzmaDecompressionFailed Lzma.LzmaRet
|
| LzmaDecompressionFailed Lzma.LzmaRet
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
@ -31,7 +31,7 @@ instance Exception SlackBuilderException
|
|||||||
where
|
where
|
||||||
displayException (UpdaterNotFound updateName) = Text.unpack
|
displayException (UpdaterNotFound updateName) = Text.unpack
|
||||||
$ Text.concat ["Requested package \"", updateName, "\" was not found"]
|
$ Text.concat ["Requested package \"", updateName, "\" was not found"]
|
||||||
displayException (HttpsUrlExpected givenURI) = Text.unpack
|
displayException (UnsupportedUrlType givenURI) = Text.unpack
|
||||||
$ "Only https URLs are supported, got: " <> URI.render givenURI
|
$ "Only https URLs are supported, got: " <> URI.render givenURI
|
||||||
displayException (LzmaDecompressionFailed Lzma.LzmaRetOK) =
|
displayException (LzmaDecompressionFailed Lzma.LzmaRetOK) =
|
||||||
"Operation completed successfully"
|
"Operation completed successfully"
|
||||||
|
Loading…
Reference in New Issue
Block a user