packages feed

url-decoders (empty) → 0.2

raw patch · 10 files changed

+604/−0 lines, 10 filesdep +QuickCheckdep +basedep +base-preludesetup-changed

Dependencies added: QuickCheck, base, base-prelude, binary-parser, bytestring, criterion, http-types, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck, text, unordered-containers, url-decoders

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2017, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ comparison-benchmark/Main.hs view
@@ -0,0 +1,101 @@+module Main where++import Prelude+import Criterion.Main+import qualified URLDecoders as A+import qualified Data.Text.Encoding as B+import qualified Data.Text.Encoding.Error as C+import qualified Data.HashMap.Strict as D+import qualified Network.HTTP.Types.URI as E+++main =+  defaultMain $+  [+    bgroup "url-decoders" $+    [+      subjectBenchmark "ascii" urlDecodersASCIISubject+      ,+      subjectBenchmark "utf8" urlDecodersUTF8Subject+    ]+    ,+    bgroup "http-types" $+    [+      subjectBenchmark "ascii" httpTypesASCIISubject+      ,+      subjectBenchmark "utf8" httpTypesUTF8Subject+    ]+  ]++subjectBenchmark :: NFData a => String -> Subject a -> Benchmark+subjectBenchmark title subject =+  bgroup title $+  [+    b "Small input" smallInput+    ,+    b "Medium input" mediumInput+    ,+    b "Large input" largeInput+  ]+  where+    b title input =+      bench title $ nf subject $ input+++-- * Subjects+-------------------------++type Subject a =+  ByteString -> HashMap a [a]++urlDecodersASCIISubject :: Subject ByteString+urlDecodersASCIISubject =+  either (error . show) id . A.asciiQuery++urlDecodersUTF8Subject :: Subject Text+urlDecodersUTF8Subject =+  either (error . show) id . A.utf8Query++httpTypesASCIISubject :: Subject ByteString+httpTypesASCIISubject =+  foldl' step D.empty .+  E.parseQuery+  where+    step map (key, value) =+      D.insertWith (<>) key (maybe [] (: []) value) map++httpTypesUTF8Subject :: Subject Text+httpTypesUTF8Subject =+  foldl' step D.empty .+  E.parseQuery+  where+    step map (key, value) =+      D.insertWith (<>) (decodeText key) (maybe [] ((: []) . decodeText) value) map+    decodeText =+      B.decodeUtf8With C.lenientDecode+++-- * Inputs+-------------------------++{-# NOINLINE smallInput #-}+smallInput :: ByteString+!smallInput =+  inputOfSize 3+  +{-# NOINLINE mediumInput #-}+mediumInput :: ByteString+!mediumInput =+  inputOfSize 10++{-# NOINLINE largeInput #-}+largeInput :: ByteString+!largeInput =+  inputOfSize 100++inputOfSize :: Int -> ByteString+inputOfSize size =+  E.renderQuery False $+  E.queryTextToQuery $+  map (\i -> ("abc" <> (fromString . show) i, Just "Ф漢УЙФ漢УЙФ漢УЙ")) $+  [0 .. size]
+ library/URLDecoders.hs view
@@ -0,0 +1,34 @@+module URLDecoders where++import BasePrelude+import qualified Data.ByteString as B+import qualified Data.Text as C+import qualified Data.HashMap.Strict as D+import qualified BinaryParser as E+import qualified URLDecoders.BinaryParser as F+++{-|+Decodes the query part of a URL (the one following the question mark) or+the content of type @application/x-www-form-urlencoded@.++Produces a hash map of lists of values, interpreting the keys ending with @[]@+as arrays, as well as the repititive keys.+-}+{-# INLINE asciiQuery #-}+asciiQuery :: B.ByteString -> Either C.Text (D.HashMap B.ByteString [B.ByteString])+asciiQuery =+  E.run F.asciiQuery++{-|+Decodes the query part of a URL (the one following the question mark) or+the content of type @application/x-www-form-urlencoded@,+immediately applying a UTF8-decoding to it.++Produces a hash map of lists of values, interpreting the keys ending with @[]@+as arrays, as well as the repititive keys.+-}+{-# INLINE utf8Query #-}+utf8Query :: B.ByteString -> Either C.Text (D.HashMap C.Text [C.Text])+utf8Query =+  E.run F.utf8Query
+ library/URLDecoders/BinaryParser.hs view
@@ -0,0 +1,169 @@+module URLDecoders.BinaryParser where++import BasePrelude+import BinaryParser+import Data.Text (Text)+import Data.ByteString (ByteString)+import qualified Data.HashMap.Strict as A+import qualified Data.ByteString as C+import qualified Data.Text as D+import qualified Data.Text.Encoding as E+import qualified Data.Text.Encoding.Error as F+import qualified URLDecoders.ByteString.Builder as G+import qualified URLDecoders.PercentEncoding as H+++data QueryByte =+  DecodedQueryByte !Word8 | SpecialQueryByte !Word8++{-# INLINE utf8Query #-}+utf8Query :: BinaryParser (A.HashMap Text [Text])+utf8Query =+  accumulateEntries A.empty+  where+    accumulateEntries map =+      accumulateKey mempty+      where+        accumulateKey accumulator =+          optional queryByte >>= \case+            Just x -> case x of+              DecodedQueryByte byte -> addByte byte+              SpecialQueryByte byte -> case byte of+                61 -> decodeKey >>= \key -> accumulateValue key mempty+                38 -> decodeKey >>= \key -> accumulateEntries (updatedMap key [])+                91 -> finalizeArrayDeclaration <|> failure ("Broken array declaration")+                93 -> failure "Unexpected character: \"]\""+                _ -> addByte byte+            Nothing -> if G.toLength accumulator == 0+              then return map+              else decodeKey >>= \key -> return (updatedMap key [])+          where+            addByte byte =+              accumulateKey (accumulator <> G.byte byte)+            finalizeArrayDeclaration =+              do+                byteWhichIs 93+                byte >>= \case+                  61 -> decodeKey >>= \key -> accumulateValue key mempty+                  63 -> decodeKey >>= \key -> accumulateEntries (updatedMap key [])+                  x -> failure ("Unexpected byte: " <> (fromString . show) x)+            decodeKey =+              decodeUTF8 (G.toByteString accumulator)+        accumulateValue key accumulator =+          optional queryByte >>= \case+            Just x -> case x of+              DecodedQueryByte byte -> addByte byte+              SpecialQueryByte byte -> case byte of+                38 -> decodeValue >>= \value -> accumulateEntries (updatedMap key [value])+                _ -> addByte byte+            Nothing -> decodeValue >>= \value -> return (updatedMap key [value])+          where+            addByte byte =+              accumulateValue key (accumulator <> G.byte byte)+            decodeValue =+              decodeUTF8 (G.toByteString accumulator)+        updatedMap key value =+          A.insertWith (<>) key value map++{-# INLINE asciiQuery #-}+asciiQuery :: BinaryParser (A.HashMap ByteString [ByteString])+asciiQuery =+  accumulateEntries A.empty+  where+    accumulateEntries map =+      accumulateKey mempty+      where+        accumulateKey accumulator =+          optional queryByte >>= \case+            Just x -> case x of+              DecodedQueryByte byte -> addByte byte+              SpecialQueryByte byte -> case byte of+                61 -> accumulateValue key mempty+                38 -> accumulateEntries (updatedMap key [])+                91 -> finalizeArrayDeclaration <|> failure ("Broken array declaration")+                93 -> failure "Unexpected character: \"]\""+                _ -> addByte byte+            Nothing -> if G.toLength accumulator == 0+              then return map+              else return (updatedMap key [])+          where+            addByte byte =+              accumulateKey (accumulator <> G.byte byte)+            finalizeArrayDeclaration =+              do+                byteWhichIs 93+                byte >>= \case+                  61 -> accumulateValue key mempty+                  63 -> accumulateEntries (updatedMap key [])+                  x -> failure ("Unexpected byte: " <> (fromString . show) x)+            key =+              G.toByteString accumulator+        accumulateValue key accumulator =+          optional queryByte >>= \case+            Just x -> case x of+              DecodedQueryByte byte -> addByte byte+              SpecialQueryByte byte -> case byte of+                38 -> accumulateEntries (updatedMap key [value])+                _ -> addByte byte+            Nothing -> return (updatedMap key [value])+          where+            addByte byte =+              accumulateValue key (accumulator <> G.byte byte)+            value =+              G.toByteString accumulator+        updatedMap key value =+          A.insertWith (<>) key value map++{-# INLINE decodeUTF8 #-}+decodeUTF8 :: ByteString -> BinaryParser Text+decodeUTF8 bytes =+  case E.decodeUtf8' bytes of+    Left _ -> failure "Broken UTF8 sequence"+    Right text -> return text++{-# INLINE specialOrDecodedByte #-}+specialOrDecodedByte :: (Word8 -> BinaryParser a) -> (Word8 -> BinaryParser a) -> BinaryParser a+specialOrDecodedByte special decoded =+  byte >>= \case+    37 -> percentEncodedByteBody >>= decoded+    43 -> decoded 32+    38 -> special 38+    59 -> special 38+    61 -> special 61+    91 -> special 91+    93 -> special 93+    35 -> failure ("Invalid query character: \"#\"")+    63 -> failure ("Invalid query character: \"?\"")+    x -> decoded x++{-# INLINE queryByte #-}+queryByte :: BinaryParser QueryByte+queryByte =+  do+    firstByte <- byte+    case firstByte of+      37 -> DecodedQueryByte <$> percentEncodedByteBody+      43 -> return (DecodedQueryByte 32)+      38 -> return (SpecialQueryByte 38)+      59 -> return (SpecialQueryByte 38)+      61 -> return (SpecialQueryByte 61)+      91 -> return (SpecialQueryByte 91)+      93 -> return (SpecialQueryByte 93)+      35 -> failure ("Invalid query character: \"#\"")+      63 -> failure ("Invalid query character: \"?\"")+      _ -> return (DecodedQueryByte firstByte)++{-# INLINE percentEncodedByteBody #-}+percentEncodedByteBody :: BinaryParser Word8+percentEncodedByteBody =+  do+    byte1 <- byte+    byte2 <- byte+    H.matchPercentEncodedBytes (failure "Broken percent encoding") return byte1 byte2++{-# INLINE byteWhichIs #-}+byteWhichIs :: Word8 -> BinaryParser ()+byteWhichIs expected =+  do+    actual <- byte+    unless (actual == expected) (failure ("Byte " <> (fromString . show) actual <> " doesn't equal the expected " <> (fromString . show) expected))
+ library/URLDecoders/ByteString/Builder.hs view
@@ -0,0 +1,41 @@+module URLDecoders.ByteString.Builder where++import BasePrelude+import qualified Data.ByteString as A+import qualified Data.ByteString.Internal as B+import qualified Foreign as D+++data Builder =+  Builder !(D.Ptr Word8 -> IO (D.Ptr Word8)) !Int++instance Monoid Builder where+  {-# INLINE mempty #-}+  mempty =+    Builder return 0+  {-# INLINE mappend #-}+  mappend (Builder leftAction leftSize) (Builder rightAction rightSize) =+    Builder action size+    where+      action pointer =+        leftAction pointer >>= rightAction+      size =+        leftSize + rightSize++{-# INLINE byte #-}+byte :: Word8 -> Builder+byte x =+  Builder action 1+  where+    action pointer =+      D.poke pointer x $> D.plusPtr pointer 1++{-# INLINE toByteString #-}+toByteString :: Builder -> A.ByteString+toByteString (Builder action size) =+  B.unsafeCreate size (void . action)++{-# INLINE toLength #-}+toLength :: Builder -> Int+toLength (Builder _ size) =+  size
+ library/URLDecoders/PercentEncoding.hs view
@@ -0,0 +1,26 @@+module URLDecoders.PercentEncoding where++import BasePrelude+++{-# INLINE matchHexByte #-}+matchHexByte :: a -> (Word8 -> a) -> Word8 -> a+matchHexByte failure success x =+  if x >= 48 && x <= 57+    then success (x - 48)+    else if x >= 65 && x <= 70+      then success (x - 55)+      else if x >= 97 && x <= 102+        then success (x - 87)+        else failure++{-# INLINE matchPercentEncodedBytes #-}+matchPercentEncodedBytes :: a -> (Word8 -> a) -> Word8 -> Word8 -> a+matchPercentEncodedBytes failure success byte1 byte2 =+  matchHexByte failure firstByteSuccess byte1+  where+    firstByteSuccess decodedByte1 =+      matchHexByte failure secondByteSuccess byte2+      where+        secondByteSuccess decodedByte2 =+          success (shiftL decodedByte1 4 .|. decodedByte2)
+ primary-benchmark/Main.hs view
@@ -0,0 +1,24 @@+module Main where++import Prelude+import Criterion.Main+import qualified URLDecoders as A+import qualified Network.HTTP.Types.URI as E+++main =+  defaultMain $+  [+    bench "" $ nf (either (error . show) id . A.utf8Query) $! inputOfSize 10+  ]+++-- * Inputs+-------------------------++inputOfSize :: Int -> ByteString+inputOfSize size =+  E.renderQuery False $+  E.queryTextToQuery $+  map (\i -> ("abc" <> (fromString . show) i, Just "Ф漢УЙ")) $+  [0 .. size]
+ tests/Main.hs view
@@ -0,0 +1,53 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified URLDecoders as A+import qualified Network.HTTP.Types.URI as B+import qualified Data.Text.Encoding as C+import qualified Data.HashMap.Strict as D+++main =+  defaultMain $+  testGroup "All tests" $+  [+    testCase "Simple" $ do+      assertEqual "" (Right (D.fromList [("a", ["b"])])) (A.utf8Query "a=b")+    ,+    testCase "Absent value" $ do+      assertEqual "" (Right (D.fromList [("a", [])])) (A.utf8Query "a")+    ,+    testCase "Empty" $ do+      assertEqual "" (Right (D.fromList [])) (A.utf8Query "")+    ,+    testCase "Empty key" $ do+      assertEqual "" (Right (D.fromList [("", ["1"])])) (A.utf8Query "=1")+    ,+    testCase "Empty value" $ do+      assertEqual "" (Right (D.fromList [("a", [""])])) (A.utf8Query "a=")+      assertEqual "" (Right (D.fromList [("a", [""])])) (A.utf8Query "a=&")+    ,+    testCase "Array" $ do+      assertEqual "" (Right (D.fromList [("a", ["c", "b"])])) (A.utf8Query "a=b&a=c")+      assertEqual "" (Right (D.fromList [("a", ["c", "b"])])) (A.utf8Query "a[]=b&a[]=c")+      assertEqual "" (Right (D.fromList [("a", ["c", "b"])])) (A.utf8Query "a=b;a=c")+      assertEqual "" (Right (D.fromList [("a", ["c", "b"])])) (A.utf8Query "a[]=b;a[]=c")+    ,+    testCase "Unicode" $ do+      assertEqual "" (Right (D.fromList [("a", ["Держатель"])])) (A.utf8Query "a=%D0%94%D0%B5%D1%80%D0%B6%D0%B0%D1%82%D0%B5%D0%BB%D1%8C")+      assertEqual "" (Right (D.fromList [("Держатель", ["1"])])) (A.utf8Query "%D0%94%D0%B5%D1%80%D0%B6%D0%B0%D1%82%D0%B5%D0%BB%D1%8C=1")+    ,+    testCase "Ending" $ do+      assertEqual "" (Right (D.fromList [("a", ["b"])])) (A.utf8Query "a=b?blablabla")+      assertEqual "" (Right (D.fromList [("a", ["b"])])) (A.utf8Query "a=b#blablabla")+    ,+    testCase "Failure" $ do+      assertEqual "" (Left "Broken array declaration") (A.utf8Query "a[")+      assertEqual "" (Left "Unexpected character: \"]\"") (A.utf8Query "a]")+      assertEqual "" (Left "Broken array declaration") (A.utf8Query "a[]b")+  ]
+ url-decoders.cabal view
@@ -0,0 +1,132 @@+name:+  url-decoders+version:+  0.2+category:+  Web, Codecs+synopsis:+  Decoders for URL-encoding (aka Percent-encoding)+homepage:+  https://github.com/nikita-volkov/url-decoders+bug-reports:+  https://github.com/nikita-volkov/url-decoders/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2017, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/url-decoders.git++library+  hs-source-dirs:+    library+  exposed-modules:+    URLDecoders+  other-modules:+    URLDecoders.BinaryParser+    URLDecoders.ByteString.Builder+    URLDecoders.PercentEncoding+  ghc-options:+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    unordered-containers == 0.2.*,+    binary-parser == 0.5.*,+    bytestring >= 0.10.8 && < 0.11,+    text >= 1 && < 2,+    base-prelude < 2,+    base < 5++test-suite tests+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    tests+  main-is:+    Main.hs+  ghc-options:+    -O0+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    url-decoders,+    http-types == 0.9.*,+    -- testing:+    tasty == 0.11.*,+    tasty-quickcheck == 0.8.*,+    tasty-hunit == 0.9.*,+    quickcheck-instances >= 0.3.11 && < 0.4,+    QuickCheck >= 2.8.1 && < 2.10,+    -- +    rerebase < 2++benchmark primary-benchmark+  type: +    exitcode-stdio-1.0+  hs-source-dirs:+    primary-benchmark+  main-is:+    Main.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    -- +    url-decoders,+    -- +    http-types == 0.9.*,+    -- benchmarking:+    criterion == 1.1.*,+    -- general:+    rerebase == 1.*++benchmark comparison-benchmark+  type: +    exitcode-stdio-1.0+  hs-source-dirs:+    comparison-benchmark+  main-is:+    Main.hs+  ghc-options:+    -O2+    -threaded+    "-with-rtsopts=-N"+    -funbox-strict-fields+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  build-depends:+    -- +    url-decoders,+    -- +    http-types == 0.9.*,+    -- benchmarking:+    criterion == 1.1.*,+    -- general:+    rerebase == 1.*