{-# 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)