diff --git a/haskell/lib/API.hs b/haskell/lib/API.hs index e69de29..6c25ad1 100644 --- a/haskell/lib/API.hs +++ b/haskell/lib/API.hs @@ -0,0 +1,4 @@ + +module API where + +a=0 diff --git a/haskell/lib/CLI.hs b/haskell/lib/CLI.hs index e69de29..7eb2699 100644 --- a/haskell/lib/CLI.hs +++ b/haskell/lib/CLI.hs @@ -0,0 +1,3 @@ +module CLI where + +a=0 diff --git a/haskell/lib/Environment.hs b/haskell/lib/Environment.hs index e69de29..0eca44e 100644 --- a/haskell/lib/Environment.hs +++ b/haskell/lib/Environment.hs @@ -0,0 +1,54 @@ +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 + diff --git a/haskell/lib/Error.hs b/haskell/lib/Error.hs new file mode 100644 index 0000000..1a5d6dd --- /dev/null +++ b/haskell/lib/Error.hs @@ -0,0 +1,17 @@ +module Error where + + +data Error + = MkUnknownError String + | MkErrorSpawningProcess String + | MkSystemError Int String String + deriving Show + +type IOEitherError a = IO (Either Error a) + +assignError :: String -> Error +assignError = MkUnknownError +-- +-- TODO: add megaparsec to parse Error Messages +-- +-- TODO: add error when internet connection is off diff --git a/haskell/lib/JSON.hs b/haskell/lib/JSON.hs index e69de29..134fc1e 100644 --- a/haskell/lib/JSON.hs +++ b/haskell/lib/JSON.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE OverloadedStrings #-} + +module JSON + ( P2prcConfig + , IPAdressTable + , MapPortResponse + ) + where + + +import Control.Monad ( mzero ) + +import qualified Data.Text as T + +import Data.Aeson + + +newtype MapPortResponse + = MkMapPortResponse + { ipAddress :: String + -- , ipAddress :: IPAddress -- TODO: fix the api output + -- , port :: Int -- TODO: fix the api output + } + deriving Show + + + +instance FromJSON MapPortResponse where + parseJSON (Object o) = do + + ipAddress <- o .: "IPAddress" + + pure $ + MkMapPortResponse + { ipAddress=ipAddress + } + + parseJSON _ = mzero + + + +newtype P2prcConfig = MkP2prConfig + { machineName :: String + -- , iPTable :: String -- File + -- , dockerContainers :: String -- Directory + -- , defaultDockerFile :: String -- Directory + -- , dockerRunLogs :: String -- Directory + -- , speedTestFile :: String -- File + -- , iPV6Address :: Maybe String + -- , pluginPath :: String -- Directory + -- , trackContainersPath :: String -- File + -- , hostServerPort :: Int + -- , proxyPort :: Maybe Int + -- , groupTrackContainersPath :: File + -- , fRPServerPort :: Bool + -- , behindNAT :: Bool + -- , iPTableKey :: String + -- , publicKeyFile :: String -- File + -- , privateKeyFile :: String -- File + -- , pemFile :: String -- File + -- , keyFile :: String -- File + -- , bareMetal :: Bool + -- , customConfig + } + deriving Show + + +-- TODO: p2prc API + -- + -- ListServers + -- remove "ip_address" root field if not needed + -- "Nat field" returning a JSON Boolean + -- serverPort as a JSON number + -- baremetalPort as a JSON number + -- have either IPV4 or IPV6 field visible + -- remove "customInformation" if not needed anymore + -- remove "escapeImplementation" if not needed anymore + -- + -- Config file + -- + -- Fix JSON number: ServerPort + -- Fix: IPV6Address dont show if value does not exist + -- Fix JSON number: ProxyPort to number (dont show if it does not exist) + -- Fix JSON number: fRPServerPort + -- Fix JSON boolean: fRPServerPort + -- Fix JSON boolean: behindNAT + -- Fix JSON boolean: bareMetal + -- remove "customConfig" if not needed + -- + -- MapPort + -- to have a dedicated ip address (with type either IPV6 or IPV4 fields) + -- to have a dedicated port field + + +instance FromJSON P2prcConfig where + parseJSON (Object o) = do + + machineName <- o .: "MachineName" + + pure + $ MkP2prConfig + { machineName=machineName + } + + parseJSON _ = mzero + + +newtype IPAdressTable + = MkIPAdressTable [ServerInfo] + deriving Show + + +instance FromJSON IPAdressTable where + parseJSON = withObject "IPAdressTable" $ + \ v -> + MkIPAdressTable <$> v .: "ip_address" + + +data ServerInfo = MkServerInfo + { name :: T.Text + , ip :: IPAddress + , latency :: Int + , download :: Int + , upload :: Int + , serverPort :: Int + , bareMetalSSHPort :: Maybe Int + , nat :: Bool + , escapeImplementation :: Maybe T.Text + , customInformation :: Maybe T.Text + } + deriving Show + + +data IPAddress + = MkIPv4 String + | MkIPv6 String + deriving Show + + +instance FromJSON ServerInfo where + 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 -- TODO: deal with null value + } + + where + + getNat :: String -> Bool -- TODO: Change it to normal JSON + 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 + + + diff --git a/haskell/lib/P2Prc.hs b/haskell/lib/P2Prc.hs index d128fea..b090db5 100644 --- a/haskell/lib/P2Prc.hs +++ b/haskell/lib/P2Prc.hs @@ -14,19 +14,8 @@ import System.Process , ProcessHandle ) -import System.Directory - ( doesDirectoryExist - , doesFileExist - , removeDirectoryRecursive - , removeFile - ) - import Control.Concurrent ( threadDelay ) -import Control.Monad - ( when - , mzero - ) import qualified Data.Text as T @@ -34,7 +23,10 @@ import qualified Data.ByteString.Lazy.Char8 as LBC8 import Data.Aeson --- import System.IO + +import Environment ( cleanEnvironment ) +import Error (IOEitherError, Error(..), assignError) +import JSON -- URGENT TASKS @@ -221,197 +213,6 @@ getP2prcAPI = do --- Module: JSON - -newtype MapPortResponse - = MkMapPortResponse - { ipAddress :: String - -- , ipAddress :: IPAddress -- TODO: fix the api output - -- , port :: Int -- TODO: fix the api output - } - deriving Show - - - -instance FromJSON MapPortResponse where - parseJSON (Object o) = do - - ipAddress <- o .: "IPAddress" - - pure $ - MkMapPortResponse - { ipAddress=ipAddress - } - - parseJSON _ = mzero - - - -newtype P2prcConfig = MkP2prConfig - { machineName :: String - -- , iPTable :: String -- File - -- , dockerContainers :: String -- Directory - -- , defaultDockerFile :: String -- Directory - -- , dockerRunLogs :: String -- Directory - -- , speedTestFile :: String -- File - -- , iPV6Address :: Maybe String - -- , pluginPath :: String -- Directory - -- , trackContainersPath :: String -- File - -- , hostServerPort :: Int - -- , proxyPort :: Maybe Int - -- , groupTrackContainersPath :: File - -- , fRPServerPort :: Bool - -- , behindNAT :: Bool - -- , iPTableKey :: String - -- , publicKeyFile :: String -- File - -- , privateKeyFile :: String -- File - -- , pemFile :: String -- File - -- , keyFile :: String -- File - -- , bareMetal :: Bool - -- , customConfig - } - deriving Show - - --- TODO: p2prc API - -- - -- ListServers - -- remove "ip_address" root field if not needed - -- "Nat field" returning a JSON Boolean - -- serverPort as a JSON number - -- baremetalPort as a JSON number - -- have either IPV4 or IPV6 field visible - -- remove "customInformation" if not needed anymore - -- remove "escapeImplementation" if not needed anymore - -- - -- Config file - -- - -- Fix JSON number: ServerPort - -- Fix: IPV6Address dont show if value does not exist - -- Fix JSON number: ProxyPort to number (dont show if it does not exist) - -- Fix JSON number: fRPServerPort - -- Fix JSON boolean: fRPServerPort - -- Fix JSON boolean: behindNAT - -- Fix JSON boolean: bareMetal - -- remove "customConfig" if not needed - -- - -- MapPort - -- to have a dedicated ip address (with type either IPV6 or IPV4 fields) - -- to have a dedicated port field - - -instance FromJSON P2prcConfig where - parseJSON (Object o) = do - - machineName <- o .: "MachineName" - - pure - $ MkP2prConfig - { machineName=machineName - } - - parseJSON _ = mzero - - -newtype IPAdressTable - = MkIPAdressTable [ServerInfo] - deriving Show - - -instance FromJSON IPAdressTable where - parseJSON = withObject "IPAdressTable" $ - \ v -> - MkIPAdressTable <$> v .: "ip_address" - - -data ServerInfo = MkServerInfo - { name :: T.Text - , ip :: IPAddress - , latency :: Int - , download :: Int - , upload :: Int - , serverPort :: Int - , bareMetalSSHPort :: Maybe Int - , nat :: Bool - , escapeImplementation :: Maybe T.Text - , customInformation :: Maybe T.Text - } - deriving Show - - -data IPAddress - = MkIPv4 String - | MkIPv6 String - deriving Show - - -instance FromJSON ServerInfo where - 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 -- TODO: deal with null value - } - - where - - getNat :: String -> Bool -- TODO: Change it to normal JSON - 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 - - --- Module Error - -data Error - = MkUnknownError String - | MkErrorSpawningProcess String - | MkSystemError Int String String - deriving Show - -type IOEitherError a = IO (Either Error a) - -assignError :: String -> Error -assignError = MkUnknownError --- --- TODO: add megaparsec to parse Error Messages --- --- TODO: add error when internet connection is off - - -- Module: CLI data StdInput @@ -521,47 +322,3 @@ getP2PrcCmd = do $ trimString pwdOut err -> pure err - - --- Module: Environment - -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 - diff --git a/haskell/p2prc.cabal b/haskell/p2prc.cabal index a095c37..d5b8f8a 100644 --- a/haskell/p2prc.cabal +++ b/haskell/p2prc.cabal @@ -86,4 +86,10 @@ library exposed-modules: P2Prc + other-modules: API + , CLI + , Environment + , JSON + , Error + default-language: GHC2021