summaryrefslogtreecommitdiff
path: root/chaski/services/VaaS/app/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'chaski/services/VaaS/app/Main.hs')
-rw-r--r--chaski/services/VaaS/app/Main.hs58
1 files changed, 0 insertions, 58 deletions
diff --git a/chaski/services/VaaS/app/Main.hs b/chaski/services/VaaS/app/Main.hs
deleted file mode 100644
index b5697d7..0000000
--- a/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)