module Main (main) where

import           Control.Concurrent (threadDelay)
import           Control.Exception (throwIO, try)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as B8
import           Data.List (find)
import           Nuthatch.Probe.Assert
import           Nuthatch.Probe.Curl
import           Nuthatch.Probe.Oidc
import           Nuthatch.Probe.ProductClient
import           System.Entropy (getEntropy)
import           System.IO.Temp (withSystemTempDirectory)

main :: IO ()
main =
  withSystemTempDirectory "nuthatch-auth-probe" $ \directory -> do
    context <- newProbeContext directory
    runId <- B8.unpack . B16.encode <$> getEntropy 8
    verifyCredentialScope
    waitForApplication context
    verifyPublicBoundary context
    userA <- requireEnv "NUTHATCH_OIDC_USER_A"
    sessionA <- login context True userA "a"
    verifyPkceBoundary context userA
    verifyAuthenticatedBoundary context sessionA
    exerciseRoot context sessionA runId "personal" "01"
    exerciseRoot context sessionA runId "shared" "02"
    verifyCrossUserBoundary context sessionA runId
    verifyLogout context sessionA
    putStrLn "OIDC application boundary passed"

waitForApplication :: ProbeContext -> IO ()
waitForApplication context = go 30
  where
    go :: Int -> IO ()
    go remaining = do
      result <-
        try (curl
          [ "--connect-timeout", "1"
          , "--max-time", "2"
          , probeBase context <> "/readyz"
          ])
          :: IO (Either CurlTransportFailure CurlResponse)
      case result of
        Right _ -> pure ()
        Left failure
          | curlTransportExitCode failure == 7 && remaining > 1 ->
              threadDelay 1000000 >> go (remaining - 1)
          | otherwise -> throwIO failure

verifyCredentialScope :: IO ()
verifyCredentialScope = do
  endpoint <- requireEnv "NUTHATCH_S3_ENDPOINT"
  region <- requireEnv "NUTHATCH_S3_REGION"
  accessKey <- requireEnv "NUTHATCH_S3_ACCESS_KEY"
  secretKey <- requireEnv "NUTHATCH_S3_SECRET_KEY"
  let signed =
        [ "--aws-sigv4", "aws:amz:" <> region <> ":s3"
        , "--user", accessKey <> ":" <> secretKey
        ]
      denied label arguments = do
        response <- curl (signed <> arguments)
        assertEqual
          (label <> ": " <> B8.unpack (curlBody response))
          403
          (curlStatus response)
      emptyPayload =
        "X-Amz-Content-Sha256:e3b0c44298fc1c149afbf4c8996fb924"
          <> "27ae41e4649b934ca495991b7852b855"
  denied "unscoped bucket head"
    [ "--head"
    , "--header", emptyPayload
    , endpoint <> "/nuthatch-fixture"
    ]
  denied "unscoped bucket listing"
    [ "--header", emptyPayload
    , endpoint <> "/nuthatch-fixture?list-type=2"
    ]
  denied "unscoped object read"
    [ "--header", emptyPayload
    , endpoint <> "/nuthatch-fixture/scope-canary"
    ]
  denied "unscoped object write"
    [ "--request", "PUT"
    , "--header"
    , "X-Amz-Content-Sha256:16d02fe317ec0615c2039631cc72bdf9"
        <> "e6c8b7a2cb32895d6235c5775522bbc6"
    , "--data-binary", "denied-write"
    , endpoint <> "/nuthatch-fixture/denied-write"
    ]

verifyPublicBoundary :: ProbeContext -> IO ()
verifyPublicBoundary context = do
  health <- curl [probeBase context <> "/healthz"]
  assertEqual "health status" 200 (curlStatus health)
  assertContains "health response" "\"ok\":true" (curlBody health)
  ready <- curl [probeBase context <> "/readyz"]
  assertEqual "readiness status" 200 (curlStatus ready)
  assertContains "readiness response" "\"ready\":true" (curlBody ready)
  loginPost <- curl ["--request", "POST", probeBase context <> "/login"]
  assertEqual "login method boundary" 405 (curlStatus loginPost)
  root <- curl [probeBase context <> "/"]
  assertEqual "root route boundary" 404 (curlStatus root)
  downloadResponse <- curl
    [ probeBase context
      <> "/api/download?root=personal&path=unauthenticated"
    ]
  assertEqual "unauthenticated download" 303 (curlStatus downloadResponse)
  uploadResponse <- curl
    [ "--header", "X-Declared-Size: 1"
    , "--header", "X-Content-SHA256: " <> B8.unpack (sha256Hex "x")
    , "--header"
    , "X-CSRF-Token: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
    , "--data", "x"
    , probeBase context
      <> "/api/upload?root=personal&path=unauthenticated"
      <> "&operation_id=40000000-0000-4000-8000-000000000001"
    ]
  assertEqual "unauthenticated upload" 303 (curlStatus uploadResponse)
  deleteResponse <- curl
    [ "--header", "Content-Type: application/json"
    , "--data"
    , "{\"root\":\"personal\",\"path\":\"unauthenticated\","
      <> "\"operation_id\":\"40000000-0000-4000-8000-000000000002\","
      <> "\"csrf\":\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"}"
    , probeBase context <> "/api/delete"
    ]
  assertEqual "unauthenticated delete" 303 (curlStatus deleteResponse)
  removedCompatibility <- curl
    [ "--header", "Content-Type: application/json"
    , "--data"
    , "{\"root\":\"personal\",\"path\":\"unauthenticated\","
      <> "\"csrf\":\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"}"
    , probeBase context <> "/delete-prefix"
    ]
  assertEqual "removed compatibility route" 404 (curlStatus removedCompatibility)
  logoutResponse <- curl
    [ "--header"
    , "X-CSRF-Token: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
    , "--request", "POST"
    , probeBase context <> "/logout"
    ]
  assertEqual "unauthenticated logout" 303 (curlStatus logoutResponse)

