http-link-header-1.0.3/benchmark/0000755000000000000000000000000012640036035014772 5ustar0000000000000000http-link-header-1.0.3/library/0000755000000000000000000000000012640036035014504 5ustar0000000000000000http-link-header-1.0.3/library/Network/0000755000000000000000000000000012640036035016135 5ustar0000000000000000http-link-header-1.0.3/library/Network/HTTP/0000755000000000000000000000000013012316357016716 5ustar0000000000000000http-link-header-1.0.3/library/Network/HTTP/Link/0000755000000000000000000000000012640036035017611 5ustar0000000000000000http-link-header-1.0.3/test-suite/0000755000000000000000000000000012640036035015146 5ustar0000000000000000http-link-header-1.0.3/test-suite/Network/0000755000000000000000000000000012640036035016577 5ustar0000000000000000http-link-header-1.0.3/test-suite/Network/HTTP/0000755000000000000000000000000012640036035017356 5ustar0000000000000000http-link-header-1.0.3/test-suite/Network/HTTP/Link/0000755000000000000000000000000012640036035020253 5ustar0000000000000000http-link-header-1.0.3/library/Network/HTTP/Link.hs0000644000000000000000000000150013012316357020143 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE Trustworthy, FlexibleInstances #-} -- | This module exports all the things at the same time. module Network.HTTP.Link ( module Network.HTTP.Link.Types , module Network.HTTP.Link.Writer , module Network.HTTP.Link.Parser ) where import Data.ByteString.Conversion import Web.HttpApiData import safe Network.HTTP.Link.Types import safe Network.HTTP.Link.Writer import safe Network.HTTP.Link.Parser instance ToByteString [Link] where builder = builder . writeLinkHeader instance ToByteString Link where builder = builder . writeLink instance ToHttpApiData [Link] where toUrlPiece = toUrlPiece . writeLinkHeader toHeader = toByteString' instance ToHttpApiData Link where toUrlPiece = toUrlPiece . writeLink toHeader = toByteString' http-link-header-1.0.3/library/Network/HTTP/Link/Types.hs0000644000000000000000000000132612640036035021253 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. data Link = Link URI [(LinkParam, Text)] deriving (Eq, Show) -- | Extracts the URI from the link. href ∷ Link → URI href (Link h _) = h -- | Extracts the parameters from the link. linkParams ∷ Link → [(LinkParam, Text)] linkParams (Link _ ps) = ps lnk ∷ String → [(LinkParam, Text)] → Maybe Link lnk u r = parseURI u >>= return . \x → Link x r http-link-header-1.0.3/library/Network/HTTP/Link/Parser.hs0000644000000000000000000000634312640036035021407 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 ∷ Parser Link link = do charWS '<' linkText ← takeWhile1 $ allConditions [(/= '>'), not . isSpace] charWS '>' params ← many' $ param skipSpace case parseURIReference $ unpack linkText of Just u → return $ Link u params Nothing → fail "Couldn't parse the URI" -- | The Attoparsec parser for the Link header. linkHeader ∷ Parser [Link] linkHeader = link `sepBy'` (char ',') -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one). parseLinkHeader' ∷ Text → Either String [Link] parseLinkHeader' = parseOnly linkHeader -- | Parses a Link header, returns a Maybe. parseLinkHeader ∷ Text → Maybe [Link] parseLinkHeader = hush . parseLinkHeader' -- | Parses a Link header, returns an Either, where Left is the Attoparsec -- error string (probably not a useful one). parseLinkHeaderBS' ∷ ByteString → Either String [Link] parseLinkHeaderBS' = parseLinkHeader' . decodeUtf8 -- | Parses a Link header, returns a Maybe. parseLinkHeaderBS ∷ ByteString → Maybe [Link] parseLinkHeaderBS = parseLinkHeader . decodeUtf8 http-link-header-1.0.3/library/Network/HTTP/Link/Writer.hs0000644000000000000000000000210212640036035021414 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 ∷ Link → Text writeLink l = mconcat $ ["<", pack . show $ href l, ">"] ++ map writeParam (linkParams l) writeLinkHeader ∷ [Link] → Text writeLinkHeader = intercalate ", " . map writeLink http-link-header-1.0.3/test-suite/Spec.hs0000644000000000000000000000005412640036035016373 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-link-header-1.0.3/test-suite/Network/HTTP/Link/ParserSpec.hs0000644000000000000000000000512412640036035022660 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.Types import Network.HTTP.Link.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) ~> linkHeader `shouldParse` [ l "http://example.com" [(Rel, "example")] ] it "parses empty attributes" $ do ("; title=\"\"" ∷ Text) ~> linkHeader `shouldParse` [ l "http://example.com" [(Title, "")] ] it "parses custom attributes" $ do ("; weirdThingy=\"something\"" ∷ Text) ~> linkHeader `shouldParse` [ l "http://example.com" [(Other "weirdThingy", "something")] ] it "parses backslash escaped attributes" $ do ("; title=\"some \\\" thing \\\"\"" ∷ Text) ~> linkHeader `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ] it "parses escaped attributes" $ do ("; title=\"some %22 thing %22\"" ∷ Text) ~> linkHeader `shouldParse` [ l "http://example.com" [(Title, "some \" thing \"")] ] it "parses multiple attributes" $ do ("; rel=\"example\"; title=\"example dot com\"" ∷ Text) ~> linkHeader `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) ~> linkHeader `shouldParse` [ l "http://example.com" [(Rel, "hello"), (Other "relAtion", "something"), (Rev, "next")] ] it "parses unquoted rel, rev attributes" $ do ("; rel=next; rev=prev" ∷ Text) ~> linkHeader `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) ~> linkHeader `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) ~> linkHeader `shouldParse` [ l "http://example.com" [(Rel, "example"), (Title, "example dot com")] ] http-link-header-1.0.3/test-suite/Network/HTTP/Link/WriterSpec.hs0000644000000000000000000000270612640036035022703 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, UnicodeSyntax #-} module Network.HTTP.Link.WriterSpec where import Test.Hspec import Data.Maybe (fromJust) import Network.HTTP.Link.Types import Network.HTTP.Link.Writer spec ∷ Spec spec = do describe "writeLinkHeader" $ do let l u r = fromJust $ lnk u r 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.0.3/test-suite/Network/HTTP/LinkSpec.hs0000644000000000000000000000240412640036035021422 0ustar0000000000000000{-# LANGUAGE 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 instance Arbitrary Link 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 ← listOf1 $ elements ['a'..'z'] 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 http-link-header-1.0.3/benchmark/Bench.hs0000644000000000000000000000041412640036035016344 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.0.3/benchmark/ParserBench.hs0000644000000000000000000000105112640036035017517 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module ParserBench (benchmarks) where import Criterion import Network.HTTP.Link.Parser benchmarks :: [Benchmark] benchmarks = [ bench "minimal" $ whnf parseLinkHeader "; rel=\"next\"" , bench "large" $ whnf parseLinkHeader "\n\t < http://example.com>; rel=next; title=\"Hello world\", ; rev=license; someWeirdParam=\"YOLO LOL\", ; rel=\"something something something http://some.thing/lol/rel\" " ] http-link-header-1.0.3/benchmark/WriterBench.hs0000644000000000000000000000164012640036035017543 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module WriterBench (benchmarks) where import Criterion import Data.String (IsString (..)) 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 writeLinkHeader [ Link "http://example.com/thing" [ (Rel, "next") ] ] , bench "large" $ whnf writeLinkHeader [ 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") ]] ] http-link-header-1.0.3/UNLICENSE0000644000000000000000000000227312640036035014314 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.0.3/Setup.hs0000644000000000000000000000005612763250670014506 0ustar0000000000000000import Distribution.Simple main = defaultMain http-link-header-1.0.3/http-link-header.cabal0000644000000000000000000000362513012317676017201 0ustar0000000000000000name: http-link-header version: 1.0.3 synopsis: A parser and writer for the HTTP Link header as specified in RFC 5988 "Web Linking". description: https://github.com/myfreeweb/http-link-header category: Web homepage: https://github.com/myfreeweb/http-link-header author: Greg V copyright: 2014-2016 Greg V maintainer: greg@unrelenting.technology license: PublicDomain license-file: UNLICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: README.md tested-with: GHC == 8.0.1 source-repository head type: git location: git://github.com/myfreeweb/http-link-header.git library build-depends: base >= 4.3.0.0 && < 5 , text , bytestring , errors , network-uri , http-api-data , attoparsec , bytestring-conversion default-language: Haskell2010 exposed-modules: Network.HTTP.Link Network.HTTP.Link.Types Network.HTTP.Link.Parser Network.HTTP.Link.Writer ghc-options: -Wall hs-source-dirs: library test-suite tests build-depends: base >= 4.3.0.0 && < 5 , text , http-link-header , hspec , QuickCheck , hspec-attoparsec default-language: Haskell2010 ghc-options: -threaded -fhpc -Wall hs-source-dirs: test-suite main-is: Spec.hs other-modules: Network.HTTP.Link.ParserSpec Network.HTTP.Link.WriterSpec Network.HTTP.LinkSpec type: exitcode-stdio-1.0 benchmark benchmarks build-depends: base >= 4.3.0.0 && < 5 , text , http-link-header , directory , network-uri , transformers , criterion default-language: Haskell2010 hs-source-dirs: benchmark main-is: Bench.hs other-modules: ParserBench WriterBench type: exitcode-stdio-1.0 http-link-header-1.0.3/README.md0000644000000000000000000000423412640036035014322 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).