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