├── .gitignore ├── .travis.yml ├── Dockerfile ├── LICENSE ├── README.markdown ├── Setup.hs ├── cli └── Main.hs ├── docker-compose.yml ├── metrics-noop └── Lib │ └── Metrics.hs ├── metrics └── Lib │ └── Metrics.hs ├── rss-markdown-proxy.cabal ├── server └── Main.hs ├── src ├── Lib.hs └── Lib │ ├── CLI.hs │ ├── Server.hs │ └── Types.hs ├── stack.yaml └── test ├── Spec.hs └── fixtures ├── output.rss └── sounds.rss /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: c # Choose a lightweight base image 3 | 4 | cache: 5 | directories: 6 | - $HOME/.stack 7 | 8 | addons: 9 | apt: 10 | packages: 11 | - libgmp3-dev 12 | 13 | before_install: 14 | - mkdir -p ~/.local/bin 15 | - export PATH=$HOME/.local/bin:$PATH 16 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 17 | 18 | script: 19 | - stack setup 20 | - stack --no-terminal test 21 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM fpco/stack-run 2 | MAINTAINER Pascal Hartig 3 | 4 | ARG PROGVERSION=v0.2.0.0 5 | 6 | RUN apt-get install -y curl && mkdir -p /srv 7 | RUN curl -L https://github.com/passy/rss-markdown-proxy/releases/download/$PROGVERSION/rss-markdown-proxy-$PROGVERSION-lnx64.tar.bz2 | tar -C /srv -xjvf - ./rss-markdown-proxy-server 8 | 9 | EXPOSE 3000 10 | WORKDIR /srv 11 | ENTRYPOINT ["/srv/rss-markdown-proxy-server"] 12 | 13 | # vim:tw=0: 14 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Pascal Hartig (c) 2015 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Pascal Hartig nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # rss-markdown-proxy 2 | [![Build Status](https://travis-ci.org/passy/rss-markdown-proxy.svg)](https://travis-ci.org/passy/rss-markdown-proxy) 3 | 4 | > A reverse proxy rendering Markdown to HTML within RSS feeds for podcast 5 | > shownotes. 6 | 7 | ## Why? 8 | 9 | As my co-host [@monchote](https://github.com/monchote) on 10 | [Strictly Untyped](https://twitter.com/strictlyuntyped) has found out, 11 | SoundCloud does not allow embedding HTML in their RSS feeds because 12 | spammers could take advantage of this. This is, however, pretty crap 13 | if you want to use it for show notes and embed some links. 14 | 15 | This is a simple reverse proxy you can pipe any RSS feed through 16 | to render the `` and `` fields to HTML, allowing 17 | you to author them in Markdown. 18 | 19 | ## Setup 20 | 21 | ``` 22 | $ git clone http://github.com/passy/rss-markdown-proxy 23 | $ cd rss-markdown-proxy 24 | $ stack setup 25 | $ stack install 26 | ``` 27 | 28 | ## Usage 29 | 30 | This package comes with two binaries: `rss-markdown-proxy` and 31 | `rss-markdown-proxy-server`. The former is a stand-alone CLI tool version 32 | of the latter. 33 | 34 | ### `rss-markdown-proxy-server` 35 | 36 | This starts a web server for a given URL and serves the transformed feed at 37 | `/feed.rss`. Responses are cached for 5 minutes. Open an issue if you believe 38 | that this should be configurable. It binds to "0.0.0.0". Again, open an issue or 39 | PR if that bothers you. 40 | 41 | Example usage: 42 | 43 | ```bash 44 | $ rss-markdown-proxy-server -p 3000 "https://feeds.soundcloud.com/users/soundcloud:users:189413584/sounds.rss" 45 | $ curl http://localhost:3000/ 46 | ``` 47 | 48 | ### `rss-markdown-proxy` 49 | 50 | This tool can be used to transform local or remote feeds one-off or as part 51 | os a scheduled job. 52 | 53 | Local file: 54 | 55 | ```bash 56 | # From the filesystem 57 | $ rss-markdown-proxy test/fixtures/sounds.rss 58 | # From STDIN 59 | $ rss-markdown-proxy < test/fixtures/sounds.rss 60 | # From URL 61 | $ rss-markdown-proxy -u "https://feeds.soundcloud.com/users/soundcloud:users:189413584/sounds.rss" 62 | ``` 63 | 64 | ## Metrics 65 | 66 | Like stats? So do I! If you compile with the `metrics` flag, you get a built-in 67 | metrics server. Only with `rss-markdown-proxy-server`, though, as it doesn't 68 | make a whole lot of sense for short-lived programs. 69 | 70 | ``` 71 | $ stack build --flag=rss-markdown-proxy:metrics 72 | ``` 73 | 74 | The metrics server runs on port 3001 by default but you can change it through 75 | the `--metrics-port` / `-m` flags. The server binds to localhost and you 76 | probably don't want to expose this directly to the internet. Either 77 | reverse-proxy it with some authentication or SSH tunnel to it. 78 | 79 | ## Security Considerations 80 | 81 | The proxy is built to only serve a single URL. You could easily change it 82 | to proxy arbitrary RSS feeds, but I strongly advise against that setup. 83 | XML is a horrible mess and a lot of the code runs in IO. I have no idea 84 | whether or not this is vulnerable to the 85 | [Billion laughs](https://en.wikipedia.org/wiki/Billion_laughs) attack 86 | so I'd rather be safe then sorry by limiting this to trusted sources. 87 | 88 | ## Dockerizificationism :whale: 89 | 90 | If you want to use Docker to deploy this somewhere, here are some steps 91 | which might be useful. You need a recent version of Docker that supports 92 | the `ARG` command if you want to build an image yourself. There 93 | are (semi-)automatic builds available on 94 | [Docker Hub](https://hub.docker.com/r/passy/rss-markdown-proxy/). 95 | 96 | *Run image* 97 | 98 | ``` 99 | docker pull rss-markdown-proxy:v0.2.0.0 100 | docker run --rm -p 3000:3000 rss-markdown-proxy:v0.2.0.0 "https://feeds.soundcloud.com/users/soundcloud:users:189413584/sounds.rss" 101 | ``` 102 | 103 | *Build a new image* 104 | 105 | ``` 106 | docker build --build-arg version=$(git describe --tags --always) -t rss-markdown-proxy . 107 | ``` 108 | 109 | *Release an image* 110 | 111 | Check the version that's spat out above. 112 | 113 | ``` 114 | docker tag passy/rss-markdown-proxy: 115 | docker push passy/rss-markdown-proxy: 116 | ``` 117 | 118 | ## Example 119 | 120 | Input snippet: 121 | 122 | ```xml 123 | For their first real episode, Ramón and Passy talk about some of the latest news in tech and address the elephant in the room: Android vs iOS from a DX (Developer Experience) perspective. 124 | 125 | ## Follow-Up 126 | 127 | * Talking about podcasts on podcasts: https://overcast.fm/+EtBoIE-HU/7:21 128 | 129 | ## Other Topics 130 | 131 | * Apple open sourcing Swift: https://github.com/apple/swift 132 | * Dropbox shutting down Mailbox + Carousel: https://blogs.dropbox.com/dropbox/2015/12/saying-goodbye-to-carousel-and-mailbox/ 133 | * Apple's new gorgeous iPhone battery case: http://www.apple.com/shop/product/MGQM2LL/A/iphone-6s-smart-battery-case-white 134 | * Apple May Replace 3.5mm Headphone Jack on iPhone 7 With All-in-One Lightning Connector: http://www.macrumors.com/2015/11/27/iphone-7-no-3-5mm-headphone-jack-lightning/ 135 | * Google Play Store will soon display if an app contains ads: http://www.techtimes.com/articles/108538/20151120/google-play-store-will-soon-warn-users-if-apps-have-ads.htm 136 | 137 | ## Links 138 | 139 | * Android Needs A Simulator by Jake Wharton: http://jakewharton.com/android-needs-a-simulator/ 140 | 141 | ## About 142 | 143 | * Ramón Argüello: https://twitter.com/monchote 144 | * Pascal Hartig: https://twitter.com/passy 145 | * Strictly Untyped: https://twitter.com/strictlyuntyped 146 | 147 | ``` 148 | 149 | Output snippet: 150 | 151 | ```xml 152 | 153 | For their first real episode, Ramón and Passy talk about some of the latest 155 | news in tech and address the elephant in the room: Android vs iOS from a DX 156 | (Developer Experience) perspective.

