[web-devel] Yesod proxy

Michael Snoyman michael at snoyman.com
Sun May 29 15:24:59 CEST 2011


On Sun, May 29, 2011 at 12:18 PM, Jeremy Hughes <jedahu at gmail.com> wrote:
> Hi all,
>
> The app I'm writing uses a private file store accessible by HTTP
> (rackspace's cloud files). Some of what the app does is authenticate
> access to files in the store, a kind of selective proxy (or
> alternatively, like a static handler that can fetch http:// as well as
> file://).
>
> Before I go ahead and write a simple proxying function using
> http-enumerator &co, does one already exist in Yesod? And if not, any
> pointers on writing one and integrating it with GGHandler and HasReps?
>
> Cheers,
> Jeremy

Hi Jeremy,

I think this is the kind of example people would like to see more of.
Here's the uncommented, undocumented version for now. Expect a blog
post/entry in the Yesod book with more details.

In general everyone: I'm looking for these kinds of questions to drive
new documentation. Now that the new site is (almost) up, expect more
writing on my part.

Michael


{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
import Yesod
import Network.HTTP.Enumerator
import Network.HTTP.Types
import Network.Wai
import Data.ByteString (ByteString)
import Data.Enumerator (Iteratee, run_, ($$), joinI)
import Blaze.ByteString.Builder (Builder, fromByteString)
import qualified Data.Enumerator.List as EL

data Proxy = Proxy

mkYesod "Proxy" [parseRoutes|
/ RootR GET
|]

instance Yesod Proxy where
    approot _ = ""

getRootR :: GHandler Proxy Proxy ()
getRootR = do
    req <- liftIO $ parseUrl "http://www.yesodweb.com/"
    sendWaiResponse $ ResponseEnumerator $ \f -> withManager $ \m ->
        run_ (http req (blaze f) m)

blaze :: (Status -> ResponseHeaders -> Iteratee Builder IO a)
      -> Status -> ResponseHeaders -> Iteratee ByteString IO a
blaze f s h =
    joinI $ EL.map fromByteString $$ f s h'
  where
    h' = filter go h
    go ("Content-Encoding", _) = False
    go _ = True

main :: IO ()
main = warpDebug 3000 Proxy



More information about the web-devel mailing list