add search.xml

2 files changed, 42 insertions, 1 deletions

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 =
+       "<OpenSearchDescription xmlns=\"http://a9.com/-/spec/opensearch/1.1/\"\n"
+    <> "                       xmlns:moz=\"http://www.mozilla.org/2006/browser/search/\">\n"
+    <> "    <ShortName>Banger</ShortName>\n"
+    <> "    <Description>Bangs von ddg, ohne ddg</Description>\n"
+    <> "    <InputEncoding>UTF-8</InputEncoding>\n"
+    <> "    <Image width=\"16\" height=\"16\" type=\"image/x-icon\">" <> faviconUrl <> "</Image>\n"
+    <> "    <Url type=\"text/html\" template=\"" <> searchUrl <> "\"/>\n"
+    <> "    <!--<Url type=\"application/x-suggestions+json\" template=\"[suggestionURL]\"/>-->\n"
+    <> "    <!--<moz:SearchForm>[https://example.com/search]</moz:SearchForm>-->\n"
+    <> "</OpenSearchDescription>\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