implemented basic logic for readURL

src/Network/Gemini/Capsule.hs

@@ -24,36 +24,18 @@ License along with this program.  If not, see
 
 -}
 
-{-# LANGUAGE
-    LambdaCase,
-    OverloadedStrings,
-    ScopedTypeVariables,
-    RecordWildCards #-}
+{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}
 
 module Network.Gemini.Capsule (
-  -- * Running a Gemini Server
-  runGemCapsule,
-  -- * Encoding/Decoding Functions
-  encodeGemURL,
-  decodeGemURL,
-  escapeString,
-  unescapeString
+  runGemCapsule
 ) where
 
 import Control.Concurrent (forkIO)
 import Control.Exception (IOException, try)
 import Control.Exception.Base (bracket, finally)
 import Control.Monad (void)
-import qualified Data.ByteString as BS
-import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
-import qualified Data.ByteString.Lazy as BSL
-import Data.Char (chr, ord, toLower)
 import qualified Data.Connection as C
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.List (find, intercalate)
-import Data.Maybe (fromJust)
-import qualified Data.Text as T
-import Data.Text.Encoding (decodeUtf8')
 import Data.TLSSetting (makeServerParams)
 import Data.X509 (Certificate, CertificateChain (..), getSigned, signedObject)
 import qualified Network.Socket as S
@@ -85,106 +67,13 @@ runGemCapsule settings handler = bracket
     listenLoop sock params handler
   )
 
--- | Encodes a 'GemURL' into a 'String'
-encodeGemURL :: GemURL -> String
-encodeGemURL url =
-  "gemini://" ++ authority ++ "/" ++ path ++ query
-  where
-    authority = gemHost url ++ case gemPort url of
-      Just port -> ':' : show port
-      Nothing   -> ""
-    path = intercalate "/" $ map escapeString $ gemPath url
-    query = case gemQuery url of
-      Nothing -> ""
-      Just q  -> '?' : escapeString q
-
--- | Decodes a 'GemURL' from a 'String' (if possible)
-decodeGemURL :: String -> Maybe GemURL
-decodeGemURL str = do
-  let txt = T.pack str
-
-  noProt <- case T.splitOn "://" txt of
-    [prot, rest] -> if T.toLower prot == "gemini"
-      then Just rest
-      else Nothing
-    _ -> Nothing
-
-  noFrag <- case T.splitOn "#" noProt of
-    [x, _] -> Just x
-    [x]    -> Just x
-    _      -> Nothing
-
-  (noQuery, query) <- case T.splitOn "?" noFrag of
-    [nq, q] -> Just (nq, Just q)
-    [nq]    -> Just (nq, Nothing)
-    _       -> Nothing
-
-  gemQuery <- case query of
-    Just q  -> Just <$> unescapeString (T.unpack q)
-    Nothing -> Just Nothing
-
-  (auth, path) <- case T.splitOn "/" noQuery of
-    [a]     -> Just (a, [])
-    [a, ""] -> Just (a, [])
-    a:ps    -> Just (a, ps)
-    _       -> Nothing
-
-  gemPath  <- mapM (unescapeString . T.unpack) path
-
-  (host, gemPort) <- case T.splitOn ":" auth of
-    [h, p] -> case reads $ T.unpack p of
-      [(n, "")] -> Just (h, Just n)
-      _         -> Nothing
-    [h] -> Just (h, Nothing)
-    _   -> Nothing
-
-  let gemHost = T.unpack host
-  Just GemURL {..}
-
--- | add required escape sequences to a string
-escapeString :: String -> String
-escapeString = concatMap
-  ( \n -> let ch = chr $ fromIntegral n in
-    if ch `elem` unescaped
-    then [ch]
-    else '%' : toHex n
-  ) . BSL.unpack . toLazyByteString . stringUtf8
-  where
-    unescaped = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ "~-_."
-    toHex =
-      ( \n -> let
-        high = n `div` 16
-        low  = n `mod` 16
-        in [hexDigits !! high, hexDigits !! low]
-      ) . fromIntegral
-
--- | decode an escaped string back to its original value
-unescapeString :: String -> Maybe String
-unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
-    Right t -> Just $ T.unpack t
-    _       -> Nothing
-  where
-    toBytes = \case
-      "" -> []
-      '%':h:l:sub -> let
-        h' = toLower h
-        l' = toLower l
-        in if h' `elem` hexDigits && l' `elem` hexDigits
-        then toByte h' l' : toBytes sub
-        else fromIntegral (ord '%') : toBytes (h : l : sub)
-      ch:sub ->
-        BSL.unpack (toLazyByteString $ charUtf8 ch) ++ toBytes sub
-    toByte h l = toNum h * 16 + toNum l
-    toNum ch = fst $ fromJust $
-      find (\x -> snd x == ch) $ zip [0..] hexDigits
-
 listenLoop :: S.Socket -> ServerParams -> GemHandler -> IO a
 listenLoop sock params handler = do
   certRef <- newIORef Nothing
   let params' = adjustServerParams certRef params
   try (accept params' sock) >>= \case
-    Left (_ :: IOException) -> return ()
-    Right conn              -> void $ forkIO $ finally
+    Left (_::IOException) -> return ()
+    Right conn            -> void $ forkIO $ finally
       (readIORef certRef >>= runConnection conn handler)
       (C.close conn)
   listenLoop sock params handler
@@ -222,7 +111,4 @@ runConnection conn handler mCert =
     Just url -> handler (newGemRequest url) { reqCert = mCert }
   ) >>= sendResponse conn
 
-hexDigits :: String
-hexDigits = ['0'..'9'] ++ ['a'..'f']
-
 --jl

src/Network/Gemini/Capsule/Encoding.hs

@@ -0,0 +1,143 @@
+{-|
+
+Module      : Network.Gemini.Capsule.Encoding
+Description : funcitons to encode/decode our data types
+Copyright   : (C) Jonathan Lamothe
+License     : AGPL-3.0-or-later
+Maintainer  : jonathan@jlamothe.net
+Stability   : experimental
+Portability : POSIX
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as
+published by the Free Software Foundation, either version 3 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public
+License along with this program.  If not, see
+<https://www.gnu.org/licenses/>.
+
+-}
+
+{-# LANGUAGE LambdaCase, OverloadedStrings, RecordWildCards #-}
+
+module Network.Gemini.Capsule.Encoding (
+  encodeGemURL,
+  decodeGemURL,
+  escapeString,
+  unescapeString
+) where
+
+import qualified Data.ByteString as BS
+import Data.ByteString.Builder (charUtf8, stringUtf8, toLazyByteString)
+import qualified Data.ByteString.Lazy as BSL
+import Data.Char (chr, ord, toLower)
+import Data.List (find, intercalate)
+import Data.Maybe (fromJust)
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8')
+
+import Network.Gemini.Capsule.Types
+
+-- | Encodes a 'GemURL' into a 'String'
+encodeGemURL :: GemURL -> String
+encodeGemURL url =
+  "gemini://" ++ authority ++ "/" ++ path ++ query
+  where
+    authority = gemHost url ++ case gemPort url of
+      Just port -> ':' : show port
+      Nothing   -> ""
+    path = intercalate "/" $ map escapeString $ gemPath url
+    query = case gemQuery url of
+      Nothing -> ""
+      Just q  -> '?' : escapeString q
+
+-- | Decodes a 'GemURL' from a 'String' (if possible)
+decodeGemURL :: String -> Maybe GemURL
+decodeGemURL str = do
+  let txt = T.pack str
+
+  noProt <- case T.splitOn "://" txt of
+    [prot, rest] -> if T.toLower prot == "gemini"
+      then Just rest
+      else Nothing
+    _ -> Nothing
+
+  noFrag <- case T.splitOn "#" noProt of
+    [x, _] -> Just x
+    [x]    -> Just x
+    _      -> Nothing
+
+  (noQuery, query) <- case T.splitOn "?" noFrag of
+    [nq, q] -> Just (nq, Just q)
+    [nq]    -> Just (nq, Nothing)
+    _       -> Nothing
+
+  gemQuery <- case query of
+    Just q  -> Just <$> unescapeString (T.unpack q)
+    Nothing -> Just Nothing
+
+  (auth, path) <- case T.splitOn "/" noQuery of
+    [a]     -> Just (a, [])
+    [a, ""] -> Just (a, [])
+    a:ps    -> Just (a, ps)
+    _       -> Nothing
+
+  gemPath  <- mapM (unescapeString . T.unpack) path
+
+  (host, gemPort) <- case T.splitOn ":" auth of
+    [h, p] -> case reads $ T.unpack p of
+      [(n, "")] -> Just (h, Just n)
+      _         -> Nothing
+    [h] -> Just (h, Nothing)
+    _   -> Nothing
+
+  let gemHost = T.unpack host
+  Just GemURL {..}
+
+-- | add required escape sequences to a string
+escapeString :: String -> String
+escapeString = concatMap
+  ( \n -> let ch = chr $ fromIntegral n in
+    if ch `elem` unescaped
+    then [ch]
+    else '%' : toHex n
+  ) . BSL.unpack . toLazyByteString . stringUtf8
+  where
+    unescaped = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] ++ "~-_."
+    toHex =
+      ( \n -> let
+        high = n `div` 16
+        low  = n `mod` 16
+        in [hexDigits !! high, hexDigits !! low]
+      ) . fromIntegral
+
+-- | decode an escaped string back to its original value
+unescapeString :: String -> Maybe String
+unescapeString str = case decodeUtf8' $ BS.pack $ toBytes str of
+    Right t -> Just $ T.unpack t
+    _       -> Nothing
+  where
+    toBytes = \case
+      "" -> []
+      '%':h:l:sub -> let
+        h' = toLower h
+        l' = toLower l
+        in if h' `elem` hexDigits && l' `elem` hexDigits
+        then toByte h' l' : toBytes sub
+        else fromIntegral (ord '%') : toBytes (h : l : sub)
+      ch:sub ->
+        BSL.unpack (toLazyByteString $ charUtf8 ch) ++ toBytes sub
+    toByte h l = toNum h * 16 + toNum l
+    toNum ch = fst $ fromJust $
+      find (\x -> snd x == ch) $ zip [0..] hexDigits
+
+hexDigits :: String
+hexDigits = ['0'..'9'] ++ ['a'..'f']
+
+--jl

src/Network/Gemini/Capsule/Internal.hs

@@ -30,6 +30,8 @@ time.
 
 -}
 
