me/p2p-rendering-computation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

moved Haskell client library to Bindings folder

Browse Source
This commit is contained in:
xecarlox94
2025-01-11 00:44:06 +00:00
parent 3cfd4c56dc
commit 0c7874913a
15 changed files with 15 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
Bindings/Haskell/.gitignore vendored Normal file
View File

@@ -0,0 +1,15 @@
CHANGELOG.md
client
config.json
dist-newstyle
p2p
p2prc.privateKey
p2prc.PublicKeyBareMetal
plugin
server
haddocks/
key.pem
cert.pem
cabal.project.local

120
Bindings/Haskell/README.md Normal file
View File

@@ -0,0 +1,120 @@
<div id="package-header">
<span class="caption">p2prc-0.1.0.0: P2PRC haskell library</span>
- [Contents](index.html)
- [Index](doc-index.html)
</div>
<div id="content">
<div id="module-header">
| | |
|--------------|-----------------------------------------|
| Copyright | Copyright (C) 2006-2024 John MacFarlane |
| License | GNU GPL, version 2 or above |
| Maintainer | John MacFarlane \<jgm@berkeley.edu\> |
| Stability | alpha |
| Portability | portable |
| Safe Haskell | Safe-Inferred |
| Language | GHC2021 |
P2PRC
</div>
<div id="description">
Description
<div class="doc">
This helper module exports the main writers, readers, and data structure
definitions from the Pandoc libraries.
A typical application will chain together a reader and a writer to
convert strings from one format to another. For example, the following
simple program will act as a filter converting markdown fragments to
reStructuredText, using reference-style links instead of inline links:
module Main where
import Text.Pandoc
import Data.Text (Text)
import qualified Data.Text.IO as T
mdToRST :: Text -> IO Text
mdToRST txt = runIOorExplode $
readMarkdown def txt
>>= writeRST def{ writerReferenceLinks = True }
main :: IO ()
main = do
T.getContents >>= mdToRST >>= T.putStrLn
</div>
</div>
<div id="synopsis">
Synopsis
- [runP2PRC](#v:runP2PRC) ::
[MapPortRequest](P2PRC.html#t:MapPortRequest "P2PRC") -\>
[IO]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/System-IO.html#t:IO "System.IO")
()
- <span class="keyword">data</span> [MapPortRequest](#t:MapPortRequest)
= [MkMapPortRequest](#v:MkMapPortRequest)
[Int]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/Data-Int.html#t:Int "Data.Int")
[String]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/Data-String.html#t:String "Data.String")
</div>
<div id="interface">
# Documentation
<div class="top">
<span id="v:runP2PRC" class="def">runP2PRC</span> ::
[MapPortRequest](P2PRC.html#t:MapPortRequest "P2PRC") -\>
[IO]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/System-IO.html#t:IO "System.IO")
() <a href="#v:runP2PRC" class="selflink">#</a>
<div class="doc">
Hello World
</div>
</div>
<div class="top">
<span class="keyword">data</span> <span id="t:MapPortRequest"
class="def">MapPortRequest</span>
<a href="#t:MapPortRequest" class="selflink">#</a>
<div class="subs constructors">
Constructors
| | |
|-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|-----|
| <span id="v:MkMapPortRequest" class="def">MkMapPortRequest</span> [Int]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/Data-Int.html#t:Int "Data.Int") [String]($%7Bpkgroot%7D/../../../../dcnyq1a8qi8x59n5p53d0dx42cl8hf8x-ghc-9.6.5-doc/share/doc/ghc/html/libraries/base-4.18.2.1/Data-String.html#t:String "Data.String") |   |
</div>
</div>
</div>
</div>
<div id="footer">
Produced by [Haddock](http://www.haskell.org/haddock/) version 2.29.2
</div>

4
Bindings/Haskell/cabal.project Normal file
View File

@@ -0,0 +1,4 @@
packages: ./p2prc.cabal
index-state: 2024-11-09T17:56:52Z

3
Bindings/Haskell/dev_run.sh Executable file
View File

@@ -0,0 +1,3 @@
rm -rf *pem client/ plugin/ server/ p2p/ p2prc.[pP]* config.json dist-newstyle/ &&\
cabal clean &&\
cabal run

15
Bindings/Haskell/flake.nix Normal file
View File

@@ -0,0 +1,15 @@
{
description = "A very basic flake";
inputs = {
nixpkgs.url = "github:nixos/nixpkgs?ref=nixos-unstable";
};
outputs = { self, nixpkgs }: {
packages.x86_64-linux.hello = nixpkgs.legacyPackages.x86_64-linux.hello;
packages.x86_64-linux.default = self.packages.x86_64-linux.hello;
};
}

9
Bindings/Haskell/gen_docs.sh Executable file
View File

@@ -0,0 +1,9 @@
#!/bin/bash
cabal haddock
rm -rf ../Docs/haskell
cp -r ./dist-newstyle/build/x86_64-linux/ghc-9.6.5/p2prc-0.1.0.0/doc/html/p2prc/ ../Docs/haskell

151
Bindings/Haskell/lib/API.hs Normal file
View File

@@ -0,0 +1,151 @@
module API
( P2PRCapi(..)
, MapPortRequest(..)
, getP2prcAPI
)
where
import System.Process ( ProcessHandle )
import Data.Aeson ( FromJSON )
import Error
( IOEitherError
)
import JSON
( IPAddressTable(..)
, MapPortResponse(..)
, P2prcConfig
)
import CLI
( StdInput(..)
, CLIOpt(..)
, eitherErrDecode
, getP2PrcCmd
, eitherExecProcess
, eitherExecProcessParser
, spawnProcP2Prc
)
import Environment ( cleanEnvironment )
-- | Lower level P2PRC Haskell api that exposes basic functionality necessary to joint the network.
data P2PRCapi
= MkP2PRCapi
{ startServer :: IOEitherError ProcessHandle
-- ^ Start server
, execInitConfig :: IOEitherError P2prcConfig
-- ^ Instantiate server configuration
, execListServers :: IOEitherError IPAddressTable
-- ^ List servers in network
, execMapPort :: MapPortRequest -> IOEitherError MapPortResponse
-- ^ Exposes and associates a local TCP port with a remote DNS address
}
-- | This defines the request required to create an association between a TCP socket port and a DNS server in the network. If successful, it makes a resource available in the network.
data MapPortRequest =
MkMapPortRequest -- ^ P2PRC's port allocation request value
Int -- ^ TCP socket number
String -- ^ Network domain name
{-|
This function cleans the previous running state (ensuring a pure P2PRC runtime state) and builds up a conditional 'P2PRCapi' instance.
==== __Example__
The following example show how this function can be used to expose the runtime functionalities:
@
example :: IOEitherError P2PRCapi
example = do
eitherP2prcAPI <- getP2prcAPI
case eitherP2prcAPI of
( Right
( MkP2PRCapi
{ startServer = startServer
, execInitConfig = execInitConfig
, execListServers = execListServers
, execMapPort = execMapPort
}
)) -> do
-- Your code logic
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
eitherP2prcCmd <- getP2PrcCmd
pure $ case eitherP2prcCmd of
(Right p2prcCmd) -> let
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 $ MkP2PRCapi
{ startServer = spawnProcP2Prc p2prcCmd [ MkOptAtomic "--s" ]
, execListServers =
execProcP2PrcParser [ MkOptAtomic "--ls" ] MkEmptyStdInput
, 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
configContent <- readFile fname
pure $ eitherErrDecode configContent
(Left err) -> pure $ Left err
}
(Left err) -> Left err

140
Bindings/Haskell/lib/CLI.hs Normal file
View File

@@ -0,0 +1,140 @@
module CLI where
import System.Process
( readProcessWithExitCode
, proc
, createProcess
, terminateProcess
, ProcessHandle
)
import System.Exit
( ExitCode(ExitFailure)
)
import Error
( IOEitherError
, Error(..)
, assignError
)
import Data.Aeson
( FromJSON
, eitherDecode
)
import qualified Data.Text as T
import qualified Data.ByteString.Lazy.Char8 as LBC8
data StdInput
= MkEmptyStdInput
| MkStdInputVal String
instance Show StdInput where
show MkEmptyStdInput = ""
show (MkStdInputVal v) = v
data CLIOpt
= MkEmptyOpts
| MkOptAtomic String
| MkOptTuple (String, String)
type CLIOptsInput = [String]
type CLICmd = String
eitherExecProcessParser ::
FromJSON a =>
CLICmd -> [CLIOpt] -> StdInput -> IOEitherError a
eitherExecProcessParser p2prcCmd opts stdInput =
do
val <- eitherExecProcess p2prcCmd opts stdInput
pure $ case val of
(Right v) -> eitherErrDecode v
(Left e) -> Left e
eitherErrDecode ::
FromJSON a =>
String -> Either Error a
eitherErrDecode = eitherErrorDecode . eitherDecode . LBC8.pack
eitherExecProcess :: CLICmd -> [CLIOpt] -> StdInput -> IOEitherError String
eitherExecProcess cmd opts input =
do
(code, out, err) <-
readProcessWithExitCode
cmd
(optsToCLI opts)
(show input)
pure $ case code of
ExitFailure i -> Left $ MkCLISystemError i cmd err
_ -> Right out
optsToCLI :: [CLIOpt] -> CLIOptsInput
optsToCLI = concatMap _optToCLI
where
_optToCLI :: CLIOpt -> CLIOptsInput
_optToCLI MkEmptyOpts = []
_optToCLI (MkOptAtomic o) = [o]
_optToCLI (MkOptTuple (o, v)) = [o, v]
spawnProcP2Prc :: CLICmd -> [CLIOpt] -> IOEitherError ProcessHandle
spawnProcP2Prc cmd opts =
do
let prc = proc cmd $ optsToCLI opts
creationResult <- createProcess prc
let (_, _, _, ph) = creationResult
case creationResult of
(_, _, Just _, _) -> do
terminateProcess ph
pure $ Left $ MkErrorSpawningProcess cmd
_-> pure $ Right ph
eitherErrorDecode :: Either String a -> Either Error a
eitherErrorDecode esa =
case esa of
(Left s) -> Left $ assignError s
(Right v) -> Right v
getP2PrcCmd :: IOEitherError String
getP2PrcCmd = do
-- assumes the program is ran inside the haskell module in p2prc's repo
-- 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

160
Bindings/Haskell/lib/Engine.hs Normal file
View File

@@ -0,0 +1,160 @@
{-# LANGUAGE OverloadedStrings #-}
module Engine
( runP2PRC
)
where
import Control.Concurrent
import Data.Char (toLower)
import System.IO
import Control.Monad (when)
import System.Process ( terminateProcess )
import API
( P2PRCapi(..)
, MapPortRequest(..)
, getP2prcAPI
)
-- URGENT TASKS
--
--
-- TODO: add Haddock documentation
--
-- TODO: P2PRC setup
-- check version P2PRC: only run if version if above a certain value
-- setup p2prc command
-- check if p2prc command is available in environment first
-- otherwise check folder above
--
-- TODO: Fix API TODOS
--
-- TODO: Fix JSON TODOS
--
-- create DSL to start and orchestrate network
--
-- TODO: publish haskell library
--
{-|
This function starts and bootstraps the P2PRC runtime that associates the a specific host's machine port to a DNS address to expose a certain application to the P2PRC network. You will only need to also import the 'MkMapPortRequest' data constructor to represent the this port request.
==== __Example__
This example demonstrates how it can be ran on the IO context:
@
example :: IO ()
example = do
runP2PRC
( MkMapPortRequest 8080 "jose.akilan.io"
)
@
-}
runP2PRC
:: MapPortRequest -- ^ TCP Port Request
-> IO ()
runP2PRC (MkMapPortRequest portNumber domainName) = do
--
-- TODO: add quickcheck testing (quickchecking-dynamic)
--
-- TODO: Change Standard Library
-- TODO: add GDTA syntax to data types
--
-- TODO: need monad transformers to refactor the code
--
--
-- TODO: parse IO arguments;
-- TODO: create DSL from the standard input
--
-- TODO: add use case examples (extra-source_files)
--
-- TODO: setup nix flake package
-- Nix p2prc runtime packaging
-- Perhaps create internal script to run P2PRC from nix flake
-- "nix flake run ..."
-- simplify packaging
--
-- Extra:
--
-- TODO: Error
-- assign error: should parse other error
eitherP2prcAPI <- getP2prcAPI
case eitherP2prcAPI of
(Right
( MkP2PRCapi
{ startServer = startServer
, execInitConfig = execInitConfig
, execListServers = execListServers
, execMapPort = execMapPort
}
)) -> do
let
configValue <- execInitConfig
-- TODO: get name of host server from config json
print configValue
putStrLn "\n\n\n"
eitherStartProcessHandle <- startServer
case eitherStartProcessHandle of
(Right startProcessHandle) -> do
let sleepNSecs i = threadDelay (i * 1000000)
sleepNSecs 5
outputStr <- execListServers
print outputStr
mapPortOut <- execMapPort $ MkMapPortRequest portNumber domainName
case mapPortOut of
(Right v) -> print v
(Left e) -> print e
-- TODO: work on looping function
--
-- 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
exitOnQ $ terminateProcess startProcessHandle
(Left err) -> print err
(Left err) -> print err
where
exitOnQ :: IO () -> IO ()
exitOnQ exitF = do
hSetBuffering stdin NoBuffering
c <- getChar
when (toLower c /= 'q') $ exitOnQ exitF
exitF

57
Bindings/Haskell/lib/Environment.hs Normal file
View File

@@ -0,0 +1,57 @@
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

36
Bindings/Haskell/lib/Error.hs Normal file
View File

@@ -0,0 +1,36 @@
module Error
( Error(..)
, IOEitherError
, assignError
) where
{- |
Haskell-side Error value. This type is designed to parse and track System and P2PRC's error signals in a safe and effective manner.
It does have an 'MkUnknownError' value which is meant to be warn about new kinds of error not yet accounted in this client. Github issues and pull requests are very welcome to improve error handling by parsing more types of errors.
-}
data Error
= MkCLISystemError -- ^ This is a CLI System Error
Int -- ^ System error code
String -- ^ Command name executed
String -- ^ Error output
| MkErrorSpawningProcess -- ^ Spawing process error
String -- ^ Spawning executable name
| MkUnknownError -- ^ This is an unparsed P2PRC's error
String -- ^ Unparsed error message
deriving Show
-- | Type synonym for an IO action with either returns an Error or a parsed value
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
--
-- Left (MkUnknownError "Unexpected end-of-input, expecting JSON value")
-- MkSystemError 1 "/home/xecarlox/Desktop/p2p-rendering-computation/p2p-rendering-computation" "2024/11/09 21:08:06 Get \"http://0.0.0.0:8088/MAPPort?port=3333&domain_name=\": dial tcp 0.0.0.0:8088: connect: connection refused\n"

202
Bindings/Haskell/lib/JSON.hs Normal file
View File

@@ -0,0 +1,202 @@
{-# LANGUAGE OverloadedStrings #-}
module JSON
( P2prcConfig(..)
, IPAddressTable(..)
, IPAddress(..)
, ServerInfo(..)
, MapPortResponse(..)
)
where
import Control.Monad ( mzero )
import qualified Data.Text as T
import Data.Aeson
{-# WARNING MapPortResponse "This newtype is unstable at the moment due to the P2PRC's library error handling bug. For more information visit: https://github.com/Akilan1999/p2p-rendering-computation/issues/114#issuecomment-2474737015" #-}
-- ^ This represents P2PRC's response to the TCP port and DNS address allocation. This value will confirm the successful allocation and return information about it.
newtype MapPortResponse
= MkMapPortResponse -- ^ Allocation information value
String -- ^ Column separated Host's IP address and Port String
deriving Show
instance FromJSON MapPortResponse where
parseJSON (Object o) = do
ipAddress <- o .: "IPAddress"
pure $ MkMapPortResponse ipAddress
parseJSON _ = mzero
{-# WARNING P2prcConfig "This type is unstable at the moment due to the P2PRC's library error handling bug. For more information visit: https://github.com/Akilan1999/p2p-rendering-computation/issues/114#issuecomment-2474737015" #-}
-- | This represents the server configuration that defines its attributes and behaviours in the network, as well as, the location of the runtime persistence artifacts.
newtype P2prcConfig
= MkP2prConfig
{ machineName :: String -- ^ Machine Name
} deriving Show
-- , hostServerPort :: Int
-- , iPV6Address :: Maybe String
-- , proxyPort :: Maybe Int
-- , fRPServerPort :: Bool
-- , behindNAT :: Bool
-- , iPTableKey :: String
-- , bareMetal :: Bool
-- , customConfig :: String
--
-- , iPTable :: String -- File
-- , dockerContainers :: String -- Directory
-- , defaultDockerFile :: String -- Directory
-- , dockerRunLogs :: String -- Directory
-- , speedTestFile :: String -- File
-- , pluginPath :: String -- Directory
-- , trackContainersPath :: String -- File
-- , publicKeyFile :: String -- File
-- , privateKeyFile :: String -- File
-- , pemFile :: String -- File
-- , keyFile :: String -- File
-- , groupTrackContainersPath :: String -- File
-- 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
{-# WARNING IPAddressTable "This newtype is highly unstable due to undergoing work on improving P2PRC's server api. For more information, visit: https://github.com/Akilan1999/p2p-rendering-computation/issues/114" #-}
-- | This is a wrapper value that parses a json key value from the list of ip addresses in the network.
newtype IPAddressTable
= MkIPAddressTable -- ^ Wrapping constructor
[ServerInfo] -- ^ List current network servers
deriving Show
instance FromJSON IPAddressTable where
parseJSON = withObject "IPAdressTable" $
\ v ->
MkIPAddressTable <$> v .: "ip_address"
{-# WARNING ServerInfo "This type is highly unstable due to undergoing work on improving P2PRC's server api. For more information, visit: https://github.com/Akilan1999/p2p-rendering-computation/issues/114" #-}
{- |
This is a record that keeps track of the current state of every node in the network. It is crucial information required for orchestration strategies.
-}
data ServerInfo =
MkServerInfo
{ name :: T.Text -- ^ Machine name
, ip :: IPAddress -- ^ Machine IP address
, latency :: Int -- ^ Response latency
, download :: Int -- ^ Download speed
, upload :: Int -- ^ Upload speed
, serverPort :: Int -- ^ Server port number
, bareMetalSSHPort :: Maybe Int -- ^ SSH machine port number
, nat :: Bool -- ^ Checking if node is behind a NAT
, escapeImplementation :: Maybe T.Text -- ^ Type of NAT trasversal technique
, customInformation :: Maybe T.Text -- ^ Custom String information
}
deriving Show
-- | This is a simple representation of the IP address of nodes in the network.
data IPAddress
= MkIPv4 String -- ^ IP version 4 address
| MkIPv6 String -- ^ IP version 6 address
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

94
Bindings/Haskell/lib/P2PRC.hs Normal file
View File

@@ -0,0 +1,94 @@
{-# OPTIONS_HADDOCK show-extensions #-}
{- |
Module : P2PRC
Copyright : Copyright (C) 2024-2024 Jose Fernandes
License : GNU GPL, version 2 or above
Maintainer : Jose Fernandes <jf94.uk@gmail.com>
Stability : beta
Portability : portable
This library provides an interface to the P2Prc runtime.
This Module intends to export the main functions and data type definitions necessary to get started with the P2PRC api.
A minimal application will require the import of 'runP2PRC' function that accepts a 'MapPortRequest' value that exposes a specific port number and associates it with a domain name in the internet.
This is a small template to get quickly get started with this interface. We assume the user has already an application listening on the tcp socket "8080".
> module Main where
>
> import P2PRC
> ( runP2PRC
> , MapPortRequest(MkMapPortRequest)
> )
>
> main :: IO ()
> main =
> runP2PRC
> ( MkMapPortRequest 8080 "jose.akilan.io"
> )
-}
module P2PRC
(
-- * Functions
{- | These are the available functions available to interact with the P2Prc environment, at a lower level of abstraction.
It is intended this way to give freedom to the developer to implement their own orchestration strategies.
-}
runP2PRC
, getP2prcAPI
-- * Data Types
{- | This section describes and explains the library's type system, more specifically, the interfaces and primitive types.
-}
-- ** Interface data types
-- | This section gives an overview on the runtime and host machine interfaces.
, P2PRCapi(..)
, P2prcConfig(..)
, MapPortRequest(..)
, MapPortResponse(..)
-- ** Primitive data types
-- | These types represent the core data that is communicated between requests and the runtime.
, IPAddressTable(..)
, ServerInfo(..)
, IPAddress(..)
, Error(..)
-- ** Type Synonyms
-- | This section is reserved to some useful type synonyms that add significant ergonomics.
, IOEitherError
)
where
import Engine
( runP2PRC
)
import JSON
( IPAddressTable(..)
, ServerInfo(..)
, IPAddress(..)
, MapPortResponse(..)
, P2prcConfig(..)
)
import API
( MapPortRequest(..)
, P2PRCapi(..)
, getP2prcAPI
)
import Error
( Error(..)
, IOEitherError
)

67
Bindings/Haskell/p2prc.cabal Normal file
View File

@@ -0,0 +1,67 @@
cabal-version: 3.0
name: p2prc
-- See the Haskell package versioning policy (PVP) for standards
-- guiding when and how versions should be incremented.
-- https://pvp.haskell.org
-- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
version: 0.1.0.0
synopsis: P2PRC haskell library
description: Implements a client interface to the P2PRC networking runtime
author: xecarlox94
maintainer: jf94.uk@gmail.com
category: Network
build-type: Simple
extra-doc-files: README.md
common warnings
ghc-options: -Wall
executable p2prc
import: warnings
hs-source-dirs: src
main-is: Main.hs
other-extensions: OverloadedStrings
build-depends: base
, p2prc
default-language: GHC2021
library
import: warnings
build-depends: base
, text
, aeson
, process
, bytestring
, directory
hs-source-dirs: lib
exposed-modules: P2PRC
other-modules: API
, Engine
, CLI
, Environment
, JSON
, Error
default-language: GHC2021

12
Bindings/Haskell/src/Main.hs Normal file
View File

@@ -0,0 +1,12 @@
module Main where
import P2PRC
( runP2PRC
, MapPortRequest(MkMapPortRequest)
)
main :: IO ()
main =
runP2PRC
( MkMapPortRequest 8080 "jose.akilan.io"
)