2 files changed, 78 insertions(+), 4 deletions(-)

M hurl.cabal
M src/Network/URI/Fetch.hs

@@ 53,6 53,11 @@ Flag http
   Default:     True
   Manual:      True
 
+Flag gemini
+  Description: Support gemini: URIs.
+  Default:     True
+  Manual:      True
+
 Flag file
   Description: Support file: URIs.
   Default:     True


@@ 101,6 106,9 @@ library
     CPP-options:   -DWITH_HTTP_URI
     build-depends: http-client >= 0.6 && <0.7, http-types >= 0.12 && <0.13,
                    http-client-tls >= 0.3 && <0.4
+  if flag(gemini)
+    CPP-options:   -DWITH_GEMINI_URI -DWITH_RAW_CONNECTIONS
+    build-depends: connection == 0.3.0
   if flag(file)
     CPP-options:   -DWITH_FILE_URI
   if flag(data)

@@ 9,21 9,26 @@ import           Data.Text (Text)
 import           Network.URI
 import           Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Char8 as C8
+import           Network.URI.Charset
 import           Control.Exception
 
--- for about: URIs, all standard lib
+-- for about: URIs & port parsing, all standard lib
 import Data.Maybe (fromMaybe, listToMaybe)
+import Text.Read (readMaybe)
 
 #ifdef WITH_HTTP_URI
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.HTTP.Client.TLS as TLS
 import           Network.HTTP.Types
-import           Network.URI.Charset
 import           Data.List (intercalate)
 #endif
 
+#ifdef WITH_RAW_CONNECTIONS
+import Network.Connection
+#endif
+
 #ifdef WITH_DATA_URI
-import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Base64 as B64
 #endif
 


@@ 39,6 44,9 @@ data Session = Session {
 #ifdef WITH_HTTP_URI
     managerHTTP :: HTTP.Manager,
 #endif
+#ifdef WITH_RAW_CONNECTIONS
+    connCtxt :: ConnectionContext,
+#endif
 #ifdef WITH_XDG
     apps :: XDGConfig,
 #endif


@@ 56,6 64,9 @@ newSession = do
 #ifdef WITH_HTTP_URI
     managerHTTP' <- HTTP.newManager TLS.tlsManagerSettings
 #endif
+#ifdef WITH_RAW_CONNECTIONS
+    connCtxt <- initConnectionContext
+#endif
 #ifdef WITH_XDG
     apps' <- loadXDGConfig unixLocale
 #endif


@@ 64,6 75,9 @@ newSession = do
 #ifdef WITH_HTTP_URI
         managerHTTP = managerHTTP',
 #endif
+#ifdef WITH_RAW_CONNECTIONS
+        connCtxt = connCtxt,
+#endif
 #ifdef WITH_XDG
         apps = apps',
 #endif


@@ 72,6 86,8 @@ newSession = do
     }
 
 llookup key fallback map = fallback `fromMaybe` listToMaybe [v | (k, v) <- map, k == key]
+parsePort fallback (':':port) = fallback `fromMaybe` readMaybe port
+parsePort fallback _ = fallback
 
 -- | Retrieves a URL-identified resource & it's MIMEtype, possibly decoding it's text.
 fetchURL :: Session -- ^ The session of which this request is a part.


@@ 102,7 118,7 @@ fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "ht
       ) of
         ("", _) -> ("text/plain", Right $ B.fromStrict $ statusMessage $ HTTP.responseStatus response)
         (response, (mimetype:_)) -> let mime = Txt.toLower $ convertCharset "utf-8" mimetype
-            in resolveCharset (map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" $ mime) response
+            in resolveCharset (map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" mime) response
         (response, []) -> (defaultMIME, Right response)
   `catches` [
     Handler $ \e -> do return ("text/plain", Left $ Txt.pack $ trans (locale session) $ Http e),


@@ 110,6 126,44 @@ fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "ht
   ]
 #endif
 
+#ifdef WITH_GEMINI_URI
+fetchURL sess@Session {connCtxt = ctxt} mimes uri@URI {
+        uriScheme = "gemini:", uriAuthority = Just (URIAuth _ host port)
+    } = do
+        conn <- connectTo ctxt $ ConnectionParams {
+            connectionHostname = host,
+            connectionPort = parsePort 1965 port,
+            -- TODO implement Trust-On-First-Use, client certificates
+            connectionUseSecure = Just $ TLSSettingsSimple False False False,
+            connectionUseSocks = Nothing
+        }
+        connectionPut conn $ C8.pack $ uriToString id uri "\r\n"
+        header <- connectionGetLine 1024 conn
+        ret <- case parseHeader header of
+            -- NOTE: This case won't actually do anything until the caller (Rhapsode) implements forms.
+            ('1', _, label) -> return ("application/xhtml+xml", Left $ Txt.concat [
+                    "<form><label for='input'>",
+                    Txt.replace "<" "&lt;" $ Txt.replace "&" "&amp;" label,
+                    "</label><input id='input' /></form>"
+                ])
+            ('2', _, mime) -> do
+                chunks <- mWhile (connectionWaitForInput conn 60000) $ connectionGetChunk conn
+                let mime' = map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" mime
+                return $ resolveCharset mime' $ B.fromChunks chunks
+            ('3', _, redirect) | Just redirect' <- parseURIReference $ Txt.unpack redirect ->
+                fetchURL sess mimes $ relativeTo redirect' uri
+            -- TODO Implement client certificates, once I have a way for the user/caller to select one.
+            --      And once I figure out how to configure the TLS cryptography.
+            (_, _, err) -> return ("text/plain", Left err)
+        connectionClose conn
+        return ret
+    where
+        parseHeader header
+            | Just (major, header') <- Txt.uncons $ convertCharset "utf-8" header,
+                Just (minor, meta) <- Txt.uncons header' = (major, minor, Txt.strip meta)
+            | otherwise = ('4', '1', "Invalid response!")
+#endif
+
 #ifdef WITH_FILE_URI
 fetchURL Session {locale = l} (defaultMIME:_) uri@URI {uriScheme = "file:"} = do
     response <- B.readFile $ uriPath uri


@@ 152,8 206,20 @@ dispatchByMIME Session {locale = l, apps = a} mime uri = do
 dispatchByMIME _ _ _ = return Nothing
 #endif
 
+-- Utils
+
 #ifdef WITH_DATA_URI
 breakOn c (a:as) | c == a = ([], as)
     | otherwise = let (x, y) = breakOn c as in (a:x, y)
 breakOn _ [] = ([], [])
 #endif
+
+#ifdef WITH_GEMINI_URI
+mWhile test body = do
+    cond <- test
+    if cond then do
+        x <- body
+        xs <- mWhile test body
+        return (x:xs)
+    else return []
+#endif