{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Backend.Rust.Validator (run, RustValidator (..), RustValidatorEnv (..)) where

import Control.Monad.Reader
import Convex.Validator
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.Exit (ExitCode (..))
import System.FilePath ((</>))
import System.IO (hGetContents)
import System.Process (CreateProcess (..), StdStream (..), createProcess, proc, waitForProcess)

newtype RustValidator a = RustValidator
  { forall a. RustValidator a -> ReaderT RustValidatorEnv IO a
runRustValidator :: ReaderT RustValidatorEnv IO a
  }
  deriving ((forall a b. (a -> b) -> RustValidator a -> RustValidator b)
-> (forall a b. a -> RustValidator b -> RustValidator a)
-> Functor RustValidator
forall a b. a -> RustValidator b -> RustValidator a
forall a b. (a -> b) -> RustValidator a -> RustValidator b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RustValidator a -> RustValidator b
fmap :: forall a b. (a -> b) -> RustValidator a -> RustValidator b
$c<$ :: forall a b. a -> RustValidator b -> RustValidator a
<$ :: forall a b. a -> RustValidator b -> RustValidator a
Functor, Functor RustValidator
Functor RustValidator =>
(forall a. a -> RustValidator a)
-> (forall a b.
    RustValidator (a -> b) -> RustValidator a -> RustValidator b)
-> (forall a b c.
    (a -> b -> c)
    -> RustValidator a -> RustValidator b -> RustValidator c)
-> (forall a b.
    RustValidator a -> RustValidator b -> RustValidator b)
-> (forall a b.
    RustValidator a -> RustValidator b -> RustValidator a)
-> Applicative RustValidator
forall a. a -> RustValidator a
forall a b. RustValidator a -> RustValidator b -> RustValidator a
forall a b. RustValidator a -> RustValidator b -> RustValidator b
forall a b.
RustValidator (a -> b) -> RustValidator a -> RustValidator b
forall a b c.
(a -> b -> c)
-> RustValidator a -> RustValidator b -> RustValidator c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> RustValidator a
pure :: forall a. a -> RustValidator a
$c<*> :: forall a b.
RustValidator (a -> b) -> RustValidator a -> RustValidator b
<*> :: forall a b.
RustValidator (a -> b) -> RustValidator a -> RustValidator b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> RustValidator a -> RustValidator b -> RustValidator c
liftA2 :: forall a b c.
(a -> b -> c)
-> RustValidator a -> RustValidator b -> RustValidator c
$c*> :: forall a b. RustValidator a -> RustValidator b -> RustValidator b
*> :: forall a b. RustValidator a -> RustValidator b -> RustValidator b
$c<* :: forall a b. RustValidator a -> RustValidator b -> RustValidator a
<* :: forall a b. RustValidator a -> RustValidator b -> RustValidator a
Applicative, Applicative RustValidator
Applicative RustValidator =>
(forall a b.
 RustValidator a -> (a -> RustValidator b) -> RustValidator b)
-> (forall a b.
    RustValidator a -> RustValidator b -> RustValidator b)
-> (forall a. a -> RustValidator a)
-> Monad RustValidator
forall a. a -> RustValidator a
forall a b. RustValidator a -> RustValidator b -> RustValidator b
forall a b.
RustValidator a -> (a -> RustValidator b) -> RustValidator b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
RustValidator a -> (a -> RustValidator b) -> RustValidator b
>>= :: forall a b.
RustValidator a -> (a -> RustValidator b) -> RustValidator b
$c>> :: forall a b. RustValidator a -> RustValidator b -> RustValidator b
>> :: forall a b. RustValidator a -> RustValidator b -> RustValidator b
$creturn :: forall a. a -> RustValidator a
return :: forall a. a -> RustValidator a
Monad, Monad RustValidator
Monad RustValidator =>
(forall a. IO a -> RustValidator a) -> MonadIO RustValidator
forall a. IO a -> RustValidator a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> RustValidator a
liftIO :: forall a. IO a -> RustValidator a
MonadIO, MonadReader RustValidatorEnv, Monad RustValidator
Monad RustValidator =>
(forall a. String -> RustValidator a) -> MonadFail RustValidator
forall a. String -> RustValidator a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall a. String -> RustValidator a
fail :: forall a. String -> RustValidator a
MonadFail)

data RustValidatorEnv = RustValidatorEnv {RustValidatorEnv -> String
projectPath :: FilePath}

run :: RustValidatorEnv -> RustValidator a -> IO a
run :: forall a. RustValidatorEnv -> RustValidator a -> IO a
run RustValidatorEnv
renv RustValidator a
action = ReaderT RustValidatorEnv IO a -> RustValidatorEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RustValidator a -> ReaderT RustValidatorEnv IO a
forall a. RustValidator a -> ReaderT RustValidatorEnv IO a
runRustValidator RustValidator a
action) RustValidatorEnv
renv

instance Validator RustValidator where
  -- \| Sets up the Rust validation sandbox project.
  setup :: RustValidator ()
setup = do
    RustValidatorEnv
