From 6bb45f40fe7928ed9c7e3a57bf96034acfaab5d6 Mon Sep 17 00:00:00 2001 From: xecarlox94 Date: Sat, 26 Oct 2024 23:09:51 +0100 Subject: [PATCH] improved p2prc API --- haskell/app/Main.hs | 125 ++++++++++++++++++++++++++------------------ 1 file changed, 73 insertions(+), 52 deletions(-) diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs index 55684ed..a74024e 100644 --- a/haskell/app/Main.hs +++ b/haskell/app/Main.hs @@ -2,9 +2,9 @@ module Main where -import System.Exit ( ExitCode(ExitFailure) ) - -import System.IO +import System.Exit + ( ExitCode(ExitFailure) + ) import System.Process ( readProcessWithExitCode @@ -28,8 +28,6 @@ import Control.Monad , mzero ) --- TODO: Change Standard Library - import qualified Data.Text as T import qualified Data.ByteString.Lazy.Char8 as LBC8 @@ -37,6 +35,10 @@ import qualified Data.ByteString.Lazy.Char8 as LBC8 import Data.Aeson +-- import System.IO +-- +-- TODO: Change Standard Library + main :: IO () main = do @@ -61,23 +63,23 @@ main = do , execInitConfig = execInitConfig , execListServers = execListServers , execMapPort = execMapPort - } - ) = p2prcAPI + }) = p2prcAPI - configValue <- execInitConfig + configValue <- execInitConfig $ MkConfigParams "dummy" print configValue putStrLn "\n\n\n" eitherStartProcessHandle <- startServer + -- TODO: get name of host server from config json -- TODO: add option to change some default config attributes -- TODO: parse config file -- - -- TODO: abstract init and server running logic into its function - -- work on looping function + -- TODO: work on looping function + case eitherStartProcessHandle of (Right startProcessHandle) -> do @@ -87,15 +89,26 @@ main = do outputStr <- execListServers print outputStr - mapPortOut <- execMapPort 3333 -- TODO: add domain name + mapPortOut <- execMapPort $ MkMapPortRequest 3333 "domain" + + case mapPortOut of + (Right v) -> print v + (Left e) -> print e -- -- TODO: Add loop to print servers list -- + -- + -- Loop (Run replica of haskell program on different $NODES) + -- - Start server + -- - wait 4 seconds + -- - Identify new node running p2prc with SSH external port exposed + -- - SSH into machine + -- - Use simple File transfer to setup files + -- - Run server + -- - Use remote machine p2prc cmd to map a port using --mp + -- - Return back the exposed public IP and port number back to stdout - case mapPortOut of - (Right v) -> putStrLn $ show v - (Left e) -> print e terminateProcess startProcessHandle @@ -105,26 +118,24 @@ main = do - -- Loop (Run replica of haskell program on different $NODES) - -- - Start server - -- - wait 4 seconds - -- - Identify new node running p2prc with SSH external port exposed - -- - SSH into machine - -- - Use simple File transfer to setup files - -- - Run server - -- - Use remote machine p2prc cmd to map a port using --mp - -- - Return back the exposed public IP and port number back to stdout - - - data P2prAPI = MkP2prAPI { startServer :: IOEitherError ProcessHandle - , execInitConfig :: IOEitherError P2prcConfig -- TODO: add parameters that can be modified + , execInitConfig :: ConfigParams -> IOEitherError P2prcConfig , execListServers :: IOEitherError IPAdressTable - , execMapPort :: Int -> IOEitherError MapPortResponse + , execMapPort :: MapPortRequest -> IOEitherError MapPortResponse } +data ConfigParams = MkConfigParams String + + +type DomainName = String +type PortNumber = Int + +data MapPortRequest + = MkMapPortRequest PortNumber DomainName + + getP2prcAPI :: IOEitherError P2prAPI getP2prcAPI = do @@ -133,11 +144,17 @@ getP2prcAPI = do eitherP2prcCmd <- getP2PrcCmd pure $ case eitherP2prcCmd of - (Right p2prcCmd) -> do + (Right p2prcCmd) -> let - let execProcP2PrcParser = eitherExecProcessParser p2prcCmd - let execProcP2Prc = eitherExecProcess p2prcCmd + 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" ] @@ -146,38 +163,39 @@ getP2prcAPI = do execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput , execMapPort = - \ portNumber -> + \ (MkMapPortRequest portNumber _) -> execProcP2PrcParser [ MkOptTuple ( "--mp" , show portNumber ) - ] - MkEmptyStdInput - -- , MkOptTuple -- TODO: add domain parameter -- ( "--dm" -- , domainName -- ) + ] + MkEmptyStdInput - , execInitConfig = do + , execInitConfig = + \ (MkConfigParams _) -> do - confInitRes <- execProcP2Prc [ MkOptAtomic "--dc" ] MkEmptyStdInput + confInitRes <- execProcP2Prc [ MkOptAtomic "--dc" ] MkEmptyStdInput - case confInitRes of - (Right _) -> do + case confInitRes of + (Right _) -> do - -- TODO: get config file name dynamically - let fname = "/home/xecarlox/Desktop/p2p-rendering-computation/haskell/config.json" :: FilePath + -- TODO: get config file name dynamically + let fname = "/home/xecarlox/Desktop/p2p-rendering-computation/haskell/config.json" :: FilePath - -- TODO: change values before loading file + -- TODO: change values before loading file - -- TODO: read config check if file exists - configContent <- readFile fname + -- TODO: read config check if file exists + configContent <- readFile fname - pure $ eitherErrDecode configContent + pure $ eitherErrDecode configContent + + (Left err) -> pure $ Left err - (Left err) -> pure $ Left err } (Left err) -> Left err @@ -248,6 +266,7 @@ newtype IPAdressTable = MkIPAdressTable [ServerInfo] deriving Show + instance FromJSON IPAdressTable where parseJSON = withObject "IPAdressTable" $ \v -> @@ -260,8 +279,8 @@ data ServerInfo = MkServerInfo , latency :: Int , download :: Int , upload :: Int - , serverPort :: Int - , bareMetalSSHPort :: Maybe Int + , serverPort :: PortNumber + , bareMetalSSHPort :: Maybe PortNumber , nat :: Bool , escapeImplementation :: Maybe T.Text , customInformation :: Maybe T.Text @@ -311,11 +330,11 @@ instance FromJSON ServerInfo where getNat ('T':_) = True getNat _ = False - getBMShhPort :: String -> Maybe Int -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! + getBMShhPort :: String -> Maybe PortNumber -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! getBMShhPort [] = Nothing getBMShhPort bmSshPort = Just $ getPortUNSAFE bmSshPort - getPortUNSAFE :: String -> Int -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! + getPortUNSAFE :: String -> PortNumber -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! getPortUNSAFE = read getIPAddress :: String -> String -> IPAddress @@ -323,11 +342,11 @@ instance FromJSON ServerInfo where getIPAddress ip4 _ = MkIPv4 ip4 - data StdInput = MkEmptyStdInput | MkStdInputVal String + instance Show StdInput where show MkEmptyStdInput = "" show (MkStdInputVal v) = v @@ -335,6 +354,7 @@ instance Show StdInput where type IOEitherError a = IO (Either Error a) + eitherExecProcessParser :: FromJSON a => CLICmd -> [CLIOpt] -> StdInput -> IOEitherError a @@ -377,7 +397,6 @@ eitherExecProcess cmd opts input = _ -> Right out - optsToCLI :: [CLIOpt] -> CLIOptsInput optsToCLI = concatMap _optToCLI where @@ -423,9 +442,11 @@ data Error assignError :: String -> Error assignError = MkUnknownError +-- -- TODO: add megaparsec to parse Error Messages -- -- TODO: add error when internet connection is off +-- getP2PrcCmd :: IOEitherError String