un-inception/clients/haskell/sync/tests/test_functional.hs

#!/usr/bin/env runhaskell

{-
Functional Tests for Un Haskell SDK

Run with: runhaskell test_functional.hs
Requires: UNSANDBOX_PUBLIC_KEY and UNSANDBOX_SECRET_KEY environment variables

These tests make real API calls to api.unsandbox.com
-}

import System.Exit (exitFailure, exitSuccess)
import System.Environment (lookupEnv)
import System.Process (readProcessWithExitCode)
import Data.List (isPrefixOf, isInfixOf)
import Data.Char (isDigit)

-- ANSI colors
blue, red, green, yellow, reset :: String
blue = "\x1b[34m"
red = "\x1b[31m"
green = "\x1b[32m"
yellow = "\x1b[33m"
reset = "\x1b[0m"

-- API constants
apiBase :: String
apiBase = "https://api.unsandbox.com"

portalBase :: String
portalBase = "https://unsandbox.com"

-- Import HMAC from crypto library
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Crypto.Hash.SHA256 (hmac)
import Text.Printf (printf)
import Data.Time.Clock.POSIX (getPOSIXTime)

hmacSha256 :: String -> String -> String
hmacSha256 secret message =
  let secretBS = BSC.pack secret
      messageBS = BSC.pack message
      mac = hmac secretBS messageBS
  in concatMap (printf "%02x") (BS.unpack mac)

main :: IO ()
main = do
  putStrLn $ "\n" ++ blue ++ "=== Un Haskell SDK Functional Tests ===" ++ reset ++ "\n"

  -- Check for credentials
  publicKey <- lookupEnv "UNSANDBOX_PUBLIC_KEY"
  secretKey <- lookupEnv "UNSANDBOX_SECRET_KEY"

  case (publicKey, secretKey) of
    (Just pk, Just sk) -> do
      results <- sequence
        [ runTest "health_check" (testHealthCheck pk sk)
        , runTest "validate_keys" (testValidateKeys pk sk)
        , runTest "execute_python" (testExecutePython pk sk)
        , runTest "execute_with_error" (testExecuteWithError pk sk)
        , runTest "session_list" (testSessionList pk sk)
        , runTest "service_list" (testServiceList pk sk)
        , runTest "snapshot_list" (testSnapshotList pk sk)
        , runTest "image_list" (testImageList pk sk)
        ]

      let passed = length $ filter id results
      let failed = length $ filter not results
      let total = length results

      putStrLn $ "\n" ++ blue ++ "Results: " ++ show passed ++ "/" ++ show total ++ " passed" ++ reset

      if failed > 0
        then do
          putStrLn $ red ++ show failed ++ " test(s) failed" ++ reset
          exitFailure
        else do
          putStrLn $ green ++ "All functional tests passed!" ++ reset
          exitSuccess

    _ -> do
      putStrLn $ yellow ++ "SKIP: UNSANDBOX_PUBLIC_KEY and UNSANDBOX_SECRET_KEY not set" ++ reset
      exitSuccess

runTest :: String -> IO Bool -> IO Bool
runTest name test = do
  putStr $ "  Running " ++ name ++ "... "
  result <- test
  if result
    then putStrLn $ green ++ "PASS" ++ reset
    else putStrLn $ red ++ "FAIL" ++ reset
  return result

-- Build auth headers
buildAuthHeaders :: String -> String -> String -> String -> String -> IO [String]
buildAuthHeaders publicKey secretKey method path body = do
  now <- getPOSIXTime
  let timestamp = show (floor now :: Integer)
  let message = timestamp ++ ":" ++ method ++ ":" ++ path ++ ":" ++ body
  let signature = hmacSha256 secretKey message
  return [ "-H", "Authorization: Bearer " ++ publicKey
         , "-H", "X-Timestamp: " ++ timestamp
         , "-H", "X-Signature: " ++ signature
         ]