Follow-Up

  • 157 |

    Talking about podcasts on podcasts: https://overcast.fm/+EtBoIE-HU/7:21

    158 |

Other Topics

  • Apple open sourcing Swift: 159 | https://github.com/apple/swift
  • Dropbox shutting down Mailbox + 160 | Carousel: 161 | https://blogs.dropbox.com/dropbox/2015/12/saying-goodbye-to-carousel-and-mailbox/
  • Apple's 162 | new gorgeous iPhone battery case: 163 | http://www.apple.com/shop/product/MGQM2LL/A/iphone-6s-smart-battery-case-white
  • Apple 164 | May Replace 3.5mm Headphone Jack on iPhone 7 With All-in-One Lightning 165 | Connector: 166 | http://www.macrumors.com/2015/11/27/iphone-7-no-3-5mm-headphone-jack-lightning/
  • Google 167 | Play Store will soon display if an app contains ads: 168 | http://www.techtimes.com/articles/108538/20151120/google-play-store-will-soon-warn-users-if-apps-have-ads.htm

Links

  • Android 169 | Needs A Simulator by Jake Wharton: 170 | http://jakewharton.com/android-needs-a-simulator/

About

  • Ramón 171 | Argüello: https://twitter.com/monchote
  • Pascal Hartig: 172 | https://twitter.com/passy
  • Strictly Untyped: 173 | https://twitter.com/strictlyuntyped
]]> 174 | 175 | ``` 176 | 177 | ## License 178 | 179 | BSD-3 180 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cli/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Main where 5 | 6 | import qualified Data.Text.Lazy as T 7 | import Lib (fetchFeed, transformRSS) 8 | 9 | import Data.Version (Version(), showVersion) 10 | import Options.Applicative 11 | import Paths_rss_markdown_proxy (version) 12 | 13 | data CliOptions = CliOptions 14 | { path :: Maybe FilePath 15 | , url :: Maybe String 16 | } 17 | 18 | cliParser :: Version -> ParserInfo CliOptions 19 | cliParser ver = 20 | info ( helper <*> appOpts <**> versionInfo ) 21 | ( fullDesc 22 | <> progDesc "Transform an RSS feed to render Markdown to HTML in description fields" 23 | <> header "rss-markdown-proxy" ) 24 | where 25 | appOpts = CliOptions 26 | <$> optional ( argument str (metavar "FILE") ) 27 | <*> optional ( strOption 28 | ( long "url" 29 | <> short 'u' 30 | <> help "Remote URL to fetch" ) ) 31 | 32 | versionInfo = infoOption ( "rss-markdown-proxy " ++ showVersion ver ) 33 | ( short 'V' 34 | <> long "version" 35 | <> hidden 36 | <> help "Show version information" ) 37 | 38 | main :: IO () 39 | main = 40 | execParser (cliParser version) >>= run 41 | where 42 | run :: CliOptions -> IO () 43 | run opts = 44 | case url opts of 45 | Nothing -> transformFile opts 46 | Just u -> T.unpack <$> fetchFeed u >>= transformRSS >>= putStrLn 47 | 48 | transformFile :: CliOptions -> IO () 49 | transformFile opts = 50 | putStrLn =<< transformRSS =<< case path opts of 51 | Nothing -> getContents 52 | Just path' -> readFile path' 53 | -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | rssprox: 2 | image: passy/rss-markdown-proxy:v0.2.0.0 3 | ports: 4 | - "3000:3000" 5 | restart: unless-stopped 6 | command: "https://feeds.soundcloud.com/users/soundcloud:users:189413584/sounds.rss" 7 | -------------------------------------------------------------------------------- /metrics-noop/Lib/Metrics.hs: -------------------------------------------------------------------------------- 1 | module Lib.Metrics 2 | ( getMetricsMiddleware 3 | ) where 4 | 5 | import Lib.Types (Metrics, Port) 6 | import Network.Wai (Middleware) 7 | 8 | getMetricsMiddleware :: Port Metrics -> IO Middleware 9 | getMetricsMiddleware = const $ return id 10 | -------------------------------------------------------------------------------- /metrics/Lib/Metrics.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Lib.Metrics where 4 | 5 | import Lib.Types (Metrics, Port, unPort) 6 | import Network.Wai (Middleware) 7 | import System.Remote.Monitoring (forkServer, serverMetricStore) 8 | import qualified Network.Wai.Metrics as Metrics 9 | 10 | getMetricsMiddleware :: Port Metrics -> IO Middleware 11 | getMetricsMiddleware port = do 12 | store <- serverMetricStore <$> forkServer "localhost" (unPort port) 13 | waiMetrics <- Metrics.registerWaiMetrics store 14 | return $ Metrics.metrics waiMetrics 15 | -------------------------------------------------------------------------------- /rss-markdown-proxy.cabal: -------------------------------------------------------------------------------- 1 | name: rss-markdown-proxy 2 | version: 0.2.0.0 3 | synopsis: An RSS proxy rendering markdown descriptions 4 | description: Please see README.md 5 | homepage: http://github.com/passy/rss-markdown-proxy#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Pascal Hartig 9 | maintainer: phartig@rdrei.net 10 | copyright: 2015 Pascal Hartig 11 | category: Web 12 | build-type: Simple 13 | cabal-version: >=1.10 14 | 15 | library 16 | hs-source-dirs: src 17 | exposed-modules: Lib 18 | , Lib.Server 19 | , Lib.CLI 20 | , Lib.Types 21 | , Lib.Metrics 22 | build-depends: base >= 4.7 && < 5 23 | , lens 24 | , text 25 | , transformers 26 | , bytestring 27 | , scotty 28 | , wreq 29 | , hxt 30 | , markdown 31 | , blaze-html 32 | , TCache 33 | , data-default 34 | , hourglass 35 | , wai 36 | if flag(metrics) 37 | build-depends: wai-middleware-metrics 38 | , ekg 39 | hs-source-dirs: metrics 40 | else 41 | hs-source-dirs: metrics-noop 42 | default-language: Haskell2010 43 | other-extensions: OverloadedStrings 44 | , Arrows 45 | , NoImplicitPrelude 46 | , ExistentialQuantification 47 | , TemplateHaskell 48 | ghc-options: -Wall 49 | -fwarn-tabs 50 | -fwarn-incomplete-record-updates 51 | -fwarn-monomorphism-restriction 52 | -fwarn-unused-do-bind 53 | 54 | executable rss-markdown-proxy-server 55 | hs-source-dirs: server 56 | main-is: Main.hs 57 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T 58 | build-depends: base 59 | , rss-markdown-proxy 60 | , optparse-applicative 61 | , data-default 62 | default-language: Haskell2010 63 | Ghc-options: -Wall 64 | -fwarn-tabs 65 | -fwarn-incomplete-record-updates 66 | -fwarn-monomorphism-restriction 67 | -fwarn-unused-do-bind 68 | 69 | executable rss-markdown-proxy 70 | hs-source-dirs: cli 71 | main-is: Main.hs 72 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 73 | build-depends: base 74 | , rss-markdown-proxy 75 | , text 76 | , optparse-applicative 77 | default-language: Haskell2010 78 | ghc-options: -Wall 79 | -fwarn-tabs 80 | -fwarn-incomplete-record-updates 81 | -fwarn-monomorphism-restriction 82 | -fwarn-unused-do-bind 83 | 84 | test-suite rss-markdown-proxy-test 85 | type: exitcode-stdio-1.0 86 | hs-source-dirs: test 87 | main-is: Spec.hs 88 | build-depends: base 89 | , rss-markdown-proxy 90 | , hspec 91 | , directory 92 | , hxt 93 | , text 94 | , filepath 95 | , transformers 96 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 97 | default-language: Haskell2010 98 | 99 | source-repository head 100 | type: git 101 | location: https://github.com/passy/rss-markdown-proxy 102 | 103 | flag metrics 104 | description: Enable runtime statistics 105 | default: False 106 | manual: True 107 | -------------------------------------------------------------------------------- /server/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | module Main where 4 | 5 | import Lib.Server (server) 6 | import Lib.Types (Port(..), ServerOptions(..)) 7 | 8 | import Data.Default (def) 9 | import Data.Version (Version(), showVersion) 10 | import Options.Applicative 11 | import Paths_rss_markdown_proxy (version) 12 | 13 | readPort :: forall a. ReadM (Port a) 14 | readPort = eitherReader $ \arg -> case reads arg of 15 | [(r, "")] -> return $ Port r 16 | _ -> Left $ "cannot parse port value `" <> arg <> "'" 17 | 18 | serverParser :: Version -> ParserInfo ServerOptions 19 | serverParser ver = 20 | info ( helper <*> appOpts <**> versionInfo ) 21 | ( fullDesc 22 | <> progDesc "Reverse proxy for rendering Markdown in RSS feeds" 23 | <> header "rss-markdown-proxy-server" ) 24 | where 25 | appOpts = ServerOptions 26 | <$> argument str (metavar "URL") 27 | <*> option readPort 28 | ( long "port" 29 | <> short 'p' 30 | <> value def 31 | <> showDefault 32 | <> help "HTTP proxy server port" ) 33 | <*> option readPort 34 | ( long "metrics-port" 35 | <> short 'm' 36 | <> value def 37 | <> showDefault 38 | <> help "HTTP metrics server port" ) 39 | 40 | versionInfo = infoOption ( "rss-markdown-proxy-server " ++ showVersion ver ) 41 | ( short 'V' 42 | <> long "version" 43 | <> hidden 44 | <> help "Show version information" ) 45 | 46 | main :: IO () 47 | main = execParser (serverParser version) >>= server 48 | -------------------------------------------------------------------------------- /src/Lib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Lib 4 | ( selectDescriptions 5 | , fetchFeed 6 | , transformRSS 7 | ) where 8 | 9 | import qualified Data.Text.Lazy as T 10 | import qualified Data.Text.Lazy.Encoding as TE 11 | import qualified Network.Wreq as W 12 | 13 | import Text.Blaze.Html.Renderer.Text (renderHtml) 14 | import Text.Markdown (def, markdown) 15 | 16 | import Control.Lens hiding (deep) 17 | import Text.XML.HXT.Core 18 | 19 | itunesNs :: String 20 | itunesNs = "http://www.itunes.com/dtds/podcast-1.0.dtd" 21 | 22 | infixr 5 />/ 23 | (/>/) :: ArrowXml a => a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree 24 | predicate />/ action = processChildren action `when` predicate 25 | 26 | transformRSS :: String -> IO String 27 | transformRSS input = do 28 | let doc = readString [withWarnings yes] input 29 | [res] <- runX $ 30 | doc 31 | >>> propagateNamespaces 32 | >>> processTopDown processFeed 33 | >>> indentDoc 34 | >>> writeDocumentToString [] 35 | return res 36 | 37 | processFeed :: ArrowXml a => a XmlTree XmlTree 38 | processFeed = (isElem >>> hasName "item") 39 | />/ selectDescriptions 40 | />/ (getText >>> arr renderMarkdownToHtml >>> mkCdata) 41 | 42 | renderMarkdownToHtml :: String -> String 43 | renderMarkdownToHtml = T.pack >>> markdown def >>> renderHtml >>> T.unpack 44 | 45 | fetchFeed :: String -> IO T.Text 46 | fetchFeed url = do 47 | r <- W.get url 48 | return $ r ^. W.responseBody & TE.decodeUtf8 49 | 50 | selectDescriptions :: ArrowXml a => a XmlTree XmlTree 51 | selectDescriptions = 52 | let summaryQName = mkNsName "summary" itunesNs 53 | in isElem >>> (hasQName summaryQName <+> hasName "description") 54 | -------------------------------------------------------------------------------- /src/Lib/CLI.hs: -------------------------------------------------------------------------------- 1 | module Lib.CLI 2 | ( cliMain 3 | ) where 4 | 5 | import qualified Data.Text.Lazy as T 6 | import Lib (fetchFeed, transformRSS) 7 | import System.Environment (getArgs) 8 | cliMain :: IO () 9 | cliMain = do 10 | [url] <- getArgs 11 | rss <- T.unpack <$> fetchFeed url 12 | transformRSS rss >>= putStrLn 13 | -------------------------------------------------------------------------------- /src/Lib/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Lib.Server 5 | ( server 6 | ) where 7 | 8 | import qualified Data.Text.Lazy as T 9 | import qualified Web.Scotty as S 10 | 11 | import Control.Lens 12 | import Control.Monad.IO.Class (liftIO) 13 | import Data.Hourglass.Types (Seconds(), toSeconds) 14 | import Data.TCache (atomically) 15 | import Data.TCache.Memoization (cachedByKeySTM) 16 | 17 | import Lib (fetchFeed, transformRSS) 18 | import Lib.Types (ServerOptions(), port, unPort, url, metricsPort) 19 | import qualified Lib.Metrics as Metrics 20 | 21 | -- | Cache expiration time in seconds. 22 | cacheTime :: Seconds 23 | cacheTime = 60 24 | 25 | transformUrlCached :: String -> IO String 26 | transformUrlCached url' = 27 | let perform = transformRSS =<< T.unpack <$> fetchFeed url' 28 | seconds = fromEnum $ toSeconds cacheTime 29 | in atomically $ cachedByKeySTM url' seconds perform 30 | 31 | server :: ServerOptions -> IO () 32 | server opts = do 33 | metricsMiddleware <- Metrics.getMetricsMiddleware (opts ^. metricsPort) 34 | 35 | S.scotty (opts ^. port & unPort) $ do 36 | S.middleware metricsMiddleware 37 | S.get "/feed.rss" $ do 38 | res <- liftIO . transformUrlCached $ opts ^. url 39 | S.setHeader "Content-Type" "application/rss+xml;charset=utf-8" 40 | S.text $ T.pack res 41 | -------------------------------------------------------------------------------- /src/Lib/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | 4 | module Lib.Types 5 | ( Port(Port) 6 | , ServerOptions(ServerOptions) 7 | , unPort 8 | , Metrics 9 | , Server 10 | , metricsPort 11 | , port 12 | , url 13 | ) where 14 | 15 | import Control.Lens 16 | import Data.Default (Default(), def) 17 | 18 | newtype Port a = 19 | Port Int 20 | deriving (Read, Show) 21 | 22 | unPort :: Port a -> Int 23 | unPort (Port i) = i 24 | 25 | data Server 26 | data Metrics 27 | 28 | -- | Command line options provided to start up the server. 29 | data ServerOptions = ServerOptions 30 | { _url :: String 31 | , _port :: Port Server 32 | , _metricsPort :: Port Metrics 33 | } 34 | 35 | makeLenses ''ServerOptions 36 | 37 | instance Default (Port Server) where 38 | def = Port 3000 39 | 40 | instance Default (Port Metrics) where 41 | def = Port 3001 42 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md 2 | 3 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) 4 | resolver: lts-13.22 5 | 6 | # Local packages, usually specified by relative directory name 7 | packages: 8 | - '.' 9 | 10 | # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) 11 | extra-deps: [] 12 | 13 | # Override default flag values for local packages and extra-deps 14 | flags: {} 15 | 16 | # Extra package databases containing global packages 17 | extra-package-dbs: [] 18 | 19 | # Control whether we use the GHC we find on the path 20 | # system-ghc: true 21 | 22 | # Require a specific version of stack, using version ranges 23 | # require-stack-version: -any # Default 24 | # require-stack-version: >= 0.1.4.0 25 | 26 | # Override the architecture used by stack, especially useful on Windows 27 | # arch: i386 28 | # arch: x86_64 29 | 30 | # Extra directories used by stack for building 31 | # extra-include-dirs: [/path/to/dir] 32 | # extra-lib-dirs: [/path/to/dir] 33 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | import Control.Monad.IO.Class (liftIO) 5 | import qualified Data.Text as T 6 | import qualified Data.Text.IO as TIO 7 | import Lib 8 | import System.Directory (getCurrentDirectory) 9 | import System.FilePath (()) 10 | import System.IO (Handle (), IOMode (ReadMode), openFile) 11 | import Test.Hspec 12 | import Text.XML.HXT.Core 13 | 14 | openFixture :: forall a. (FilePath -> IO a) -> FilePath -> IO a 15 | openFixture f path = do 16 | dir <- getCurrentDirectory 17 | f $ dir "test" "fixtures" path 18 | 19 | openXMLFixture :: forall s b. FilePath -> IO (IOStateArrow s b XmlTree) 20 | openXMLFixture = openFixture openXMLFile 21 | 22 | openStringFixture :: FilePath -> IO String 23 | openStringFixture = openFixture readFile 24 | 25 | openXMLFile :: forall s b. FilePath -> IO (IOStateArrow s b XmlTree) 26 | openXMLFile = (readXMLFileHandle =<<) . getHandle 27 | where 28 | getHandle path = openFile path ReadMode 29 | 30 | readXMLFileHandle :: forall s b. Handle -> IO (IOStateArrow s b XmlTree) 31 | readXMLFileHandle h = do 32 | contents <- TIO.hGetContents h 33 | return $ readString [withWarnings yes] $ T.unpack contents 34 | 35 | main :: IO () 36 | main = hspec $ do 37 | describe "XML Parser" $ 38 | it "reads descriptions" $ do 39 | doc <- liftIO $ openXMLFixture "sounds.rss" 40 | descs <- liftIO $ runX $ 41 | doc >>> propagateNamespaces >>> deep selectDescriptions /> getText 42 | 43 | length descs `shouldBe` 5 44 | 45 | describe "RSS Transformer" $ 46 | it "transforms correctly" $ do 47 | input <- liftIO $ openStringFixture "sounds.rss" 48 | expected <- liftIO $ openStringFixture "output.rss" 49 | 50 | output <- liftIO $ transformRSS input 51 | 52 | output `shouldBe` expected 53 | -------------------------------------------------------------------------------- /test/fixtures/output.rss: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 57 | 58 | -------------------------------------------------------------------------------- /test/fixtures/sounds.rss: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 109 | 110 | --------------------------------------------------------------------------------