urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-21 09:51:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

king: get tests passing after nat-pmp changes

Browse Source
This commit is contained in:
Elliot Glaysher 2020-08-07 13:04:57 -04:00
parent 6368aa2b02
commit 149565cd97
3 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkg/hs/urbit-king/lib/Urbit/King/Main.hs
View File

@ -475,7 +475,7 @@ newShip CLI.New{..} opts = do
-- TODO: We hit the same problem as above: we need the running options to -- TODO: We hit the same problem as above: we need the running options to
-- determine how to configure the ports -- determine how to configure the ports
ports <- buildInactivePorts let ports = buildInactivePorts
-- here we are with a king env, and we now need a multi env. -- here we are with a king env, and we now need a multi env.
runRunningEnv multi ports go runRunningEnv multi ports go
@ -591,7 +591,7 @@ runShip (CLI.Run pierPath) opts daemon = do
buildPortHandler :: (HasLogFunc e) => Bool -> RIO e PortControlApi buildPortHandler :: (HasLogFunc e) => Bool -> RIO e PortControlApi
buildPortHandler False = buildInactivePorts buildPortHandler False = pure $ buildInactivePorts
buildPortHandler True = buildNATPorts buildPortHandler True = buildNATPorts
startBrowser :: HasLogFunc e => FilePath -> RIO e () startBrowser :: HasLogFunc e => FilePath -> RIO e ()

4
pkg/hs/urbit-king/lib/Urbit/Vere/Ports.hs
View File

@ -23,8 +23,8 @@ data PortControlApi = PortControlApi
} }
-- Builds a Ports struct which does nothing when called. -- Builds a Ports struct which does nothing when called.
buildInactivePorts :: RIO e PortControlApi buildInactivePorts :: PortControlApi
buildInactivePorts = pure $ PortControlApi noop noop buildInactivePorts = PortControlApi noop noop
where where
noop x = pure () noop x = pure ()

51
pkg/hs/urbit-king/test/AmesTests.hs
View File

@ -15,6 +15,7 @@ import Urbit.Noun.Time
import Urbit.Prelude import Urbit.Prelude
import Urbit.Vere.Ames import Urbit.Vere.Ames
import Urbit.Vere.Pier.Types import Urbit.Vere.Pier.Types
import Urbit.Vere.Ports
import Control.Concurrent (runInBoundThread) import Control.Concurrent (runInBoundThread)
import Data.LargeWord (LargeKey(..)) import Data.LargeWord (LargeKey(..))
@ -27,7 +28,8 @@ import qualified Urbit.EventLog.LMDB as Log
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
type HasAmes e = (HasLogFunc e, HasNetworkConfig e, HasKingId e) type HasAmes e = (HasLogFunc e, HasNetworkConfig e, HasKingId e,
HasPortControlApi e)
-- Utils ----------------------------------------------------------------------- -- Utils -----------------------------------------------------------------------
@ -41,9 +43,10 @@ sendEf :: Galaxy -> Wen -> Bytes -> NewtEf
sendEf g w bs = NewtEfSend (0, ()) (EachYes g) bs sendEf g w bs = NewtEfSend (0, ()) (EachYes g) bs
data NetworkTestApp = NetworkTestApp data NetworkTestApp = NetworkTestApp
{ _ntaLogFunc :: !LogFunc { _ntaLogFunc :: !LogFunc
, _ntaNetworkConfig :: !NetworkConfig , _ntaNetworkConfig :: !NetworkConfig
, _ntaKingId :: !Word16 , _ntaPortControlApi :: PortControlApi
, _ntaKingId :: !Word16
} }
makeLenses ''NetworkTestApp makeLenses ''NetworkTestApp
@ -57,20 +60,25 @@ instance HasNetworkConfig NetworkTestApp where
instance HasKingId NetworkTestApp where instance HasKingId NetworkTestApp where
kingIdL = ntaKingId kingIdL = ntaKingId
instance HasPortControlApi NetworkTestApp where
portControlApiL = ntaPortControlApi
runNetworkApp :: RIO NetworkTestApp a -> IO a runNetworkApp :: RIO NetworkTestApp a -> IO a
runNetworkApp = runRIO NetworkTestApp runNetworkApp =
{ _ntaLogFunc = mkLogFunc (\_ _ _ _ -> pure ()) runRIO NetworkTestApp
, _ntaKingId = 34 { _ntaLogFunc = mkLogFunc (\_ _ _ _ -> pure ())
, _ntaNetworkConfig = NetworkConfig { _ncNetMode = NMNormal , _ntaKingId = 34
, _ncAmesPort = Nothing , _ntaPortControlApi = buildInactivePorts
, _ncNoAmes = False , _ntaNetworkConfig = NetworkConfig { _ncNetMode = NMNormal
, _ncNoHttp = False , _ncAmesPort = Nothing
, _ncNoHttps = False , _ncNoAmes = False
, _ncHttpPort = Nothing , _ncNoHttp = False
, _ncHttpsPort = Nothing , _ncNoHttps = False
, _ncLocalPort = Nothing , _ncHttpPort = Nothing
} , _ncHttpsPort = Nothing
} , _ncLocalPort = Nothing
}
}
runGala runGala
:: forall e :: forall e
@ -110,8 +118,7 @@ sendThread cb (to, val) = void $ mkRAcquire start cancel
zodSelfMsg :: Property zodSelfMsg :: Property
zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest) zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest)
where where
runTest runTest :: (HasAmes e) => Bytes -> RIO e Bool
:: (HasLogFunc e, HasNetworkConfig e, HasKingId e) => Bytes -> RIO e Bool
runTest val = runRAcquire $ do runTest val = runRAcquire $ do
env <- ask env <- ask
(zodQ, zod) <- runGala 0 (zodQ, zod) <- runGala 0
@ -121,15 +128,13 @@ zodSelfMsg = forAll arbitrary (ioProperty . runNetworkApp . runTest)
twoTalk :: Property twoTalk :: Property
twoTalk = forAll arbitrary (ioProperty . runNetworkApp . runTest) twoTalk = forAll arbitrary (ioProperty . runNetworkApp . runTest)
where where
runTest :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) runTest :: (HasAmes e) => (Word8, Word8, Bytes) -> RIO e Bool
=> (Word8, Word8, Bytes) -> RIO e Bool
runTest (aliceShip, bobShip, val) = runTest (aliceShip, bobShip, val) =
if aliceShip == bobShip if aliceShip == bobShip
then pure True then pure True
else go aliceShip bobShip val else go aliceShip bobShip val
go :: (HasLogFunc e, HasNetworkConfig e, HasKingId e) go :: (HasAmes e) => Word8 -> Word8 -> Bytes -> RIO e Bool
=> Word8 -> Word8 -> Bytes -> RIO e Bool
go aliceShip bobShip val = runRAcquire $ do go aliceShip bobShip val = runRAcquire $ do
(aliceQ, alice) <- runGala aliceShip (aliceQ, alice) <- runGala aliceShip
(bobQ, bob) <- runGala bobShip (bobQ, bob) <- runGala bobShip