+{-# LANGUAGE LambdaCase #-}
+
 module Network.Gemini.Capsule.Internal (
   readURL,
   sendResponse
@@ -37,14 +39,24 @@ module Network.Gemini.Capsule.Internal (
 
 import Data.Connection (Connection)
 
+import Network.Gemini.Capsule.Encoding
 import Network.Gemini.Capsule.Types
 
+-- Constants
+
+-- Maximum size to read from a conneciton
+inBufSize :: Int
+inBufSize = 1026
+
 -- | Reads a 'GemURL' from a 'Connection'
 readURL
   :: Connection a
   -- ^ the connection
   -> IO (Maybe GemURL)
-readURL = undefined
+readURL conn =
+  strFromConn inBufSize conn >>= \case
+    Nothing  -> return Nothing
+    Just str -> return $ decodeGemURL str
 
 -- | Sends a 'GemResponse' to a 'Connection'
 sendResponse
@@ -55,4 +67,15 @@ sendResponse
   -> IO ()
 sendResponse = undefined
 
+-- | Reads up to a maxumum number of bytes from a 'Connection', UTF-8
+-- decodes it, and returns the resulting string (if possible) without
+-- the trailing CR/LF
+strFromConn
+  :: Int
+  -- ^ The maximum number of bytes to read
+  -> Connection a
+  -- ^ The connection to read from
+  -> IO (Maybe String)
+strFromConn = undefined
+
 --jl