pinterest-url-normalizer (empty) → 0.1.1.0

raw patch · 6 files changed

+422/−0 lines, 6 filesdep +basedep +network-uridep +pinterest-url-normalizer

Dependencies added: base, network-uri, pinterest-url-normalizer

Files

• CHANGELOG.md +11/−0
• LICENSE +21/−0
• README.md +70/−0
• pinterest-url-normalizer.cabal +40/−0
• src/SavePinner/PinterestURL.hs +217/−0
• test/Spec.hs +63/−0

@@ -0,0 +1,11 @@+# Changelog++## 0.1.1.0 — 2026-08-07++- Update project homepage and documentation for the current SavePinner workflow.++## 0.1.0.0 — 2026-08-02++- Initial release.+- Parse and normalize Pin, short, profile, board, and Ideas URLs.+- Reject HTTP URLs, credentials, non-standard ports, and lookalike domains.

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 SavePinner++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++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 OR COPYRIGHT HOLDERS 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.

@@ -0,0 +1,70 @@+# pinterest-url-normalizer++Parse, classify, and normalize Pinterest URLs without making network requests.++[SavePinner](https://savepinner.com/) · [Hackage](https://hackage.haskell.org/package/pinterest-url-normalizer)++The library recognizes Pin, `pin.it`, profile, board, and Ideas URLs across+Pinterest country domains. It uses an exact host allow list, rejects HTTP URLs,+credentials, non-standard ports, and lookalike domains, and removes query+parameters from normalized output.++## Install++Add the package to your Cabal file:++```cabal+build-depends: pinterest-url-normalizer ^>= 0.1.1.0+```++## Usage++```haskell+import SavePinner.PinterestURL++normalizePinterestUrl+  "https://de.pinterest.com/pin/987654321/?utm_source=share"+-- Right "https://www.pinterest.com/pin/987654321/"++parsePinterestUrl "https://pin.it/AbC123"+isPinterestUrl "https://www.pinterest.com/savepinner/media-tools/"+```++`parsePinterestUrl` returns `Either ParseError PinterestUrl`, so callers get a+specific failure instead of an exception.++## Supported URL kinds++| Kind | Example |+| --- | --- |+| `Pin` | `https://www.pinterest.com/pin/123456789/` |+| `Short` | `https://pin.it/AbC123` |+| `Profile` | `https://www.pinterest.com/savepinner/` |+| `Board` | `https://www.pinterest.com/savepinner/media-tools/` |+| `Ideas` | `https://www.pinterest.com/ideas/space-wallpaper/926295399832/` |++`pin.it` links are classified and normalized but are not followed. Resolving+them requires a network request and belongs in the consuming application.++## Development++```bash+cabal update+cabal test+cabal check+cabal sdist+```++## Why this package exists++This parser is maintained by the team behind the+[Pinterest image downloader](https://savepinner.com/), a browser tool for+inspecting media exposed by public Pinterest Pin URLs. The library contains no+downloader, tracking, browser automation, or remote code.++Pinterest is a trademark of Pinterest, Inc. This project is independent and is+not affiliated with or endorsed by Pinterest.++## License++MIT

@@ -0,0 +1,40 @@+cabal-version:      3.0+name:               pinterest-url-normalizer+version:            0.1.1.0+synopsis:           Parse and normalize Pinterest URLs without network requests+description:+  A small, zero-I/O library for classifying and normalizing Pinterest Pin,+  short, profile, board, and Ideas URLs. It uses an exact host allow list and+  rejects HTTP URLs, credentials, non-standard ports, and lookalike domains.+homepage:           https://savepinner.com/+bug-reports:        https://github.com/jiankn/pinterest-url-normalizer-haskell/issues+license:            MIT+license-file:       LICENSE+author:             SavePinner+maintainer:         jiankn@users.noreply.github.com+copyright:          2026 SavePinner+category:           Web+build-type:         Simple+extra-source-files: README.md+extra-doc-files:    CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/jiankn/pinterest-url-normalizer-haskell.git++library+  exposed-modules:  SavePinner.PinterestURL+  hs-source-dirs:   src+  build-depends:    base >=4.15 && <5,+                    network-uri >=2.6 && <2.7+  default-language: Haskell2010+  ghc-options:      -Wall++test-suite pinterest-url-normalizer-test+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  hs-source-dirs:   test+  build-depends:    base >=4.15 && <5,+                    pinterest-url-normalizer+  default-language: Haskell2010+  ghc-options:      -Wall

