http-link-header-1.2.3/benchmark/0000755000000000000000000000000014771425774015017 5ustar0000000000000000http-link-header-1.2.3/library/0000755000000000000000000000000014771425774014531 5ustar0000000000000000http-link-header-1.2.3/library/Network/0000755000000000000000000000000014771425774016162 5ustar0000000000000000http-link-header-1.2.3/library/Network/HTTP/0000755000000000000000000000000014771427306016732 5ustar0000000000000000http-link-header-1.2.3/library/Network/HTTP/Link/0000755000000000000000000000000014777410344017627 5ustar0000000000000000http-link-header-1.2.3/test-suite/0000755000000000000000000000000014771425774015173 5ustar0000000000000000http-link-header-1.2.3/test-suite/Network/0000755000000000000000000000000014771425774016624 5ustar0000000000000000http-link-header-1.2.3/test-suite/Network/HTTP/0000755000000000000000000000000014771425774017403 5ustar0000000000000000http-link-header-1.2.3/test-suite/Network/HTTP/Link/0000755000000000000000000000000014771425774020300 5ustar0000000000000000http-link-header-1.2.3/library/Network/HTTP/Link.hs0000644000000000000000000000206614771427306020167 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 (encodeUtf8) import safe Network.HTTP.Link.Parser import safe Network.HTTP.Link.Types import safe Network.HTTP.Link.Writer import Web.HttpApiData (ToHttpApiData(..)) 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.3/library/Network/HTTP/Link/Parser.hs0000644000000000000000000000676714777410344021437 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 ((<|>), many) import Control.Error.Util (hush) import Data.Text (Text, pack, unpack) 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 (Parser, parseOnly, char, sepBy', many', skipSpace, takeWhile, takeWhile1, take, inClass) import Network.URI (unEscapeString) 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.3/library/Network/HTTP/Link/Types.hs0000644000000000000000000000263114771427023021265 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax, Safe #-} -- | The data type definitions for the HTTP Link header. module Network.HTTP.Link.Types where import Data.Text (Text, pack, unpack) import Network.URI (URI, parseURIReference) -- | 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.3/library/Network/HTTP/Link/Writer.hs0000644000000000000000000000216114771427243021437 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 (escapeURIString) 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.3/test-suite/Spec.hs0000644000000000000000000000005414771425774016420 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-link-header-1.2.3/test-suite/Network/HTTP/Link/ParserSpec.hs0000644000000000000000000000545214771425774022711 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.3/test-suite/Network/HTTP/Link/WriterSpec.hs0000644000000000000000000000303614771425774022725 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.3/test-suite/Network/HTTP/LinkSpec.hs0000644000000000000000000000275714771425774021462 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.3/benchmark/Bench.hs0000644000000000000000000000041414771425774016371 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.3/benchmark/ParserBench.hs0000644000000000000000000000131414771425774017546 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.3/benchmark/WriterBench.hs0000644000000000000000000000203714771425774017571 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.3/README.md0000644000000000000000000000354414771425774014352 0ustar0000000000000000[![Hackage](https://img.shields.io/hackage/v/http-link-header?style=flat) ![](https://img.shields.io/endpoint?url=https://hackage-downloads-badge.deno.dev/http-link-header)](https://hackage.haskell.org/package/http-link-header) [![unlicense](https://img.shields.io/badge/un-license-green.svg?style=flat)](https://unlicense.org) [![Support me on Patreon](https://img.shields.io/badge/dynamic/json?logo=patreon&color=%23e85b46&label=support%20me%20on%20patreon&query=data.attributes.patron_count&suffix=%20patrons&url=https%3A%2F%2Fwww.patreon.com%2Fapi%2Fcampaigns%2F9395291)](https://www.patreon.com/valpackett) # http-link-header 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 ## License This is free and unencumbered software released into the public domain. For more information, please refer to the `UNLICENSE` file or [unlicense.org](https://unlicense.org). http-link-header-1.2.3/UNLICENSE0000644000000000000000000000227314771425774014341 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.3/Setup.hs0000644000000000000000000000005614771425774014522 0ustar0000000000000000import Distribution.Simple main = defaultMain http-link-header-1.2.3/http-link-header.cabal0000644000000000000000000000425614777412364017215 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: http-link-header version: 1.2.3 synopsis: HTTP Link header parser/writer description: Library for the HTTP Link header as specified in RFC 5988 "Web Linking" category: Web homepage: https://codeberg.org/valpackett/http-link-header bug-reports: https://codeberg.org/valpackett/http-link-header/issues author: Val Packett maintainer: val@packett.cool copyright: 2014-2025 Val Packett license: PublicDomain license-file: UNLICENSE build-type: Simple extra-source-files: README.md source-repository head type: git location: https://codeberg.org/valpackett/http-link-header.git 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 , hspec-discover , 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