diff --git a/haskell/dev_run.sh b/haskell/dev_run.sh index 44b89f7..949f6cc 100755 --- a/haskell/dev_run.sh +++ b/haskell/dev_run.sh @@ -1,3 +1,3 @@ -# rm -rf *pem client/ plugin/ server/ p2p/ p2prc.[pP]* config.json dist-newstyle/ &&\ +rm -rf *pem client/ plugin/ server/ p2p/ p2prc.[pP]* config.json dist-newstyle/ &&\ cabal clean &&\ cabal run diff --git a/haskell/lib/API.hs b/haskell/lib/API.hs index 6c25ad1..2fec7cc 100644 --- a/haskell/lib/API.hs +++ b/haskell/lib/API.hs @@ -1,4 +1,111 @@ -module API where +module API + ( P2prAPI(..) + , MapPortRequest(..) + , getP2prcAPI + ) + where + +import System.Process ( ProcessHandle ) + +import Data.Aeson ( FromJSON ) + +import Error (IOEitherError) + +import JSON + ( IPAdressTable + , MapPortResponse + , P2prcConfig + ) + +import CLI + ( StdInput(..) + , CLIOpt(..) + , eitherErrDecode + , getP2PrcCmd + , eitherExecProcess + , eitherExecProcessParser + , spawnProcP2Prc + ) + +import Environment ( cleanEnvironment ) + + + +data P2prAPI = MkP2prAPI + { startServer :: IOEitherError ProcessHandle + , execInitConfig :: IOEitherError P2prcConfig + , execListServers :: IOEitherError IPAdressTable + , execMapPort :: MapPortRequest -> IOEitherError MapPortResponse + } + + +data MapPortRequest + = MkMapPortRequest Int String + + +getP2prcAPI :: IOEitherError P2prAPI +getP2prcAPI = do + + cleanEnvironment + + eitherP2prcCmd <- getP2PrcCmd + + pure $ case eitherP2prcCmd of + (Right p2prcCmd) -> let + + execProcP2PrcParser :: + FromJSON a => + [CLIOpt] -> StdInput -> IOEitherError a + execProcP2PrcParser = eitherExecProcessParser p2prcCmd + -- TODO: GHC question, why does it scope down instead staying generic + + execProcP2Prc = eitherExecProcess p2prcCmd + + in do + + Right $ MkP2prAPI + { startServer = spawnProcP2Prc p2prcCmd [ MkOptAtomic "--s" ] + + , execListServers = + execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput + + , execMapPort = + \ (MkMapPortRequest portNumber _) -> + execProcP2PrcParser + [ MkOptTuple + ( "--mp" + , show portNumber + ) + -- , MkOptTuple -- TODO: add domain parameter + -- ( "--dm" + -- , domainName + -- ) + ] + MkEmptyStdInput + + , execInitConfig = do + + confInitRes <- execProcP2Prc [ MkOptAtomic "--dc" ] MkEmptyStdInput + + case confInitRes of + (Right _) -> do + + -- TODO: get config file name dynamically + + -- TODO: change values before loading file + let fname = "/home/xecarlox/Desktop/p2p-rendering-computation/haskell/config.json" :: FilePath + + + -- TODO: read config check if file exists + configContent <- readFile fname + + pure $ eitherErrDecode configContent + + (Left err) -> pure $ Left err + + } + + (Left err) -> Left err + -a=0 diff --git a/haskell/lib/P2Prc.hs b/haskell/lib/P2Prc.hs index 6ae52e8..2970ff3 100644 --- a/haskell/lib/P2Prc.hs +++ b/haskell/lib/P2Prc.hs @@ -2,74 +2,59 @@ module P2Prc ( runP2Prc ) where -import System.Process - ( ProcessHandle - , terminateProcess - ) +import System.Process ( terminateProcess ) import Control.Concurrent ( threadDelay ) -import Data.Aeson ( FromJSON ) - - -import Environment ( cleanEnvironment ) - -import Error (IOEitherError) - -import JSON - ( IPAdressTable - , MapPortResponse - , P2prcConfig - ) - -import CLI - ( StdInput(..) - , CLIOpt(..) - , eitherErrDecode - , getP2PrcCmd - , eitherExecProcess - , eitherExecProcessParser - , spawnProcP2Prc +import API + ( P2prAPI(..) + , MapPortRequest(..) + , getP2prcAPI ) -- URGENT TASKS -- -- --- TODO: splitting code on different files and directories --- -- TODO: add Haddock documentation -- -- TODO: P2PRC setup - -- p2prc runtime packaging - -- Perhaps create internal script to run P2PRC from nix flake - -- "nix flake run ..." - -- simplify packaging -- check version P2PRC: only run if version if above a certain value -- setup p2prc command -- check if p2prc command is available in environment first -- otherwise check folder above -- +-- TODO: Fix API TODOS +-- +-- TODO: Fix JSON TODOS +-- +-- create DSL to start and orchestrate network +-- -- TODO: publish haskell library -- --- TODO: add use case examples (extra-source_files) runP2Prc :: IO () runP2Prc = do - -- important but not urgent yet -- -- TODO: Change Standard Library -- TODO: add GDTA syntax to data types -- TODO: need monad transformers to refactor the code -- + -- TODO: add quickcheck testing (quickchecking-dynamic) + -- -- TODO: parse IO arguments; -- TODO: create DSL from the standard input -- + -- TODO: add use case examples (extra-source_files) + -- -- TODO: setup nix flake package - -- TODO: add quickcheck testing (quickchecking-dynamic) + -- Nix p2prc runtime packaging + -- Perhaps create internal script to run P2PRC from nix flake + -- "nix flake run ..." + -- simplify packaging -- -- Extra: -- @@ -140,84 +125,3 @@ runP2Prc = do (Left err) -> print err --- Module: API - -data P2prAPI = MkP2prAPI - { startServer :: IOEitherError ProcessHandle - , execInitConfig :: IOEitherError P2prcConfig - , execListServers :: IOEitherError IPAdressTable - , execMapPort :: MapPortRequest -> IOEitherError MapPortResponse - } - - -data MapPortRequest - = MkMapPortRequest Int String - - -getP2prcAPI :: IOEitherError P2prAPI -getP2prcAPI = do - - cleanEnvironment - - eitherP2prcCmd <- getP2PrcCmd - - pure $ case eitherP2prcCmd of - (Right p2prcCmd) -> let - - execProcP2PrcParser :: - FromJSON a => - [CLIOpt] -> StdInput -> IOEitherError a - execProcP2PrcParser = eitherExecProcessParser p2prcCmd - -- TODO: GHC question, why does it scope down instead staying generic - - execProcP2Prc = eitherExecProcess p2prcCmd - - in do - - Right $ MkP2prAPI - { startServer = spawnProcP2Prc p2prcCmd [ MkOptAtomic "--s" ] - - , execListServers = - execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput - - , execMapPort = - \ (MkMapPortRequest portNumber _) -> - execProcP2PrcParser - [ MkOptTuple - ( "--mp" - , show portNumber - ) - -- , MkOptTuple -- TODO: add domain parameter - -- ( "--dm" - -- , domainName - -- ) - ] - MkEmptyStdInput - - , execInitConfig = do - - confInitRes <- execProcP2Prc [ MkOptAtomic "--dc" ] MkEmptyStdInput - - case confInitRes of - (Right _) -> do - - -- TODO: get config file name dynamically - - -- TODO: change values before loading file - let fname = "/home/xecarlox/Desktop/p2p-rendering-computation/haskell/config.json" :: FilePath - - - -- TODO: read config check if file exists - configContent <- readFile fname - - pure $ eitherErrDecode configContent - - (Left err) -> pure $ Left err - - } - - (Left err) -> Left err - - - -