1 files changed, 18 insertions(+), 2 deletions(-)

M src/Network/URI/Fetch.hs

@@ 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