@@ -0,0 +1,217 @@+module SavePinner.PinterestURL+  ( UrlKind (..)+  , PinterestUrl (..)+  , ParseError (..)+  , parsePinterestUrl+  , normalizePinterestUrl+  , isPinterestUrl+  , isPinterestHost+  ) where++import Data.Char (isAlphaNum, isDigit, isSpace, toLower)+import Data.List (dropWhileEnd)+import Network.URI (URI (..), URIAuth (..), parseURI)++data UrlKind = Pin | Short | Profile | Board | Ideas+  deriving (Eq, Show)++data PinterestUrl = PinterestUrl+  { urlKind :: UrlKind+  , originalUrl :: String+  , normalizedUrl :: String+  , normalizedHost :: String+  , pinId :: Maybe String+  , shortCode :: Maybe String+  , username :: Maybe String+  , boardSlug :: Maybe String+  , ideaSlug :: Maybe String+  , ideaId :: Maybe String+  }+  deriving (Eq, Show)++data ParseError+  = InvalidUrl String+  | UnsupportedUrl String+  deriving (Eq, Show)++parsePinterestUrl :: String -> Either ParseError PinterestUrl+parsePinterestUrl input = do+  let original = trim input+  if null original || length original > 2048+    then Left (InvalidUrl "URL is empty or too long")+    else pure ()+  uri <- maybe (Left (InvalidUrl "URL could not be parsed")) Right (parseURI original)+  authority <- maybe (Left (InvalidUrl "URL has no host")) Right (uriAuthority uri)+  let scheme = lower (uriScheme uri)+      host = lower (uriRegName authority)+      port = uriPort authority+  if scheme /= "https:"+    then Left (InvalidUrl "Only HTTPS URLs are supported")+    else pure ()+  if not (null (uriUserInfo authority)) || port `notElem` ["", ":443"]+    then Left (InvalidUrl "Credentials and non-standard ports are not supported")+    else pure ()+  route original host (pathSegments (uriPath uri))++normalizePinterestUrl :: String -> Either ParseError String+normalizePinterestUrl value = normalizedUrl <$> parsePinterestUrl value++isPinterestUrl :: String -> Bool+isPinterestUrl = either (const False) (const True) . parsePinterestUrl++isPinterestHost :: String -> Bool+isPinterestHost host = lower host `elem` pinterestHosts++route :: String -> String -> [String] -> Either ParseError PinterestUrl+route original "pin.it" [code]+  | validShortCode code = Right+      ((emptyResult Short original ("https://pin.it/" ++ code ++ "/") "pin.it")+        { shortCode = Just code })+route _ "pin.it" _ = Left (UnsupportedUrl "Unsupported pin.it path")+route original host segments+  | not (isPinterestHost host) = Left (InvalidUrl "Host is not an allowed Pinterest domain")+  | otherwise = routePinterest original segments++routePinterest :: String -> [String] -> Either ParseError PinterestUrl+routePinterest original [first, value]+  | lower first == "pin"+  , Just ident <- extractPinId value = Right (pinResult original ident)+routePinterest original [first, value, trailing]+  | lower first == "pin"+  , Just ident <- extractPinId value+  , validBoardSlug trailing = Right (pinResult original ident)+routePinterest original [first, slug, ident]+  | lower first == "ideas"+  , validBoardSlug slug+  , validNumericId ident = Right+      ((emptyResult Ideas original normalized canonicalHost)+        { ideaSlug = Just slug+        , ideaId = Just ident+        })+  where+    normalized = "https://" ++ canonicalHost ++ "/ideas/" ++ slug ++ "/" ++ ident ++ "/"+routePinterest original [name]+  | validUsername name+  , lower name `notElem` reservedFirstSegments = Right+      ((emptyResult Profile original normalized canonicalHost)+        { username = Just name })+  where+    normalized = "https://" ++ canonicalHost ++ "/" ++ name ++ "/"+routePinterest original [name, slug]+  | validUsername name+  , lower name `notElem` reservedFirstSegments+  , validBoardSlug slug = Right+      ((emptyResult Board original normalized canonicalHost)+        { username = Just name+        , boardSlug = Just slug+        })+  where+    normalized = "https://" ++ canonicalHost ++ "/" ++ name ++ "/" ++ slug ++ "/"+routePinterest _ _ = Left (UnsupportedUrl "Unsupported Pinterest path")++pinResult :: String -> String -> PinterestUrl+pinResult original ident = (emptyResult Pin original normalized canonicalHost)+  { pinId = Just ident }+  where+    normalized = "https://" ++ canonicalHost ++ "/pin/" ++ ident ++ "/"++emptyResult :: UrlKind -> String -> String -> String -> PinterestUrl+emptyResult kind original normalized host = PinterestUrl+  { urlKind = kind+  , originalUrl = original+  , normalizedUrl = normalized+  , normalizedHost = host+  , pinId = Nothing+  , shortCode = Nothing+  , username = Nothing+  , boardSlug = Nothing+  , ideaSlug = Nothing+  , ideaId = Nothing+  }++extractPinId :: String -> Maybe String+extractPinId value+  | validNumericId value = Just value+  | otherwise =+      let (reversedDigits, rest) = span isDigit (reverse value)+          slug = reverse (drop 2 rest)+          ident = reverse reversedDigits+      in if take 2 rest == "--" && validBoardSlug slug && validNumericId ident+           then Just ident+           else Nothing++validNumericId :: String -> Bool+validNumericId value = not (null value) && length value <= 20 && all isDigit value++validShortCode :: String -> Bool+validShortCode value = length value >= 2 && all isAlphaNum value++validUsername :: String -> Bool+validUsername [] = False+validUsername (first : rest) =+  (isAlphaNum first || first == '_') && all isUsernameChar rest+  where+    isUsernameChar char = isAlphaNum char || char `elem` "_.-"++validBoardSlug :: String -> Bool+validBoardSlug [] = False+validBoardSlug (first : rest) = isAlphaNum first && all isSlugChar rest+  where+    isSlugChar char = isAlphaNum char || char `elem` "_-"++pathSegments :: String -> [String]+pathSegments path = filter (not . null) (splitOnSlash path)++splitOnSlash :: String -> [String]+splitOnSlash [] = []+splitOnSlash value =+  let withoutSlash = dropWhile (== '/') value+      (segment, remainder) = break (== '/') withoutSlash+  in if null withoutSlash then [] else segment : splitOnSlash remainder++trim :: String -> String+trim = dropWhileEnd isSpace . dropWhile isSpace++lower :: String -> String+lower = map toLower++canonicalHost :: String+canonicalHost = "www.pinterest.com"++reservedFirstSegments :: [String]+reservedFirstSegments =+  [ "business", "categories", "explore", "help", "ideas", "login"+  , "logout", "oauth", "pin", "pin-builder", "resource", "search"+  , "settings", "signup", "today", "topics"+  ]++pinterestHosts :: [String]+pinterestHosts =+  [ "pinterest.com", "www.pinterest.com", "m.pinterest.com"+  , "pinterest.at", "www.pinterest.at", "pinterest.be", "www.pinterest.be"+  , "pinterest.ca", "www.pinterest.ca", "pinterest.ch", "www.pinterest.ch"+  , "pinterest.cl", "www.pinterest.cl", "pinterest.co", "www.pinterest.co"+  , "pinterest.co.kr", "www.pinterest.co.kr", "pinterest.co.nz", "www.pinterest.co.nz"+  , "pinterest.co.uk", "www.pinterest.co.uk", "pinterest.com.au", "www.pinterest.com.au"+  , "pinterest.com.br", "www.pinterest.com.br", "pinterest.com.mx", "www.pinterest.com.mx"+  , "pinterest.com.pe", "www.pinterest.com.pe", "pinterest.com.tr", "www.pinterest.com.tr"+  , "pinterest.cz", "www.pinterest.cz", "pinterest.de", "www.pinterest.de"+  , "pinterest.dk", "www.pinterest.dk", "pinterest.es", "www.pinterest.es"+  , "pinterest.fi", "www.pinterest.fi", "pinterest.fr", "www.pinterest.fr"+  , "pinterest.gr", "www.pinterest.gr", "pinterest.hu", "www.pinterest.hu"+  , "pinterest.id", "www.pinterest.id", "pinterest.ie", "www.pinterest.ie"+  , "pinterest.it", "www.pinterest.it", "pinterest.jp", "www.pinterest.jp"+  , "pinterest.nl", "www.pinterest.nl", "pinterest.no", "www.pinterest.no"+  , "pinterest.ph", "www.pinterest.ph", "pinterest.pl", "www.pinterest.pl"+  , "pinterest.pt", "www.pinterest.pt", "pinterest.ro", "www.pinterest.ro"+  , "pinterest.se", "www.pinterest.se", "pinterest.sk", "www.pinterest.sk"+  , "at.pinterest.com", "au.pinterest.com", "be.pinterest.com", "br.pinterest.com"+  , "ca.pinterest.com", "ch.pinterest.com", "cl.pinterest.com", "co.pinterest.com"+  , "cz.pinterest.com", "de.pinterest.com", "dk.pinterest.com", "es.pinterest.com"+  , "fi.pinterest.com", "fr.pinterest.com", "gr.pinterest.com", "hu.pinterest.com"+  , "id.pinterest.com", "ie.pinterest.com", "it.pinterest.com", "jp.pinterest.com"+  , "kr.pinterest.com", "mx.pinterest.com", "nl.pinterest.com", "no.pinterest.com"+  , "nz.pinterest.com", "pe.pinterest.com", "ph.pinterest.com", "pl.pinterest.com"+  , "pt.pinterest.com", "ro.pinterest.com", "se.pinterest.com", "sk.pinterest.com"+  , "tr.pinterest.com", "uk.pinterest.com"+  ]

