updating haskell module to nix build and development environment
This commit is contained in:
6
Bindings/Haskell/flake.lock
generated
6
Bindings/Haskell/flake.lock
generated
@@ -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"
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
|
||||||
|
|
||||||
@@ -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
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -60,7 +60,6 @@ library
|
|||||||
other-modules: API
|
other-modules: API
|
||||||
, Engine
|
, Engine
|
||||||
, CLI
|
, CLI
|
||||||
, Environment
|
|
||||||
, JSON
|
, JSON
|
||||||
, Error
|
, Error
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user