hoogle 5.0.17.9 → 5.0.17.10
raw patch · 12 files changed
+75/−65 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +6/−0
- hoogle.cabal +2/−2
- html/log.html +1/−41
- html/log.js +38/−0
- html/search.xml +4/−4
- src/Action/CmdLine.hs +2/−2
- src/Action/Search.hs +2/−4
- src/Action/Server.hs +4/−1
- src/General/Log.hs +1/−1
- src/General/Util.hs +1/−1
- src/General/Web.hs +11/−6
- src/Output/Types.hs +3/−3
CHANGES.txt view
@@ -1,5 +1,11 @@ Changelog for Hoogle (* = breaking change) +5.0.17.10, released 2019-08-02+ #314, fix bad URL trying to access package on Hoogle with --local+ #311, fix an overflow with weight computations+ Fix up the /log page to avoid raising CSP errors+ Avoid raising error when you see a bad URL+ Make errors from the server be code 400 rather than 500 5.0.17.9, released 2019-05-30 #306, fix a potential directory traversal bug #305, add a flag to disable security headers
hoogle.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hoogle-version: 5.0.17.9+version: 5.0.17.10 license: BSD3 license-file: LICENSE category: Development@@ -13,7 +13,7 @@ Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries by either function name, or by approximate type signature.-homepage: http://hoogle.haskell.org/+homepage: https://hoogle.haskell.org/ bug-reports: https://github.com/ndmitchell/hoogle/issues tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 extra-doc-files:
html/log.html view
@@ -6,53 +6,13 @@ <link type="text/css" rel="stylesheet" href="#{cdn}hoogle.css" /> <link type="image/png" rel="icon" href="#{cdn}favicon.png" /> <script type="text/javascript" src="#{jquery}"> </script>+ <script type="text/javascript" src="log.js"> </script> <script type="text/javascript" src="plugin/jquery.flot.js"> </script> <script type="text/javascript" src="plugin/jquery.flot.time.js"> </script> <style type="text/css"> .plot {width: 90%; max-width: 600px; height: 200px;} </style>--<script type="text/javascript">-var data = #{data};-function series(name, val)-{- val.label = name;- val.data = [];- for (var i = 0; i < data.length; i++)- {- var x = data[i][name.toLowerCase()];- val.data.push([new Date(data[i].date),x == 0 ? null : x]);- }- return val;-}-$(function(){- var settings =- {series: {lines: {show: true}, points: {show: true}}- ,xaxis: {mode: "time", minTickSize: [1, "day"]}- ,yaxes: [{}, {position: "right"}]- ,grid: {hoverable: true, clickable: true}};- $.plot("#users",[series("Uses",{yaxis:2}),series("Users",{})], settings);- $.plot("#timings",[series("Average",{}),series("Slowest",{yaxis:2})], settings);- settings.series.lines.show = false;- $.plot("#errors",[series("Errors",{color:"darkred"})], settings);-- $(".plot").bind("plothover", function (event, pos, item) {- if (item) {- var x = new Date(item.datapoint[0]).toDateString();- var y = item.datapoint[1];- y = Math.floor(y) == y ? y : y.toFixed(3);-- $("#tooltip").html(y + " = " + item.series.label + " on " + x)- .css({top: item.pageY+5, left: item.pageX+5})- .fadeIn(200);- } else {- $("#tooltip").hide();- }- });--});-</script> </head> <body>
+ html/log.js view
@@ -0,0 +1,38 @@+var data = #{data};+function series(name, val)+{+ val.label = name;+ val.data = [];+ for (var i = 0; i < data.length; i++)+ {+ var x = data[i][name.toLowerCase()];+ val.data.push([new Date(data[i].date),x == 0 ? null : x]);+ }+ return val;+}+$(function(){+ var settings =+ {series: {lines: {show: true}, points: {show: true}}+ ,xaxis: {mode: "time", minTickSize: [1, "day"]}+ ,yaxes: [{}, {position: "right"}]+ ,grid: {hoverable: true, clickable: true}};+ $.plot("#users",[series("Uses",{yaxis:2}),series("Users",{})], settings);+ $.plot("#timings",[series("Average",{}),series("Slowest",{yaxis:2})], settings);+ settings.series.lines.show = false;+ $.plot("#errors",[series("Errors",{color:"darkred"})], settings);++ $(".plot").bind("plothover", function (event, pos, item) {+ if (item) {+ var x = new Date(item.datapoint[0]).toDateString();+ var y = item.datapoint[1];+ y = Math.floor(y) == y ? y : y.toFixed(3);++ $("#tooltip").html(y + " = " + item.series.label + " on " + x)+ .css({top: item.pageY+5, left: item.pageX+5})+ .fadeIn(200);+ } else {+ $("#tooltip").hide();+ }+ });++});
html/search.xml view
@@ -8,11 +8,11 @@ or by approximate type signature. </Description> <Tags>haskell</Tags>- <Url type="text/html" template="http://hoogle.haskell.org/?hoogle={searchTerms}"/>- <Url type="application/x-suggestions+json" template="http://hoogle.haskell.org/?hoogle={searchTerms}&mode=suggest"/>+ <Url type="text/html" template="https://hoogle.haskell.org/?hoogle={searchTerms}"/>+ <Url type="application/x-suggestions+json" template="https://hoogle.haskell.org/?hoogle={searchTerms}&mode=suggest"/> - <Image height="16" width="16" type="image/png">http://hoogle.haskell.org/favicon.png</Image>- <Image height="64" width="64" type="image/png">http://hoogle.haskell.org/favicon64.png</Image>+ <Image height="16" width="16" type="image/png">https://hoogle.haskell.org/favicon.png</Image>+ <Image height="64" width="64" type="image/png">https://hoogle.haskell.org/favicon64.png</Image> <Developer>Neil Mitchell</Developer> <AdultContent>false</AdultContent> <Language>en-us</Language>
src/Action/CmdLine.hs view
@@ -104,7 +104,7 @@ cmdLineMode = cmdArgsMode $ modes [search_ &= auto,generate,server,replay,test] &= verbosity &= program "hoogle"- &= summary ("Hoogle " ++ showVersion version ++ ", http://hoogle.haskell.org/")+ &= summary ("Hoogle " ++ showVersion version ++ ", https://hoogle.haskell.org/") search_ = Search {color = def &= name "colour" &= help "Use colored output (requires ANSI terminal)"@@ -137,7 +137,7 @@ ,haddock = def &= help "Serve local haddocks from a specified directory" ,scope = def &= help "Default scope to start with" ,links = def &= help "Display extra links"- ,home = "http://hoogle.haskell.org" &= typ "URL" &= help "Set the URL linked to by the Hoogle logo."+ ,home = "https://hoogle.haskell.org" &= typ "URL" &= help "Set the URL linked to by the Hoogle logo." ,host = "" &= help "Set the host to bind on (e.g., an ip address; '!4' for ipv4-only; '!6' for ipv6-only; default: '*' for any host)." ,https = def &= help "Start an https server (use --cert and --key to specify paths to the .pem files)" ,cert = "cert.pem" &= typFile &= help "Path to the certificate pem file (when running an https server)"
src/Action/Search.hs view
@@ -253,10 +253,8 @@ query "(a -> b) -> Maybe a -> Maybe b" [ InTop 3 ("fmap" `inPackage` "base") ]- query "IO a -> m a" -- see GitHub issue #180- [ InTop 50 ("liftIO" `inPackage` "base")- , KnownFailure "GitHub issue #180" $- InTop 3 ("liftIO" `inPackage` "base")+ query "IO a -> m a"+ [ InTop 3 ("liftIO" `inPackage` "base") ] query "a -> m a" -- see GitHub issue #180 [ InTop 20 ("pure" `inPackage` "base")
src/Action/Server.hs view
@@ -131,8 +131,10 @@ "Updates " ++ (if alive < 1.5 then "good" else "bad") ++ ": Last updated " ++ showDP 2 alive ++ " days ago.\n" ["log"] -> do+ OutputHTML <$> templateRender templateLog []+ ["log.js"] -> do log <- displayLog <$> logSummary log- OutputHTML <$> templateRender templateLog [("data",html $ H.string log)]+ OutputJavascript <$> templateRender templateLogJs [("data",html $ H.preEscapedString log)] ["stats"] -> do stats <- getStatsDebug return $ case stats of@@ -167,6 +169,7 @@ templateEmpty = templateFile (htmlDir </> "welcome.html") templateHome = templateIndex `templateApply` [("tags",html $ tagOptions []),("body",templateEmpty),("title",text "Hoogle"),("search",text ""),("robots",text "index")] templateLog = templateFile (htmlDir </> "log.html") `templateApply` params+ templateLogJs = templateFile (htmlDir </> "log.js") `templateApply` params dedupeTake :: Ord k => Int -> (v -> k) -> [v] -> [[v]]
src/General/Log.hs view
@@ -112,7 +112,7 @@ {-# NOINLINE parseLogLine #-} parseLogLine :: (BS.ByteString -> Bool) -> BS.ByteString -> Maybe (Day, SummaryI) parseLogLine interesting (BS.words -> time:user:dur:query:err)- | use && not isErr+ | use || isErr , user /= BS.singleton '-' , Just [a, b, c] <- fmap (map fst) $ mapM BS.readInt $ BS.split '-' $ BS.takeWhile (/= 'T') time = Just (fromGregorian (fromIntegral a) b c, SummaryI
src/General/Util.hs view
@@ -366,7 +366,7 @@ add mp x | Just x2 <- Map.lookupLE (fst x) mp, overlap x x2 = add (Map.delete (fst x2) mp) (merge x x2) | Just x2 <- Map.lookupGE (fst x) mp, overlap x x2 = add (Map.delete (fst x2) mp) (merge x x2)- | otherwise = Map.insert (fst x) (snd x) mp+ | otherwise = uncurry Map.insert x mp general_util_test :: IO ()
src/General/Web.hs view
@@ -22,7 +22,7 @@ import Data.Char import Data.String import Data.Tuple.Extra-import Data.Maybe (fromMaybe)+import Data.Maybe import Data.Monoid import System.FilePath import Control.Exception.Extra@@ -44,7 +44,7 @@ parsePath = map Text.unpack . decodePathSegments . BS.pack- badPath = any $ all (== '.')+ badPath = any (all (== '.')) . filter (/= "") args = parseArgs b parseArgs = map (\(n, v) -> (BS.unpack n, maybe "" BS.unpack v)) . parseQuery@@ -55,6 +55,7 @@ data Output = OutputText LBS.ByteString | OutputHTML LBS.ByteString+ | OutputJavascript LBS.ByteString | OutputJSON Encoding | OutputFail LBS.ByteString | OutputFile FilePath@@ -65,6 +66,7 @@ forceBS (OutputText x) = force x forceBS (OutputJSON x) = force $ encodingToLazyByteString x forceBS (OutputHTML x) = force x+forceBS (OutputJavascript x) = force x forceBS (OutputFail x) = force x forceBS (OutputFile x) = rnf x `seq` LBS.empty @@ -158,9 +160,11 @@ runServer $ \req reply -> do let pq = BS.unpack $ rawPathInfo req <> rawQueryString req putStrLn pq- let pay = fromMaybe (error $ "Bad URL: " ++ pq) (readInput pq)- (time,res) <- duration $ try_ $ do s <- act pay; bs <- evaluate $ forceBS s; return (s, bs)- res <- either (fmap Left . showException) (return . Right) res+ (time, res) <- duration $ case readInput pq of+ Nothing -> return $ Right (OutputFail "", LBS.pack $ "Bad URL: " ++ pq)+ Just pay ->+ handle_ (fmap Left . showException) $ do+ s <- act pay; bs <- evaluate $ forceBS s; return $ Right (s, bs) logAddEntry log (showSockAddr $ remoteHost req) pq time (either Just (const Nothing) res) case res of Left s -> reply $ responseLBS status500 [] $ LBS.pack s@@ -169,7 +173,8 @@ ([("content-type",c) | Just c <- [lookup (takeExtension file) contentType]] ++ secH) file Nothing OutputText{} -> responseLBS status200 (("content-type","text/plain") : secH) bs OutputJSON{} -> responseLBS status200 (("content-type","application/json") : ("access-control-allow-origin","*") : secH) bs- OutputFail{} -> responseLBS status500 (("content-type","text/plain") : secH) bs+ OutputFail{} -> responseLBS status400 (("content-type","text/plain") : secH) bs OutputHTML{} -> responseLBS status200 (("content-type","text/html") : secH) bs+ OutputJavascript{} -> responseLBS status200 (("content-type","text/javascript") : secH) bs contentType = [(".html","text/html"),(".css","text/css"),(".js","text/javascript")]
src/Output/Types.hs view
@@ -314,7 +314,7 @@ where -- CAFs must match perfectly, otherwise too many is better than too few arity | ta == 0 = \ca -> if ca == 0 then mfpJust $ mfpCost "arity equal" 0 else mfpMiss "arity different and query a CAF" -- searching for a CAF- | otherwise = \ca -> case fromIntegral $ ca - ta of+ | otherwise = \ca -> case fromIntegral ca - fromIntegral ta of _ | ca == 0 -> mfpMiss "arity different and answer a CAF" -- searching for a CAF 0 -> mfpJust $ mfpCost "arity equal" 0 -- perfect match -1 -> mfpJust $ mfpCost "arity 1 to remove" 1000 -- not using something the user carefully wrote@@ -327,7 +327,7 @@ allowMore = TVar name0 [] `elem` sigTy sig -- missing terms are a bit worse than invented terms, but it's fairly balanced, clip at large numbers- terms = \ct -> case fromIntegral $ ct - tt of+ terms = \ct -> case fromIntegral ct - fromIntegral tt of n | abs n > 20 -> mfpMiss $ "terms " ++ show n ++ " different" -- too different | n == 0 -> mfpJust $ mfpCost "terms equal" 0 | n > 0 -> mfpJust $ mfpCost ("terms " ++ show n ++ " to add") $ n * 10 -- candidate has more terms@@ -348,7 +348,7 @@ differences :: Double -> Double -> Fingerprint -> Fingerprint -> a differences !rare !common !want !have = fpRaresFold mfpAdd f want where f n | fpRaresElem n have = mfpCost ("term in common " ++ prettyName n) 0- | n == name0 = mfpCost ("term _ missing") $ floor rare -- should this be common?+ | n == name0 = mfpCost "term _ missing" 0 -- will pay the cost the other way around | otherwise = let p = popularityName n in mfpCost ("term " ++ prettyName n ++ " (" ++ showDP 2 p ++ ") missing") $ floor $ (p*common) + ((1-p)*rare)