diff --git a/gemcap.cabal b/gemcap.cabal
index 83772a4..eef8732 100644
--- a/gemcap.cabal
+++ b/gemcap.cabal
@@ -24,6 +24,7 @@ extra-source-files:
library
exposed-modules:
Network.Gemini.Capsule
+ Network.Gemini.Capsule.Encoding
Network.Gemini.Capsule.Internal
Network.Gemini.Capsule.Types
other-modules:
@@ -34,6 +35,7 @@ library
build-depends:
base >=4.7 && <5
, bytestring >=0.10.12.0 && <0.11
+ , io-streams
, network
, tcp-streams >=1.0.1.1 && <1.1
, text >=1.2.4.1 && <1.3
@@ -46,6 +48,7 @@ test-suite gemcap-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
+ Network.Gemini.Capsule.EncodingSpec
Network.Gemini.Capsule.InternalSpec
Network.Gemini.CapsuleSpec
Paths_gemcap
@@ -57,6 +60,7 @@ test-suite gemcap-test
, bytestring >=0.10.12.0 && <0.11
, gemcap
, hspec >=2.7.10 && <2.8
+ , io-streams
, network
, tcp-streams >=1.0.1.1 && <1.1
, text >=1.2.4.1 && <1.3
diff --git a/package.yaml b/package.yaml
index 856a878..b836528 100644
--- a/package.yaml
+++ b/package.yaml
@@ -28,6 +28,7 @@ dependencies:
- bytestring >= 0.10.12.0 && < 0.11
- tcp-streams >= 1.0.1.1 && < 1.1
- text >= 1.2.4.1 && < 1.3
+- io-streams
- network
- tls
- x509
diff --git a/src/Network/Gemini/Capsule.hs b/src/Network/Gemini/Capsule.hs
index 5540e49..94fac5a 100644
--- a/src/Network/Gemini/Capsule.hs
+++ b/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
diff --git a/src/Network/Gemini/Capsule/Encoding.hs b/src/Network/Gemini/Capsule/Encoding.hs
new file mode 100644
index 0000000..8d40d03
--- /dev/null
+++ b/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
+.
+
+-}
+
+{-# 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
diff --git a/src/Network/Gemini/Capsule/Internal.hs b/src/Network/Gemini/Capsule/Internal.hs
index 4279230..8f14cf7 100644
--- a/src/Network/Gemini/Capsule/Internal.hs
+++ b/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
diff --git a/test/Network/Gemini/Capsule/EncodingSpec.hs b/test/Network/Gemini/Capsule/EncodingSpec.hs
new file mode 100644
index 0000000..02f816d
--- /dev/null
+++ b/test/Network/Gemini/Capsule/EncodingSpec.hs
@@ -0,0 +1,146 @@
+{-
+
+gemcap
+
+Cooyright (C) Jonathan Lamothe
+
+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
+.
+
+-}
+
+module Network.Gemini.Capsule.EncodingSpec (spec) where
+
+import Test.Hspec (Spec, context, describe, it, shouldBe)
+
+import Network.Gemini.Capsule.Encoding
+import Network.Gemini.Capsule.Types
+
+spec :: Spec
+spec = describe "Encoding" $ do
+ encodeGemURLSpec
+ decodeGemURLSpec
+ escapeStringSpec
+ unescapeStringSpec
+
+encodeGemURLSpec :: Spec
+encodeGemURLSpec = describe "encodeGemURL" $ mapM_
+ ( \(desc, req, expected) -> context desc $
+ it ("should be " ++ show expected) $
+ encodeGemURL req `shouldBe` expected
+ )
+
+ -- description, request, expected
+ [ ( "simple", simpleURL, simpleExp )
+ , ( "with port", withPortURL, withPortExp )
+ , ( "with path", withPathURL, withPathExp )
+ , ( "with query", withQueryURL, withQueryExp )
+ , ( "blank query", blankQueryURL, blankQueryExp )
+ , ( "with escape", withEscapeURL, withEscapeExp )
+ ]
+
+ where
+ simpleURL = newGemURL "example.com"
+ simpleExp = "gemini://example.com/"
+ withPortURL = simpleURL { gemPort = Just 1965 }
+ withPortExp = "gemini://example.com:1965/"
+ withPathURL = simpleURL { gemPath = ["foo", "bar"] }
+ withPathExp = "gemini://example.com/foo/bar"
+ withQueryURL = simpleURL { gemQuery = Just "foo" }
+ withQueryExp = "gemini://example.com/?foo"
+ blankQueryURL = simpleURL { gemQuery = Just "" }
+ blankQueryExp = "gemini://example.com/?"
+
+ withEscapeURL = simpleURL
+ { gemPath = ["foo bar"]
+ , gemQuery = Just "baz quux"
+ }
+
+ withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
+
+decodeGemURLSpec :: Spec
+decodeGemURLSpec = describe "decodeGemURL" $ mapM_
+ ( \(str, expected) -> context (show str) $
+ it ("should be " ++ show expected) $
+ decodeGemURL str `shouldBe` expected
+ )
+
+ -- URL string, expected
+ [ ( simpleStr, Just simpleURL )
+ , ( withSlashStr, Just simpleURL )
+ , ( withPathStr, Just withPathURL )
+ , ( withQueryStr, Just withQueryURL )
+ , ( pathQueryStr, Just pathQueryURL )
+ , ( blankQueryStr, Just blankQueryURL )
+ , ( withFragmentStr, Just simpleURL )
+ , ( escapedStr, Just escapedURL )
+ , ( httpStr, Nothing )
+ , ( malformed, Nothing )
+ , ( "", Nothing )
+ ]
+
+ where
+ simpleStr = "gemini://example.com"
+ simpleURL = newGemURL "example.com"
+ withSlashStr = simpleStr ++ "/"
+ withPathStr = simpleStr ++ "/foo/bar"
+ withPathURL = simpleURL { gemPath = ["foo", "bar"] }
+ withQueryStr = simpleStr ++ "?foo"
+ withQueryURL = simpleURL { gemQuery = Just "foo" }
+ pathQueryStr = withPathStr ++ "?baz"
+ pathQueryURL = withPathURL { gemQuery = Just "baz" }
+ blankQueryStr = simpleStr ++"?"
+ blankQueryURL = simpleURL { gemQuery = Just "" }
+ withFragmentStr = simpleStr ++ "#foo"
+ escapedStr = simpleStr ++ "/foo%20bar/baz?quux%20stuff"
+
+ escapedURL = simpleURL
+ { gemPath = ["foo bar", "baz"]
+ , gemQuery = Just "quux stuff"
+ }
+
+ httpStr = "http://example.com"
+ malformed = "foo"
+
+escapeStringSpec :: Spec
+escapeStringSpec = describe "escapeString" $ mapM_
+ ( \(input, expected) -> context (show input) $
+ it ("should be " ++ show expected) $
+ escapeString input `shouldBe` expected
+ )
+
+ -- input, expected
+ [ ( "~foo-bar_baz.quux", "~foo-bar_baz.quux" )
+ , ( "foo:/?=%", "foo%3a%2f%3f%3d%26%23%25" )
+ , ( "foo\xe9", "foo%c3%a9" )
+ ]
+
+unescapeStringSpec :: Spec
+unescapeStringSpec = describe "unescapeString" $ mapM_
+ ( \(input, expected) -> context (show input) $
+ it ("should be " ++ show expected) $
+ unescapeString input `shouldBe` expected
+ )
+
+ -- input, expected
+ [ ( "foo", Just "foo" )
+ , ( "foo%20bar", Just "foo bar" )
+ , ( "foo%7x", Just "foo%7x" )
+ , ( "foo%a", Just "foo%a" )
+ , ( "foo%", Just "foo%" )
+ , ( "foo%c3%a9", Just "foo\xe9" )
+ , ( "foo%ff", Nothing )
+ ]
+
+--jl
diff --git a/test/Network/Gemini/Capsule/InternalSpec.hs b/test/Network/Gemini/Capsule/InternalSpec.hs
index 7131ae2..390381f 100644
--- a/test/Network/Gemini/Capsule/InternalSpec.hs
+++ b/test/Network/Gemini/Capsule/InternalSpec.hs
@@ -20,11 +20,70 @@ License along with this program. If not, see
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Network.Gemini.Capsule.InternalSpec (spec) where
-import Test.Hspec (Spec, describe)
+import qualified Data.ByteString as BS
+import Data.Char (ord)
+import Data.Connection (Connection (..))
+import System.IO.Streams (nullInput, unRead)
+import Test.Hspec (Spec, context, describe, shouldReturn, xit)
+
+import Network.Gemini.Capsule.Types
+import Network.Gemini.Capsule.Internal
spec :: Spec
-spec = describe "Internal" $ return ()
+spec = describe "Internal" $ do
+ readURLSpec
+ sendResponseSpec
+ strFromConnSpec
+
+readURLSpec :: Spec
+readURLSpec = describe "readURL" $ mapM_
+ ( \(desc, ioConn, expect) -> context desc $
+ xit ("should return " ++ show expect) $
+ do
+ conn <- ioConn
+ readURL conn `shouldReturn` expect
+ )
+
+ -- description, connection, expected result
+ [ ( "valid URL", validConn, Just validExp )
+ , ( "long URL", longConn, Just longExp )
+ , ( "too long URL", tooLongConn, Nothing )
+ , ( "gibberish input", gibConn, Nothing )
+ ]
+
+ where
+ validConn = mkConn "gemini://example.com/\r\n"
+ longConn = mkConn longBS
+ tooLongConn = mkConn tooLongBS
+ gibConn = mkConn "aosidjfwoeinboijwefr"
+ longBS = BS.pack (take 1024 bytes) <> "\r\n"
+ tooLongBS = BS.pack (take 1025 bytes) <> "\r\n"
+ bytes = BS.unpack prefix ++ repeat (fromIntegral $ ord 'A')
+ validExp = newGemURL "example.com"
+ longExp = validExp { gemPath = [longDir] }
+ longDir = replicate (1024 - BS.length prefix) 'A'
+ prefix = "gemini://example.com/"
+ mkConn bs = do
+ s <- nullInput
+ unRead bs s
+ return sampleConnection { source = s }
+
+sendResponseSpec :: Spec
+sendResponseSpec = describe "sendResponse" $ return ()
+
+sampleConnection :: Connection a
+sampleConnection = Connection
+ { source = undefined
+ , send = const $ return ()
+ , close = return ()
+ , connExtraInfo = undefined
+ }
+
+strFromConnSpec :: Spec
+strFromConnSpec = describe "strFromConn" $ return ()
--jl
diff --git a/test/Network/Gemini/CapsuleSpec.hs b/test/Network/Gemini/CapsuleSpec.hs
index 85f6fb6..fccdc80 100644
--- a/test/Network/Gemini/CapsuleSpec.hs
+++ b/test/Network/Gemini/CapsuleSpec.hs
@@ -22,128 +22,14 @@ License along with this program. If not, see
module Network.Gemini.CapsuleSpec (spec) where
-import Test.Hspec (Spec, context, describe, it, shouldBe)
+import Test.Hspec (Spec, describe)
+import qualified Network.Gemini.Capsule.EncodingSpec as Encoding
import qualified Network.Gemini.Capsule.InternalSpec as Internal
-import Network.Gemini.Capsule
-import Network.Gemini.Capsule.Types
-
spec :: Spec
spec = describe "Network.Gemini.Capsule" $ do
+ Encoding.spec
Internal.spec
- encodeGemURLSpec
- decodeGemURLSpec
- escapeStringSpec
- unescapeStringSpec
-
-encodeGemURLSpec :: Spec
-encodeGemURLSpec = describe "encodeGemURL" $ mapM_
- ( \(desc, req, expected) -> context desc $
- it ("should be " ++ show expected) $
- encodeGemURL req `shouldBe` expected
- )
-
- -- description, request, expected
- [ ( "simple", simpleURL, simpleExp )
- , ( "with port", withPortURL, withPortExp )
- , ( "with path", withPathURL, withPathExp )
- , ( "with query", withQueryURL, withQueryExp )
- , ( "blank query", blankQueryURL, blankQueryExp )
- , ( "with escape", withEscapeURL, withEscapeExp )
- ]
-
- where
- simpleURL = newGemURL "example.com"
- simpleExp = "gemini://example.com/"
- withPortURL = simpleURL { gemPort = Just 1965 }
- withPortExp = "gemini://example.com:1965/"
- withPathURL = simpleURL { gemPath = ["foo", "bar"] }
- withPathExp = "gemini://example.com/foo/bar"
- withQueryURL = simpleURL { gemQuery = Just "foo" }
- withQueryExp = "gemini://example.com/?foo"
- blankQueryURL = simpleURL { gemQuery = Just "" }
- blankQueryExp = "gemini://example.com/?"
-
- withEscapeURL = simpleURL
- { gemPath = ["foo bar"]
- , gemQuery = Just "baz quux"
- }
-
- withEscapeExp = "gemini://example.com/foo%20bar?baz%20quux"
-
-decodeGemURLSpec :: Spec
-decodeGemURLSpec = describe "decodeGemURL" $ mapM_
- ( \(str, expected) -> context (show str) $
- it ("should be " ++ show expected) $
- decodeGemURL str `shouldBe` expected
- )
-
- -- URL string, expected
- [ ( simpleStr, Just simpleURL )
- , ( withSlashStr, Just simpleURL )
- , ( withPathStr, Just withPathURL )
- , ( withQueryStr, Just withQueryURL )
- , ( pathQueryStr, Just pathQueryURL )
- , ( blankQueryStr, Just blankQueryURL )
- , ( withFragmentStr, Just simpleURL )
- , ( escapedStr, Just escapedURL )
- , ( httpStr, Nothing )
- , ( malformed, Nothing )
- , ( "", Nothing )
- ]
-
- where
- simpleStr = "gemini://example.com"
- simpleURL = newGemURL "example.com"
- withSlashStr = simpleStr ++ "/"
- withPathStr = simpleStr ++ "/foo/bar"
- withPathURL = simpleURL { gemPath = ["foo", "bar"] }
- withQueryStr = simpleStr ++ "?foo"
- withQueryURL = simpleURL { gemQuery = Just "foo" }
- pathQueryStr = withPathStr ++ "?baz"
- pathQueryURL = withPathURL { gemQuery = Just "baz" }
- blankQueryStr = simpleStr ++"?"
- blankQueryURL = simpleURL { gemQuery = Just "" }
- withFragmentStr = simpleStr ++ "#foo"
- escapedStr = simpleStr ++ "/foo%20bar/baz?quux%20stuff"
-
- escapedURL = simpleURL
- { gemPath = ["foo bar", "baz"]
- , gemQuery = Just "quux stuff"
- }
-
- httpStr = "http://example.com"
- malformed = "foo"
-
-escapeStringSpec :: Spec
-escapeStringSpec = describe "escapeString" $ mapM_
- ( \(input, expected) -> context (show input) $
- it ("should be " ++ show expected) $
- escapeString input `shouldBe` expected
- )
-
- -- input, expected
- [ ( "~foo-bar_baz.quux", "~foo-bar_baz.quux" )
- , ( "foo:/?=%", "foo%3a%2f%3f%3d%26%23%25" )
- , ( "foo\xe9", "foo%c3%a9" )
- ]
-
-unescapeStringSpec :: Spec
-unescapeStringSpec = describe "unescapeString" $ mapM_
- ( \(input, expected) -> context (show input) $
- it ("should be " ++ show expected) $
- unescapeString input `shouldBe` expected
- )
-
- -- input, expected
- [ ( "foo", Just "foo" )
- , ( "foo%20bar", Just "foo bar" )
- , ( "foo%7x", Just "foo%7x" )
- , ( "foo%a", Just "foo%a" )
- , ( "foo%", Just "foo%" )
- , ( "foo%c3%a9", Just "foo\xe9" )
- , ( "foo%ff", Nothing )
- ]
--jl