restructuring directories

1 files changed, 0 insertions, 58 deletions

diff --git a/hosts/chaski/services/VaaS/app/Main.hs b/hosts/chaski/services/VaaS/app/Main.hs
deleted file mode 100644
index b5697d7..0000000
--- a/hosts/chaski/services/VaaS/app/Main.hs
+++ /dev/null
@@ -1,58 +0,0 @@
-{-# 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)