-- HTTP helpers
curlGet :: String -> String -> String -> IO String
curlGet publicKey secretKey endpoint = do
  authHeaders <- buildAuthHeaders publicKey secretKey "GET" endpoint ""
  (_, stdout, _) <- readProcessWithExitCode "curl"
    (["-s", apiBase ++ endpoint] ++ authHeaders) ""
  return stdout

curlPost :: String -> String -> String -> String -> IO String
curlPost publicKey secretKey endpoint json = do
  authHeaders <- buildAuthHeaders publicKey secretKey "POST" endpoint json
  (_, stdout, _) <- readProcessWithExitCode "curl"
    (["-s", "-X", "POST", apiBase ++ endpoint, "-H", "Content-Type: application/json"] ++ authHeaders ++ ["-d", json]) ""
  return stdout

curlPostPortal :: String -> String -> String -> String -> IO String
curlPostPortal publicKey secretKey endpoint json = do
  authHeaders <- buildAuthHeaders publicKey secretKey "POST" endpoint json
  (_, stdout, _) <- readProcessWithExitCode "curl"
    (["-s", "-X", "POST", portalBase ++ endpoint, "-H", "Content-Type: application/json"] ++ authHeaders ++ ["-d", json]) ""
  return stdout

-- ============================================================================
-- Functional Tests
-- ============================================================================

testHealthCheck :: String -> String -> IO Bool
testHealthCheck _ _ = do
  (_, stdout, _) <- readProcessWithExitCode "curl"
    ["-s", "-o", "/dev/null", "-w", "%{http_code}", apiBase ++ "/health"] ""
  return $ filter isDigit stdout == "200"

testValidateKeys :: String -> String -> IO Bool
testValidateKeys publicKey secretKey = do
  response <- curlPostPortal publicKey secretKey "/keys/validate" "{}"
  -- Check response is JSON with expected fields
  return $ "{" `isPrefixOf` response && ("\"valid\"" `isInfixOf` response || "\"status\"" `isInfixOf` response)

testExecutePython :: String -> String -> IO Bool
testExecutePython publicKey secretKey = do
  let json = "{\"language\":\"python\",\"code\":\"print(6 * 7)\"}"
  response <- curlPost publicKey secretKey "/execute" json
  -- Check output contains 42
  return $ "42" `isInfixOf` response

testExecuteWithError :: String -> String -> IO Bool
testExecuteWithError publicKey secretKey = do
  let json = "{\"language\":\"python\",\"code\":\"import sys; sys.exit(1)\"}"
  response <- curlPost publicKey secretKey "/execute" json
  -- Check exit_code is 1
  return $ "\"exit_code\":1" `isInfixOf` response || "\"exit_code\": 1" `isInfixOf` response

testSessionList :: String -> String -> IO Bool
testSessionList publicKey secretKey = do
  response <- curlGet publicKey secretKey "/sessions"
  -- Response should be JSON array or object
  let trimmed = dropWhile (== ' ') response
  return $ "[" `isPrefixOf` trimmed || "{" `isPrefixOf` trimmed

testServiceList :: String -> String -> IO Bool
testServiceList publicKey secretKey = do
  response <- curlGet publicKey secretKey "/services"
  let trimmed = dropWhile (== ' ') response
  return $ "[" `isPrefixOf` trimmed || "{" `isPrefixOf` trimmed

testSnapshotList :: String -> String -> IO Bool
testSnapshotList publicKey secretKey = do
  response <- curlGet publicKey secretKey "/snapshots"
  let trimmed = dropWhile (== ' ') response
  return $ "[" `isPrefixOf` trimmed || "{" `isPrefixOf` trimmed

testImageList :: String -> String -> IO Bool
testImageList publicKey secretKey = do
  response <- curlGet publicKey secretKey "/images"
  let trimmed = dropWhile (== ' ') response
  return $ "[" `isPrefixOf` trimmed || "{" `isPrefixOf` trimmed