~alcinnz/hurl

2d5e8445c3e4d5d88d7eb7910ffee950dbd6b816 — Adrian Cochrane 4 years ago 5123ffb
Add support for about: URIs.
1 files changed, 18 insertions(+), 2 deletions(-)

M src/Network/URI/Fetch.hs
M src/Network/URI/Fetch.hs => src/Network/URI/Fetch.hs +18 -2
@@ 11,6 11,9 @@ import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import           Control.Exception

-- for about: URIs, all standard lib
import Data.Maybe (fromMaybe, listToMaybe)

#ifdef WITH_HTTP_URI
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Client.TLS as TLS


@@ 40,7 43,9 @@ data Session = Session {
    apps :: XDGConfig,
#endif
    -- | The languages (RFC2616-encoded) to which responses should be localized.
    locale :: [String]
    locale :: [String],
    -- | Additional files to serve from about: URIs.
    aboutPages :: [(FilePath, ByteString)]
}

-- | Initializes a default Session object to support HTTPS & Accept-Language


@@ 62,14 67,25 @@ newSession = do
#ifdef WITH_XDG
        apps = apps',
#endif
        locale = ietfLocale
        locale = ietfLocale,
        aboutPages = []
    }

llookup key fallback map = fallback `fromMaybe` listToMaybe [v | (k, v) <- map, k == key]

-- | Retrieves a URL-identified resource & it's MIMEtype, possibly decoding it's text.
fetchURL :: Session -- ^ The session of which this request is a part.
    -> [String] -- ^ The expected MIMEtypes in priority order.
    -> URI -- ^ The URL to retrieve
    -> IO (String, Either Text ByteString) -- ^ The MIMEtype & possibly text-decoded response.
fetchURL session mimes uri@(URI {uriScheme = "about:", uriPath = ""}) =
    fetchURL session mimes $ uri {uriPath = "version"}
fetchURL Session {aboutPages = pages} _ URI {uriScheme = "about:", uriPath = path} =
    return (
        Txt.unpack $ convertCharset "utf-8" $ B.toStrict $
            llookup (path ++ ".mime") "text/html" pages,
        Right $ llookup path "" pages)

#ifdef WITH_HTTP_URI
fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "https:"] = do
    request <- HTTP.requestFromURI uri