diff --git a/haskell/dev_run.sh b/haskell/dev_run.sh new file mode 100755 index 0000000..44b89f7 --- /dev/null +++ b/haskell/dev_run.sh @@ -0,0 +1,3 @@ +# rm -rf *pem client/ plugin/ server/ p2p/ p2prc.[pP]* config.json dist-newstyle/ &&\ + cabal clean &&\ + cabal run diff --git a/haskell/lib/CLI.hs b/haskell/lib/CLI.hs index 7eb2699..1750df9 100644 --- a/haskell/lib/CLI.hs +++ b/haskell/lib/CLI.hs @@ -1,3 +1,135 @@ module CLI where -a=0 +import System.Process + ( readProcessWithExitCode + , proc + , createProcess + , terminateProcess + , ProcessHandle + ) + +import System.Exit ( ExitCode(ExitFailure) ) + +import Data.Aeson + +import Error + ( IOEitherError + , Error(..) + , assignError + ) + +import qualified Data.Text as T + +import qualified Data.ByteString.Lazy.Char8 as LBC8 + + + +data StdInput + = MkEmptyStdInput + | MkStdInputVal String + + +instance Show StdInput where + show MkEmptyStdInput = "" + show (MkStdInputVal v) = v + + +data CLIOpt + = MkEmptyOpts + | MkOptAtomic String + | MkOptTuple (String, String) + +type CLIOptsInput = [String] +type CLICmd = String + + +eitherExecProcessParser :: + FromJSON a => + CLICmd -> [CLIOpt] -> StdInput -> IOEitherError a +eitherExecProcessParser p2prcCmd opts stdInput = + do + val <- eitherExecProcess p2prcCmd opts stdInput + + pure $ case val of + (Right v) -> eitherErrDecode v + (Left e) -> Left e + + +eitherErrDecode :: + FromJSON a => + String -> Either Error a +eitherErrDecode = eitherErrorDecode . eitherDecode . LBC8.pack + + +eitherExecProcess :: CLICmd -> [CLIOpt] -> StdInput -> IOEitherError String +eitherExecProcess cmd opts input = + do + (code, out, err) <- + readProcessWithExitCode + cmd + (optsToCLI opts) + (show input) + + pure $ case code of + ExitFailure i -> Left $ MkSystemError i cmd err + _ -> Right out + + +optsToCLI :: [CLIOpt] -> CLIOptsInput +optsToCLI = concatMap _optToCLI + where + + _optToCLI :: CLIOpt -> CLIOptsInput + _optToCLI MkEmptyOpts = [] + _optToCLI (MkOptAtomic o) = [o] + _optToCLI (MkOptTuple (o, v)) = [o, v] + + +spawnProcP2Prc :: CLICmd -> [CLIOpt] -> IOEitherError ProcessHandle +spawnProcP2Prc cmd opts = + do + let prc = proc cmd $ optsToCLI opts + + creationResult <- createProcess prc + + let (_, _, _, ph) = creationResult + + case creationResult of + (_, _, Just _, _) -> do + + terminateProcess ph + + pure $ Left $ MkErrorSpawningProcess cmd + + _-> pure $ Right ph + + +eitherErrorDecode :: Either String a -> Either Error a +eitherErrorDecode esa = + case esa of + (Left s) -> Left $ assignError s + (Right v) -> Right v + + +getP2PrcCmd :: IOEitherError String +getP2PrcCmd = do + + -- assumes the program is ran inside the haskell module in p2prc's repo + -- assumes that last path segment is "haskell" and that p2prc binary's name is "p2p-rendering-computation" + + let trimString = T.unpack . T.strip . T.pack + + eitherErrPwd <- eitherExecProcess "pwd" [MkEmptyOpts] MkEmptyStdInput + + case eitherErrPwd of + + (Right pwdOut) -> + eitherExecProcess + "sed" + [ MkOptAtomic "s/haskell/p2p-rendering-computation/" ] + $ MkStdInputVal + $ trimString pwdOut + + err -> pure err + + diff --git a/haskell/lib/Error.hs b/haskell/lib/Error.hs index 1a5d6dd..92c1e21 100644 --- a/haskell/lib/Error.hs +++ b/haskell/lib/Error.hs @@ -15,3 +15,5 @@ assignError = MkUnknownError -- TODO: add megaparsec to parse Error Messages -- -- TODO: add error when internet connection is off +-- +-- MkSystemError 1 "/home/xecarlox/Desktop/p2p-rendering-computation/p2p-rendering-computation" "2024/11/09 21:08:06 Get \"http://0.0.0.0:8088/MAPPort?port=3333&domain_name=\": dial tcp 0.0.0.0:8088: connect: connection refused\n" diff --git a/haskell/lib/P2Prc.hs b/haskell/lib/P2Prc.hs index b090db5..5aa03f7 100644 --- a/haskell/lib/P2Prc.hs +++ b/haskell/lib/P2Prc.hs @@ -4,36 +4,32 @@ module P2Prc ( runP2Prc ) where -import System.Exit ( ExitCode(ExitFailure) ) - -import System.Process - ( readProcessWithExitCode - , proc - , createProcess - , terminateProcess - , ProcessHandle - ) +import System.Process ( ProcessHandle, terminateProcess ) import Control.Concurrent ( threadDelay ) -import qualified Data.Text as T - -import qualified Data.ByteString.Lazy.Char8 as LBC8 - import Data.Aeson -import Environment ( cleanEnvironment ) -import Error (IOEitherError, Error(..), assignError) +import Environment ( cleanEnvironment ) + +import Error (IOEitherError) + import JSON + ( IPAdressTable + , MapPortResponse + , P2prcConfig + ) + +import CLI -- URGENT TASKS -- --- TODO: setup the project as a haskell library +-- -- TODO: splitting code on different files and directories --- TODO: lock cabal index +-- -- TODO: add Haddock documentation -- -- TODO: P2PRC setup @@ -69,6 +65,11 @@ runP2Prc = do -- -- TODO: setup nix flake package -- TODO: add quickcheck testing (quickchecking-dynamic) + -- + -- Extra: + -- + -- TODO: Error + -- assign error: should parse other error @@ -213,112 +214,4 @@ getP2prcAPI = do --- Module: CLI -data StdInput - = MkEmptyStdInput - | MkStdInputVal String - - -instance Show StdInput where - show MkEmptyStdInput = "" - show (MkStdInputVal v) = v - - -data CLIOpt - = MkEmptyOpts - | MkOptAtomic String - | MkOptTuple (String, String) - -type CLIOptsInput = [String] -type CLICmd = String - - -eitherExecProcessParser :: - FromJSON a => - CLICmd -> [CLIOpt] -> StdInput -> IOEitherError a -eitherExecProcessParser p2prcCmd opts stdInput = - do - val <- eitherExecProcess p2prcCmd opts stdInput - - pure $ case val of - (Right v) -> eitherErrDecode v - (Left e) -> Left e - - -eitherErrDecode :: - FromJSON a => - String -> Either Error a -eitherErrDecode = eitherErrorDecode . eitherDecode . LBC8.pack - - -eitherExecProcess :: CLICmd -> [CLIOpt] -> StdInput -> IOEitherError String -eitherExecProcess cmd opts input = - do - (code, out, err) <- - readProcessWithExitCode - cmd - (optsToCLI opts) - (show input) - - pure $ case code of - ExitFailure i -> Left $ MkSystemError i cmd err - _ -> Right out - - -optsToCLI :: [CLIOpt] -> CLIOptsInput -optsToCLI = concatMap _optToCLI - where - - _optToCLI :: CLIOpt -> CLIOptsInput - _optToCLI MkEmptyOpts = [] - _optToCLI (MkOptAtomic o) = [o] - _optToCLI (MkOptTuple (o, v)) = [o, v] - - -spawnProcP2Prc :: CLICmd -> [CLIOpt] -> IOEitherError ProcessHandle -spawnProcP2Prc cmd opts = - do - let prc = proc cmd $ optsToCLI opts - - creationResult <- createProcess prc - - let (_, _, _, ph) = creationResult - - case creationResult of - (_, _, Just _, _) -> do - - terminateProcess ph - - pure $ Left $ MkErrorSpawningProcess cmd - - _-> pure $ Right ph - - -eitherErrorDecode :: Either String a -> Either Error a -eitherErrorDecode esa = - case esa of - (Left s) -> Left $ assignError s - (Right v) -> Right v - - -getP2PrcCmd :: IOEitherError String -getP2PrcCmd = do - - -- assumes the program is ran inside the haskell module in p2prc's repo - -- assumes that last path segment is "haskell" and that p2prc binary's name is "p2p-rendering-computation" - - let trimString = T.unpack . T.strip . T.pack - - eitherErrPwd <- eitherExecProcess "pwd" [MkEmptyOpts] MkEmptyStdInput - - case eitherErrPwd of - - (Right pwdOut) -> - eitherExecProcess - "sed" - [ MkOptAtomic "s/haskell/p2p-rendering-computation/" ] - $ MkStdInputVal - $ trimString pwdOut - - err -> pure err diff --git a/haskell/src/Main.hs b/haskell/src/Main.hs index a6764d8..33b16b7 100644 --- a/haskell/src/Main.hs +++ b/haskell/src/Main.hs @@ -1,9 +1,10 @@ + module Main where import P2Prc (runP2Prc) main :: IO () -main = do +main = runP2Prc