diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 ----- diff --git a/erebos.cabal b/erebos.cabal --- a/erebos.cabal +++ b/erebos.cabal @@ -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, diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -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 diff --git a/main/Version.hs b/main/Version.hs new file mode 100644 --- /dev/null +++ b/main/Version.hs @@ -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 diff --git a/main/Version/Git.hs b/main/Version/Git.hs new file mode 100644 --- /dev/null +++ b/main/Version/Git.hs @@ -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) diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -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