http-link-header-1.2.1/benchmark/0000755000000000000000000000000014130434154014772 5ustar0000000000000000http-link-header-1.2.1/library/0000755000000000000000000000000014130434154014504 5ustar0000000000000000http-link-header-1.2.1/library/Network/0000755000000000000000000000000014130434154016135 5ustar0000000000000000http-link-header-1.2.1/library/Network/HTTP/0000755000000000000000000000000014130434154016714 5ustar0000000000000000http-link-header-1.2.1/library/Network/HTTP/Link/0000755000000000000000000000000014130434154017611 5ustar0000000000000000http-link-header-1.2.1/test-suite/0000755000000000000000000000000014130434154015146 5ustar0000000000000000http-link-header-1.2.1/test-suite/Network/0000755000000000000000000000000014130434154016577 5ustar0000000000000000http-link-header-1.2.1/test-suite/Network/HTTP/0000755000000000000000000000000014130434154017356 5ustar0000000000000000http-link-header-1.2.1/test-suite/Network/HTTP/Link/0000755000000000000000000000000014130434154020253 5ustar0000000000000000http-link-header-1.2.1/library/Network/HTTP/Link.hs0000644000000000000000000000202514130434154020144 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE Trustworthy, FlexibleInstances, UnicodeSyntax #-} -- | This module exports all the things at the same time, plus a utility -- function. module Network.HTTP.Link ( module Network.HTTP.Link.Types , module Network.HTTP.Link.Writer , module Network.HTTP.Link.Parser , lnk ) where import Control.Error.Util (hush) import Data.Text (Text, pack) import Data.Text.Encoding import safe Network.HTTP.Link.Parser import safe Network.HTTP.Link.Types import safe Network.HTTP.Link.Writer import Web.HttpApiData instance (IsURI uri) ⇒ ToHttpApiData [Link uri] where toUrlPiece = toUrlPiece . writeLinkHeader toHeader = encodeUtf8 . writeLinkHeader instance (IsURI uri) ⇒ ToHttpApiData (Link uri) where toUrlPiece = toUrlPiece . writeLink toHeader = encodeUtf8 . writeLink -- | Construct a Link. lnk ∷ (IsURI uri) ⇒ String → [(LinkParam, Text)] → Maybe (Link uri) lnk u r = fmap (\x → Link x r) $ hush $ uriFromText $ pack u http-link-header-1.2.1/library/Network/HTTP/Link/Parser.hs0000644000000000000000000000660714130434154021412 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnicodeSyntax, Safe, CPP #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- | The parser for the HTTP Link header as defined in RFC 5988. -- More liberal than the RFC though: -- does not validate URLs and other deep stuff, -- accepts whitespace in weird places. module Network.HTTP.Link.Parser ( linkHeader , parseLinkHeader' , parseLinkHeader , parseLinkHeaderBS' , parseLinkHeaderBS ) where import Prelude hiding (takeWhile, take) import Control.Applicative import Control.Error.Util (hush) import Data.Text hiding (takeWhile, map, take) import Data.Text.Encoding (decodeUtf8) import Data.ByteString (ByteString) import Data.Char (isSpace) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mconcat) #endif import Data.Attoparsec.Text import Network.URI import Network.HTTP.Link.Types allConditions ∷ [a → Bool] → a → Bool allConditions cs x = and $ map ($ x) cs charWS ∷ Char → Parser () charWS x = skipSpace >> char x >> skipSpace quotedString ∷ Parser Text quotedString = do char '"' v ← many stringPart char '"' return $ pack $ unEscapeString $ unpack $ mconcat v where stringPart = takeWhile1 (allConditions [(/= '"'), (/= '\\')]) <|> escapedChar escapedChar = char '\\' >> take 1 paramName ∷ Text → LinkParam paramName "rel" = Rel paramName "anchor" = Anchor paramName "rev" = Rev paramName "hreflang" = Hreflang paramName "media" = Media paramName "title" = Title paramName "title*" = Title' paramName "type" = ContentType paramName x = Other x relType ∷ Parser Text relType = takeWhile1 $ inClass "-0-9a-z." paramValue ∷ LinkParam → Parser Text paramValue Rel = quotedString <|> relType paramValue Rev = quotedString <|> relType paramValue Title' = takeWhile (allConditions [not . isSpace]) paramValue _ = quotedString param ∷ Parser (LinkParam, Text) param = do charWS ';' n ← takeWhile (allConditions [(/= '='), not . isSpace]) let n' = paramName n charWS '=' v ← paramValue n' return (n', v) link ∷ (IsURI uri) ⇒ Parser (Link uri) link = do charWS '<' linkText ← takeWhile1 $ allConditions [(/= '>'), not . isSpace] charWS '>' params ← many' $ param skipSpace case uriFromText linkText of Right u → return $ Link u params Left e → fail $ "Couldn't parse the URI " ++ show linkText ++ if e == "" then "" else ": " ++ e -- | The Attoparsec parser for the Link header. linkHeader ∷ (IsURI uri) ⇒ Parser [Link uri] linkHeader = link `sepBy'` (char ',') -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one). parseLinkHeader' ∷ (IsURI uri) ⇒ Text → Either String [Link uri] parseLinkHeader' = parseOnly linkHeader -- | Parses a Link header, returns a Maybe. parseLinkHeader ∷ (IsURI uri) ⇒ Text → Maybe [Link uri] parseLinkHeader = hush . parseLinkHeader' -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one). parseLinkHeaderBS' ∷ (IsURI uri) ⇒ ByteString → Either String [Link uri] parseLinkHeaderBS' = parseLinkHeader' . decodeUtf8 -- | Parses a Link header, returns a Maybe. parseLinkHeaderBS ∷ (IsURI uri) ⇒ ByteString → Maybe [Link uri] parseLinkHeaderBS = parseLinkHeader . decodeUtf8 http-link-header-1.2.1/library/Network/HTTP/Link/Types.hs0000644000000000000000000000255314130434154021256 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax, Safe #-} -- | The data type definitions for the HTTP Link header. module Network.HTTP.Link.Types where import Data.Text import Network.URI -- | The link attribute key. data LinkParam = Rel | Anchor | Rev | Hreflang | Media | Title | Title' | ContentType | Other Text deriving (Eq, Show) -- | A single link containing some representation of a URL. data Link uri = Link uri [(LinkParam, Text)] deriving (Eq, Show) -- | Types that can represent URLs. -- -- For example, to parse links containing @Text.URI.URI@ from the -- [modern-uri](https://hackage.haskell.org/package/modern-uri-0.3.2.0/docs/Text-URI.html#t:URI) -- package, simply define the orphan instance: -- -- @ -- instance IsURI Modern.URI where -- uriFromText = left displayException . mkURI -- uriToText = render -- @ -- -- @since 1.1.0 class IsURI uri where uriFromText ∷ Text → Either String uri uriToText ∷ uri → Text instance IsURI URI where uriFromText = maybe (Left "") Right . parseURIReference . unpack uriToText = pack . show instance IsURI Text where uriFromText = Right uriToText = id -- | Extracts the URI from the link. href ∷ (IsURI uri) ⇒ Link uri → uri href (Link h _) = h -- | Extracts the parameters from the link. linkParams ∷ Link uri → [(LinkParam, Text)] linkParams (Link _ ps) = ps http-link-header-1.2.1/library/Network/HTTP/Link/Writer.hs0000644000000000000000000000213714130434154021424 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnicodeSyntax, Safe, CPP #-} module Network.HTTP.Link.Writer ( writeLink , writeLinkHeader ) where import Data.Text hiding (map) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mconcat) #endif import Network.URI import Network.HTTP.Link.Types writeParamKey ∷ LinkParam → Text writeParamKey Rel = "rel" writeParamKey Anchor = "anchor" writeParamKey Rev = "rev" writeParamKey Hreflang = "hreflang" writeParamKey Media = "media" writeParamKey Title = "title" writeParamKey Title' = "title*" writeParamKey ContentType = "type" writeParamKey (Other t) = t writeParam ∷ (LinkParam, Text) → Text writeParam (t, v) = mconcat ["; ", writeParamKey t, "=\"", escPar v, "\""] where escPar = pack . escapeURIString (/= '"') . unpack -- maybe URI escaping is not what we should do here? eh, whatever writeLink ∷ (IsURI uri) ⇒ Link uri → Text writeLink (Link u ps) = mconcat $ ["<", uriToText u, ">"] ++ map writeParam ps writeLinkHeader ∷ (IsURI uri) ⇒ [Link uri] → Text writeLinkHeader = intercalate ", " . map writeLink http-link-header-1.2.1/test-suite/Spec.hs0000644000000000000000000000005414130434154016373 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-link-header-1.2.1/test-suite/Network/HTTP/Link/ParserSpec.hs0000644000000000000000000000545214130434154022664 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-} module Network.HTTP.Link.ParserSpec where import Test.Hspec import Test.Hspec.Attoparsec import Data.Text import Data.Maybe (fromJust) import Network.HTTP.Link (lnk) import Network.HTTP.Link.Types import Network.HTTP.Link.Parser import Network.URI (URI) import Data.Attoparsec.Text (Parser) spec ∷ Spec spec = do describe "linkHeader" $ do let l u r = fromJust $ lnk u r it "parses a single link" $ do ("; rel=\"example\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Rel, "example")] ] it "parses empty attributes" $ do ("; title=\"\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Title, "")] ] it "parses custom attributes" $ do ("; weirdThingy=\"something\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Other "weirdThingy", "something")] ] it "parses backslash escaped attributes" $ do ("; title=\"some \\\" thing \\\"\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ] it "parses escaped attributes" $ do ("; title=\"some %22 thing %22\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ] it "parses multiple attributes" $ do ("; rel=\"example\"; title=\"example dot com\"" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Rel, "example"), (Title, "example dot com")] ] it "parses custom attributes named similarly to standard ones" $ do -- this was caught by QuickCheck! <3 ("; rel=hello; relAtion=\"something\"; rev=next" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Rel, "hello"), (Other "relAtion", "something"), (Rev, "next")] ] it "parses unquoted rel, rev attributes" $ do ("; rel=next; rev=prev" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Rel, "next"), (Rev, "prev")] ] it "does not blow up on title*" $ do ("; title*=UTF-8'de'n%c3%a4chstes%20Kapitel" ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Title', "UTF-8'de'n%c3%a4chstes%20Kapitel")] ] it "parses weird whitespace all over the place" $ do ("\n\t < http://example.com\t>;rel=\t\"example\"; \ttitle =\"example dot com\" \n " ∷ Text) ~> linkHeaderURI `shouldParse` [ l "http://example.com" [(Rel, "example"), (Title, "example dot com")] ] where linkHeaderURI = linkHeader :: Parser [Link URI] http-link-header-1.2.1/test-suite/Network/HTTP/Link/WriterSpec.hs0000644000000000000000000000303614130434154022700 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-} module Network.HTTP.Link.WriterSpec where import Test.Hspec import Data.Maybe (fromJust) import Network.HTTP.Link (lnk) import Network.HTTP.Link.Types import Network.HTTP.Link.Writer import Network.URI (URI) spec ∷ Spec spec = do describe "writeLinkHeader" $ do let l u r = fromJust $ lnk u r :: Link URI it "writes a single link" $ do writeLinkHeader [l "http://example.com" [(Rel, "next")]] `shouldBe` "; rel=\"next\"" it "writes params with quote escaping" $ do writeLinkHeader [l "http://example.com" [(Rel, "some \"weirdness\"")]] `shouldBe` "; rel=\"some %22weirdness%22\"" it "writes multiple parameters" $ do writeLinkHeader [l "http://example.com" [(Rel, "next"), (Title, "hello world")]] `shouldBe` "; rel=\"next\"; title=\"hello world\"" it "writes custom params" $ do writeLinkHeader [l "http://example.com" [(Rel, "next"), (Other "thing", "http://example.com/foo"), (Rev, "license")]] `shouldBe` "; rel=\"next\"; thing=\"http://example.com/foo\"; rev=\"license\"" it "writes multiple links" $ do writeLinkHeader [ l "http://example.com" [(Rel, "next"), (Title, "hello world")] , l "https://hello.world" [(Rev, "license")] ] `shouldBe` "; rel=\"next\"; title=\"hello world\", ; rev=\"license\"" http-link-header-1.2.1/test-suite/Network/HTTP/LinkSpec.hs0000644000000000000000000000275714130434154021435 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, OverloadedStrings, UnicodeSyntax, CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.HTTP.LinkSpec where import Test.Hspec import Test.QuickCheck #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mconcat) #endif import qualified Data.Text as T import Data.Maybe (fromJust) import Network.HTTP.Link import Network.URI (URI) instance Arbitrary (Link URI) where arbitrary = do urlScheme ← elements ["http://", "https://", "ftp://", "git+ssh://"] urlDomain ← listOf1 $ elements ['a'..'z'] urlTld ← elements ["com", "net", "org", "me", "is", "technology", "club"] urlPath ← listOf $ elements ['a'..'z'] params ← listOf genParam return $ fromJust $ lnk (mconcat [urlScheme, urlDomain, ".", urlTld, "/", urlPath]) params where genParam = do otherParamKey ← suchThat (listOf1 $ elements ['a'..'z']) (\x → x /= "rel" && x /= "rev" && x /= "title" && x /= "title*" && x /= "hreflang" && x /= "anchor" && x /= "media" && x /= "type") paramKey ← elements [Rel, Rev, Title, Hreflang, Anchor, Media, ContentType, Other (T.pack otherParamKey)] paramValue ← listOf $ elements ['a'..'z'] return (paramKey, T.pack paramValue) spec ∷ Spec spec = do describe "writeLinkHeader → parseLinkHeader" $ it "roundtrips successfully" $ property $ \x → parseLinkHeader (writeLinkHeader x) == Just (x :: [Link URI]) http-link-header-1.2.1/benchmark/Bench.hs0000644000000000000000000000041414130434154016344 0ustar0000000000000000module Main (main) where import Criterion.Main (bgroup, defaultMain) import qualified ParserBench import qualified WriterBench main :: IO () main = defaultMain [ bgroup "Parser" ParserBench.benchmarks , bgroup "Writer" WriterBench.benchmarks ] http-link-header-1.2.1/benchmark/ParserBench.hs0000644000000000000000000000131414130434154017521 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module ParserBench (benchmarks) where import Criterion import Network.HTTP.Link.Parser import Network.HTTP.Link.Types (Link) import Network.URI (URI) benchmarks :: [Benchmark] benchmarks = [ bench "minimal" $ whnf parseLinkHeaderURI "; rel=\"next\"" , bench "large" $ whnf parseLinkHeaderURI "\n\t < http://example.com>; rel=next; title=\"Hello world\", ; rev=license; someWeirdParam=\"YOLO LOL\", ; rel=\"something something something http://some.thing/lol/rel\" " ] where parseLinkHeaderURI t = parseLinkHeader t :: Maybe [Link URI] http-link-header-1.2.1/benchmark/WriterBench.hs0000644000000000000000000000203714130434154017544 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module WriterBench (benchmarks) where import Criterion import Data.String (IsString (..)) import Data.Text (Text) import Network.HTTP.Link.Types import Network.HTTP.Link.Writer import Network.URI instance IsString URI where fromString str = case parseURI str of Just uri -> uri Nothing -> error $ "Failed to parse URI: " ++ str benchmarks :: [Benchmark] benchmarks = [ bench "minimal" $ whnf writeLinkHeaderURI [ Link "http://example.com/thing" [ (Rel, "next") ] ] , bench "large" $ whnf writeLinkHeaderURI [ Link "http://example.com/something_long" [ (Rel, "next prev http://hello.world/undefined") , (Title, "this is a test benchmark thingy") ] , Link "https://use.tls.everywhere.pls" [ (Rel, "license") , (Rev, "author") ]] ] where writeLinkHeaderURI = writeLinkHeader :: [Link URI] -> Text http-link-header-1.2.1/UNLICENSE0000644000000000000000000000227314130434154014314 0ustar0000000000000000This is free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. 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 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. For more information, please refer to http-link-header-1.2.1/Setup.hs0000644000000000000000000000005614130434154014475 0ustar0000000000000000import Distribution.Simple main = defaultMain http-link-header-1.2.1/http-link-header.cabal0000644000000000000000000000430714130434306017167 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack name: http-link-header version: 1.2.1 synopsis: A parser and writer for the HTTP Link header per RFC 5988 description: Please see the README on GitHub at category: Web homepage: https://github.com/myfreeweb/http-link-header#readme bug-reports: https://github.com/myfreeweb/http-link-header/issues author: Greg V maintainer: stevenjshuck@gmail.com copyright: 2014-2021 Greg V license: PublicDomain license-file: UNLICENSE build-type: Simple extra-source-files: README.md source-repository head type: git location: https://github.com/myfreeweb/http-link-header library exposed-modules: Network.HTTP.Link Network.HTTP.Link.Parser Network.HTTP.Link.Types Network.HTTP.Link.Writer other-modules: Paths_http_link_header hs-source-dirs: library ghc-options: -Wall build-depends: attoparsec , base >=4.3 && <5 , bytestring , errors , http-api-data , network-uri , text default-language: Haskell2010 test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Network.HTTP.Link.ParserSpec Network.HTTP.Link.WriterSpec Network.HTTP.LinkSpec Paths_http_link_header hs-source-dirs: test-suite ghc-options: -threaded -Wall build-depends: QuickCheck , attoparsec , base >=4.3 && <5 , bytestring , errors , hspec , hspec-attoparsec , http-api-data , http-link-header , network-uri , text default-language: Haskell2010 benchmark benchmarks type: exitcode-stdio-1.0 main-is: Bench.hs other-modules: ParserBench WriterBench Paths_http_link_header hs-source-dirs: benchmark ghc-options: -threaded -Wall build-depends: attoparsec , base >=4.3 && <5 , bytestring , criterion , directory , errors , http-api-data , http-link-header , network-uri , text , transformers default-language: Haskell2010 http-link-header-1.2.1/README.md0000644000000000000000000000423414130434154014322 0ustar0000000000000000# http-link-header [![Hackage](https://img.shields.io/hackage/v/http-link-header.svg?style=flat)](https://hackage.haskell.org/package/http-link-header) [![Build Status](https://img.shields.io/travis/myfreeweb/http-link-header.svg?style=flat)](https://travis-ci.org/myfreeweb/http-link-header) [![Coverage Status](https://img.shields.io/coveralls/myfreeweb/http-link-header.svg?style=flat)](https://coveralls.io/r/myfreeweb/http-link-header) [![unlicense](https://img.shields.io/badge/un-license-green.svg?style=flat)](http://unlicense.org) A Haskell library than implements a parser and a writer for the HTTP Link header as specified in [RFC 5988 "Web Linking"](https://tools.ietf.org/html/rfc5988). ## Usage ```haskell import Network.HTTP.Link import Network.URI import Data.Maybe ----- Writing writeLinkHeader [ Link (fromJust $ parseURI "https://example.com/hello%20world") [(Rel, "next"), (Title, "hello world")] , Link (fromJust $ parseURI "https://yolo.tld") [(Rel, "license")] ] -- "; rel=\"next\"; title=\"hello world\", ; rel=\"license\"" ----- Parsing parseLinkHeader "; rel=\"next\", ; rel=prev" -- Just [ Link https://example.com/2 [(Rel, "next")] -- , Link https://example.com/0 [(Rel, "prev")] ] ``` ## Development Use [stack] to build. Use ghci to run tests quickly with `:test` (see the `.ghci` file). ```bash $ stack build $ stack test && rm tests.tix $ stack bench $ stack ghci --ghc-options="-fno-hpc" ``` [stack]: https://github.com/commercialhaskell/stack ## Contributing Please feel free to submit pull requests! Bugfixes and simple non-breaking improvements will be accepted without any questions :-) By participating in this project you agree to follow the [Contributor Code of Conduct](http://contributor-covenant.org/version/1/2/0/). [The list of contributors is available on GitHub](https://github.com/myfreeweb/http-link-header/graphs/contributors). ## License This is free and unencumbered software released into the public domain. For more information, please refer to the `UNLICENSE` file or [unlicense.org](http://unlicense.org).