modern-uri 0.3.5.0 → 0.3.6.0
raw patch · 4 files changed
+73/−17 lines, 4 filesdep ~template-haskell
Dependency ranges changed: template-haskell
Files
- CHANGELOG.md +8/−0
- Text/URI/Render.hs +59/−11
- modern-uri.cabal +1/−1
- tests/Text/URISpec.hs +5/−5
CHANGELOG.md view
@@ -1,3 +1,11 @@+## 0.3.6.0++* Now colons are not escaped in paths, unless the `URI` in question is a+ URI-reference, in which case colons in the first path segment are escaped.+ See [RFC 3986, section+ 3.3](https://www.rfc-editor.org/rfc/rfc3986#section-3.3). [Issue+ 55](https://github.com/mrkkrp/modern-uri/issues/55).+ ## Modern URI 0.3.5.0 * Added `Hashable` instances for `URI`, `Authority`, `UserInfo`,
Text/URI/Render.hs view
@@ -37,7 +37,6 @@ import Data.Kind (Type) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE import Data.Proxy import Data.Reflection import qualified Data.Semigroup as S@@ -65,7 +64,14 @@ render' x = equip TLB.decimal- (TLB.fromText . percentEncode (uriScheme x))+ ( \mw r ->+ TLB.fromText+ ( percentEncode+ (uriScheme x)+ (mediateExtraEscaping x mw)+ r+ )+ ) (genericRender x) -- | Render a given 'URI' value as a strict 'ByteString'.@@ -77,7 +83,16 @@ renderBs' x = equip BB.wordDec- (BB.byteString . TE.encodeUtf8 . percentEncode (uriScheme x))+ ( \mw r ->+ BB.byteString+ ( TE.encodeUtf8+ ( percentEncode+ (uriScheme x)+ (mediateExtraEscaping x mw)+ r+ )+ )+ ) (genericRender x) -- | Render a given 'URI' value as a 'String'.@@ -94,21 +109,38 @@ toShowS $ equip (DString . showInt)- (fromString . T.unpack . percentEncode (uriScheme x))+ ( \mw r ->+ fromString+ ( T.unpack+ ( percentEncode+ (uriScheme x)+ (mediateExtraEscaping x mw)+ r+ )+ )+ ) (genericRender x) +-- | This is a (slightly hackish) way used to only escape ':' in the first+-- path segment and only if there no scheme and no authority component.+mediateExtraEscaping :: URI -> Maybe Word8 -> Maybe Word8+mediateExtraEscaping uri mw =+ case (uriScheme uri, uriAuthority uri) of+ (Nothing, Left _) -> mw+ _ -> Nothing+ ---------------------------------------------------------------------------- -- Reflection stuff data Renders b = Renders { rWord :: Word -> b,- rText :: forall l. RLabel l => RText l -> b+ rText :: forall l. RLabel l => Maybe Word8 -> RText l -> b } equip :: forall b. (Word -> b) ->- (forall l. RLabel l => RText l -> b) ->+ (forall l. RLabel l => Maybe Word8 -> RText l -> b) -> (forall (s :: Type). Reifies s (Renders b) => Tagged s b) -> b equip rWord rText f = reify Renders {..} $ \(Proxy :: Proxy s') ->@@ -126,8 +158,16 @@ (Reifies s (Renders b), RLabel l) => RText l -> Tagged s b-renderText = Tagged . rText (reflect (Proxy :: Proxy s))+renderText = Tagged . rText (reflect (Proxy :: Proxy s)) Nothing +renderTextEscaping ::+ forall s b l.+ (Reifies s (Renders b), RLabel l) =>+ Word8 ->+ RText l ->+ Tagged s b+renderTextEscaping w = Tagged . rText (reflect (Proxy :: Proxy s)) (Just w)+ ---------------------------------------------------------------------------- -- Generic render @@ -188,7 +228,9 @@ case path of Nothing -> mempty Just (trailingSlash, ps) ->- (mconcat . intersperse "/" . fmap renderText . NE.toList) ps+ ( mconcat . intersperse "/" $ case ps of+ (x :| xs) -> renderTextEscaping 58 x : fmap renderText xs+ ) <> if trailingSlash then "/" else mempty {-# INLINE rPath #-} @@ -232,11 +274,13 @@ RLabel l => -- | Scheme of the URI Maybe (RText 'Scheme) ->+ -- | A byte to additionally escape+ Maybe Word8 -> -- | Input text to encode RText l -> -- | Percent-encoded text Text-percentEncode mscheme rtxt =+percentEncode mscheme alsoEscape rtxt = if skipEscaping (Proxy :: Proxy l) txt then txt else T.unfoldr f (TE.encodeUtf8 txt, [])@@ -256,7 +300,11 @@ encodeByte x = '%' :| [intToDigit h, intToDigit l] where (h, l) = fromIntegral x `quotRem` 16- nne = needsNoEscaping (Proxy :: Proxy l) mscheme+ nne w =+ let normalCase = needsNoEscaping (Proxy :: Proxy l) mscheme w+ in case alsoEscape of+ Nothing -> normalCase+ Just w' -> if w == w' then False else normalCase sap = spaceAsPlus (Proxy :: Proxy l) txt = unRText rtxt {-# INLINE percentEncode #-}@@ -298,7 +346,7 @@ then commonCase || x == 64 else commonCase where- commonCase = isUnreserved x+ commonCase = isUnreserved x || x == 58 instance RLabel 'QueryKey where needsNoEscaping Proxy _ x =
modern-uri.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: modern-uri-version: 0.3.5.0+version: 0.3.6.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov <markkarpov92@gmail.com>
tests/Text/URISpec.hs view
@@ -284,13 +284,13 @@ it "sort of works" $ fmap URI.render mkTestURI `shouldReturn` testURI context "when URI has scheme" $- it "escapes colon in path components" $+ it "does not escape colon in path components" $ (URI.render <$> URI.mkURI "https:/fir:st/se:cond")- `shouldReturn` "https:/fir%3ast/se%3acond"+ `shouldReturn` "https:/fir:st/se:cond" context "when URI is a network-path reference" $ it "does not escape colon in path components" $ (URI.render <$> URI.mkURI "//host/fir:st/se:cond")- `shouldReturn` "//host/fir%3ast/se%3acond"+ `shouldReturn` "//host/fir:st/se:cond" context "when URI is a relative-path reference" $ it "escapes colon but only in the first path segment" $ do firstSeg <- URI.mkPathPiece "fir:st"@@ -299,7 +299,7 @@ URI.emptyURI { uriPath = Just (False, firstSeg :| [secondSeg]) }- URI.render uri `shouldBe` "fir%3ast/se%3acond"+ URI.render uri `shouldBe` "fir%3ast/se:cond" context "when URI has no path" $ it "is rendered without trailing slash" $ do let uriWithoutSlash = "https://example.com"@@ -382,7 +382,7 @@ -- | Polymorphic textual rendering of the 'URI' generated by 'mkTestURI'. testURI :: IsString a => a-testURI = "https://mark%3a%40:secret:%40@github.com:443/mrkkrp/modern-uri%2b%3a%40?foo:@=bar+:@#fragment:@"+testURI = "https://mark%3a%40:secret:%40@github.com:443/mrkkrp/modern-uri%2b:%40?foo:@=bar+:@#fragment:@" -- | A utility wrapper around 'URI.parser'. urip :: Parsec Void Text URI