From a61806f8e439d6072725cd8d4bede18ce93bc9cd Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Sun, 24 Oct 2021 12:47:37 -0400 Subject: [PATCH] implemented unescapeString --- gemserv.cabal | 4 ++++ package.yaml | 2 ++ src/Network/GemServ.hs | 35 ++++++++++++++++++++++++++++++++--- test/Network/GemServSpec.hs | 18 ++++++++++++++++++ 4 files changed, 56 insertions(+), 3 deletions(-) diff --git a/gemserv.cabal b/gemserv.cabal index 61cc79e..b510345 100644 --- a/gemserv.cabal +++ b/gemserv.cabal @@ -30,7 +30,9 @@ library ghc-options: -Wall build-depends: base >=4.7 && <5 + , bytestring >=0.10.12.0 && <0.11 , tcp-streams >=1.0.1.1 && <1.1 + , text >=1.2.4.1 && <1.3 , tls , x509 default-language: Haskell2010 @@ -46,9 +48,11 @@ test-suite gemserv-test ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , bytestring >=0.10.12.0 && <0.11 , gemserv , hspec >=2.7.10 && <2.8 , tcp-streams >=1.0.1.1 && <1.1 + , text >=1.2.4.1 && <1.3 , tls , x509 default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 4d8ffb5..f2c3840 100644 --- a/package.yaml +++ b/package.yaml @@ -23,7 +23,9 @@ ghc-options: dependencies: - base >= 4.7 && < 5 +- bytestring >= 0.10.12.0 && < 0.11 - tcp-streams >= 1.0.1.1 && < 1.1 +- text >= 1.2.4.1 && < 1.3 - tls - x509 diff --git a/src/Network/GemServ.hs b/src/Network/GemServ.hs index 2f25344..9dcf8d5 100644 --- a/src/Network/GemServ.hs +++ b/src/Network/GemServ.hs @@ -24,13 +24,22 @@ License along with this program. If not, see -} +{-# LANGUAGE LambdaCase #-} + module Network.GemServ ( encodeRequest, - escapeString + escapeString, + unescapeString ) where -import Data.Char (ord) -import Data.List (intercalate) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (charUtf8, toLazyByteString) +import qualified Data.ByteString.Lazy as BSL +import Data.Char (ord, toLower) +import Data.List (find, intercalate) +import Data.Maybe (fromJust) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8') import Network.GemServ.Types @@ -61,6 +70,26 @@ escapeString = concatMap $ \ch -> low = n `mod` 16 in [hexDigits !! high, hexDigits !! low] +-- | 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'] diff --git a/test/Network/GemServSpec.hs b/test/Network/GemServSpec.hs index ebdc3e4..b58c21f 100644 --- a/test/Network/GemServSpec.hs +++ b/test/Network/GemServSpec.hs @@ -31,6 +31,7 @@ spec :: Spec spec = describe "Network.GemServ" $ do encodeRequestSpec escapeStringSpec + unescapeStringSpec encodeRequestSpec :: Spec encodeRequestSpec = describe "encodeRequest" $ mapM_ @@ -76,4 +77,21 @@ escapeStringSpec = describe "escapeString" $ mapM_ , ( "foo:/?=&#%", "foo%3a%2f%3f%3d%26%23%25" ) ] +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