remote: align record field naming

This commit is contained in:
sorki 2023-12-09 17:29:35 +01:00
parent 656d4dd72d
commit 1f1d437a40
2 changed files with 37 additions and 37 deletions

View File

@ -36,25 +36,25 @@ import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig(..))
import qualified Data.DList import qualified Data.DList
data RemoteStoreState = RemoteStoreState { data RemoteStoreState = RemoteStoreState {
remoteStoreState_config :: ProtoStoreConfig remoteStoreStateConfig :: ProtoStoreConfig
, remoteStoreState_logs :: DList Logger , remoteStoreStateLogs :: DList Logger
, remoteStoreState_mDataSource :: Maybe (Word64 -> IO (Maybe ByteString)) , remoteStoreStateMDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
-- ^ Source for @Logger_Read@, this will be called repeatedly -- ^ Source for @Logger_Read@, this will be called repeatedly
-- as the daemon requests chunks of size @Word64@. -- as the daemon requests chunks of size @Word64@.
-- If the function returns Nothing and daemon tries to read more -- If the function returns Nothing and daemon tries to read more
-- data an error is thrown. -- data an error is thrown.
-- Used by @AddToStoreNar@ and @ImportPaths@ operations. -- Used by @AddToStoreNar@ and @ImportPaths@ operations.
, remoteStoreState_mDataSink :: Maybe (ByteString -> IO ()) , remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
-- ^ Sink for @Logger_Write@, called repeatedly by the daemon -- ^ Sink for @Logger_Write@, called repeatedly by the daemon
-- to dump us some data. Used by @ExportPath@ operation. -- to dump us some data. Used by @ExportPath@ operation.
, remoteStoreState_mNarSource :: Maybe (NarSource IO) , remoteStoreStateMNarSource :: Maybe (NarSource IO)
} }
instance HasStoreDir RemoteStoreState where instance HasStoreDir RemoteStoreState where
hasStoreDir = hasStoreDir . remoteStoreState_config hasStoreDir = hasStoreDir . remoteStoreStateConfig
instance HasProtoVersion RemoteStoreState where instance HasProtoVersion RemoteStoreState where
hasProtoVersion = hasProtoVersion . remoteStoreState_config hasProtoVersion = hasProtoVersion . remoteStoreStateConfig
data RemoteStoreError data RemoteStoreError
= RemoteStoreError_Fixme String = RemoteStoreError_Fixme String
@ -75,9 +75,9 @@ data RemoteStoreError
| RemoteStoreError_LoggerError (Either BasicError ErrorInfo) | RemoteStoreError_LoggerError (Either BasicError ErrorInfo)
| RemoteStoreError_LoggerLeftovers String ByteString -- when there are bytes left over after incremental logger parser is done, (Done x leftover), first param is show x | RemoteStoreError_LoggerLeftovers String ByteString -- when there are bytes left over after incremental logger parser is done, (Done x leftover), first param is show x
| RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result) | RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result)
| RemoteStoreError_NoDataSourceProvided -- remoteStoreState_mDataSource is required but it is Nothing | RemoteStoreError_NoDataSourceProvided -- remoteStoreStateMDataSource is required but it is Nothing
| RemoteStoreError_DataSourceExhausted -- remoteStoreState_mDataSource returned Nothing but more data was requested | RemoteStoreError_DataSourceExhausted -- remoteStoreStateMDataSource returned Nothing but more data was requested
| RemoteStoreError_NoDataSinkProvided -- remoteStoreState_mDataSink is required but it is Nothing | RemoteStoreError_NoDataSinkProvided -- remoteStoreStateMDataSink is required but it is Nothing
| RemoteStoreError_NoNarSourceProvided | RemoteStoreError_NoNarSourceProvided
| RemoteStoreError_OperationFailed | RemoteStoreError_OperationFailed
| RemoteStoreError_ProtocolMismatch | RemoteStoreError_ProtocolMismatch
@ -135,18 +135,18 @@ runRemoteStoreT
-> RemoteStoreT m a -> RemoteStoreT m a
-> m (Either RemoteStoreError a, DList Logger) -> m (Either RemoteStoreError a, DList Logger)
runRemoteStoreT sock = runRemoteStoreT sock =
fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreState_logs)) fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreStateLogs))
. (`runReaderT` sock) . (`runReaderT` sock)
. (`runStateT` emptyState) . (`runStateT` emptyState)
. runExceptT . runExceptT
. _unRemoteStoreT . _unRemoteStoreT
where where
emptyState = RemoteStoreState emptyState = RemoteStoreState
{ remoteStoreState_config = def { remoteStoreStateConfig = def
, remoteStoreState_logs = mempty , remoteStoreStateLogs = mempty
, remoteStoreState_mDataSource = Nothing , remoteStoreStateMDataSource = Nothing
, remoteStoreState_mDataSink = Nothing , remoteStoreStateMDataSink = Nothing
, remoteStoreState_mNarSource = Nothing , remoteStoreStateMNarSource = Nothing
} }
class ( MonadIO m class ( MonadIO m
@ -302,18 +302,18 @@ instance MonadRemoteStore m => MonadRemoteStore (ExceptT RemoteStoreError m)
instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where
getConfig = RemoteStoreT $ gets remoteStoreState_config getConfig = RemoteStoreT $ gets remoteStoreStateConfig
getProtoVersion = RemoteStoreT $ gets hasProtoVersion getProtoVersion = RemoteStoreT $ gets hasProtoVersion
setProtoVersion pv = setProtoVersion pv =
RemoteStoreT $ modify $ \s -> RemoteStoreT $ modify $ \s ->
s { remoteStoreState_config = s { remoteStoreStateConfig =
(remoteStoreState_config s) { protoStoreConfig_protoVersion = pv } (remoteStoreStateConfig s) { protoStoreConfigProtoVersion = pv }
} }
getStoreDir = RemoteStoreT $ gets hasStoreDir getStoreDir = RemoteStoreT $ gets hasStoreDir
setStoreDir sd = setStoreDir sd =
RemoteStoreT $ modify $ \s -> RemoteStoreT $ modify $ \s ->
s { remoteStoreState_config = s { remoteStoreStateConfig =
(remoteStoreState_config s) { protoStoreConfig_dir = sd } (remoteStoreStateConfig s) { protoStoreConfigDir = sd }
} }
getStoreSocket = RemoteStoreT ask getStoreSocket = RemoteStoreT ask
@ -321,18 +321,18 @@ instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where
appendLog x = appendLog x =
RemoteStoreT RemoteStoreT
$ modify $ modify
$ \s -> s { remoteStoreState_logs = remoteStoreState_logs s `Data.DList.snoc` x } $ \s -> s { remoteStoreStateLogs = remoteStoreStateLogs s `Data.DList.snoc` x }
setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = pure x } setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSource = pure x }
getDataSource = RemoteStoreT (gets remoteStoreState_mDataSource) getDataSource = RemoteStoreT (gets remoteStoreStateMDataSource)
clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = Nothing } clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSource = Nothing }
setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = pure x } setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSink = pure x }
getDataSink = RemoteStoreT (gets remoteStoreState_mDataSink) getDataSink = RemoteStoreT (gets remoteStoreStateMDataSink)
clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = Nothing } clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMDataSink = Nothing }
setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mNarSource = pure x } setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreStateMNarSource = pure x }
takeNarSource = RemoteStoreT $ do takeNarSource = RemoteStoreT $ do
x <- remoteStoreState_mNarSource <$> get x <- remoteStoreStateMNarSource <$> get
modify $ \s -> s { remoteStoreState_mNarSource = Nothing } modify $ \s -> s { remoteStoreStateMNarSource = Nothing }
pure x pure x

