aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs16
1 files changed, 15 insertions, 1 deletions
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