content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE DeriveGeneric      #-}
  {-# LANGUAGE OverloadedStrings  #-}
  
  module Main where
  
  import qualified Codec.Archive.Tar             as Tar
  import qualified Codec.Compression.GZip        as GZ
  import           Control.Monad
  import           Data.Aeson
  import qualified Data.ByteString.Lazy          as B
  import           Data.Foldable
  import           Data.List
  import qualified Data.List.NonEmpty            as NE
  import           Data.Maybe
  import           Data.Monoid
  import qualified Data.Text                     as T
  import           Data.Version                  (showVersion)
  import           GHC.Generics
  import           Network.HTTP.Conduit
  import           Network.HTTP.Simple
  import           Paths_curl_runnings           (version)
  import           System.Console.CmdArgs
  import           System.Directory
  import           System.Environment
  import           System.Exit
  import           System.Info
  import           Testing.CurlRunnings
  import           Testing.CurlRunnings.Internal
  import           Testing.CurlRunnings.Types
  
  -- | Command line flags
  data CurlRunnings = CurlRunnings
    { file           :: FilePath
    , grep           :: Maybe T.Text
    , upgrade        :: Bool
    , json_output    :: Maybe FilePath
    , skip_tls_check :: Bool
    } deriving (Show, Data, Typeable, Eq)
  
  -- | cmdargs object
  argParser :: CurlRunnings
  argParser =
    CurlRunnings
      { file = def &= typFile &= help "File to run"
      , grep = def &= help "Regex to filter test cases by name"
      , upgrade = def &= help "Pull the latest version of curl runnings"
      , json_output =
          def &= typFile &=
          help "Write test results to a json file specified by path"
      , skip_tls_check =
          def &=
          help
            "Don't perform a TLS check (USE WITH CAUTION. Only use this if you signed your own certs)"
      } &=
    summary ("curl-runnings " ++ showVersion version) &=
    program "curl-runnings" &=
    verbosity &=
    help "Use the --file or -f flag to specify an intput file spec to run"
  
  -- | A single release asset in a github release. Eg curl-runnings-${version}.tar.gz
  data GithubReleaseAsset = GithubReleaseAsset
    { name                 :: T.Text
    , browser_download_url :: T.Text -- snake case because that's what we get back from github
    } deriving (Show, Generic)
  
  instance FromJSON GithubReleaseAsset
  
  -- | The json response we expect from github when we check for the latest release
  data GithubRelease = GithubRelease
    { assets   :: [GithubReleaseAsset]
    , tag_name :: T.Text -- snake case because that's what we get back from github
    } deriving (Show, Generic)
  instance FromJSON GithubRelease
  
  newtype GithubReleasesResponse =
    GithubReleasesResponse (NE.NonEmpty GithubRelease)
    deriving (Show, Generic)
  instance FromJSON GithubReleasesResponse
  
  -- | Github requires a user agent, preferably with a username
  setGithubReqHeaders :: Request -> Request
  setGithubReqHeaders = setRequestHeaders [("User-Agent", "aviaviavi")]
  
  runFile ::
       FilePath
    -> Verbosity
    -> Maybe T.Text
    -> TLSCheckType
    -> Maybe FilePath
    -> IO ()
  runFile "" _ _ _ _ =
    putStrLn
      "Please specify an input file with the --file (-f) flag or use --help for more information"
  runFile path verbosityLevel regexp tlsType maybeOutputFile = do
    home <- getEnv "HOME"
    suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path)
    case suite of
      Right s -> do
        results <-
          runSuite (s {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) tlsType
        for_ maybeOutputFile $ \outputFile -> do
          let jsonSummary = encode results
          B.writeFile (outputFile) jsonSummary
        if any isFailing results
          then putStrLn (T.unpack $ makeRed "Some tests failed") >>
               exitWith (ExitFailure 1)
          else putStrLn . T.unpack $ makeGreen "All tests passed!"
      Left message ->
        (putStrLn . T.unpack . makeRed . T.pack $
         "Couldn't read input json or yaml file: " <> message) >>
        exitWith (ExitFailure 1)
  
  -- | If we're on mac, we want a *-mac tarball from the releases page. If we're on linux we
  -- do not
  filterAsset :: [GithubReleaseAsset] -> Maybe GithubReleaseAsset
  filterAsset assetList = find filterFn assetList
    where
      filterFn' a = "mac" `T.isInfixOf` Main.name a
      filterFn =
        if os == "darwin"
          then filterFn'
          else not . filterFn'
  
  -- | From the list of releases on github, find the newest release that has a binary
  -- tarball for the platform we're on.
  findAssetFromReleases :: GithubReleasesResponse -> Maybe GithubReleaseAsset
  findAssetFromReleases (GithubReleasesResponse releases) =
    let assetList = map (filterAsset . assets) $ NE.toList releases
    in join $ find isJust assetList
  
  -- | We'll upgrade any time the latest version is different from what we have
  shouldUpgrade :: GithubReleaseAsset -> Bool
  shouldUpgrade asset =
    let assetNameTokens = T.splitOn "-" (Main.name asset)
    in if length assetNameTokens `notElem` [3, 4]
         then False
         else (T.replace  ".tar.gz" "" (assetNameTokens !! 2)) /= T.pack (showVersion version)
  
  -- | If conditions are met, download the appropriate tarball from the latest
  -- github release, extract and copy to /usr/local/bin
  upgradeCurlRunnings :: IO ()
  upgradeCurlRunnings =
    let tmpArchive = "/tmp/curl-runnings-latest.tar.gz"
        tmpArchiveExtracedFolder = "/tmp/curl-runnings-latest"
        tmpExtractedBin = tmpArchiveExtracedFolder ++ "/curl-runnings"
        installPath = "/usr/local/bin/curl-runnings"
    in do req <-
            parseRequest
              "https://api.github.com/repos/aviaviavi/curl-runnings/releases"
          req' <- return $ setGithubReqHeaders req
          resp <- httpBS req'
          decoded <- return $ eitherDecode' . B.fromStrict $ getResponseBody resp
          case decoded of
            Right r ->
              let asset = findAssetFromReleases r
              in if maybe False shouldUpgrade asset
                   then case asset of
                          (Just a) -> do
                            let downloadUrl = browser_download_url a
                            putStrLn
                              "Getting the latest version of curl-runnings..."
                            downloadResp <-
                              httpBS . setGithubReqHeaders =<<
                              (parseRequest $ T.unpack downloadUrl)
                            _ <-
                              B.writeFile
                                tmpArchive
                                (B.fromStrict $ getResponseBody downloadResp)
                            putStrLn "Extracting..."
                            Tar.unpack tmpArchiveExtracedFolder .
                              Tar.read . GZ.decompress =<<
                              B.readFile tmpArchive
                            putStrLn "Copying..."
                            permissions <- getPermissions tmpExtractedBin
                            setPermissions
                              tmpExtractedBin
                              (setOwnerExecutable True permissions)
                            copyFile tmpExtractedBin installPath
                            putStrLn $
                              "The latest version curl-runnings has been installed to /usr/local/bin. " ++
                              "If you are using curl-runnings from a different location," ++
                              " please update your environment accordingly."
                          -- We got a good response from github, but no asset for our platform was there
                          Nothing -> do
                            putStrLn . T.unpack $
                              makeRed "Error upgrading curl-runnings"
                            putStrLn $
                              "No asset found from github. It's possible the binary for your " ++
                              "platform hasn't yet been uploaded to the latest release. Please wait and try again. " ++
                              "If the issue persists, please open an issue at https://github.com/aviaviavi/curl-runnings/issues."
                            exitWith (ExitFailure 1)
                -- No upgrade required
                   else putStrLn $
                        "curl-runnings is already at the newest version: " ++
                        showVersion version ++ ". Nothing to upgrade."
            -- Coudn't decode github response
            Left err -> do
              putStrLn . T.unpack $ makeRed "Error upgrading curl-runnings"
              putStrLn err
              exitWith (ExitFailure 1)
  
  toLogLevel :: Verbosity -> LogLevel
  toLogLevel v = toEnum $ fromEnum v
  
  main :: IO ()
  main = do
    userArgs <- cmdArgs argParser
    verbosityLevel <- getVerbosity
    let tlsCheckType =
          if skip_tls_check userArgs
            then SkipTLSCheck
            else DoTLSCheck
    if upgrade userArgs
      then upgradeCurlRunnings
      else runFile
             (file userArgs)
             verbosityLevel
             (grep userArgs)
             tlsCheckType
             (json_output userArgs)
  