Detect Tor IPs and shame them for having JS on

package.nix

@@ -13,6 +13,8 @@
     p.blaze-markup
     p.directory
     p.elm-street
+    p.http-client
+    p.http-client-tls
     p.http-types
     p.scotty
     p.text

src/Main.hs

@@ -5,6 +5,7 @@
 module Main (main) where
 
 import Data.FileEmbed (embedStringFile)
+import Data.Function ((&))
 import Data.Text.Lazy (Text)
 import Network.Wai.Handler.Warp (Port)
 import Network.Wai.Middleware.RequestLogger (logStdoutDev)
@@ -15,20 +16,27 @@ import Network.HTTP.Types
 import Network.Wai.Middleware.Gzip
 import Web.Scotty as S
 
+import qualified Data.List as List
+import qualified Data.Maybe as Maybe
+import qualified Network.HTTP.Client as Http
+import qualified Network.HTTP.Client.TLS as Http
+
+
 import qualified Control.Exception as E
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
 
 -- HTML
 index :: H.Html -> Text
-index compiledElmApp = renderHtml $ do
+index body = renderHtml $ do
   H.docTypeHtml $ do
     H.head $ do
       H.title "TESTING Scotty+Elm"
       H.meta ! A.charset "utf-8"
       H.style "body{margin:0px;}"
     (H.body ! A.id "body") $ do
-      embedJs compiledElmApp
+      H.noscript "You don't have Javascript enabled! This site doesn't work without it."
+      body
 
 -- CONF
 port :: Port
@@ -37,15 +45,6 @@ port = 8080
 adminContact :: String
 adminContact = "[Matrix] @mtgmonkey:calitabby.net"
 
-compiledElmAppFile :: AssetPath
-compiledElmAppFile = "/main.js"
-
-boilerplateJsFile :: AssetPath
-boilerplateJsFile = "/init.js"
-
-assetsFolder :: FilePath
-assetsFolder = "."
-
 compiledElmApp :: H.Html
 compiledElmApp = H.toHtml ($(embedStringFile "./main.js") :: String)
 
@@ -55,6 +54,10 @@ boilerplateJs = H.toHtml ($(embedStringFile "./init.js") :: String)
 -- MAIN
 main :: IO ()
 main = do
+  httpman <- Http.newManager Http.tlsManagerSettings
+  let tor_ips_req = Http.setQueryString [] "https://raw.githubusercontent.com/7c/torfilter/refs/heads/main/lists/txt/torfilter-2d-flat.txt"
+  tor_ips_resp <- Http.httpLbs tor_ips_req httpman
+  let tor_ips = show tor_ips_resp
   scotty port $ do
     
     middleware $ gzip $ def { gzipFiles = GzipCompress }
@@ -62,16 +65,43 @@ main = do
   
     -- GET requests
     get "/" $ do
-      h <- header "HTTP_CLIENT_IP"
+      client_ip <- header "CLIENT_IP"
-      r <- header "REMOTE_ADDR"
+      x_forwarded_for <- header "X_FORWARDED_FOR"
-      let fromMaybe d x = case x of {Nothing -> d;Just v -> v}
+      x_forwarded_for_lower <- header "x-forwarded-for"
+      x_forwarded <- header "X_FORWARDED"
+      x_cluster_client_ip <- header "X_CLUSTER_CLIENT_IP"
+      forwarded_for <- header "FORWARDED_FOR"
+      forwarded <- header "FORWARDED"
+      via <- header "VIA"
+      remote_addr <- header "REMOTE_ADDR"
+      let ip = [ client_ip
+                , x_forwarded_for
+                , x_forwarded_for_lower
+                , x_forwarded
+                , x_cluster_client_ip
+                , forwarded_for
+                , forwarded
+                , via
+                , remote_addr
+                , Just "NO_IP"
+                ]
+                & List.dropWhile ((==) Nothing)
+                & List.head
+                & Maybe.fromMaybe "0.0.0.0"
+                & show
+                & List.init
+                & List.tail
       shortCache
       status ok200
       S.html $ index $ do
+        if List.isInfixOf ip tor_ips
+        then do
+          H.text "You are using Tor. I won't serve Javascript to Tor, because you should have it disabled. Go disable it now and leave :3"
+          H.text " (psst. The onionsite lets you use javascript. You can get it from the Onion-Location header)"
+        else
+          embedJs $ do
             compiledElmApp
             boilerplateJs
-        H.toHtml $ fromMaybe "HTTP_CLIENT_IP: Nothing" h
-        H.toHtml $ fromMaybe "REMOTE_ADDR: Nothing" r
 
     get "/favicon.ico/" $ do
       shortCache