@@ -0,0 +1,63 @@+module Main (main) where++import SavePinner.PinterestURL+import System.Exit (exitFailure)++main :: IO ()+main = do+  results <- sequence+    [ expectNormalized+        "regional pin"+        "https://de.pinterest.com/pin/987654321/?utm_source=test"+        "https://www.pinterest.com/pin/987654321/"+    , expectPinId+        "slugged pin"+        "https://www.pinterest.com/pin/roasted-pineapple--68746366275/"+        "68746366275"+    , expectKind "short URL" "https://pin.it/AbC123?source=share" Short+    , expectNormalized+        "short URL normalization"+        "https://pin.it/AbC123?source=share"+        "https://pin.it/AbC123/"+    , expectKind "profile" "https://pinterest.com/savepinner/" Profile+    , expectKind "board" "https://www.pinterest.com/savepinner/media-tools/" Board+    , expectKind+        "ideas"+        "https://www.pinterest.com/ideas/space-wallpaper-4k/926295399832/"+        Ideas+    , expectRejected "lookalike" "https://www.pinterest.com.evil.example/pin/123/"+    , expectRejected "HTTP" "http://www.pinterest.com/pin/123/"+    , expectRejected "credentials" "https://user:pass@www.pinterest.com/pin/123/"+    , expectRejected "non-standard port" "https://www.pinterest.com:8443/pin/123/"+    , expectRejected "reserved path" "https://www.pinterest.com/search/pins/?q=cats"+    , expectEqual "country host" True (isPinterestHost "PINTEREST.CO.UK")+    , expectEqual "lookalike host" False (isPinterestHost "pinterest.co.uk.evil.example")+    ]+  if and results then putStrLn "All tests passed." else exitFailure++expectNormalized :: String -> String -> String -> IO Bool+expectNormalized label input expected =+  expectEqual label (Right expected) (normalizePinterestUrl input)++expectKind :: String -> String -> UrlKind -> IO Bool+expectKind label input expected =+  case parsePinterestUrl input of+    Right parsed -> expectEqual label expected (urlKind parsed)+    Left err -> reportFailure label ("unexpected parse error: " ++ show err)++expectPinId :: String -> String -> String -> IO Bool+expectPinId label input expected =+  case parsePinterestUrl input of+    Right parsed -> expectEqual label (Just expected) (pinId parsed)+    Left err -> reportFailure label ("unexpected parse error: " ++ show err)++expectRejected :: String -> String -> IO Bool+expectRejected label input = expectEqual label False (isPinterestUrl input)++expectEqual :: (Eq value, Show value) => String -> value -> value -> IO Bool+expectEqual label expected actual+  | expected == actual = putStrLn ("PASS: " ++ label) >> pure True+  | otherwise = reportFailure label ("expected " ++ show expected ++ ", got " ++ show actual)++reportFailure :: String -> String -> IO Bool+reportFailure label message = putStrLn ("FAIL: " ++ label ++ " — " ++ message) >> pure False