From 22c6837abde39c5a75baeefa95908792867e42de Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 3 Oct 2021 03:13:05 +0200
Subject: add gtfs validator as a service
This just runs the GTFS validator as a web service, since it's a
horrible piece of python2 stuff which I don't want to set up every time
I used it (nor except other people to do so if they need it).
---
hosts/chaski/services/VaaS/.gitignore | 1 +
hosts/chaski/services/VaaS/CHANGELOG.md | 5 +++
hosts/chaski/services/VaaS/app/Main.hs | 58 ++++++++++++++++++++++++++++++++
hosts/chaski/services/VaaS/default.nix | 30 +++++++++++++++++
hosts/chaski/services/VaaS/haskell.cabal | 35 +++++++++++++++++++
hosts/chaski/services/VaaS/index.html | 46 +++++++++++++++++++++++++
6 files changed, 175 insertions(+)
create mode 100644 hosts/chaski/services/VaaS/.gitignore
create mode 100644 hosts/chaski/services/VaaS/CHANGELOG.md
create mode 100644 hosts/chaski/services/VaaS/app/Main.hs
create mode 100644 hosts/chaski/services/VaaS/default.nix
create mode 100644 hosts/chaski/services/VaaS/haskell.cabal
create mode 100644 hosts/chaski/services/VaaS/index.html
(limited to 'hosts/chaski/services/VaaS')
diff --git a/hosts/chaski/services/VaaS/.gitignore b/hosts/chaski/services/VaaS/.gitignore
new file mode 100644
index 0000000..b5e3679
--- /dev/null
+++ b/hosts/chaski/services/VaaS/.gitignore
@@ -0,0 +1 @@
+dist-newstyle/*
diff --git a/hosts/chaski/services/VaaS/CHANGELOG.md b/hosts/chaski/services/VaaS/CHANGELOG.md
new file mode 100644
index 0000000..500a0d0
--- /dev/null
+++ b/hosts/chaski/services/VaaS/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for haskell
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/hosts/chaski/services/VaaS/app/Main.hs b/hosts/chaski/services/VaaS/app/Main.hs
new file mode 100644
index 0000000..b5697d7
--- /dev/null
+++ b/hosts/chaski/services/VaaS/app/Main.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Exception (try)
+import Control.Exception.Base (handle)
+import qualified Data.ByteString as BS
+import Data.ByteString.Base32
+import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy as LB
+import Data.Maybe (mapMaybe)
+import Network.HTTP.Client (httpLbs, newManager, parseRequest,
+ responseBody)
+import Network.HTTP.Client.TLS
+import Network.HTTP.Types
+import Network.Wai
+import Network.Wai.Handler.Warp (run)
+import qualified System.Environment as SE
+import System.Process
+
+simpleResponse = responseLBS status200 [("Content-Type", "text/plain")]
+
+simpleError = responseLBS status400 [("Content-Type", "text/plain")]
+
+serveFile filename = do
+ content <- LB.readFile filename
+ pure $ responseLBS status200 [("Content-Type", "text/html")] content
+
+app :: FilePath -> FilePath -> Application
+app validator index req respond =
+ case requestMethod req of
+ "GET" -> case pathInfo req of
+ [] -> serveFile index >>= respond
+ ["validate"] -> do
+ let gtfsuri = head $ mapMaybe (\case { ("gtfs",a) -> Just a; _ -> Nothing }) $ queryString req
+ putStrLn $ "uri is " <> show gtfsuri
+ case gtfsuri of
+ Just uri -> do
+ man <- newManager tlsManagerSettings
+ request <- parseRequest $ C8.unpack uri
+ gtfs <- httpLbs request man
+ let filename = "/tmp/" <> C8.unpack (encodeBase32' uri) <> ".zip"
+ LB.writeFile filename (responseBody gtfs)
+ readProcessWithExitCode "python" [validator,"-n", filename, "--output", "/tmp/gtfs-validated.html"] ""
+
+ serveFile "/tmp/gtfs-validated.html" >>= respond
+
+ Nothing -> respond $ simpleError "missing gtfs parameter"
+ _ -> respond $ simpleError "unknown path"
+ _ -> respond $ simpleError "invalid reqeust method"
+
+main :: IO ()
+main = do
+ args <- SE.getArgs
+ let validator = head args
+ putStrLn "http://localhost:7000/"
+ run 7000 $ app validator (args!!1)
diff --git a/hosts/chaski/services/VaaS/default.nix b/hosts/chaski/services/VaaS/default.nix
new file mode 100644
index 0000000..427270c
--- /dev/null
+++ b/hosts/chaski/services/VaaS/default.nix
@@ -0,0 +1,30 @@
+{ pkgs, compiler ? "default", doBenchmark ? false }:
+
+let
+
+ inherit pkgs;
+
+ f = { mkDerivation, base, base32, bytestring, http-client
+ , http-client-tls, http-types, lib, process, wai, warp
+ }:
+ mkDerivation {
+ pname = "VaaS";
+ version = "0.1.0.0";
+ src = ./.;
+ isLibrary = false;
+ isExecutable = true;
+ executableHaskellDepends = [
+ base base32 bytestring http-client http-client-tls http-types
+ process wai warp
+ ];
+ license = "unknown";
+ hydraPlatforms = lib.platforms.none;
+ };
+
+ haskellPackages = if compiler == "default"
+ then pkgs.haskellPackages
+ else pkgs.haskell.packages.${compiler};
+
+ variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
+in
+ variant (haskellPackages.callPackage f {})
diff --git a/hosts/chaski/services/VaaS/haskell.cabal b/hosts/chaski/services/VaaS/haskell.cabal
new file mode 100644
index 0000000..262b65f
--- /dev/null
+++ b/hosts/chaski/services/VaaS/haskell.cabal
@@ -0,0 +1,35 @@
+cabal-version: 2.4
+name: VaaS
+version: 0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author: stuebinm
+maintainer: stuebinm@disroot.org
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+executable VaaS
+ main-is: Main.hs
+
+ -- Modules included in this executable, other than Main.
+ -- other-modules:
+
+ -- LANGUAGE extensions used by modules in this package.
+ -- other-extensions:
+ build-depends: base ^>=4.14.1.0, wai, warp, http-types, bytestring, process,
+ http-client, http-client-tls, base32
+ hs-source-dirs: app
+ default-language: Haskell2010
diff --git a/hosts/chaski/services/VaaS/index.html b/hosts/chaski/services/VaaS/index.html
new file mode 100644
index 0000000..a7f59e0
--- /dev/null
+++ b/hosts/chaski/services/VaaS/index.html
@@ -0,0 +1,46 @@
+<!doctype html>
+<html class="no-js" lang="">
+ <head>
+ <meta charset="utf-8">
+ <meta http-equiv="x-ua-compatible" content="ie=edge">
+ <title>GTFS Validator</title>
+ <meta name="description" content="">
+ <meta name="viewport" content="width=device-width, initial-scale=1">
+
+ <link rel="apple-touch-icon" href="/apple-touch-icon.png">
+ <!-- Place favicon.ico in the root directory -->
+
+ </head>
+ <body>
+ <!--[if lt IE 8]>
+ <p class="browserupgrade">
+ You are using an <strong>outdated</strong> browser. Please
+ <a href="http://browsehappy.com/">upgrade your browser</a> to improve
+ your experience.
+ </p>
+ <![endif]-->
+
+ <h1>GTFS Validator</h1>
+ <p>
+ This runs the validator contained in the
+ <a href="https://github.com/google/transitfeed">transitfeed
+ git repository
+ </a>.
+ </p>
+
+ <p>Paste the url to your GTFS zip below</p>
+
+ <input id="url">
+ <button id="submit">Validate</button>
+
+ <script>
+ let submit = document.getElementById("submit");
+ let url = document.getElementById("url");
+
+ submit.onclick = () => {
+ window.location =
+ "/validate?gtfs=" + url.value
+ }
+ </script>
+ </body>
+</html>
--
cgit v1.2.3