mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-10-26 21:56:29 +03:00
remote: add LoggerOpCode
This commit is contained in:
Richard Marko
sorki
parent
2462c9ee90
commit
fb02185c29
@ -23,5 +23,8 @@ deriving via GenericArbitrary ActivityResult
|
||||
deriving via GenericArbitrary Field
|
||||
instance Arbitrary Field
|
||||
|
||||
deriving via GenericArbitrary LoggerOpCode
|
||||
instance Arbitrary LoggerOpCode
|
||||
|
||||
deriving via GenericArbitrary Verbosity
|
||||
instance Arbitrary Verbosity
|
||||
|
||||
@ -5,8 +5,7 @@ module System.Nix.Store.Remote.Logger
|
||||
) where
|
||||
|
||||
import Control.Monad.Except (throwError)
|
||||
import Control.Monad.State.Strict (get)
|
||||
import Data.Serialize.Get (Get, Result(..))
|
||||
import Data.Serialize (Get, Result(..))
|
||||
import System.Nix.Store.Remote.Serialize ()
|
||||
import System.Nix.Store.Remote.Serialize.Prim
|
||||
import System.Nix.Store.Remote.Socket
|
||||
@ -14,30 +13,38 @@ import System.Nix.Store.Remote.MonadStore
|
||||
import System.Nix.Store.Remote.Types
|
||||
|
||||
import qualified Control.Monad
|
||||
import qualified Control.Monad.State.Strict
|
||||
import qualified Data.Serialize
|
||||
import qualified Data.Serialize.Get
|
||||
|
||||
controlParser :: Get Logger
|
||||
controlParser = do
|
||||
ctrl <- getInt
|
||||
case (ctrl :: Int) of
|
||||
0x6f6c6d67 -> Next <$> getByteString
|
||||
0x64617461 -> Read <$> getInt
|
||||
0x64617416 -> Write <$> getByteString
|
||||
0x616c7473 -> pure Last
|
||||
0x63787470 -> flip Error <$> getByteString
|
||||
<*> getInt
|
||||
0x53545254 -> StartActivity <$> (ActivityID <$> getInt)
|
||||
<*> Data.Serialize.get
|
||||
<*> getInt
|
||||
<*> getByteString
|
||||
<*> getFields
|
||||
<*> (ActivityID <$> getInt)
|
||||
0x53544f50 -> StopActivity <$> (ActivityID <$> getInt)
|
||||
0x52534c54 -> Result <$> (ActivityID <$> getInt)
|
||||
<*> getInt
|
||||
<*> getFields
|
||||
x -> fail $ "Invalid control message received:" <> show x
|
||||
ctrl <- Data.Serialize.get
|
||||
case (ctrl :: LoggerOpCode) of
|
||||
LoggerOpCode_Next ->
|
||||
Next <$> getByteString
|
||||
LoggerOpCode_Read ->
|
||||
Read <$> getInt
|
||||
LoggerOpCode_Write ->
|
||||
Write <$> getByteString
|
||||
LoggerOpCode_Last ->
|
||||
pure Last
|
||||
LoggerOpCode_Error ->
|
||||
flip Error <$> getByteString
|
||||
<*> getInt
|
||||
LoggerOpCode_StartActivity ->
|
||||
StartActivity <$> (ActivityID <$> getInt)
|
||||
<*> Data.Serialize.get
|
||||
<*> getInt
|
||||
<*> getByteString
|
||||
<*> getFields
|
||||
<*> (ActivityID <$> getInt)
|
||||
LoggerOpCode_StopActivity ->
|
||||
StopActivity <$> (ActivityID <$> getInt)
|
||||
LoggerOpCode_Result ->
|
||||
Result <$> (ActivityID <$> getInt)
|
||||
<*> getInt
|
||||
<*> getFields
|
||||
|
||||
processOutput :: MonadStore [Logger]
|
||||
processOutput = do
|
||||
@ -50,7 +57,7 @@ processOutput = do
|
||||
e@(Error _ _) -> pure [e]
|
||||
Last -> pure [Last]
|
||||
Read _n -> do
|
||||
(mdata, _) <- get
|
||||
(mdata, _) <- Control.Monad.State.Strict.get
|
||||
case mdata of
|
||||
Nothing -> throwError "No data to read provided"
|
||||
Just part -> do
|
||||
|
||||
@ -133,6 +133,10 @@ instance Serialize Field where
|
||||
put (Field_LogInt x) = putInt (0 :: Word8) >> putInt x
|
||||
put (Field_LogStr x) = putInt (1 :: Word8) >> putByteString x
|
||||
|
||||
instance Serialize LoggerOpCode where
|
||||
get = getInt @Int >>= either fail pure . intToLoggerOpCode
|
||||
put = putInt @Int . loggerOpCodeToInt
|
||||
|
||||
instance Serialize Verbosity where
|
||||
get = getEnum
|
||||
put = putEnum
|
||||
|
||||
@ -32,6 +32,7 @@ module System.Nix.Store.Remote.Serializer
|
||||
, maybeActivity
|
||||
, activityResult
|
||||
, field
|
||||
, loggerOpCode
|
||||
, verbosity
|
||||
) where
|
||||
|
||||
@ -220,5 +221,8 @@ activityResult = liftSerialize
|
||||
field :: NixSerializer r e Field
|
||||
field = liftSerialize
|
||||
|
||||
loggerOpCode :: NixSerializer r e LoggerOpCode
|
||||
loggerOpCode = liftSerialize
|
||||
|
||||
verbosity :: NixSerializer r e Verbosity
|
||||
verbosity = liftSerialize
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
module System.Nix.Store.Remote.Types.Logger
|
||||
( Field(..)
|
||||
, Logger(..)
|
||||
, LoggerOpCode(..)
|
||||
, loggerOpCodeToInt
|
||||
, intToLoggerOpCode
|
||||
, isError
|
||||
-- to be nuked/newtyped
|
||||
, ActivityType
|
||||
@ -20,8 +23,42 @@ data Field
|
||||
| Field_LogInt Int
|
||||
deriving (Eq, Generic, Ord, Show)
|
||||
|
||||
data Logger =
|
||||
Next ByteString
|
||||
data LoggerOpCode
|
||||
= LoggerOpCode_Next
|
||||
| LoggerOpCode_Read
|
||||
| LoggerOpCode_Write
|
||||
| LoggerOpCode_Last
|
||||
| LoggerOpCode_Error
|
||||
| LoggerOpCode_StartActivity
|
||||
| LoggerOpCode_StopActivity
|
||||
| LoggerOpCode_Result
|
||||
deriving (Eq, Generic, Ord, Show)
|
||||
|
||||
loggerOpCodeToInt :: LoggerOpCode -> Int
|
||||
loggerOpCodeToInt = \case
|
||||
LoggerOpCode_Next -> 0x6f6c6d67
|
||||
LoggerOpCode_Read -> 0x64617461
|
||||
LoggerOpCode_Write -> 0x64617416
|
||||
LoggerOpCode_Last -> 0x616c7473
|
||||
LoggerOpCode_Error -> 0x63787470
|
||||
LoggerOpCode_StartActivity -> 0x53545254
|
||||
LoggerOpCode_StopActivity -> 0x53544f50
|
||||
LoggerOpCode_Result -> 0x52534c54
|
||||
|
||||
intToLoggerOpCode :: Int -> Either String LoggerOpCode
|
||||
intToLoggerOpCode = \case
|
||||
0x6f6c6d67 -> Right LoggerOpCode_Next
|
||||
0x64617461 -> Right LoggerOpCode_Read
|
||||
0x64617416 -> Right LoggerOpCode_Write
|
||||
0x616c7473 -> Right LoggerOpCode_Last
|
||||
0x63787470 -> Right LoggerOpCode_Error
|
||||
0x53545254 -> Right LoggerOpCode_StartActivity
|
||||
0x53544f50 -> Right LoggerOpCode_StopActivity
|
||||
0x52534c54 -> Right LoggerOpCode_Result
|
||||
x -> Left $ "Invalid LoggerOpCode: " ++ show x
|
||||
|
||||
data Logger
|
||||
= Next ByteString
|
||||
| Read Int -- data needed from source
|
||||
| Write ByteString -- data for sink
|
||||
| Last
|
||||
|
||||
@ -85,4 +85,5 @@ spec = parallel $ do
|
||||
prop "Maybe Activity" $ roundtripS maybeActivity
|
||||
prop "ActivityResult" $ roundtripS activityResult
|
||||
prop "Field" $ roundtripS field
|
||||
prop "LoggerOpCode" $ roundtripS loggerOpCode
|
||||
prop "Verbosity" $ roundtripS verbosity
|
||||
|
||||
@ -114,6 +114,7 @@ spec = parallel $ do
|
||||
prop "ActivityID" $ roundtripS @ActivityID
|
||||
prop "Activity" $ roundtripS @Activity
|
||||
prop "Field" $ roundtripS @Field
|
||||
prop "LoggerOpCode" $ roundtripS @LoggerOpCode
|
||||
prop "Verbosity" $ roundtripS @Verbosity
|
||||
|
||||
describe "Enums" $ do
|
||||
@ -165,6 +166,16 @@ spec = parallel $ do
|
||||
it' "SetExpected" ActivityResult_SetExpected 106
|
||||
it' "PostBuildLogLine" ActivityResult_PostBuildLogLine 107
|
||||
|
||||
describe "LoggerOpCode matches Nix" $ do
|
||||
it' "Next" LoggerOpCode_Next 0x6f6c6d67
|
||||
it' "Read" LoggerOpCode_Read 0x64617461
|
||||
it' "Write" LoggerOpCode_Write 0x64617416
|
||||
it' "Last" LoggerOpCode_Last 0x616c7473
|
||||
it' "Error" LoggerOpCode_Error 0x63787470
|
||||
it' "StartActivity" LoggerOpCode_StartActivity 0x53545254
|
||||
it' "StopActivity" LoggerOpCode_StopActivity 0x53544f50
|
||||
it' "Result" LoggerOpCode_Result 0x52534c54
|
||||
|
||||
describe "Verbosity enum order matches Nix" $ do
|
||||
it' "Error" Verbosity_Error 0
|
||||
it' "Warn" Verbosity_Warn 1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user