diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Server.hs | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/app/Server.hs b/app/Server.hs index 9eaeca1..07f1e45 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -39,6 +39,7 @@ import qualified Data.Aeson.Lens as AL import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy.UTF8 as BLU import qualified Data.ByteString.Short as BSS import Data.Default (def) import Data.Either (lefts, rights) @@ -61,7 +62,6 @@ import Data.Pagination , paginatedPagesTotal ) import Data.Proxy (Proxy(..)) -import Data.Semigroup ((<>)) import qualified Data.Serialize as Serialize import qualified Data.Set as S import qualified Data.Text as T @@ -72,6 +72,8 @@ import Data.Version (Version(..)) import GHC.Exts (Down(..), groupWith) import GHC.Generics (Generic) import qualified HaskellCodeExplorer.Types as HCE +import Network.Connection (TLSSettings (..)) +import Network.HTTP.Client.TLS (mkManagerSettings) import Network.HTTP.Types (hContentEncoding, hContentType, status200, status404) import Network.URI.Encode (encode) import Network.Mime (defaultMimeLookup) @@ -177,6 +179,8 @@ data ServerConfig = ServerConfig , configMaxPerPage :: !Int , configStore :: !(Maybe Store) , configUseHoogleApi :: !Bool + , configHoogleApi :: !String + , configHoogleApiDisableCertCheck :: !Bool } deriving (Show, Eq) data PackagesPath = PackagesPath @@ -256,7 +260,17 @@ configParser = switch (long "use-hoogle-api" <> help - "Use public Hoogle JSON API (https://github.com/ndmitchell/hoogle/blob/3dbf68bfd701f942d3af2e6debb74a0a78cd392e/docs/API.md#json-api) to get documentation for not indexed packages (disabled by default)") + "Use public Hoogle JSON API to get documentation for not indexed packages (disabled by default)") <*> + (pure "https://hoogle.haskell.org" <|> + strOption + (long "hoogle-api" <> + help "host of Hoogle API, defaulting to the public instance https://hoogle.haskell.org." <> + metavar "HOOGLE_API")) <*> + switch + (long "disable-hoogle-api-cert-check" <> + help + "Disable https certificate check for hoogle API (checks cert by default)") + parsePackagesPath :: Parser FilePath -> Parser [FilePath] -> Parser PackagesPath parsePackagesPath parseDir parsePaths = @@ -1530,9 +1544,6 @@ valueToHoogleResultItem value = mbResultSort = value ^? AL.key "url" . AL._String >>= urlToSort in HoogleResultItem <$> mbResultSort <*> mbModuleName <*> mbHtmlDocs -hoogleApiHost :: String -hoogleApiHost = "https://hoogle.haskell.org/" - getHoogleDocs :: PackageId -> HCE.HaskellModuleName @@ -1542,15 +1553,21 @@ getHoogleDocs :: getHoogleDocs packageId (HCE.HaskellModuleName moduleName) itemSort name | Just (packageName, _mbVersion) <- parsePackageId packageId = do useHoogle <- asks (configUseHoogleApi . envConfig) + hoogleApiHost <- asks (configHoogleApi . envConfig) + disableCertCheck <- asks (configHoogleApiDisableCertCheck . envConfig) unless useHoogle $ error404 "Hoogle API is disabled" let hoogleQuery = T.unpack name ++ " is:exact package:" ++ T.unpack (getPackageName packageName) - url = hoogleApiHost ++ "?hoogle=" ++ encode hoogleQuery ++ "&mode=json" + url = hoogleApiHost </> "?hoogle=" ++ encode hoogleQuery ++ "&mode=json" error502 e = throwServantError $ err502 {errBody = BSL.fromStrict $ BSC.pack $ show e} - response <- liftIO $ handleSync error502 (Wreq.get url) + opts = Wreq.defaults & Wreq.manager .~ + Left (mkManagerSettings + (TLSSettingsSimple disableCertCheck False False) Nothing) + + response <- liftIO $ handleSync error502 (Wreq.getWith opts url) let body = response ^. Wreq.responseBody case A.decode body of Just (value :: A.Value) -> @@ -1570,7 +1587,7 @@ getHoogleDocs packageId (HCE.HaskellModuleName moduleName) itemSort name BSL.append "Unexpected JSON response from hoogle.haskell.org" body Nothing -> error500 $ - BSL.append "Unexpected response from hoogle.haskell.org: " body + "Unexpected response from " <> BLU.fromString hoogleApiHost <> ": " <> body getHoogleDocs packageId _ _ _ = error404 $ BSL.append "Incorrect package id: " (toLazyBS $ getPackageId packageId) |