View File

@ -18,8 +18,8 @@ instance HasStoreSocket Socket where
hasStoreSocket = id hasStoreSocket = id
data ProtoStoreConfig = ProtoStoreConfig data ProtoStoreConfig = ProtoStoreConfig
{ protoStoreConfig_dir :: StoreDir { protoStoreConfigDir :: StoreDir
, protoStoreConfig_protoVersion :: ProtoVersion , protoStoreConfigProtoVersion :: ProtoVersion
} deriving (Eq, Generic, Ord, Show) } deriving (Eq, Generic, Ord, Show)
instance Default ProtoStoreConfig where instance Default ProtoStoreConfig where
@ -29,12 +29,12 @@ instance HasStoreDir StoreDir where
hasStoreDir = id hasStoreDir = id
instance HasStoreDir ProtoStoreConfig where instance HasStoreDir ProtoStoreConfig where
hasStoreDir = protoStoreConfig_dir hasStoreDir = protoStoreConfigDir
instance HasProtoVersion ProtoStoreConfig where instance HasProtoVersion ProtoStoreConfig where
hasProtoVersion = protoStoreConfig_protoVersion hasProtoVersion = protoStoreConfigProtoVersion
data StoreConfig = StoreConfig data StoreConfig = StoreConfig
{ storeConfig_dir :: Maybe StoreDir { storeConfigDir :: Maybe StoreDir
, storeConfig_socketPath :: FilePath , storeConfigSocketPath :: FilePath
} deriving (Eq, Generic, Ord, Show) } deriving (Eq, Generic, Ord, Show)