diff --git a/hnix.cabal b/hnix.cabal index 477347192..a260d7687 100644 --- a/hnix.cabal +++ b/hnix.cabal @@ -353,12 +353,12 @@ common shared base >= 4.12 && < 5 , data-fix >= 0.3.0 && < 0.4 , exceptions >= 0.10.0 && < 0.11 - , filepath >= 1.4.2 && < 1.5 + , filepath >= 1.4.2 && < 1.6 , optparse-applicative >= 0.14.3 && < 0.19 , relude >= 1.0.0 && < 1.3 , serialise >= 0.2.1 && < 0.3 - , template-haskell >= 2.13 && < 2.22 - , time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.13 + , template-haskell >= 2.13 && < 2.23 + , time >= 1.8.0 && < 1.9 || >= 1.9.3 && < 1.15 ghc-options: -Wall -Wno-incomplete-uni-patterns @@ -435,24 +435,30 @@ library hs-source-dirs: src build-depends: - aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.2 + aeson >= 1.4.2 && < 1.6 || >= 2.0 && < 2.3 , array >= 0.4 && < 0.6 , base16-bytestring >= 0.1.1 && < 1.1 , binary >= 0.8.5 && < 0.9 - , bytestring >= 0.10.8 && < 0.12 - , cryptonite + , bytestring >= 0.10.8 && < 0.13 + , crypton , comonad >= 5.0.4 && < 5.1 - , containers >= 0.5.11.0 && < 0.7 + , containers >= 0.5.11.0 && < 0.8 + , constraints-extras + , data-default-class , deepseq >= 1.4.3 && <1.6 + , dependent-sum > 0.7 , deriving-compat >= 0.3 && < 0.7 , directory >= 1.3.1 && < 1.4 + , dlist , extra >= 1.7 && < 1.8 , free >= 5.1 && < 5.3 , gitrev >= 1.1.0 && < 1.4 - , hashable >= 1.2.5 && < 1.5 + , hashable >= 1.2.5 && < 1.6 , hashing >= 0.1.0 && < 0.2 - , hnix-store-core >= 0.6.0 && < 0.7 - , hnix-store-remote >= 0.6.0 && < 0.7 + , hnix-store-core >= 0.8.0 && < 0.9 + , hnix-store-nar >= 0.1.0 && < 0.2 + , hnix-store-readonly >= 0.1.0 && < 0.2 + , hnix-store-remote >= 0.7.0 && < 0.8 , http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.8 , http-client-tls >= 0.3.5 && < 0.4 , http-types >= 0.12.2 && < 0.13 @@ -460,7 +466,7 @@ library , lens-family-core >= 1.2.2 && < 2.2 , lens-family-th >= 0.5.0 && < 0.6 , logict >= 0.6.0 && < 0.7 || >= 0.7.0.2 && < 0.9 - , megaparsec >= 7.0 && < 9.6 + , megaparsec >= 7.0 && < 9.7 , monad-control >= 1.0.2 && < 1.1 , monadlist >= 0.0.2 && < 0.1 , mtl >= 2.2.2 && < 2.4 diff --git a/src/Nix/Builtins.hs b/src/Nix/Builtins.hs index 4ff48ed1f..54a4063cd 100644 --- a/src/Nix/Builtins.hs +++ b/src/Nix/Builtins.hs @@ -78,6 +78,9 @@ import Nix.Value.Equal import Nix.Value.Monad import Nix.XML import System.Nix.Base32 as Base32 +import System.Nix.Store.Types ( FileIngestionMethod(..) + , RepairMode(..) + ) import System.PosixCompat.Files ( isRegularFile , isDirectory , isSymbolicLink @@ -912,7 +915,15 @@ pathNix arg = name <- toText <$> attrGetOr (takeFileName path) (fmap (coerce . toString) . fromStringNoContext) "name" attrs recursive <- attrGetOr True pure "recursive" attrs - Right (coerce . toText . coerce @StorePath @String -> s) <- addToStore name (NarFile path) recursive False + Right (coerce . toText . coerce @StorePath @String -> s) + <- addToStore + name + (NarFile path) + (if recursive + then FileIngestionMethod_FileRecursive + else FileIngestionMethod_Flat + ) + RepairMode_DontRepair -- TODO: Ensure that s matches sha256 when not empty pure $ NVStr $ mkNixStringWithSingletonContext (StringContext DirectPath s) s where diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs index 7ca87a6eb..656a5d302 100644 --- a/src/Nix/Effects.hs +++ b/src/Nix/Effects.hs @@ -5,7 +5,6 @@ {-# language DataKinds #-} {-# language GeneralizedNewtypeDeriving #-} {-# language UndecidableInstances #-} -{-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ {-# language TypeOperators #-} {-# options_ghc -Wno-orphans #-} @@ -18,12 +17,13 @@ import Nix.Prelude hiding ( putStrLn ) import qualified Nix.Prelude as Prelude import GHC.Exception ( ErrorCall(ErrorCall) ) -import qualified Data.HashSet as HS +import Data.Default.Class ( Default(def) ) +import Data.DList ( DList ) +import Data.Some ( Some(Some) ) import qualified Data.Text as Text import Network.HTTP.Client hiding ( path, Proxy ) import Network.HTTP.Client.TLS import Network.HTTP.Types -import qualified "cryptonite" Crypto.Hash as Hash import Nix.Utils.Fix1 import Nix.Expr.Types.Annotated import Nix.Frames hiding ( Proxy ) @@ -33,11 +33,18 @@ import Nix.Value import qualified Paths_hnix import System.Exit import qualified System.Info -import System.Process - +import System.Nix.Hash ( HashAlgo(HashAlgo_SHA256) ) +import System.Nix.Store.Types ( FileIngestionMethod(..) + , RepairMode(..) + ) +import System.Nix.Store.Remote ( Logger + , RemoteStoreError + , StoreText(..) + ) import qualified System.Nix.Store.Remote as Store.Remote import qualified System.Nix.StorePath as Store import qualified System.Nix.Nar as Store.Nar +import System.Process -- | A path into the nix store newtype StorePath = StorePath Path @@ -293,7 +300,7 @@ baseNameOf a = Text.takeWhileEnd (/='/') $ Text.dropWhileEnd (=='/') a -- conversion from Store.StorePath to Effects.StorePath, different type with the same name. toStorePath :: Store.StorePath -> StorePath -toStorePath = StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath +toStorePath = StorePath . coerce . decodeUtf8 @FilePath @ByteString . Store.storePathToRawFilePath def -- ** Instances @@ -317,7 +324,7 @@ instance MonadHttp IO where (pure $ Left $ ErrorCall $ "fail, got " <> show status <> " when fetching url = " <> urlstr) -- using addTextToStore' result in different hash from the addToStore. -- see https://github.com/haskell-nix/hnix/pull/1051#issuecomment-1031380804 - (addToStore name (NarText $ toStrict body) False False) + (addToStore name (NarText $ toStrict body) FileIngestionMethod_Flat RepairMode_DontRepair) (status == 200) @@ -374,12 +381,8 @@ print = putStrLn . show -- ** Data type synonyms -type RecursiveFlag = Bool -type RepairFlag = Bool type StorePathName = Text type PathFilter m = Path -> m Bool -type StorePathSet = HS.HashSet StorePath - -- ** @class MonadStore m@ @@ -396,14 +399,14 @@ class -- | Copy the contents of a local path(Or pure text) to the store. The resulting store -- path is returned. Note: This does not support yet support the expected -- `filter` function that allows excluding some files. - addToStore :: StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) - default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> NarContent -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath) + addToStore :: StorePathName -> NarContent -> FileIngestionMethod -> RepairMode -> m (Either ErrorCall StorePath) + default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> NarContent -> FileIngestionMethod -> RepairMode -> m (Either ErrorCall StorePath) addToStore a b c d = lift $ addToStore a b c d -- | Like addToStore, but the contents written to the output path is a -- regular file containing the given string. - addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) - default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath) + addTextToStore' :: StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m (Either ErrorCall StorePath) + default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m (Either ErrorCall StorePath) addTextToStore' a b c d = lift $ addTextToStore' a b c d @@ -413,37 +416,58 @@ instance MonadStore IO where addToStore name content recursive repair = either - (\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> err) + (\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> show err) (\ pathName -> do - res <- Store.Remote.runStore $ Store.Remote.addToStore @Hash.SHA256 pathName (toNarSource content) recursive repair + res <- + Store.Remote.runStore + $ Store.Remote.addToStore + pathName + (toNarSource content) + recursive + (Some HashAlgo_SHA256) + repair either Left -- err (pure . toStorePath) -- store path <$> parseStoreResult "addToStore" res ) - (Store.makeStorePathName name) + (Store.mkStorePathName name) addTextToStore' name text references repair = - do - res <- Store.Remote.runStore $ Store.Remote.addTextToStore name text references repair - either - Left -- err - (pure . toStorePath) -- path - <$> parseStoreResult "addTextToStore" res + either + (\ err -> pure $ Left $ ErrorCall $ "String '" <> show name <> "' is not a valid path name: " <> show err) + (\ pathName -> + do + res <- + Store.Remote.runStore + $ Store.Remote.addTextToStore + (StoreText pathName text) + references + repair + either + Left -- err + (pure . toStorePath) -- path + <$> parseStoreResult "addTextToStore" res + ) + (Store.mkStorePathName name) -- ** Functions -parseStoreResult :: Monad m => Text -> (Either String a, [Store.Remote.Logger]) -> m (Either ErrorCall a) +parseStoreResult + :: Monad m + => Text + -> (Either RemoteStoreError a, DList Logger) + -> m (Either ErrorCall a) parseStoreResult name (res, logs) = pure $ either - (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> msg <> "\n" <> show logs) + (\ msg -> Left $ ErrorCall $ "Failed to execute '" <> toString name <> "': " <> show msg <> "\n" <> show logs) pure res -addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath +addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> HashSet Store.StorePath -> RepairMode -> m StorePath addTextToStore a b c d = either throwError @@ -457,7 +481,11 @@ addPath p = either throwError pure - =<< addToStore (fromString $ coerce takeFileName p) (NarFile p) True False + =<< addToStore + (fromString $ coerce takeFileName p) + (NarFile p) + FileIngestionMethod_FileRecursive + RepairMode_DontRepair toFile_ :: (Framed e m, MonadStore m) => Path -> Text -> m StorePath -toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty False +toFile_ p contents = addTextToStore (fromString $ coerce p) contents mempty RepairMode_DontRepair diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs index 27438011d..c9dc83508 100644 --- a/src/Nix/Effects/Derivation.hs +++ b/src/Nix/Effects/Derivation.hs @@ -1,6 +1,7 @@ {-# language DataKinds #-} {-# language NamedFieldPuns #-} {-# language RecordWildCards #-} +{-# language RankNTypes #-} {-# language PackageImports #-} -- 2021-07-05: Due to hashing Haskell IT system situation, in HNix we currently ended-up with 2 hash package dependencies @{hashing, cryptonite}@ module Nix.Effects.Derivation ( defaultDerivationStrict ) where @@ -10,6 +11,11 @@ import GHC.Exception ( ErrorCall(ErrorCall) ) import Data.Char ( isAscii , isAlphaNum ) +import "crypton" Crypto.Hash (Digest, SHA256) +import qualified "crypton" Crypto.Hash +import Data.Constraint.Extras (Has(has)) +import Data.Dependent.Sum (DSum((:=>))) +import Data.Default.Class (Default(def)) import qualified Data.HashMap.Lazy as M import qualified Data.HashMap.Strict as MS ( insert ) import qualified Data.HashSet as S @@ -21,8 +27,6 @@ import qualified Data.Text as Text import Text.Megaparsec import Text.Megaparsec.Char -import qualified "cryptonite" Crypto.Hash as Hash -- 2021-07-05: Attrocity of Haskell hashing situation, in HNix we ended-up with 2 hash package dependencies @{hashing, cryptonite}@ - import Nix.Atoms import Nix.Expr.Types hiding ( Recursive ) import Nix.Convert @@ -38,8 +42,11 @@ import Nix.String.Coerce import Nix.Value import Nix.Value.Monad -import qualified System.Nix.ReadonlyStore as Store -import qualified System.Nix.Hash as Store +import System.Nix.Base (BaseEncoding(Base16)) +import System.Nix.Hash (HashAlgo, NamedAlgo) +import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..)) +import qualified System.Nix.Store.ReadOnly as Store +import qualified System.Nix.Hash import qualified System.Nix.StorePath as Store @@ -52,22 +59,19 @@ data Derivation = Derivation , builder :: Text -- should be typed as a store path , args :: [ Text ] , env :: Map Text Text - , mFixed :: Maybe Store.SomeNamedDigest - , hashMode :: HashMode + , mFixed :: Maybe (DSum HashAlgo Digest) + , hashMode :: FileIngestionMethod , useJson :: Bool } deriving Show -data HashMode = Flat | Recursive - deriving (Show, Eq) - makeStorePathName :: (Framed e m) => Text -> m Store.StorePathName -makeStorePathName name = case Store.makeStorePathName name of - Left err -> throwError $ ErrorCall $ "Invalid name '" <> show name <> "' for use in a store path: " <> err +makeStorePathName name = case Store.mkStorePathName name of + Left err -> throwError $ ErrorCall $ "Invalid name '" <> show name <> "' for use in a store path: " <> show err Right spname -> pure spname parsePath :: (Framed e m) => Text -> m Store.StorePath -parsePath p = case Store.parsePath "/nix/store" (encodeUtf8 p) of +parsePath p = case Store.parsePath def (encodeUtf8 p) of Left err -> throwError $ ErrorCall $ "Cannot parse store path " <> show p <> ":\n" <> show err Right path -> pure path @@ -75,26 +79,31 @@ writeDerivation :: (Framed e m, MonadStore m) => Derivation -> m Store.StorePath writeDerivation drv@Derivation{inputs, name} = do let (inputSrcs, inputDrvs) = inputs references <- Set.fromList <$> traverse parsePath (Set.toList $ inputSrcs <> Set.fromList (Map.keys inputDrvs)) - path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) False + path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) RepairMode_DontRepair parsePath $ fromString $ coerce path -- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash. -- this avoids propagating changes to their .drv when the output hash stays the same. -hashDerivationModulo :: (MonadNix e t f m, MonadState (b, KeyMap Text) m) => Derivation -> m (Hash.Digest Hash.SHA256) +hashDerivationModulo + :: ( MonadNix e t f m + , MonadState (b, KeyMap Text) m + ) + => Derivation + -> m (Digest SHA256) hashDerivationModulo Derivation - { mFixed = Just (Store.SomeDigest (digest :: Hash.Digest hashType)) + { mFixed = Just (hashAlgo :=> digest) , outputs , hashMode } = case Map.toList outputs of [("out", path)] -> pure $ - Hash.hash @ByteString @Hash.SHA256 $ + Crypto.Hash.hash @ByteString @SHA256 $ encodeUtf8 $ "fixed:out" - <> (if hashMode == Recursive then ":r" else mempty) - <> ":" <> (Store.algoName @hashType) - <> ":" <> Store.encodeDigestWith Store.Base16 digest + <> (if hashMode == FileIngestionMethod_FileRecursive then ":r" else mempty) + <> ":" <> System.Nix.Hash.algoToText hashAlgo + <> ":" <> System.Nix.Hash.encodeDigestWith Base16 digest <> ":" <> path _outputsList -> throwError $ ErrorCall $ "This is weird. A fixed output drv should only have one output named 'out'. Got " <> show _outputsList hashDerivationModulo @@ -112,14 +121,14 @@ hashDerivationModulo maybe (do drv' <- readDerivation $ coerce $ toString path - hash <- Store.encodeDigestWith Store.Base16 <$> hashDerivationModulo drv' + hash <- System.Nix.Hash.encodeDigestWith Base16 <$> hashDerivationModulo drv' pure (hash, outs) ) (\ hash -> pure (hash, outs)) (M.lookup path cache) ) (Map.toList inputDrvs) - pure $ Hash.hash @ByteString @Hash.SHA256 $ encodeUtf8 $ unparseDrv $ drv {inputs = (inputSrcs, inputsModulo)} + pure $ Crypto.Hash.hash @ByteString @SHA256 $ encodeUtf8 $ unparseDrv $ drv {inputs = (inputSrcs, inputsModulo)} unparseDrv :: Derivation -> Text unparseDrv Derivation{..} = @@ -145,12 +154,17 @@ unparseDrv Derivation{..} = ] where produceOutputInfo (outputName, outputPath) = - let prefix = if hashMode == Recursive then "r:" else mempty in + let prefix = + if hashMode == FileIngestionMethod_FileRecursive + then "r:" + else mempty + in parens $ (s <$>) $ ([outputName, outputPath] <>) $ maybe [mempty, mempty] - (\ (Store.SomeDigest (digest :: Hash.Digest hashType)) -> - [prefix <> Store.algoName @hashType, Store.encodeDigestWith Store.Base16 digest] + (\ (hashAlgo :=> digest) -> + [ prefix <> System.Nix.Hash.algoToText hashAlgo + , System.Nix.Hash.encodeDigestWith Base16 digest] ) mFixed parens :: [Text] -> Text @@ -223,21 +237,21 @@ derivationParser = do serializeList :: Parsec () Text a -> Parsec () Text [a] serializeList = wrap "[" "]" - parseFixed :: [(Text, Text, Text, Text)] -> (Maybe Store.SomeNamedDigest, HashMode) + parseFixed :: [(Text, Text, Text, Text)] -> (Maybe (DSum HashAlgo Digest), FileIngestionMethod) parseFixed fullOutputs = case fullOutputs of [("out", _path, rht, hash)] | rht /= mempty && hash /= mempty -> let (hashType, hashMode) = case Text.splitOn ":" rht of - ["r", ht] -> (ht, Recursive) - [ht] -> (ht, Flat) + ["r", ht] -> (ht, FileIngestionMethod_FileRecursive) + [ht] -> (ht, FileIngestionMethod_Flat) _ -> error $ "Unsupported hash type for output of fixed-output derivation in .drv file: " <> show fullOutputs in either -- Please, no longer `error show` after migrating to Text (\ err -> error $ show $ "Unsupported hash " <> show (hashType <> ":" <> hash) <> "in .drv file: " <> err) (\ digest -> (pure digest, hashMode)) - (Store.mkNamedDigest hashType hash) - _ -> (Nothing, Flat) + (System.Nix.Hash.mkNamedDigest hashType hash) + _ -> (Nothing, FileIngestionMethod_Flat) defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, KeyMap Text) m) => NValue t f m -> m (NValue t f m) @@ -254,9 +268,16 @@ defaultDerivationStrict val = do -- Compute the output paths, and add them to the environment if needed. -- Also add the inputs, just computed from the strings contexts. drv' <- case mFixed drv of - Just (Store.SomeDigest digest) -> do + Just (hashAlgo :=> (digest :: Digest a)) -> do let - out = pathToText $ Store.makeFixedOutputPath "/nix/store" (hashMode drv == Recursive) digest drvName + -- XXX: NamedAlgo :/ + out = pathToText + $ has @NamedAlgo hashAlgo + $ Store.makeFixedOutputPath @a + def + (hashMode drv) + digest + drvName env' = ifNotJsonModEnv $ Map.insert "out" out pure $ drv { inputs, env = env', outputs = one ("out", out) } @@ -283,7 +304,7 @@ defaultDerivationStrict val = do (coerce @Text @VarName -> drvPath) <- pathToText <$> writeDerivation drv' -- Memoize here, as it may be our last chance in case of readonly stores. - drvHash <- Store.encodeDigestWith Store.Base16 <$> hashDerivationModulo drv' + drvHash <- System.Nix.Hash.encodeDigestWith Base16 <$> hashDerivationModulo drv' modify $ second $ MS.insert (coerce drvPath) drvHash let @@ -299,11 +320,11 @@ defaultDerivationStrict val = do where - pathToText = decodeUtf8 . Store.storePathToRawFilePath + pathToText = decodeUtf8 . Store.storePathToRawFilePath def makeOutputPath o h n = do name <- makeStorePathName $ Store.unStorePathName n <> if o == "out" then mempty else "-" <> o - pure $ pathToText $ Store.makeStorePath "/nix/store" ("output:" <> encodeUtf8 o) h name + pure $ pathToText $ Store.makeStorePath def ("output:" <> encodeUtf8 o) h name toStorePaths :: HashSet StringContext -> (Set Text, Map Text [Text]) toStorePaths = foldl (flip addToInputs) mempty @@ -335,7 +356,7 @@ buildDerivationWithContext drvAttrs = do builder <- getAttr "builder" extractNixString platform <- getAttr "system" $ assertNonNull <=< extractNoCtx mHash <- getAttrOr "outputHash" mempty $ (pure . pure) <=< extractNoCtx - hashMode <- getAttrOr "outputHashMode" Flat $ parseHashMode <=< extractNoCtx + hashMode <- getAttrOr "outputHashMode" FileIngestionMethod_Flat $ parseFileIngestionMethod <=< extractNoCtx outputs <- getAttrOr "outputs" (one "out") $ traverse (extractNoCtx <=< fromValue') mFixedOutput <- @@ -344,7 +365,12 @@ buildDerivationWithContext drvAttrs = do (\ hash -> do when (outputs /= one "out") $ lift $ throwError $ ErrorCall "Multiple outputs are not supported for fixed-output derivations" hashType <- getAttr "outputHashAlgo" extractNoCtx - digest <- lift $ either (throwError . ErrorCall) pure $ Store.mkNamedDigest hashType hash + digest <- + lift + $ either + (throwError . ErrorCall) + pure + $ System.Nix.Hash.mkNamedDigest (if Text.null hashType then "sha256" else hashType) hash pure $ pure digest) mHash @@ -429,10 +455,10 @@ buildDerivationWithContext drvAttrs = do when (Text.null t) $ lift $ throwError $ ErrorCall "Value must not be empty" pure t - parseHashMode :: MonadNix e t f m => Text -> WithStringContextT m HashMode - parseHashMode = \case - "flat" -> pure Flat - "recursive" -> pure Recursive + parseFileIngestionMethod :: MonadNix e t f m => Text -> WithStringContextT m FileIngestionMethod + parseFileIngestionMethod = \case + "flat" -> pure FileIngestionMethod_Flat + "recursive" -> pure FileIngestionMethod_FileRecursive other -> lift $ throwError $ ErrorCall $ "Hash mode " <> show other <> " is not valid. It must be either 'flat' or 'recursive'" -- Other helpers