erebos 0.1.0 → 0.1.1
raw patch · 7 files changed
+143/−12 lines, 7 filesdep +processdep +template-haskelldep ~directory
Dependencies added: process, template-haskell
Dependency ranges changed: directory
Files
- CHANGELOG.md +5/−0
- README.md +13/−1
- erebos.cabal +30/−9
- main/Main.hs +25/−1
- main/Version.hs +19/−0
- main/Version/Git.hs +31/−0
- src/Erebos/Network.hs +20/−1
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for erebos +## 0.1.1 -- 2024-02-18++* Added build flag to enable/disable ICE support with pjproject.+* Added `-V` command-line switch to show version.+ ## 0.1.0 -- 2024-02-10 * First version.
README.md view
@@ -2,13 +2,25 @@ ====== The erebos binary provides simple CLI interface to the decentralized Erebos-messaging service. Local identity is created on the first run.+messaging service. Local identity is created on the first run. Protocol and+services specification is being written at: +[http://erebosprotocol.net](http://erebosprotocol.net)+ Erebos identity is based on locally stored cryptographic keys, all communication is end-to-end encrypted. Multiple devices can be attached to the same identity, after which they function interchangeably, without any one being in any way "primary"; messages and other state data are then synchronized automatically whenever the devices are able to connect with one another.++Status+------++This is experimental implementation of yet unfinished specification, so+changes, especially in the library API, are expected. Storage format and+network protocol should generally remain backward compatible, with their+respective versions to be increased in case of incompatible changes, to allow+for interoperability even in that case. Usage -----
erebos.cabal view
@@ -1,7 +1,7 @@ Cabal-Version: 2.2 Name: erebos-Version: 0.1.0+Version: 0.1.1 Synopsis: Decentralized messaging and synchronization Description: Library and simple CLI interface implementing the Erebos identity@@ -30,6 +30,9 @@ Extra-Source-Files: src/Erebos/ICE/pjproject.h +Flag ice+ Description: Enable peer discovery with ICE support using pjproject+ source-repository head type: git location: git://erebosprotocol.net/erebos@@ -61,11 +64,16 @@ TypeFamilyDependencies other-extensions:+ CPP ForeignFunctionInterface OverloadedStrings RecursiveDo+ TemplateHaskell UndecidableInstances + if flag(ice)+ cpp-options: -DENABLE_ICE_SUPPORT+ library import: common default-language: Haskell2010@@ -75,8 +83,6 @@ Erebos.Attach Erebos.Channel Erebos.Contact- Erebos.Discovery- Erebos.ICE Erebos.Identity Erebos.Message Erebos.Network@@ -99,16 +105,23 @@ Erebos.Util c-sources:- src/Erebos/ICE/pjproject.c src/Erebos/Network/ifaddrs.c include-dirs:- src/Erebos/ICE src- includes:- src/Erebos/ICE/pjproject.h- build-tool-depends: c2hs:c2hs- pkgconfig-depends: libpjproject >= 2.9 + if flag(ice)+ exposed-modules:+ Erebos.Discovery+ Erebos.ICE+ c-sources:+ src/Erebos/ICE/pjproject.c+ include-dirs:+ src/Erebos/ICE+ includes:+ src/Erebos/ICE/pjproject.h+ build-tool-depends: c2hs:c2hs+ pkgconfig-depends: libpjproject >= 2.9+ build-depends: async >=2.2 && <2.3, binary >=0.8 && <0.11,@@ -144,15 +157,23 @@ main-is: Main.hs other-modules:+ Paths_erebos Test+ Version+ Version.Git+ autogen-modules:+ Paths_erebos build-depends: bytestring, cryptonite,+ directory, erebos, haskeline >=0.7 && <0.9, mtl, network,+ process >=1.6 && <1.7,+ template-haskell >=2.18 && <2.22, text, time, transformers >= 0.5 && <0.7,
main/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where@@ -32,8 +33,10 @@ import Erebos.Attach import Erebos.Contact+#ifdef ENABLE_ICE_SUPPORT import Erebos.Discovery import Erebos.ICE+#endif import Erebos.Identity import Erebos.Message import Erebos.Network@@ -46,14 +49,17 @@ import Erebos.Sync import Test+import Version data Options = Options { optServer :: ServerOptions+ , optShowVersion :: Bool } defaultOptions :: Options defaultOptions = Options { optServer = defaultServerOptions+ , optShowVersion = False } options :: [OptDescr (Options -> Options)]@@ -64,6 +70,9 @@ , Option ['s'] ["silent"] (NoArg (so $ \opts -> opts { serverLocalDiscovery = False })) "do not send announce packets for local discovery"+ , Option ['V'] ["version"]+ (NoArg $ \opts -> opts { optShowVersion = True })+ "show version and exit" ] where so f opts = opts { optServer = f $ optServer opts } @@ -125,9 +134,12 @@ (o, [], []) -> return (foldl (flip id) defaultOptions o) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: erebos [OPTION...]"- interactiveLoop st opts + if optShowVersion opts+ then putStrLn versionLine+ else interactiveLoop st opts + interactiveLoop :: Storage -> Options -> IO () interactiveLoop st opts = runInputT defaultSettings $ do erebosHead <- liftIO $ loadLocalStateHead st@@ -150,7 +162,9 @@ , someService @SyncService Proxy , someService @ContactService Proxy , someService @DirectMessage Proxy+#ifdef ENABLE_ICE_SUPPORT , someService @DiscoveryService Proxy+#endif ] peers <- liftIO $ newMVar []@@ -218,7 +232,9 @@ loop $ Just $ CommandState { csHead = erebosHead , csContext = NoContext+#ifdef ENABLE_ICE_SUPPORT , csIceSessions = []+#endif , csIcePeer = Nothing } @@ -235,7 +251,9 @@ data CommandState = CommandState { csHead :: Head LocalState , csContext :: CommandContext+#ifdef ENABLE_ICE_SUPPORT , csIceSessions :: [IceSession]+#endif , csIcePeer :: Maybe Peer } @@ -293,6 +311,7 @@ , ("contact-add", cmdContactAdd) , ("contact-accept", cmdContactAccept) , ("contact-reject", cmdContactReject)+#ifdef ENABLE_ICE_SUPPORT , ("discovery-init", cmdDiscoveryInit) , ("discovery", cmdDiscovery) , ("ice-create", cmdIceCreate)@@ -300,6 +319,7 @@ , ("ice-show", cmdIceShow) , ("ice-connect", cmdIceConnect) , ("ice-send", cmdIceSend)+#endif ] cmdUnknown :: String -> Command@@ -399,6 +419,8 @@ cmdContactReject :: Command cmdContactReject = contactReject =<< getSelectedPeer +#ifdef ENABLE_ICE_SUPPORT+ cmdDiscoveryInit :: Command cmdDiscoveryInit = void $ do server <- asks ciServer@@ -468,3 +490,5 @@ s:_ <- gets csIceSessions server <- asks ciServer liftIO $ serverPeerIce server s++#endif
+ main/Version.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}++module Version (+ versionLine,+) where++import Paths_erebos (version)+import Data.Version (showVersion)+import Version.Git++{-# NOINLINE versionLine #-}+versionLine :: String+versionLine = do+ let ver = case $$tGitVersion of+ Just gver+ | 'v':v <- gver, not $ all (`elem` ('.': ['0'..'9'])) v+ -> "git " <> gver+ _ -> "version " <> showVersion version+ in "Erebos CLI " <> ver
+ main/Version/Git.hs view
@@ -0,0 +1,31 @@+module Version.Git (+ tGitVersion,+) where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax++import System.Directory+import System.Exit+import System.Process++tGitVersion :: Code Q (Maybe String)+tGitVersion = unsafeCodeCoerce $ do+ let git args = do+ (ExitSuccess, out, _) <- readCreateProcessWithExitCode+ (proc "git" $ [ "--git-dir=./.git", "--work-tree=." ] ++ args) ""+ return $ lines out++ mbver <- runIO $ do+ doesPathExist "./.git" >>= \case+ False -> return Nothing+ True -> do+ desc:_ <- git [ "describe", "--always", "--dirty= (dirty)" ]+ files <- git [ "ls-files" ]+ return $ Just (desc, files)++ case mbver of+ Just (_, files) -> mapM_ addDependentFile files+ Nothing -> return ()++ lift (fst <$> mbver :: Maybe String)
src/Erebos/Network.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Erebos.Network ( Server, startServer,@@ -10,7 +12,10 @@ PeerIdentity(..), peerIdentity, WaitingRef, wrDigest, Service(..),- serverPeer, serverPeerIce,+ serverPeer,+#ifdef ENABLE_ICE_SUPPORT+ serverPeerIce,+#endif sendToPeer, sendToPeerStored, sendToPeerWith, runPeerService, @@ -44,7 +49,9 @@ import qualified Network.Socket.ByteString as S import Erebos.Channel+#ifdef ENABLE_ICE_SUPPORT import Erebos.ICE+#endif import Erebos.Identity import Erebos.Network.Protocol import Erebos.PubKey@@ -127,7 +134,9 @@ (==) = (==) `on` peerIdentityVar data PeerAddress = DatagramAddress SockAddr+#ifdef ENABLE_ICE_SUPPORT | PeerIceSession IceSession+#endif instance Show PeerAddress where show (DatagramAddress saddr) = unwords $ case IP.fromSockAddr saddr of@@ -137,18 +146,24 @@ Just (addr, port) -> [show addr, show port] _ -> [show saddr]+#ifdef ENABLE_ICE_SUPPORT show (PeerIceSession ice) = show ice+#endif instance Eq PeerAddress where DatagramAddress addr == DatagramAddress addr' = addr == addr'+#ifdef ENABLE_ICE_SUPPORT PeerIceSession ice == PeerIceSession ice' = ice == ice' _ == _ = False+#endif instance Ord PeerAddress where compare (DatagramAddress addr) (DatagramAddress addr') = compare addr addr'+#ifdef ENABLE_ICE_SUPPORT compare (DatagramAddress _ ) _ = LT compare _ (DatagramAddress _ ) = GT compare (PeerIceSession ice ) (PeerIceSession ice') = compare ice ice'+#endif data PeerIdentity = PeerIdentityUnknown (TVar [UnifiedIdentity -> ExceptT String IO ()])@@ -261,7 +276,9 @@ (paddr, msg) <- readFlowIO serverRawPath case paddr of DatagramAddress addr -> void $ S.sendTo sock msg addr+#ifdef ENABLE_ICE_SUPPORT PeerIceSession ice -> iceSend ice msg+#endif forkServerThread server $ forever $ do readFlowIO serverControlFlow >>= \case@@ -655,12 +672,14 @@ serverPeer server paddr = do serverPeer' server (DatagramAddress paddr) +#ifdef ENABLE_ICE_SUPPORT serverPeerIce :: Server -> IceSession -> IO Peer serverPeerIce server@Server {..} ice = do let paddr = PeerIceSession ice peer <- serverPeer' server paddr iceSetChan ice $ mapFlow undefined (paddr,) serverRawPath return peer+#endif serverPeer' :: Server -> PeerAddress -> IO Peer serverPeer' server paddr = do