mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
Alexander Bondarenko
b729144773
* WIP: start working on /connect remote ctrl OOB is broken, requires fixing simplexmq bits. * WIP: pull CtrlCryptoHandle from xrcp * place xrcp stubs * WIP: start switching to RemoteControl.Client types * fix http2 sha * fix sha256map.nix * fix cabal.project * update RC test * WIP: add new remote session * fix compilation * simplify * attach HTTP2 server to TLS * starting host session in controller (WIP) * more WIP * compiles * compiles2 * wip * pass startRemote' test * async to poll for events from host, test to send messages fails * move xrcp handshake test to simplexmq * detect session stops * fix connectRemoteCtrl * use step type * app info * WIP: pairing stores * plug in hello/appInfo/pairings * negotiate app version * update simplexmw, remove KEM secrets from DB * fix file tests * tone down http2 shutdown errors * Add stored session test * bump simplexmq tag * update simplexmq * refactor, fix * removed unused errors * rename fields, remove unused file * rename errors --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
70 lines
2.2 KiB
Haskell
70 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Simplex.Chat.Remote.AppVersion
|
|
( AppVersionRange (minVersion, maxVersion),
|
|
AppVersion (..),
|
|
pattern AppCompatible,
|
|
mkAppVersionRange,
|
|
compatibleAppVersion,
|
|
isAppCompatible,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson (FromJSON (..), ToJSON (..))
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Encoding as JE
|
|
import qualified Data.Aeson.TH as JQ
|
|
import qualified Data.Text as T
|
|
import Data.Version (parseVersion, showVersion)
|
|
import qualified Data.Version as V
|
|
import Simplex.Messaging.Parsers (defaultJSON)
|
|
import Text.ParserCombinators.ReadP (readP_to_S)
|
|
|
|
newtype AppVersion = AppVersion V.Version
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance ToJSON AppVersion where
|
|
toJSON (AppVersion v) = J.String . T.pack $ showVersion v
|
|
toEncoding (AppVersion v) = JE.text . T.pack $ showVersion v
|
|
|
|
instance FromJSON AppVersion where
|
|
parseJSON = J.withText "AppVersion" $ parse . T.unpack
|
|
where
|
|
parse s = case filter (null . snd) $ readP_to_S parseVersion s of
|
|
(v, _) : _ -> pure $ AppVersion v
|
|
_ -> fail $ "bad AppVersion: " <> s
|
|
|
|
data AppVersionRange = AppVRange
|
|
{ minVersion :: AppVersion,
|
|
maxVersion :: AppVersion
|
|
}
|
|
|
|
mkAppVersionRange :: AppVersion -> AppVersion -> AppVersionRange
|
|
mkAppVersionRange v1 v2
|
|
| v1 <= v2 = AppVRange v1 v2
|
|
| otherwise = error "invalid version range"
|
|
|
|
newtype AppCompatible a = AppCompatible_ a
|
|
|
|
pattern AppCompatible :: a -> AppCompatible a
|
|
pattern AppCompatible a <- AppCompatible_ a
|
|
|
|
{-# COMPLETE AppCompatible #-}
|
|
|
|
isAppCompatible :: AppVersion -> AppVersionRange -> Bool
|
|
isAppCompatible v (AppVRange v1 v2) = v1 <= v && v <= v2
|
|
|
|
isCompatibleAppRange :: AppVersionRange -> AppVersionRange -> Bool
|
|
isCompatibleAppRange (AppVRange min1 max1) (AppVRange min2 max2) = min1 <= max2 && min2 <= max1
|
|
|
|
compatibleAppVersion :: AppVersionRange -> AppVersionRange -> Maybe (AppCompatible AppVersion)
|
|
compatibleAppVersion vr1 vr2 =
|
|
min (maxVersion vr1) (maxVersion vr2) `mkCompatibleIf` isCompatibleAppRange vr1 vr2
|
|
|
|
mkCompatibleIf :: AppVersion -> Bool -> Maybe (AppCompatible AppVersion)
|
|
v `mkCompatibleIf` cond = if cond then Just $ AppCompatible_ v else Nothing
|
|
|
|
$(JQ.deriveJSON defaultJSON ''AppVersionRange)
|