verifyAuthenticatedBoundary :: ProbeContext -> Session -> IO ()
verifyAuthenticatedBoundary context session = do
  html <- curl
    [ "--cookie", sessionCookies session
    , probeBase context <> "/api/browse"
    ]
  assertEqual "authenticated HTML browse" 200 (curlStatus html)
  json <- browse context session ""
  assertEqual "authenticated JSON browse" 200 (curlStatus json)
  let prohibited =
        [ "NUTHATCH_S3"
        , "AWS_ACCESS_KEY"
        , "AWS_SECRET_ACCESS_KEY"
        , "client_secret"
        ]
      bodies = curlBody html <> curlBody json
  mapM_
    (\value ->
      assert ("browser response exposed " <> value) $
        not (B8.pack value `BS.isInfixOf` bodies))
    prohibited

exerciseRoot
  :: ProbeContext
  -> Session
  -> String
  -> String
  -> String
  -> IO ()
exerciseRoot context session runId root suffix = do
  let path = "smoke-" <> suffix <> ".txt"
      first = B8.pack ("first-" <> root)
      second = B8.pack ("second-" <> root)
      operation prefix =
        runId <> "-" <> prefix <> "-" <> suffix
  firstUpload <- upload context session root path (operation "0") first
  requireSucceeded "first upload" firstUpload
  listing <- browse context session ("?root=" <> root)
  assertContains "uploaded object listing" (B8.pack path) (curlBody listing)
  firstDownload <- download context session root path
  assertEqual "first download status" 200 (curlStatus firstDownload)
  assertEqual "first download body" first (curlBody firstDownload)
  overwrite <- upload context session root path (operation "1") second
  requireSucceeded "overwrite" overwrite
  secondDownload <- download context session root path
  assertEqual "overwrite body" second (curlBody secondDownload)
  deleted <- deleteObject context session root path (operation "2")
  requireSucceeded "delete" deleted
  missing <- download context session root path
  assertEqual "deleted object" 404 (curlStatus missing)

verifyCrossUserBoundary :: ProbeContext -> Session -> String -> IO ()
verifyCrossUserBoundary context sessionA runId = do
  let body = "private-a"
  personal <- upload context sessionA "personal" "cross-user.txt"
    (runId <> "-cross-personal") body
  requireSucceeded "personal cross-user setup" personal
  shared <- upload context sessionA "shared" "cross-user.txt"
    (runId <> "-cross-shared") body
  requireSucceeded "shared cross-user setup" shared
  userB <- requireEnv "NUTHATCH_OIDC_USER_B"
  sessionB <- login context False userB "b"
  personalB <- browse context sessionB "?root=personal"
  assert "another user observed a personal object" $
    not ("cross-user.txt" `BS.isInfixOf` curlBody personalB)
  sharedB <- browse context sessionB "?root=shared"
  assertContains "shared object visibility" "cross-user.txt" (curlBody sharedB)

verifyLogout :: ProbeContext -> Session -> IO ()
verifyLogout context session = do
  rejected <- curl
    [ "--cookie", sessionCookies session
    , "--header"
    , "X-CSRF-Token: bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
    , "--request", "POST"
    , probeBase context <> "/logout"
    ]
  assert "logout accepted the wrong CSRF token" (curlStatus rejected >= 400)
  completed <- curl
    [ "--cookie", sessionCookies session
    , "--header", "X-CSRF-Token: " <> B8.unpack (sessionCsrf session)
    , "--request", "POST"
    , probeBase context <> "/logout"
    ]
  assertEqual "logout status" 200 (curlStatus completed)
  mapM_
    (\name ->
      let matching =
            find
              (BS.isPrefixOf (name <> "="))
              (headerValues "set-cookie" completed)
      in assert (B8.unpack name <> " was not expired") $
          maybe False
            (BS.isInfixOf "Max-Age=0")
            matching)
    ["nuthatch_session", "nuthatch_csrf", "nuthatch_oidc"]
  after <- curl
    [ "--header", "Accept: application/json"
    , probeBase context <> "/api/browse"
    ]
  assertEqual "session after logout" 303 (curlStatus after)

requireSucceeded :: String -> CurlResponse -> IO ()
requireSucceeded label response = do
  assertEqual (label <> " status") 200 (curlStatus response)
  assertContains label "\"result\":\"succeeded\"" (curlBody response)