implemented unescapeString

This commit is contained in:
Jonathan Lamothe 2021-10-24 12:47:37 -04:00
parent 3484fda01e
commit a61806f8e4
4 changed files with 56 additions and 3 deletions

View File

@ -30,7 +30,9 @@ library
ghc-options: -Wall ghc-options: -Wall
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, bytestring >=0.10.12.0 && <0.11
, tcp-streams >=1.0.1.1 && <1.1 , tcp-streams >=1.0.1.1 && <1.1
, text >=1.2.4.1 && <1.3
, tls , tls
, x509 , x509
default-language: Haskell2010 default-language: Haskell2010
@ -46,9 +48,11 @@ test-suite gemserv-test
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, bytestring >=0.10.12.0 && <0.11
, gemserv , gemserv
, hspec >=2.7.10 && <2.8 , hspec >=2.7.10 && <2.8
, tcp-streams >=1.0.1.1 && <1.1 , tcp-streams >=1.0.1.1 && <1.1
, text >=1.2.4.1 && <1.3
, tls , tls
, x509 , x509
default-language: Haskell2010 default-language: Haskell2010

View File

@ -23,7 +23,9 @@ ghc-options:
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- bytestring >= 0.10.12.0 && < 0.11
- tcp-streams >= 1.0.1.1 && < 1.1 - tcp-streams >= 1.0.1.1 && < 1.1
- text >= 1.2.4.1 && < 1.3
- tls - tls
- x509 - x509

View File

@ -24,13 +24,22 @@ License along with this program. If not, see
-} -}
{-# LANGUAGE LambdaCase #-}
module Network.GemServ ( module Network.GemServ (
encodeRequest, encodeRequest,
escapeString escapeString,
unescapeString
) where ) where
import Data.Char (ord) import qualified Data.ByteString as BS
import Data.List (intercalate) 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 import Network.GemServ.Types
@ -61,6 +70,26 @@ escapeString = concatMap $ \ch ->
low = n `mod` 16 low = n `mod` 16
in [hexDigits !! high, hexDigits !! low] 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 :: String
hexDigits = ['0'..'9'] ++ ['a'..'f'] hexDigits = ['0'..'9'] ++ ['a'..'f']

View File

@ -31,6 +31,7 @@ spec :: Spec
spec = describe "Network.GemServ" $ do spec = describe "Network.GemServ" $ do
encodeRequestSpec encodeRequestSpec
escapeStringSpec escapeStringSpec
unescapeStringSpec
encodeRequestSpec :: Spec encodeRequestSpec :: Spec
encodeRequestSpec = describe "encodeRequest" $ mapM_ encodeRequestSpec = describe "encodeRequest" $ mapM_
@ -76,4 +77,21 @@ escapeStringSpec = describe "escapeString" $ mapM_
, ( "foo:/?=&#%", "foo%3a%2f%3f%3d%26%23%25" ) , ( "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 --jl