config <- RustValidator RustValidatorEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    let rustProjectPath :: String
rustProjectPath = RustValidatorEnv -> String
projectPath RustValidatorEnv
config
    -- Create the directory structure.
    IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
rustProjectPath String -> String -> String
</> String
"src")

    -- Write the Cargo.toml file if it doesn't exist.
    let cargoTomlPath :: String
cargoTomlPath = String
rustProjectPath String -> String -> String
</> String
"Cargo.toml"
    Bool
cargoTomlExists <- IO Bool -> RustValidator Bool
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RustValidator Bool) -> IO Bool -> RustValidator Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
cargoTomlPath
    if Bool -> Bool
not Bool
cargoTomlExists
      then IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
cargoTomlPath String
cargoTomlContent
      else () -> RustValidator ()
forall a. a -> RustValidator a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- Write the src/lib.rs file if it doesn't exist.
    let libRsPath :: String
libRsPath = String
rustProjectPath String -> String -> String
</> String
"src" String -> String -> String
</> String
"lib.rs"
    Bool
libRsExists <- IO Bool -> RustValidator Bool
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RustValidator Bool) -> IO Bool -> RustValidator Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
libRsPath
    if Bool -> Bool
not Bool
libRsExists
      then IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
libRsPath String
libRsContent
      else () -> RustValidator ()
forall a. a -> RustValidator a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- \| Validates the generated Rust code.
  validate :: String -> RustValidator (Maybe String)
validate String
generatedCode = do
    String
rustProjectPath <- (RustValidatorEnv -> String) -> RustValidator String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RustValidatorEnv -> String
projectPath
    let generatedFilePath :: String
generatedFilePath = String
rustProjectPath String -> String -> String
</> String
"src" String -> String -> String
</> String
"generated_api.rs"

    -- Write the generated code to the sandbox project.
    IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
generatedFilePath String
generatedCode

    -- Run `cargo fmt` to format the code.
    IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"[Validator] Running 'cargo fmt'..."
    let fmtCmd :: CreateProcess
fmtCmd = (String -> [String] -> CreateProcess
proc String
"cargo" [String
"fmt"]) {cwd = Just rustProjectPath}
    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
fmtHandle) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> RustValidator
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> RustValidator
      (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> RustValidator
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
fmtCmd
    ExitCode
fmtExitCode <- IO ExitCode -> RustValidator ExitCode
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> RustValidator ExitCode)
-> IO ExitCode -> RustValidator ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
fmtHandle

    if ExitCode
fmtExitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess
      then do
        IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"[Validator] Error: 'cargo fmt' failed. The generated code has syntax errors."
        Maybe String -> RustValidator (Maybe String)
forall a. a -> RustValidator a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else do
        -- Run `cargo check` to validate types and ownership.
        IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"[Validator] Running 'cargo check'..."
        let checkCmd :: CreateProcess
checkCmd = (String -> [String] -> CreateProcess
proc String
"cargo" [String
"check"]) {cwd = Just rustProjectPath, std_err = CreatePipe}
        (Maybe Handle
_, Maybe Handle
_, Just Handle
stdErr, ProcessHandle
checkHandle) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> RustValidator
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> RustValidator
      (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> RustValidator
     (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
checkCmd
        ExitCode
checkExitCode <- IO ExitCode -> RustValidator ExitCode
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> RustValidator ExitCode)
-> IO ExitCode -> RustValidator ExitCode
forall a b. (a -> b) -> a -> b
$ ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
checkHandle

        if ExitCode
checkExitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
          then do
            IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"[Validator] Validation successful."
            -- Read file content from the checked and formatted file.
            String
content <- IO String -> RustValidator String
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> RustValidator String)
-> IO String -> RustValidator String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
generatedFilePath
            Maybe String -> RustValidator (Maybe String)
forall a. a -> RustValidator a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> RustValidator (Maybe String))
-> Maybe String -> RustValidator (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
content
          else do
            IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"[Validator] Error: 'cargo check' failed. The generated code is invalid."
            IO () -> RustValidator ()
forall a. IO a -> RustValidator a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RustValidator ()) -> IO () -> RustValidator ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
hGetContents Handle
stdErr IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
putStrLn
            Maybe String -> RustValidator (Maybe String)
forall a. a -> RustValidator a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- | The content for the validation project's Cargo.toml file.
cargoTomlContent :: String
cargoTomlContent :: String
cargoTomlContent =
  [String] -> String
unlines
    [ String
"[package]",
      String
"name = \"validation-project\"",
      String
"version = \"0.1.0\"",
      String
"edition = \"2021\"",
      String
"",
      String
"[dependencies]",
      String
"convex = \"0.9.0\"",
      String
"serde = { version = \"1\", features = [\"derive\"] }",
      String
"serde_json = \"1\"",
      String
"thiserror = \"1.0\"",
      String
"anyhow = \"1.0\"",
      String
"futures-util = { version = \"0.3\" }",
      String
"tokio = { version = \"1\", features = [\"full\"] }"
    ]

-- | The content for the validation project's src/lib.rs file.
libRsContent :: String
libRsContent :: String
libRsContent = String
"pub mod generated_api;\n"