http-link-header-1.0.2/benchmark/0000755000000000000000000000000012761045501014773 5ustar0000000000000000http-link-header-1.0.2/library/0000755000000000000000000000000012761045501014505 5ustar0000000000000000http-link-header-1.0.2/library/Network/0000755000000000000000000000000012761045501016136 5ustar0000000000000000http-link-header-1.0.2/library/Network/HTTP/0000755000000000000000000000000012761045501016715 5ustar0000000000000000http-link-header-1.0.2/library/Network/HTTP/Link/0000755000000000000000000000000012761045501017612 5ustar0000000000000000http-link-header-1.0.2/test-suite/0000755000000000000000000000000012761045501015147 5ustar0000000000000000http-link-header-1.0.2/test-suite/Network/0000755000000000000000000000000012761045501016600 5ustar0000000000000000http-link-header-1.0.2/test-suite/Network/HTTP/0000755000000000000000000000000012761045501017357 5ustar0000000000000000http-link-header-1.0.2/test-suite/Network/HTTP/Link/0000755000000000000000000000000012761045501020254 5ustar0000000000000000http-link-header-1.0.2/library/Network/HTTP/Link.hs0000644000000000000000000000111712761045501020146 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 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 http-link-header-1.0.2/library/Network/HTTP/Link/Types.hs0000644000000000000000000000132612761045501021254 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.2/library/Network/HTTP/Link/Parser.hs0000644000000000000000000000634312761045501021410 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.2/library/Network/HTTP/Link/Writer.hs0000644000000000000000000000210212761045501021415 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.2/test-suite/Spec.hs0000644000000000000000000000005412761045501016374 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-link-header-1.0.2/test-suite/Network/HTTP/Link/ParserSpec.hs0000644000000000000000000000512412761045501022661 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.2/test-suite/Network/HTTP/Link/WriterSpec.hs0000644000000000000000000000270612761045501022704 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.2/benchmark/Bench.hs0000644000000000000000000000041412761045501016345 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.2/benchmark/ParserBench.hs0000644000000000000000000000105112761045501017520 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.2/benchmark/WriterBench.hs0000644000000000000000000000164012761045501017544 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.2/UNLICENSE0000644000000000000000000000227312761045501014315 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.2/Setup.hs0000644000000000000000000000005612761110047014474 0ustar0000000000000000import Distribution.Simple main = defaultMain http-link-header-1.0.2/http-link-header.cabal0000644000000000000000000000361012761110157017165 0ustar0000000000000000name: http-link-header version: 1.0.2 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 == 7.10.3 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 , 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 ghc-prof-options: -auto-all -prof hs-source-dirs: test-suite main-is: Spec.hs other-modules: Network.HTTP.Link.ParserSpec Network.HTTP.Link.WriterSpec 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.2/README.md0000644000000000000000000000423412761045501014323 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).