updating haskell module to nix build and development environment

This commit is contained in:
2025-01-11 13:26:59 +00:00
parent 406947f249
commit a0e0a8f73e
8 changed files with 74 additions and 161 deletions

View File

@@ -79,12 +79,12 @@
}, },
"locked": { "locked": {
"lastModified": 0, "lastModified": 0,
"narHash": "sha256-mMecuPKOwnmSinCpRVbvcm2typJxjQ1ETJd4JbOaPVE=", "narHash": "sha256-SNCJZpBetNSp/V2z/ywWb11HjBWmos9uHUM+LRC4ZyI=",
"path": "/nix/store/3b9bxx2s97wdly7bvfsw0yqafq94jrcp-source", "path": "/nix/store/kf835db5hb805pmbrigx9dsq8pkdmfz6-source",
"type": "path" "type": "path"
}, },
"original": { "original": {
"path": "/nix/store/3b9bxx2s97wdly7bvfsw0yqafq94jrcp-source", "path": "/nix/store/kf835db5hb805pmbrigx9dsq8pkdmfz6-source",
"type": "path" "type": "path"
} }
}, },

View File

@@ -2,10 +2,13 @@
module API module API
( P2PRCapi(..) ( P2PRCapi(..)
, MapPortRequest(..) , MapPortRequest(..)
, getP2prcAPI , p2prcAPI
) )
where where
import System.Directory ( getCurrentDirectory )
import System.Process ( ProcessHandle ) import System.Process ( ProcessHandle )
import Data.Aeson ( FromJSON ) import Data.Aeson ( FromJSON )
@@ -24,13 +27,12 @@ import CLI
( StdInput(..) ( StdInput(..)
, CLIOpt(..) , CLIOpt(..)
, eitherErrDecode , eitherErrDecode
, getP2PrcCmd , p2PrcCmdName
, eitherExecProcess , eitherExecProcess
, eitherExecProcessParser , eitherExecProcessParser
, spawnProcP2Prc , spawnProcP2Prc
) )
import Environment ( cleanEnvironment )
-- | Lower level P2PRC Haskell api that exposes basic functionality necessary to joint the network. -- | Lower level P2PRC Haskell api that exposes basic functionality necessary to joint the network.
@@ -56,7 +58,7 @@ data MapPortRequest =
{-| {-|
This function cleans the previous running state (ensuring a pure P2PRC runtime state) and builds up a conditional 'P2PRCapi' instance. This function intiates a pure P2PRC runtime state and builds up a 'P2PRCapi' API instance.
==== __Example__ ==== __Example__
@@ -83,69 +85,62 @@ data MapPortRequest =
errValue -> errValue errValue -> errValue
@ @
-} -}
{-# WARNING getP2prcAPI "This function is currently unstable since it assumes that the Haskell program is executed from the P2PRC \"haskell\" subfolder and the \"p2prc\" executable in the the root folder." #-}
getP2prcAPI :: IOEitherError P2PRCapi
getP2prcAPI = do
cleanEnvironment {-# WARNING p2prcAPI "This function is currently unstable because the configuration reading is dependent on the following issue: https://github.com/Akilan1999/p2p-rendering-computation/issues/120" #-}
p2prcAPI :: P2PRCapi
p2prcAPI =
MkP2PRCapi
{ startServer = spawnProcP2Prc p2PrcCmdName [ MkOptAtomic "--s" ]
eitherP2prcCmd <- getP2PrcCmd , execListServers =
execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput
pure $ case eitherP2prcCmd of , execMapPort =
(Right p2prcCmd) -> let \ (MkMapPortRequest portNumber domainName) ->
execProcP2PrcParser
[ MkOptTuple
( "--mp"
, show portNumber
)
, MkOptTuple
( "--dn"
, domainName
)
]
MkEmptyStdInput
execProcP2PrcParser :: , execInitConfig = do
FromJSON a =>
[CLIOpt] -> StdInput -> IOEitherError a
execProcP2PrcParser = eitherExecProcessParser p2prcCmd
-- TODO: GHC question, why does it scope down instead staying generic
execProcP2Prc = eitherExecProcess p2prcCmd confInitRes <- execProcP2Prc [ MkOptAtomic "--dc" ] MkEmptyStdInput
in do case confInitRes of
(Right _) -> do
Right $ MkP2PRCapi -- TODO: get config file name dynamically
{ startServer = spawnProcP2Prc p2prcCmd [ MkOptAtomic "--s" ] --
currDirectory <- getCurrentDirectory
, execListServers = -- TODO: change values before loading file
execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput let fname = currDirectory ++ "/config.json" :: FilePath
, execMapPort =
\ (MkMapPortRequest portNumber domainName) ->
execProcP2PrcParser
[ MkOptTuple
( "--mp"
, show portNumber
)
, MkOptTuple
( "--dn"
, 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 -- TODO: read config check if file exists
configContent <- readFile fname configContent <- readFile fname
pure $ eitherErrDecode configContent pure $ eitherErrDecode configContent
(Left err) -> pure $ Left err (Left err) -> pure $ Left err
} }
(Left err) -> Left err
where
execProcP2PrcParser ::
FromJSON a =>
[CLIOpt] -> StdInput -> IOEitherError a
execProcP2PrcParser = eitherExecProcessParser p2PrcCmdName
-- TODO: GHC question, why does it scope down instead staying generic
execProcP2Prc = eitherExecProcess p2PrcCmdName

View File

@@ -23,8 +23,6 @@ import Data.Aeson
, eitherDecode , eitherDecode
) )
import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as LBC8 import qualified Data.ByteString.Lazy.Char8 as LBC8
@@ -116,25 +114,8 @@ eitherErrorDecode esa =
(Right v) -> Right v (Right v) -> Right v
getP2PrcCmd :: IOEitherError String -- assumes the program is ran inside the haskell module in p2prc's repo
getP2PrcCmd = do -- assumes that last path segment is "haskell" and that p2prc binary's name is "p2p-rendering-computation"
p2PrcCmdName :: String
-- assumes the program is ran inside the haskell module in p2prc's repo p2PrcCmdName = "p2p-rendering-computation"
-- 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

View File

@@ -18,7 +18,7 @@ import System.Process ( terminateProcess )
import API import API
( P2PRCapi(..) ( P2PRCapi(..)
, MapPortRequest(..) , MapPortRequest(..)
, getP2prcAPI , p2prcAPI
) )
@@ -60,7 +60,7 @@ import API
runP2PRC runP2PRC
:: MapPortRequest -- ^ TCP Port Request :: MapPortRequest -- ^ TCP Port Request
-> IO () -> IO ()
runP2PRC (MkMapPortRequest portNumber domainName) = do runP2PRC (MkMapPortRequest portNumber domainName) = let
-- --
-- TODO: add quickcheck testing (quickchecking-dynamic) -- TODO: add quickcheck testing (quickchecking-dynamic)
@@ -87,19 +87,15 @@ runP2PRC (MkMapPortRequest portNumber domainName) = do
-- TODO: Error -- TODO: Error
-- assign error: should parse other error -- assign error: should parse other error
( MkP2PRCapi
{ startServer = startServer
, execInitConfig = execInitConfig
, execListServers = execListServers
, execMapPort = execMapPort
}
) = p2prcAPI
in do
eitherP2prcAPI <- getP2prcAPI
case eitherP2prcAPI of
(Right
( MkP2PRCapi
{ startServer = startServer
, execInitConfig = execInitConfig
, execListServers = execListServers
, execMapPort = execMapPort
}
)) -> do
let let
@@ -147,7 +143,6 @@ runP2PRC (MkMapPortRequest portNumber domainName) = do
(Left err) -> print err (Left err) -> print err
(Left err) -> print err
where where

View File

@@ -1,57 +0,0 @@
module Environment
( cleanEnvironment
)
where
import System.Directory
( doesDirectoryExist
, doesFileExist
, removeDirectoryRecursive
, removeFile
)
import Control.Monad ( when )
cleanEnvironment :: IO ()
cleanEnvironment = do
mapM_ removeFileIfExists
[ "cert.pem"
, "config.json"
, "key.pem"
, "p2prc.privateKey"
, "p2prc.PublicKeyBareMetal"
]
mapM_ removeDirRIfExists
[ "client"
, "p2p"
, "plugin"
, "server"
]
where
removeIfExists
:: (FilePath -> IO Bool)
-> (FilePath -> IO ())
-> FilePath
-> IO ()
removeIfExists doesItExists rmIt filePath =
do
res <- doesItExists filePath
when res $ rmIt filePath
removeDirRIfExists =
removeIfExists
doesDirectoryExist
removeDirectoryRecursive
removeFileIfExists =
removeIfExists
doesFileExist
removeFile

View File

@@ -40,7 +40,7 @@ module P2PRC
It is intended this way to give freedom to the developer to implement their own orchestration strategies. It is intended this way to give freedom to the developer to implement their own orchestration strategies.
-} -}
runP2PRC runP2PRC
, getP2prcAPI , p2prcAPI
-- * Data Types -- * Data Types
{- | This section describes and explains the library's type system, more specifically, the interfaces and primitive types. {- | This section describes and explains the library's type system, more specifically, the interfaces and primitive types.
@@ -82,7 +82,7 @@ import JSON
import API import API
( MapPortRequest(..) ( MapPortRequest(..)
, P2PRCapi(..) , P2PRCapi(..)
, getP2prcAPI , p2prcAPI
) )

View File

@@ -60,7 +60,6 @@ library
other-modules: API other-modules: API
, Engine , Engine
, CLI , CLI
, Environment
, JSON , JSON
, Error , Error

View File

@@ -16,9 +16,9 @@
let let
goEnv = mkGoEnv { pwd = ./.; }; goEnv = mkGoEnv { pwd = ./.; };
in in
pkgs.mkShell { pkgs.mkShell {
packages = [ packages = [
goEnv goEnv
gomod2nix gomod2nix
]; ];
} }