waldo (empty) → 0
raw patch · 35 files changed
+1173/−0 lines, 35 filesdep +Geodeticdep +Globdep +SHAsetup-changedbinary-added
Dependencies added: Geodetic, Glob, SHA, aeson, aeson-pretty, attoparsec, base, blaze-builder, browscap, bytestring, case-insensitive, conduit, conduit-extra, deepseq, directory, filepath, hs-GeoIP, http-types, imagesize-conduit, lrucache, mtl, network, network-uri, regex-tdfa, resourcet, safe, text, unordered-containers, wai, wai-app-static, wai-extra, waldo, warp, zlib-conduit
Files
- LICENSE +32/−0
- Setup.hs +2/−0
- js/waldo.js +96/−0
- panels/a1_1p1s0_0.png binary
- panels/a1_1p1s0_1.png binary
- panels/a1_1p1s0_2.png binary
- panels/a1_1p1s0_3.png binary
- panels/a1_1p1s1_0.png binary
- panels/a1_1p1s1_1.png binary
- panels/a1_1p1s1_2.png binary
- panels/a1_1p1s1_3.png binary
- panels/a1_1p1s2_0.png binary
- panels/a1_1p1s2_1.png binary
- panels/a1_1p1s2_2.png binary
- panels/a1_1p1s2_3.png binary
- panels/a1_1p2s0_0.png binary
- panels/a1_1p2s1_0.png binary
- panels/a1_1p2s2_0.png binary
- panels/a1_1p3s0_0.png binary
- panels/a1_1p3s1_0.png binary
- panels/a1_1p3s2_0.png binary
- panels/a1_1p4s1_0.png binary
- panels/a1_1p4s1_1.png binary
- resize.sh +11/−0
- src/Waldo/CityLoc.hs +71/−0
- src/Waldo/Script.hs +195/−0
- src/Waldo/Server.hs +51/−0
- src/Waldo/Stalk.hs +294/−0
- src/Waldo/Story.hs +118/−0
- src/Waldo/StoryExample.hs +67/−0
- src/Waldo/Waldo.hs +30/−0
- testcomic.html +14/−0
- tools/LoadTest.hs +50/−0
- tools/WaldoServer.hs +40/−0
- waldo.cabal +102/−0
+ LICENSE view
@@ -0,0 +1,32 @@+Images are under the http://creativecommons.org/licenses/by-nc-sa/3.0/us/+Code:+Copyright (c)2012, xkcd inc++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of davean nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ js/waldo.js view
@@ -0,0 +1,96 @@+// Note: jQuery should be included before this script.+var ENDPOINT = 'http://127.0.0.1:3000/story/jarUcyikAg3',+ PANELPATH = 'loadedPanels/'++function renderComic(comicScript) {+ var $comic = $('<div>')+ .addClass('comic')+ .css({+ width: comicScript.width,+ height: comicScript.height+ })+ $.each(comicScript.panels, function(idx, panel) {+ var $panel = $('<div>')+ .addClass('panel')+ .css({+ left: panel.pos.x,+ top: panel.pos.y,+ width: panel.width,+ height: panel.height+ })+ .appendTo($comic)+ $.each(panel.images, function(idx, image) {+ var $img = $('<img>')+ .css({+ left: image.pos.x,+ top: image.pos.y+ })+ .attr('src', PANELPATH + image.url)+ .appendTo($panel)+ })+ })+ var $cover = $('<div>')+ .addClass('cover')+ .css({+ left: 0,+ top: 0,+ width: $comic.width(),+ height: $comic.height()+ })+ .attr('title', comicScript.alttext)+ .appendTo($comic)+ return $comic+}++comicHandler = {+ lastComic: null,+ fetchComic: function() {+ var details = {+ w: $(window).width(),+ h: $(window).height(),+ r: document.referrer+ }++ var sidePadding = 10+ $.ajax(ENDPOINT, {+ data: details,+ dataType: 'jsonp',+ jsonpCallback: 'waldoCallback',+ success: $.proxy(function(comicScript) {+ if (comicScript.goto) {+ window.location = comicScript.goto+ }++ var comic = renderComic(comicScript),+ comicWidth = comic.outerWidth(true),+ comicHeight = comic.height()++ $('#container')+ .empty()+ .append(comic)+ .width(comicWidth)+ .height(comicHeight)++ this.lastComic = comicScript+ }, this)+ })+ }+}++resizeHandler = {+ delay: 250,+ timeout: null,+ onResize: function() {+ if (!this.timeout) {+ this.timeout = setTimeout($.proxy(function() {+ this.timeout = null+ comicHandler.fetchComic()+ }, this), this.delay)+ }+ }+}++$(document).ready($.proxy(comicHandler, 'fetchComic'))+$(window).resize(function() {+ resizeHandler.onResize()+})
+ panels/a1_1p1s0_0.png view
binary file changed (absent → 6460 bytes)
+ panels/a1_1p1s0_1.png view
binary file changed (absent → 6152 bytes)
+ panels/a1_1p1s0_2.png view
binary file changed (absent → 6316 bytes)
+ panels/a1_1p1s0_3.png view
binary file changed (absent → 6219 bytes)
+ panels/a1_1p1s1_0.png view
binary file changed (absent → 10970 bytes)
+ panels/a1_1p1s1_1.png view
binary file changed (absent → 10538 bytes)
+ panels/a1_1p1s1_2.png view
binary file changed (absent → 10801 bytes)
+ panels/a1_1p1s1_3.png view
binary file changed (absent → 10674 bytes)
+ panels/a1_1p1s2_0.png view
binary file changed (absent → 13529 bytes)
+ panels/a1_1p1s2_1.png view
binary file changed (absent → 13079 bytes)
+ panels/a1_1p1s2_2.png view
binary file changed (absent → 13314 bytes)
+ panels/a1_1p1s2_3.png view
binary file changed (absent → 13186 bytes)
+ panels/a1_1p2s0_0.png view
binary file changed (absent → 9465 bytes)
+ panels/a1_1p2s1_0.png view
binary file changed (absent → 11295 bytes)
+ panels/a1_1p2s2_0.png view
binary file changed (absent → 13202 bytes)
+ panels/a1_1p3s0_0.png view
binary file changed (absent → 10234 bytes)
+ panels/a1_1p3s1_0.png view
binary file changed (absent → 11754 bytes)
+ panels/a1_1p3s2_0.png view
binary file changed (absent → 14702 bytes)
+ panels/a1_1p4s1_0.png view
binary file changed (absent → 13471 bytes)
+ panels/a1_1p4s1_1.png view
binary file changed (absent → 13418 bytes)
+ resize.sh view
@@ -0,0 +1,11 @@+#!/bin/sh++mkdir panels++rm panels/*.png++for f in highres/**/*.??g+do+ echo $f+ convert $f -resize 6% "panels/`basename $f`"+done
+ src/Waldo/CityLoc.hs view
@@ -0,0 +1,71 @@+module Waldo.CityLoc where++import Control.Monad.Reader+import Data.Geo.Coord+import Data.Geo.Sphere+import Data.Geo.Haversine++import Waldo.Stalk+import Waldo.Story++data CityData = CityData {+ cityLoc :: Coord+ , cityInfluenceKm :: Double+ }++mkCity :: Coord -> Double -> CityData+mkCity l i = CityData l i++closeTo :: CityData -> StoryGuard+closeTo c =+ asks pdLatLon >>= guard . (maybe False (\latlon ->+ let kmDist = (haversine earthMean (cityLoc c) latlon)/1000+ in kmDist < (cityInfluenceKm c)))++atlanta, belfast, boston, brisbane, cambridge, chicago, christchurch, cnu, dallas, detroit, downtownNYC, greenBay, halifax, houston, jerusalem, lakeChamplain, lakeErie, lakeMead, lakeMichigan, lasVegas, london, losAngeles, melbourne, miami, montreal, nyc, ottawa, paris, philadelphia, richmond, rioDeJaneiro, riverside, sacramento, sanAntonio, sanDiego, sanFran, scotland, seattle, sendai, sydney, tampa, telAviv, tokyo, toronto, vaBeach :: CityData++atlanta = mkCity (( 33.755000) !.! (- 84.390000)) 20+belfast = mkCity (( 54.600000) !.! (- 5.916700)) 6+boston = mkCity (( 42.357778) !.! (- 71.061667)) 4+brisbane = mkCity ((-27.466700) !.! ( 153.033300)) 180+cambridge = mkCity (( 42.373611) !.! (- 71.110556)) 40+chicago = mkCity (( 41.881944) !.! (- 87.627778)) 40+christchurch = mkCity ((-43.500000) !.! ( 172.600000)) 13+cnu = mkCity (( 37.063800) !.! (- 76.494200)) 10+dallas = mkCity (( 32.782778) !.! (- 96.803889)) 73+detroit = mkCity (( 42.331389) !.! (- 83.045833)) 50+greenBay = mkCity (( 44.513333) !.! (- 88.015833)) 180+halifax = mkCity (( 44.654444) !.! (- 63.599167)) 17+houston = mkCity (( 29.762778) !.! (- 95.383056)) 20+jerusalem = mkCity (( 31.783300) !.! ( 35.216700)) 4+lakeChamplain= mkCity (( 44.533333) !.! (- 73.333333)) 58+lakeErie = mkCity (( 42.200000) !.! (- 81.200000)) 140+lakeMead = mkCity (( 36.250000) !.! (-114.390000)) 50+lakeMichigan = mkCity (( 44.000000) !.! (- 87.000000)) 130+lasVegas = mkCity (( 36.175000) !.! (-115.136389)) 20+london = mkCity (( 51.517100) !.! ( 0.106200)) 30+losAngeles = mkCity (( 34.050000) !.! (-118.250000)) 65+melbourne = mkCity ((-37.783300) !.! ( 144.966700)) 40+miami = mkCity (( 25.787778) !.! (- 80.224167)) 30+montreal = mkCity (( 45.500000) !.! (- 73.666667)) 45+downtownNYC = mkCity (( 40.664167) !.! (- 73.938611)) 20+nyc = mkCity (( 40.664167) !.! (- 73.938611)) 20+ottawa = mkCity (( 45.420833) !.! (- 75.690000)) 50+paris = mkCity (( 48.874200) !.! ( 2.347000)) 25+philadelphia = mkCity (( 39.953333) !.! (- 75.170000)) 20+richmond = mkCity (( 37.540972) !.! (- 77.432889)) 40+rioDeJaneiro = mkCity ((-22.908300) !.! (- 43.243600)) 70+riverside = mkCity (( 33.948056) !.! (-117.396111)) 15+sacramento = mkCity (( 38.555556) !.! (-121.468889)) 45+sanAntonio = mkCity (( 29.416667) !.! (- 98.500000)) 23+sanDiego = mkCity (( 32.715000) !.! (-117.162500)) 60+sanFran = mkCity (( 37.779300) !.! (-122.419200)) 10+scotland = mkCity (( 57.100000) !.! (- 4.000000)) 250+seattle = mkCity (( 47.609722) !.! (-122.333056)) 45+sendai = mkCity (( 31.816700) !.! ( 130.300600)) 35+sydney = mkCity ((-33.868300) !.! ( 151.208600)) 60+tampa = mkCity (( 27.947222) !.! (- 82.458611)) 42+telAviv = mkCity (( 32.083300) !.! ( 34.800000)) 10+tokyo = mkCity (( 35.683300) !.! ( 139.766700)) 50+toronto = mkCity (( 43.716589) !.! (- 79.340686)) 30+vaBeach = mkCity (( 36.850600) !.! (- 75.977900)) 37
+ src/Waldo/Script.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}+module Waldo.Script (+ Script(..)+ , PanelSizes, PanelData(..), Panel(..)+ , ImagePart(..)+ , TextPart(..)+ , Pos(..)+ , loadImagePanels, mkScript, scriptName+ ) where++import Data.List+import Control.Monad+import Control.Monad.Reader+import qualified Data.Text as T+import qualified Data.Aeson as JS+import qualified Data.ByteString.Lazy.Char8 as BSL8+import Control.Monad.Trans.Resource (runResourceT)+import Data.Conduit (($$))+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.ImageSize as CI+import System.FilePath ((</>), takeFileName, splitExtension)+import System.FilePath.Glob+import Data.Digest.Pure.SHA+import Control.DeepSeq+import System.Directory++import Data.Aeson ((.=))++pad :: Int+pad = 4++panelRightEdge :: Panel -> Int+panelRightEdge p = (pX $ pPos p) + (pWidth p)++scriptName :: Script -> T.Text+scriptName (s@Script {}) = T.concat $ [sName s, " : "] ++ (intersperse "+" $ map pName (sPanels s))+scriptName (ScriptTo goto) = T.concat ["Goto : ", goto]++mkScript :: T.Text -- name+ -> T.Text -- alt-text+ -> [PanelData] -- panels!+ -> Script+mkScript nm alt pds =+ let ps = snd $ mapAccumL (\xstart p ->+ let newp = panelData2panel xstart p+ in (panelRightEdge newp, newp)) 0 pds+ in Script {+ sAltText = alt+ , sPanels = ps+ , sHeight = 2*pad + (maximum $ map pHeight ps)+ , sWidth = (1+length ps)*pad + (sum $ map pWidth ps)+ , sName = nm+ }++hashImgNm :: FilePath -> FilePath+hashImgNm fn =+ let (nm, typ) = splitExtension fn+ in (showDigest $ sha256 (BSL8.pack ("basfd" ++ nm)))++typ++loadImagePanels :: Int -- Story+ -> Int -- Panel+ -> Int -- Choice+ -> ReaderT FilePath IO PanelSizes+loadImagePanels s p c = do+ bp <- ask+ fns <- liftIO $ glob (bp </> "panels" </>+ ("a1_"++show s++"p"++show p++"s*_"++show c++".*"))+ ps <- liftIO $ forM fns $ \fn -> do+ mImgInf <- runResourceT $ CB.sourceFile fn $$ CI.sinkImageSize+ case mImgInf of+ Nothing -> fail "Couldn't read image."+ Just sz -> do+ let pname = hashImgNm $ takeFileName fn+ d <- BSL8.readFile fn+ createDirectoryIfMissing False "/tmp/loadedPanels"+ BSL8.writeFile ("/tmp/loadedPanels" </> pname) d+ return $+ PanelData {+ pdWidth = CI.width sz+ , pdHeight = CI.height sz+ , pdImages = [ImagePart { ipPos = Pos 0 0, ipImageUrl = T.pack pname }]+ , pdText = []+ , pdName = T.pack ("p"++show p++"s"++show s++"_"++show c)+ }+ if null ps+ then fail ("No panels found for "++show (s, p, c))+ else return ps++panelData2panel :: Int -> PanelData -> Panel+panelData2panel xlast pd = + Panel {+ pPos = Pos (xlast+pad) pad+ , pWidth = pdWidth pd+ , pHeight = pdHeight pd+ , pImages = pdImages pd+ , pText = pdText pd+ , pName = pdName pd+ }++type PanelSizes = [PanelData]++data Script =+ ScriptTo {+ sTarget :: !T.Text+ }+ | Script {+ sWidth :: !Int+ , sHeight :: !Int+ , sAltText :: !T.Text+ , sPanels :: [Panel]+ , sName :: !T.Text+ }+ deriving (Eq, Ord, Show)++instance NFData Script where+ rnf (s@ScriptTo {sTarget=t}) = t `seq` s `seq` ()+ rnf (s@Script {sWidth=w, sHeight=h, sAltText=a, sPanels=p, sName=n}) =+ w `seq` h `seq` a `deepseq` p `deepseq` n `deepseq` s `seq` ()++data Panel = Panel {+ pPos :: !Pos+ , pWidth :: !Int+ , pHeight :: !Int+ , pImages :: [ImagePart]+ , pText :: [TextPart]+ , pName :: !T.Text+ } deriving (Eq, Ord, Show)++instance NFData Panel where+ rnf (pan@Panel {pPos=p, pWidth=w, pHeight=h, pImages=i, pText=t, pName=n}) =+ p `deepseq` w `seq` h `seq` i `deepseq` t `deepseq` n `deepseq` pan `seq` ()++data PanelData = PanelData {+ pdWidth :: !Int+ , pdHeight :: !Int+ , pdImages :: [ImagePart]+ , pdText :: [TextPart]+ , pdName :: !T.Text+ } deriving (Eq, Ord, Show)++data ImagePart = ImagePart {+ ipPos :: !Pos+ , ipImageUrl :: !T.Text+ } deriving (Eq, Ord, Show)++instance NFData ImagePart where+ rnf (i@ImagePart {ipPos=p, ipImageUrl=u}) =+ p `deepseq` u `deepseq` i `seq` ()++data TextPart = TextPart {+ tpPos :: !Pos+ , tpString :: !T.Text+ , tpSize :: !Float+ , tpFont :: !T.Text+ , tpAngle :: !Float+ } deriving (Eq, Ord, Show)++instance NFData TextPart where+ rnf (tp@TextPart {tpPos=p, tpString=t, tpSize=s, tpFont=f, tpAngle=a}) = + p `deepseq` t `deepseq` s `seq` f `deepseq` a `seq` tp `seq` ()++data Pos = Pos { pX :: !Int, pY :: !Int } deriving (Eq, Ord, Show)++instance NFData Pos where+ rnf (p@Pos {pX=x, pY=y}) = x `seq` y `seq` p `seq` ()++instance JS.ToJSON Script where+ toJSON (ScriptTo t) = JS.object ["goto" .= t]+ toJSON (Script w h alt ps _) = JS.object [ "width" .= w+ , "height" .= h+ , "alttext" .= alt+ , "panels" .= ps+ ]++instance JS.ToJSON Panel where+ toJSON (Panel p w h is ts _) = JS.object [ "pos" .= p+ , "width" .= w+ , "height" .= h+ , "images" .= is+ , "texts" .= ts+ ]++instance JS.ToJSON ImagePart where+ toJSON (ImagePart p url) = JS.object [ "pos" .= p, "url" .= url ]++instance JS.ToJSON TextPart where+ toJSON (TextPart p str sz f r) = JS.object [ "pos" .= p+ , "str" .= str+ , "size" .= sz+ , "font" .= f+ , "rad" .= r+ ]++instance JS.ToJSON Pos where+ toJSON (Pos x y) = JS.object [ "x" .= x, "y" .= y ]
+ src/Waldo/Server.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+module Waldo.Server (+ waldoApp+ ) where++import Control.Monad.Trans+import Control.Monad.Reader+import qualified Data.Text as T+import qualified Data.HashMap.Strict as Map+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Aeson as JS+import qualified Network.Wai as WAI+import qualified Network.HTTP.Types as HTTP+import qualified Blaze.ByteString.Builder.Char8 as BB8+import qualified Blaze.ByteString.Builder.ByteString as BBB++import Waldo.Waldo+import Waldo.Stalk++waldoApp :: WaldoData -> WAI.Application+waldoApp wd req resp =+ (flip runReaderT wd) $ + case (WAI.requestMethod req, WAI.pathInfo req) of+ ("GET", [s]) -> getScript req s >>= (lift . resp)+ _ -> lift $ resp resp404++resp404 :: WAI.Response+resp404 =+ WAI.responseBuilder+ HTTP.status404+ [("Content-Type", "text/plain")] $+ BB8.fromString "Not Found"++getScript :: WAI.Request -> T.Text -> ReaderT WaldoData IO WAI.Response+getScript req storySet = do+ let stalkreq = wai2stalk req+ wd <- ask+ pd <- liftIO $ stalk (wdStalkDB wd) stalkreq+ case Map.lookup storySet (wdGenScript wd) of+ Nothing -> return resp404+ Just storyGen -> do+ script <- liftIO $ storyGen pd+ return $ WAI.responseBuilder+ HTTP.status200+ [("Content-Type", "application/javascript")+ ,("Access-Control-Allow-Origin", "*")] $+ mconcat $ concat [+ [BBB.fromByteString "waldoCallback(" ]+ , map BBB.fromByteString $ BSL.toChunks $ JS.encode script+ , [BBB.fromByteString ")"]+ ]
+ src/Waldo/Stalk.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+module Waldo.Stalk (+ OS(..), Browser(..), NetSpeed(..)+ , PersonalData(..)+ , StalkRequest, wai2stalk+ , StalkDB, loadStalkDB+ , stalk+ ) where++import Data.Word+import Data.Bits+import Data.Maybe+import Data.Bifunctor+import Control.Monad+import Data.List (intercalate)+import Data.Geolocation.GeoIP+import Data.ByteString (ByteString)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), (.=), (.:), (.:?))+import Network.Socket (SockAddr(SockAddrInet, SockAddrInet6))+import Data.Either (rights)+import System.FilePath ((</>))+import qualified Text.Regex.TDFA as R+import qualified Text.Regex.TDFA.ByteString as RB+import qualified Data.Aeson as JS+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Network.Wai as WAI+import qualified Network.HTTP.Types as HTTP+import qualified Data.HashMap.Strict as Map+import qualified Data.CaseInsensitive as CI+import Network.URI+import Data.Geo.Coord+import Safe++import Data.BrowsCap+import Data.BrowsCap.Aquire++data Browser = + Chrome+ | Safari+ | FireFox+ | InternetExplorer+ | Opera+ | Netscape+ deriving (Eq, Ord, Show)++data OS =+ BSD+ | Linux+ | Windows+ | Mac+ deriving (Eq, Ord, Show)++data NetSpeed =+ Dialup+ | Cellular+ | CableDSL+ | Corporate+ deriving (Eq, Ord, Show)++data PersonalData =+ PersonalData {+ pdLocal :: [ByteString] -- Order of decreasing precision.+ , pdOrg :: Maybe ByteString -- Who owns the IP.+ , pdISP :: Maybe ByteString -- Who provides internet to the IP.+ , pdNetSpeed :: Maybe NetSpeed+ , pdReferer :: Maybe ByteString+ , pdRefURI :: Maybe URI+ , pdBrowser :: Maybe Browser+ , pdOS :: Maybe OS+ , pdLatLon :: Maybe Coord+ , pdScreen :: (Int, Int)+ , pdBrowserEntry :: Maybe BrowserEntry+ , pdStalk :: StalkRequest+ } deriving (Eq, Show)++data StalkRequest = + StalkRequest {+ srParams :: HTTP.Query+ , srHeaders :: HTTP.RequestHeaders+ , srFromIP :: Maybe ByteString+ , srTrustForward :: Bool+ }+ deriving (Eq, Ord, Show)++instance ToJSON StalkRequest where+ toJSON (StalkRequest {srParams=p, srHeaders=h, srFromIP=ip, srTrustForward=t}) =+ -- FIXME hasty conversion from aeson 0.6, partial format kept for compatability+ JS.object [ "params" .= map (bimap TE.decodeUtf8 (fmap TE.decodeUtf8)) p+ , "headers" .= map (\(k, v) -> (TE.decodeUtf8 $ CI.original k, TE.decodeUtf8 v)) h+ , "ip" .= fmap TE.decodeUtf8 ip+ , "trust_forward" .= t+ ]++instance FromJSON StalkRequest where+ parseJSON (JS.Object o) = do+ ip <- (fmap TE.encodeUtf8) <$> (o .:? "ip")+ p <- (map (bimap TE.encodeUtf8 (fmap (TE.encodeUtf8)))) <$> (o .: "params")+ t <- o .: "trust_forward"+ h <- (map (bimap (CI.mk . TE.encodeUtf8) TE.encodeUtf8)) <$> (o .: "headers")+ return $ StalkRequest {+ srParams=p+ , srHeaders=h+ , srFromIP=ip+ , srTrustForward=t+ }+ parseJSON _ = mzero++data StalkDB =+ StalkDB {+ sdbBrowserCap :: BrowsCap+ , sdbMaxMindCity :: GeoDB+ , sdbMaxMindOrg :: GeoDB+ , sdbMaxMindISP :: GeoDB+ , sdbMaxMindNet :: GeoDB+ }++loadStalkDB :: FilePath -> IO StalkDB+loadStalkDB dd = do+ bc <- browsCapFromFile $ dd </> "full_php_browscap.ini"+ cdb <- openGeoDB mmap_cache $ dd </> "GeoIPCity.dat"+ odb <- openGeoDB mmap_cache $ dd </> "GeoIPOrg.dat"+ idb <- openGeoDB mmap_cache $ dd </> "GeoIPISP.dat"+ ndb <- openGeoDB mmap_cache $ dd </> "GeoIPNet.dat"+ return $ StalkDB {+ sdbBrowserCap = bc+ , sdbMaxMindCity = cdb+ , sdbMaxMindOrg = odb+ , sdbMaxMindISP = idb+ , sdbMaxMindNet = ndb+ }++wai2stalk :: WAI.Request -> StalkRequest+wai2stalk req =+ StalkRequest {+ srParams = WAI.queryString req+ , srHeaders = WAI.requestHeaders req+ , srFromIP = ip+ , srTrustForward = True+ }+ where+ ip =+ case WAI.remoteHost req of+ SockAddrInet _ addr4 -> + let (x0, x1, x2, x3) = w32to8 addr4+ in Just $ TE.encodeUtf8 . T.pack $ concat [show x3, ".", show x2, ".", show x1, ".", show x0]+ SockAddrInet6 _ _ _ _ -> Nothing+ _ -> Nothing++stalk :: StalkDB -> StalkRequest -> IO PersonalData+stalk sdb req = do+ bc <- lookupBrowser (sdbBrowserCap sdb) $ fromMaybe "" agnt+ let mips = if srTrustForward req+ then (maybeToList $ lookup "X-Forwarded-For" (srHeaders req)) +++ (map snd $ filter (\h -> (fst h) `elem` ["X-Forward-For"]) (srHeaders req))+ else maybeToList $ srFromIP req+ let ips = mapMaybe validIP mips+ let browser = str2browser $ fromMaybe "" $ fmap beBrowser bc+ let os = str2os $ fromMaybe "" $ fmap bePlatform bc+ geos <- forM (ips) $ \ip -> do+ gipCityM <- geoLocateByIPAddress (sdbMaxMindCity sdb) ip+ gipOrgM <- geoStringByIPAddress (sdbMaxMindOrg sdb) ip+ gipISPM <- geoStringByIPAddress (sdbMaxMindISP sdb) ip+ gipNetM <- geoStringByIPAddress (sdbMaxMindNet sdb) ip+ return $+ if not $ or [isJust gipCityM, isJust gipOrgM, isJust gipISPM, isJust gipNetM]+ then Nothing+ else Just $ PersonalData {+ pdLocal = (fromMaybe [] $ fmap city2locals gipCityM) ++ ["Earth"]+ , pdOrg = fmap cleanOrg gipOrgM+ , pdISP = gipISPM+ , pdNetSpeed = join $ fmap str2speed gipNetM+ , pdReferer = referer+ , pdRefURI = refUri+ , pdBrowser = browser+ , pdOS = os+ , pdLatLon = parseLatLon gipCityM+ , pdScreen = scrn+ , pdBrowserEntry = bc+ , pdStalk = req+ }+ return $ fromMaybe (noGeoResult bc browser os) $ listToMaybe $ catMaybes geos+ where+ parseLatLon gipc = do+ c <- gipc+ return ((geoLatitude c) !.! (geoLongitude c))+ city2locals :: GeoIPRecord -> [ByteString]+ city2locals g = [geoCity g, geoRegion g, geoCountryCode3 g, geoCountryName g, geoContinentCode g]+ noGeoResult bc browser os = + PersonalData {+ pdLocal = ["Earth"]+ , pdOrg = Nothing+ , pdISP = Nothing+ , pdNetSpeed = Nothing+ , pdReferer = referer+ , pdRefURI = refUri+ , pdBrowser = browser+ , pdOS = os+ , pdLatLon = Nothing+ , pdScreen = scrn+ , pdBrowserEntry = bc+ , pdStalk = req+ }+ parms = srParams req+ hdrs = srHeaders req+ scrn =+ let x = case BS8.readInt (fromMaybe "" $ join $ lookup "w" parms) of+ Nothing -> 0+ Just (xi, _) -> xi+ y = case BS8.readInt (fromMaybe "" $ join $ lookup "h" parms) of+ Nothing -> 0+ Just (yi, _) -> yi+ in (x, y)+ agnt = lookup "User-Agent" hdrs+ referer = join $ lookup "r" parms+ refUri = join $ fmap (parseURI . T.unpack . TE.decodeUtf8) referer+ validIP :: ByteString -> Maybe ByteString+ validIP fips0 = do+ (x0, fips1) <- BS8.readInt fips0+ (x1, fips2) <- BS8.readInt $ BS.drop 1 fips1+ (x2, fips3) <- BS8.readInt $ BS.drop 1 fips2+ (x3, _) <- BS8.readInt $ BS.drop 1 fips3+ return $ TE.encodeUtf8 . T.pack $ intercalate "." [show x0, show x1, show x2, show x3]+ rComp =+ R.CompOption {R.multiline=False,R.rightAssoc=True+ ,R.caseSensitive=False,R.newSyntax=True,R.lastStarGreedy=False}+ rExec =+ R.ExecOption { R.captureGroups=False }+ rCompile (p, r) =+ case RB.compile rComp rExec p of+ Left e -> Left e+ Right c -> Right (c, r)+ clean :: [(ByteString, ByteString)] -> BS.ByteString -> BS.ByteString+ clean rules this = fromMaybe this $+ fmap snd $ headMay $+ filter (\(p, _) -> either (const False) isJust $ RB.regexec p this) $+ rights $ map rCompile rules+ cleanOrg :: BS.ByteString -> BS.ByteString+ cleanOrg = clean [+ ("\\^Google", "Google")+ ]+ str2speed =+ flip Map.lookup (Map.fromList [+ ("Dialup", Dialup)+ , ("Cellular", Cellular)+ , ("Cable/DSL", CableDSL)+ , ("Corporate", Corporate)+ ])+ str2browser =+ flip Map.lookup (Map.fromList [+ ("Chrome" , Chrome), ("Chromium", Chrome)+ , ("Safari", Safari)+ , ("Firefox", FireFox), ("Iceweasel", FireFox)+ , ("IE", InternetExplorer)+ , ("Opera", Opera), ("Opera Mini", Opera)+ , ("Netscape", Netscape)+ ])+ str2os =+ flip Map.lookup (Map.fromList [+ ("MacOSX", Mac)+ , ("Linux", Linux), ("Debian", Linux)+ , ("FreeBSD", BSD), ("NetBSD", BSD), ("OpenBSD", BSD)+ , ("IRIX", BSD), ("IRIX64", BSD)+ , ("HP-UX", BSD)+ , ("SunOS", BSD), ("Solaris", BSD)+ , ("WinCE", Windows)+ , ("Win16", Windows), ("Win32", Windows), ("Win64", Windows)+ , ("Win31", Windows)+ , ("Win95", Windows), ("Win98", Windows), ("WinME", Windows)+ , ("WinNT", Windows)+ , ("Win2000", Windows), ("Win2003", Windows)+ , ("WinXP", Windows), ("WinVista", Windows)+ , ("Win7", Windows), ("Win8", Windows)+ ])++w32to8 :: Word32 -> (Word8, Word8, Word8, Word8)+w32to8 w0 =+ let (w0_h, w0_l) = w32to16 w0+ ((x0, x1), (x2, x3)) = (w16to8 w0_h, w16to8 w0_l)+ in (x0, x1, x2, x3)++w32to16 :: Word32 -> (Word16, Word16)+w32to16 w0 =+ let w_h = fromIntegral $ w0 `shiftR` 16+ w_l = fromIntegral $ w0 .&. 0xFFFF+ in (w_h, w_l)++w16to8 :: Word16 -> (Word8, Word8)+w16to8 w0 =+ let w_h = fromIntegral $ w0 `shiftR` 8+ w_l = fromIntegral $ w0 .&. 0xFF+ in (w_h, w_l)
+ src/Waldo/Story.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}+module Waldo.Story (+ selectStory+ , knapsackSizer+ , Story(..)+ , StoryGuard, StoryOption+ , isIn, browserIs, osIs, netSpeedIs, orgIs, orgMatch, ispIs+ , refererDomainIs+ , pdTestJustIs+ , giveThem, allocate+ ) where++import Data.Maybe+import Data.List+import Control.Monad.Reader+import Data.ByteString.Char8 (ByteString)+import qualified Data.Text as T+import Network.URI+import Text.Regex.TDFA ((=~))++import Waldo.Stalk+import Waldo.Script++type StoryGuard = ReaderT PersonalData Maybe ()+type StoryOption = ReaderT PersonalData Maybe Story++data Story = + StoryGoto {+ storyGoto :: T.Text+ }+ | Story {+ storyAltText :: T.Text+ , storyPanelSets :: [PanelSizes]+ , storyPadX :: Int+ , storyPadY :: Int+ , storyName :: T.Text+ }+ deriving (Show)++selectStory :: ((Int, Int) -> Story -> Maybe Script) -> Script -> [StoryOption] -> PersonalData -> IO Script+selectStory sizer d storyGens pd = do+ --print storyGens+ -- generate stories+ let stories = catMaybes $ map (flip runReaderT pd) storyGens+ --print stories+ -- size the selected scripts+ let scripts = mapMaybe doSize stories+ --print scripts+ -- Get our script, either the default or a selected one.+ return $ fromMaybe d $ listToMaybe scripts+ where+ doSize (s@Story {}) = sizer (pdScreen pd) s+ doSize (StoryGoto t) = Just (ScriptTo t)++knapsackSizer :: Int -> (Int, Int) -> Story -> Maybe Script+knapsackSizer sitePad (w, h) s =+ -- Get the first entry if there is one, the smallest if none of them fit.+ listToMaybe $ (sortCorrectDir sizeLimited) ++ (take 1 areaSortedSized)+ where+ -- selected sort dir by what we know about the screen+ sortCorrectDir =+ if (h > 0) && (w > 0)+ then reverse+ else id+ -- The fitting scripts+ sizeLimited = fitWidth $ fitHeight $ areaSortedSized+ -- sort by area+ areaSortedSized = areaSort allScripts+ -- Of all scripts+ allScripts = do+ combo <- mapM id $ storyPanelSets s+ return $ mkScript (storyName s) (storyAltText s) combo+ areaSort = sortBy (\a b -> compare (scriptArea a) (scriptArea b))+ scriptArea scr = (sHeight scr) * (sWidth scr)+ fitHeight scripts =+ if h > 0+ then filter (\scr -> h > (sHeight scr+storyPadY s+sitePad)) scripts+ else scripts+ fitWidth scripts =+ if w > 0+ then filter (\scr -> w > (sWidth scr+storyPadX s+sitePad)) scripts+ else scripts++refererDomainIs :: String -> StoryGuard+refererDomainIs d =+ asks pdRefURI >>= guard . fromMaybe False . fmap ((isSuffixOf d) . uriRegName) . join . fmap uriAuthority++--refererMatches :: ++pdTestJustIs :: Eq a => (PersonalData -> Maybe a) -> a -> StoryGuard+pdTestJustIs g v = asks g >>= guard . maybe False (v==)++isIn :: ByteString -> StoryGuard+isIn locName = asks pdLocal >>= guard . (not . null . (filter (locName==)))++browserIs :: Browser -> StoryGuard+browserIs b = asks pdBrowser >>= guard . (maybe False (b==))++osIs :: OS -> StoryGuard+osIs os = asks pdOS >>= guard . (maybe False (os==))++netSpeedIs :: NetSpeed -> StoryGuard+netSpeedIs ns = asks pdNetSpeed >>= guard . (maybe False (ns==))++orgIs :: ByteString -> StoryGuard+orgIs o = asks pdOrg >>= guard . (maybe False (o==))++orgMatch :: ByteString -> StoryGuard+orgMatch o = asks pdOrg >>= guard . (maybe False (flip (=~) o))++ispIs :: ByteString -> StoryGuard+ispIs i = asks pdISP >>= guard . (maybe False (i==))++allocate :: MonadPlus m => m () -> a -> m a+allocate cnd r = cnd >> return r++giveThem :: MonadPlus m => m () -> m a -> m a+giveThem = (>>)
+ src/Waldo/StoryExample.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+module Waldo.StoryExample (+ loadScriptGen+ ) where++import Control.Monad+import Control.Monad.Reader+import Data.ByteString.Char8 ()+import Data.Text ()++import Paths_waldo+import Waldo.Stalk+import Waldo.Script+import Waldo.Story+import Waldo.CityLoc++loadScriptGen :: IO (PersonalData -> IO Script)+loadScriptGen = do+ bp <- getDataDir+ flip runReaderT bp $ do+ defaultScript <- loadDefaultScript+ stories <- story1example+ return $ selectStory (knapsackSizer 100) defaultScript stories++-- If they really defeat our snooping, they get this one.+loadDefaultScript :: ReaderT FilePath IO Script+loadDefaultScript = do+ p1 <- loadImagePanels 1 1 0+ p2 <- loadImagePanels 1 2 0+ p3 <- loadImagePanels 1 3 0+ p4 <- loadImagePanels 1 4 0+ return $ mkScript "failback" alt $ map head [p1, p2, p3, p4 ]+ where+ alt = "This is the testiest test ever!"++story1example :: ReaderT FilePath IO [StoryOption]+story1example = do+ s1p1c0 <- loadImagePanels 1 1 0+ s1p1c1 <- loadImagePanels 1 1 1+ s1p1c2 <- loadImagePanels 1 1 2+ s1p1c3 <- loadImagePanels 1 1 3+ + s1p2 <- loadImagePanels 1 2 0+ + s1p3 <- loadImagePanels 1 3 0+ + s1p4c0 <- loadImagePanels 1 4 0+ s1p4c1 <- loadImagePanels 1 4 1+ + return [+ do+ isIn "NA" -- Only for North Americans+ p1 <- msum [ orgIs "Massachusetts Institute of Technology" `allocate` s1p1c1+ , closeTo sydney `allocate` s1p1c2+ , closeTo sanFran `allocate` s1p1c3+ , return s1p1c0+ ]+ p4 <- msum [ osIs BSD `allocate` s1p4c1+ , osIs Linux `allocate` s1p4c0+ ]+ return $ Story {+ storyAltText = "Alt"+ , storyPanelSets = [ p1, s1p2, s1p3, p4 ]+ , storyPadX = 0, storyPadY = 0+ , storyName = "s01"+ }+ ]
+ src/Waldo/Waldo.hs view
@@ -0,0 +1,30 @@+module Waldo.Waldo (+ WaldoData(..)+ , loadWaldo+ ) where++import Control.Monad+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+import qualified Data.Text as T++import Waldo.Stalk+import Waldo.Script++data WaldoData =+ WaldoData {+ wdStalkDB :: StalkDB+ , wdGenScript :: HashMap T.Text (PersonalData -> IO Script)+ }++loadWaldo :: FilePath -> [(T.Text, IO (PersonalData -> IO Script))] ->IO WaldoData+loadWaldo dd storyGenLoaders = do+ sdb <- loadStalkDB dd+ storyGens <- forM storyGenLoaders $ \(nm, ldr) -> do+ sgen <- ldr+ return (nm, sgen)+ let wdata = WaldoData { wdStalkDB = sdb+ , wdGenScript = Map.fromList storyGens+ }+ putStrLn "Loading completed!"+ return wdata
+ testcomic.html view
@@ -0,0 +1,14 @@+<html>+<head>+<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.7.1/jquery.min.js"></script>+<script src="js/waldo.js"></script>+<style>+ .comic { position:relative; }+ .panel, img, .cover { position:absolute; }+ .comic .cover { z-index:10; }+</style>+</head>+<body>+<div id="container"></div>+</body>+</html>
+ tools/LoadTest.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad.Trans+import Control.Monad.Reader+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.Aeson as JS+import Data.Conduit (($$), ($=))+import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL+import qualified Data.Conduit.Zlib as CZ+import Control.Monad.Trans.Resource (runResourceT)+import qualified Data.HashMap.Strict as Map+import Data.Maybe+import Control.DeepSeq (deepseq)+import System.Environment++import Waldo.Stalk+import Waldo.Waldo+import qualified Waldo.StoryExample as SE++main :: IO ()+main = do+ env <- getEnvironment+ case lookup "WALDO_DATA" env of+ Nothing -> do+ putStrLn "Please set WALDO_DATA to a directory containing:"+ putStrLn " - full_php_browscap.ini"+ putStrLn " - GeoIPCity.dat"+ putStrLn " - GeoIPNet.dat"+ putStrLn " - GeoIPNet.dat"+ putStrLn " - GeoIPOrg.dat"+ Just dd -> do+ wd <- loadWaldo dd [("jarUcyikAg3", SE.loadScriptGen)]+ flip runReaderT wd $ runResourceT $+ CB.sourceFile "stalkreqs.gz" $= CZ.ungzip+ $= CB.lines+ $= CL.concatMap (maybeToList . JS.decode' . s2l::BS8.ByteString -> [StalkRequest])+ $= CL.mapM (\r -> liftIO $ stalk (wdStalkDB wd) r)+ $= CL.mapM (\p -> (liftIO $ (fromJust $ Map.lookup "ghenkEggov8" (wdGenScript wd)) p) >>= \r -> r `deepseq` return r)+-- $$ CL.mapM_ (\_ -> return ())+ $$ CL.mapM_ (\d -> liftIO $ print d)+ return ()++l2s :: BSL8.ByteString -> BS8.ByteString+l2s = BS8.concat . BSL8.toChunks++s2l :: BS8.ByteString -> BSL8.ByteString+s2l = BSL8.fromChunks . (:[])
+ tools/WaldoServer.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Applicative+import Control.Monad+import Data.Maybe+import qualified Network.Wai.Handler.Warp as Warp+import qualified Waldo.StoryExample as SE+import Waldo.Waldo+import Waldo.Server+import System.Environment+import Network.Wai.UrlMap+import Network.Wai.Application.Static+import WaiAppStatic.Types (unsafeToPiece)+import Safe++import Paths_waldo++main :: IO ()+main = do+ env <- getEnvironment+ case lookup "WALDO_DATA" env of+ Nothing -> do+ putStrLn "Please set WALDO_DATA to a directory containing:"+ putStrLn " - full_php_browscap.ini"+ putStrLn " - GeoIPCity.dat"+ putStrLn " - GeoIPNet.dat"+ putStrLn " - GeoIPNet.dat"+ putStrLn " - GeoIPOrg.dat"+ Just dd -> do+ -- This is where we "load" a set of scripts to serve. + -- Conceptually the server can serve any number of scripts.+ wdata <- loadWaldo dd [("jarUcyikAg3", SE.loadScriptGen)]+ bp <- getDataDir+ Warp.runSettings (warpsettings env) . mapUrls $+ mount "story" (waldoApp wdata)+ <|> mount "loadedPanels" ((staticApp (defaultFileServerSettings "/tmp/loadedPanels") {ssIndices=[unsafeToPiece "testcomic.html"]}))+ <|> mountRoot (staticApp (defaultFileServerSettings bp))+ where+ warpsettings env = Warp.setPort (fromMaybe 3000 (join $ fmap readMay $ lookup "WALDO_PORT" env)) Warp.defaultSettings
+ waldo.cabal view
@@ -0,0 +1,102 @@+Name: waldo+Version: 0+Synopsis: A generator of comics based on some ascertainable data about the requester.+Description: This package was writen to power <https://xkcd.com/ xkcd>'s 2012 April Fools comic <https://xkcd.com/1037 Umwelt>. It uses several datasets and a script to generate a customized story specific to the user viewing it.+License: BSD3+License-file: LICENSE+Author: davean+Maintainer: oss@xkcd.com+Copyright: davean 2012-2017+Category: Web+Build-type: Simple+Cabal-version: >=1.10++extra-source-files:+ resize.sh++data-files:+ js/waldo.js+ testcomic.html+ panels/*.png++source-repository head+ type: git+ location: https://code.xkrd.net/xkcd/waldo.git++library+ default-language: Haskell2010+ hs-source-dirs: src+ other-modules: Paths_waldo+ exposed-modules:+ Waldo.CityLoc+ , Waldo.Script+ , Waldo.Stalk+ , Waldo.StoryExample+ , Waldo.Story+ , Waldo.Waldo+ , Waldo.Server+ Build-depends:+ base >= 4.9 && < 4.11+ , deepseq >= 1.4 && < 1.5+ , directory >= 1.3 && < 1.4+ , bytestring >= 0.10 && < 0.11+ , text >= 1.2 && < 1.3+ , aeson >= 1.2 && < 1.3+ , aeson-pretty >= 0.8 && < 0.9+ , mtl >= 2.2 && < 2.3+ , unordered-containers >= 0.2 && < 0.3+ , network >= 2.6 && < 2.7+ , network-uri >= 2.6 && < 2.7+ , lrucache >= 1.2 && < 1.3+ , attoparsec >= 0.13 && < 0.14+ , hs-GeoIP >= 0.3 && < 0.4+ , filepath >= 1.4 && < 1.5+ , resourcet >= 1.1 && < 1.2+ , conduit >= 1.2 && < 1.3+ , conduit-extra >= 1.1 && < 1.2+ , imagesize-conduit >= 1.1 && < 1.2+ , zlib-conduit >= 1.1 && < 1.2+ , wai >= 3.2 && < 3.3+ , http-types >= 0.9 && < 0.10+ , case-insensitive >= 1.2 && < 1.3+ , warp >= 3.2 && < 3.3+ , blaze-builder >= 0.4 && < 0.5+ , safe >= 0.3 && < 0.4+ , regex-tdfa >= 1.2 && < 1.3+ , Geodetic >= 0.4 && < 0.5+ , SHA >= 1.6 && < 1.7+ , Glob >= 0.7 && < 0.8+ , browscap >= 0 && < 0.1++Executable waldo-example+ default-language: Haskell2010+ Ghc-Options: -rtsopts -threaded+ Main-is: tools/WaldoServer.hs+ other-modules: Paths_waldo+ Build-depends:+ base+ , waldo+ , wai >= 3.2 && < 3.3+ , wai-extra >= 3.0 && < 3.1+ , wai-app-static >= 3.1 && < 3.2+ , http-types >= 0.9 && < 0.10+ , warp >= 3.2 && < 3.3+ , safe++Executable bench+ default-language: Haskell2010+ Ghc-Options: -rtsopts -threaded+ Main-is: tools/LoadTest.hs+ Build-depends:+ base+ , waldo+ , deepseq+ , bytestring+ , mtl+ , aeson+ , unordered-containers+ , resourcet+ , conduit+ , conduit-extra+ , zlib-conduit+