From cf1d61b67ccd8336dce87b076379a787ba231102 Mon Sep 17 00:00:00 2001 From: Lia Lenckowski Date: Mon, 24 Jul 2023 21:50:32 +0200 Subject: add search.xml --- TODO | 1 + bangs-ddgless.cabal | 1 + src/Config.hs | 27 +++++++++++++++++++++++++++ src/Main.hs | 16 +++++++++++++++- 4 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 src/Config.hs diff --git a/TODO b/TODO index cb70d6d..6715ad3 100644 --- a/TODO +++ b/TODO @@ -1 +1,2 @@ - testen, ob das brotli-ding im browser funktioniert (braucht vermutlich eine https proxy) +- optional ETag oder andere Cache-Control diff --git a/bangs-ddgless.cabal b/bangs-ddgless.cabal index ff5e79c..8f6b091 100644 --- a/bangs-ddgless.cabal +++ b/bangs-ddgless.cabal @@ -19,6 +19,7 @@ executable bangs-ddgless other-modules: Bangs BangState + Config Paths_bangs_ddgless hs-source-dirs: src diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 index 0000000..d19e608 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Config ( + baseUrl, + makeOpenSearch +) where + +import Data.String (IsString) + +baseUrl :: IsString s => s +baseUrl = "http://localhost:20546" + +faviconUrl :: IsString s => s +faviconUrl = "https://69owo.de/favicon.ico" + +makeOpenSearch :: (IsString s, Semigroup s) => s -> s +makeOpenSearch searchUrl = + " " xmlns:moz=\"http://www.mozilla.org/2006/browser/search/\">\n" + <> " Banger\n" + <> " Bangs von ddg, ohne ddg\n" + <> " UTF-8\n" + <> " " <> faviconUrl <> "\n" + <> " searchUrl <> "\"/>\n" + <> " \n" + <> " \n" + <> "\n" diff --git a/src/Main.hs b/src/Main.hs index feb199b..54e6e20 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,11 +6,13 @@ module Main (main) where import Yesod import Network.Wai.Handler.Warp import Data.Function ((&)) +import Data.Functor ((<&>)) import qualified Data.ByteString as BS import Bangs import BangState +import Config data Search = Search { bangState :: BangState @@ -20,6 +22,7 @@ mkYesod "Search" [parseRoutes| / HomeR GET /bangs.json BangsR GET /submitBang SubmitR POST +/search.xml OpenSearchR GET |] instance Yesod Search where @@ -32,7 +35,7 @@ getBangsR :: Handler TypedContent getBangsR = do bangsAccessor <- lookupHeader "accept-encoding" >>= \case Just ae | "br" `BS.isInfixOf` ae -> do - addHeader "transfer-encoding" "br" + addHeader "content-encoding" "br" return getBangsBrotli _ -> do return getBangsJSON @@ -43,6 +46,17 @@ getBangsR = do postSubmitR :: Handler String postSubmitR = return "TODO" +getOpenSearchR :: Handler TypedContent +getOpenSearchR = do + url <- lookupGetParam "default" <&> \case + Nothing -> baseUrl <> "/#{searchTerms}" + Just b -> baseUrl <> "/#" <> b <> "#{searchTerms}" + + return + $ TypedContent "application/opensearchdescription+xml" + $ toContent + $ makeOpenSearch url + main :: IO () main = do s <- Search -- cgit v1.2.3-70-g09d2