From 1e773748fc134a08f4b4c30b7a9e8d27746b509d Mon Sep 17 00:00:00 2001 From: xecarlox94 Date: Sat, 19 Oct 2024 14:26:11 +0100 Subject: [PATCH] finished parsing Server information data --- haskell/app/Main.hs | 134 +++++++++++++++++++++++++++----------------- 1 file changed, 83 insertions(+), 51 deletions(-) diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs index ee877ca..0d978a2 100644 --- a/haskell/app/Main.hs +++ b/haskell/app/Main.hs @@ -2,14 +2,10 @@ module Main where - - import Data.Aeson import System.Process (readProcess, terminateProcess, ProcessHandle, spawnProcess) -import Control.Monad (MonadPlus(mzero)) - import Control.Concurrent (threadDelay) import qualified Data.ByteString.Lazy.Char8 as LBC8 @@ -19,18 +15,19 @@ import qualified Data.ByteString.Lazy.Char8 as LBC8 -- import qualified Data.Text as T - -- TODO: create library to abstract shell and go-level logic - main :: IO () main = do + -- TODO: add IO arguments; flag to optionally cleanup environment + -- TODO: add GDTA syntax to data types - -- TODO: add IO arguments; flag to cleanup environment + -- -- TODO: initialise environment; perhaps cleanup state files + -- _ <- execProcP2Prc [MkOptAtomic "-dc"] MkEmpty - -- TODO create record with all functions needed - -- TODO: initialise environment; perhaps cleanup state files - _ <- execProcP2Prc [MkOptAtomic "-dc"] MkEmpty + -- TODO: create record with all functions needed + -- + -- TODO: Add loop to print servers list cmdOut <- getP2PrcCmd @@ -56,38 +53,75 @@ instance FromJSON IPAdressTable where MkIPAdressTable <$> v .: "ip_address" - --- TODO: refactor this datatype; better definition data ServerInfo = MkServerInfo - { serverInfoName :: String - -- , serverInfoIp4 :: String - -- , serverInfoIp6 :: String - -- , serverInfoLatency :: Int - -- , serverInfoDownload :: Int - -- , serverInfoUpload :: Int - -- , serverInfoServerPort :: Int - -- , serverInfoBareMetalSSHPort :: Maybe Int - -- , serverInfoNat :: Bool - -- , serverInfoEscapeImplementation :: Maybe String - -- , serverInfoCustomInformation :: Maybe String + { name :: String + , ip :: IPAddress + , latency :: Int + , download :: Int + , upload :: Int + , serverPort :: Int -- TODO: verify if it is Maybe value + , bareMetalSSHPort :: Maybe Int -- TODO: verify if it is Maybe value + , nat :: Bool + , escapeImplementation :: Maybe String + , customInformation :: Maybe String } deriving Show +data IPAddress + = MkIPv4 String + | MkIPv6 String + deriving Show + + instance FromJSON ServerInfo where - parseJSON (Object o) = MkServerInfo - <$> o .: "Name" - -- <*> o .: "IPV4" - -- <*> o .: "IPV6" - -- <*> o .: "Latency" - -- <*> o .: "Download" - -- <*> o .: "Upload" - -- <*> o .: "ServerPort" - -- <*> o .: "BareMetalSSHPort" - -- <*> o .: "NAT" - -- <*> o .: "EscapeImplementation" - -- <*> o .: "CustomInformation" - parseJSON _ = mzero + parseJSON = withObject "ServerInfo" $ \o -> do + name <- o .: "Name" + ip4str <- o .: "IPV4" + ip6str <- o .: "IPV6" + latency <- o .: "Latency" + download <- o .: "Download" + upload <- o .: "Upload" + serverPort <- o .: "ServerPort" + bmSshPort <- o .: "BareMetalSSHPort" + nat <- o .: "NAT" + mEscImpl <- o .: "EscapeImplementation" + custInfo <- o .: "CustomInformation" + + pure $ + MkServerInfo + { name = name + , ip = getIPAddress ip4str ip6str + , latency = latency + , download = download + , upload = upload + , serverPort = getPortUNSAFE serverPort + , bareMetalSSHPort = getBMShhPort bmSshPort + , nat = getNat nat + , escapeImplementation = mEscImpl + , customInformation = custInfo + } + + where + + getNat :: String -> Bool + getNat ('T':_) = True + getNat _ = False + + getBMShhPort :: String -> Maybe Int -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! + getBMShhPort [] = Nothing + getBMShhPort bmSshPort = Just $ getPortUNSAFE bmSshPort + + getPortUNSAFE :: String -> Int -- TODO: Dangerous partial function call !!!!!!!!!!!!!!!!!!! + getPortUNSAFE = read + + getIPAddress :: String -> String -> IPAddress + getIPAddress [] ip6 = MkIPv6 ip6 + getIPAddress ip4 _ = MkIPv4 ip4 + + +-- TODO: remove this variable +p2prcCmd = "/home/xecarlox/Desktop/p2p-rendering-computation/p2p-rendering-computation" :: String data StdInput @@ -103,9 +137,10 @@ type IOEitherError a = IO (Either Error a) execProcP2PrcParser :: FromJSON a => [CLIOpt] -> StdInput -> IOEitherError a -execProcP2PrcParser opts stdInput = - eitherErrDecode - <$> execProcP2Prc opts stdInput +execProcP2PrcParser opts stdInput + = + eitherErrDecode + <$> execProcP2Prc opts stdInput where @@ -125,6 +160,7 @@ data CLIOpt | MkOptTuple (String, String) type CLIOptsInput = [String] +type CLICmd = String optsToCLI :: [CLIOpt] -> CLIOptsInput optsToCLI = concatMap _optToCLI @@ -140,18 +176,6 @@ spawnProcP2Prc = spawnProcess p2prcCmd . optsToCLI -p2prcCmd = "/home/xecarlox/Desktop/p2p-rendering-computation/p2p-rendering-computation" :: String - - - -getP2PrcCmd :: IO String -getP2PrcCmd = do - -- assumes the program is ran inside the haskell module in p2prc's repo - readProcess "pwd" [] "" >>= - \pwdOut -> - -- assumes that last path segment is "haskell" and that p2prc binary's name is "p2p-rendering-computation" - readProcess "sed" ["s/haskell/p2p-rendering-computation/"] pwdOut - eitherErrorDecode :: Either String a -> Either Error a eitherErrorDecode esa = @@ -172,3 +196,11 @@ sleepNSecs :: Int -> IO () sleepNSecs i = threadDelay (i * 1000000) + +getP2PrcCmd :: IO String +getP2PrcCmd = do + -- assumes the program is ran inside the haskell module in p2prc's repo + readProcess "pwd" [] "" >>= + \pwdOut -> + -- assumes that last path segment is "haskell" and that p2prc binary's name is "p2p-rendering-computation" + readProcess "sed" ["s/haskell/p2p-rendering-computation/"] pwdOut