diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,16 @@ # Revision history for hnix-store-remote +## [next](https://github.com/haskell-nix/hnix-store/compare/0.4.1.0...0.4.2.0) 2021-03-12 + +* Additional: + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/5d03ffc43cde9448df05e84838ece70cc83b1b6c) Cabal now properly states `tasty-discover` as `build-tool-depends`. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/b5ad38573d27e0732d0fadfebd98de1f753b4f07) added explicit `hie.yml` cradle description for `cabal` to help Haskell Language Server to work with monorepo. + + * [(link)](https://github.com/haskell-nix/hnix-store/commit/cf04083aba98ad40d183d1e26251101816cc07ae) Nix dev env: removed GHC 8.6.5 support, afaik it is not even in Nixpkgs anymore. + + ## [0.4.1.0](https://github.com/haskell-nix/hnix-store/compare/0.4.0.0...0.4.1.0) 2021-01-16 * `System.Nix.Store.Remote`: module API now re-exports `System.Nix.Store.Remote.Types` API diff --git a/hnix-store-remote.cabal b/hnix-store-remote.cabal --- a/hnix-store-remote.cabal +++ b/hnix-store-remote.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hnix-store-remote -version: 0.4.1.0 +version: 0.4.2.0 synopsis: Remote hnix store description: Implementation of the nix store using the daemon protocol. homepage: https://github.com/haskell-nix/hnix-store @@ -67,6 +67,8 @@ , Spec , Util hs-source-dirs: tests + build-tool-depends: + tasty-discover:tasty-discover build-depends: base , hnix-store-core >= 0.3 , hnix-store-remote diff --git a/src/System/Nix/Store/Remote.hs b/src/System/Nix/Store/Remote.hs --- a/src/System/Nix/Store/Remote.hs +++ b/src/System/Nix/Store/Remote.hs @@ -7,8 +7,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RecordWildCards #-} module System.Nix.Store.Remote - ( - addToStore + ( addToStore , addTextToStore , addSignatures , addIndirectRoot @@ -34,18 +33,34 @@ , verifyStore , module System.Nix.Store.Remote.Types ) - where +where -import Control.Monad (void, unless, when) -import Data.ByteString.Lazy (ByteString) -import Data.Map.Strict (Map) -import Data.Text (Text) +import Control.Monad ( void + , unless + , when + ) +import Data.ByteString.Lazy ( ByteString ) +import Data.Map.Strict ( Map ) +import Data.Text ( Text ) -import Nix.Derivation (Derivation) -import System.Nix.Build (BuildMode, BuildResult) -import System.Nix.Hash (Digest, NamedAlgo, ValidAlgo, SomeNamedDigest(..), BaseEncoding(Base32)) -import System.Nix.StorePath (StorePath, StorePathName, StorePathSet, StorePathHashAlgo) -import System.Nix.StorePathMetadata (StorePathMetadata(..), StorePathTrust(..)) +import Nix.Derivation ( Derivation ) +import System.Nix.Build ( BuildMode + , BuildResult + ) +import System.Nix.Hash ( Digest + , NamedAlgo + , ValidAlgo + , SomeNamedDigest(..) + , BaseEncoding(Base32) + ) +import System.Nix.StorePath ( StorePath + , StorePathName + , StorePathSet + , StorePathHashAlgo + ) +import System.Nix.StorePathMetadata ( StorePathMetadata(..) + , StorePathTrust(..) + ) import qualified Data.Binary.Put import qualified Data.ByteString.Lazy @@ -68,22 +83,22 @@ type SubstituteFlag = Bool -- | Pack `FilePath` as `Nar` and add it to the store. -addToStore :: forall a. (ValidAlgo a, NamedAlgo a) - => StorePathName -- ^ Name part of the newly created `StorePath` - -> FilePath -- ^ Local `FilePath` to add - -> Bool -- ^ Add target directory recursively - -> (FilePath -> Bool) -- ^ Path filter function - -> RepairFlag -- ^ Only used by local store backend - -> MonadStore StorePath +addToStore + :: forall a + . (ValidAlgo a, NamedAlgo a) + => StorePathName -- ^ Name part of the newly created `StorePath` + -> FilePath -- ^ Local `FilePath` to add + -> Bool -- ^ Add target directory recursively + -> (FilePath -> Bool) -- ^ Path filter function + -> RepairFlag -- ^ Only used by local store backend + -> MonadStore StorePath addToStore name pth recursive _pathFilter _repair = do runOpArgsIO AddToStore $ \yield -> do yield $ Data.ByteString.Lazy.toStrict $ Data.Binary.Put.runPut $ do putText $ System.Nix.StorePath.unStorePathName name - putBool - $ not - $ System.Nix.Hash.algoName @a == "sha256" && recursive + putBool $ not $ System.Nix.Hash.algoName @a == "sha256" && recursive putBool recursive @@ -97,22 +112,22 @@ -- -- Reference accepts repair but only uses it -- to throw error in case of remote talking to nix-daemon. -addTextToStore :: Text -- ^ Name of the text - -> Text -- ^ Actual text to add - -> StorePathSet -- ^ Set of `StorePath`s that the added text references - -> RepairFlag -- ^ Repair flag, must be `False` in case of remote backend - -> MonadStore StorePath +addTextToStore + :: Text -- ^ Name of the text + -> Text -- ^ Actual text to add + -> StorePathSet -- ^ Set of `StorePath`s that the added text references + -> RepairFlag -- ^ Repair flag, must be `False` in case of remote backend + -> MonadStore StorePath addTextToStore name text references' repair = do - when repair $ error "repairing is not supported when building through the Nix daemon" + when repair + $ error "repairing is not supported when building through the Nix daemon" runOpArgs AddTextToStore $ do putText name putText text putPaths references' sockGetPath -addSignatures :: StorePath - -> [ByteString] - -> MonadStore () +addSignatures :: StorePath -> [ByteString] -> MonadStore () addSignatures p signatures = do void $ simpleOpArgs AddSignatures $ do putPath p @@ -132,18 +147,17 @@ -- | Build paths if they are an actual derivations. -- -- If derivation output paths are already valid, do nothing. -buildPaths :: StorePathSet - -> BuildMode - -> MonadStore () +buildPaths :: StorePathSet -> BuildMode -> MonadStore () buildPaths ps bm = do void $ simpleOpArgs BuildPaths $ do putPaths ps putInt $ fromEnum bm -buildDerivation :: StorePath - -> Derivation StorePath Text - -> BuildMode - -> MonadStore BuildResult +buildDerivation + :: StorePath + -> Derivation StorePath Text + -> BuildMode + -> MonadStore BuildResult buildDerivation p drv buildMode = do runOpArgs BuildDerivation $ do putPath p @@ -156,7 +170,7 @@ putInt 0 res <- getSocketIncremental $ getBuildResult - return res + pure res ensurePath :: StorePath -> MonadStore () ensurePath pn = do @@ -166,30 +180,33 @@ findRoots :: MonadStore (Map ByteString StorePath) findRoots = do runOp FindRoots - sd <- getStoreDir - res <- getSocketIncremental + sd <- getStoreDir + res <- + getSocketIncremental $ getMany - $ (,) <$> (Data.ByteString.Lazy.fromStrict <$> getByteStringLen) - <*> getPath sd + $ (,) + <$> (Data.ByteString.Lazy.fromStrict <$> getByteStringLen) + <*> getPath sd r <- catRights res - return $ Data.Map.Strict.fromList r - where - catRights :: [(a, Either String b)] -> MonadStore [(a, b)] - catRights = mapM ex + pure $ Data.Map.Strict.fromList r + where + catRights :: [(a, Either String b)] -> MonadStore [(a, b)] + catRights = mapM ex - ex :: (a, Either [Char] b) -> MonadStore (a, b) - ex (x, Right y) = return (x, y) - ex (_x , Left e) = error $ "Unable to decode root: " ++ e + ex :: (a, Either [Char] b) -> MonadStore (a, b) + ex (x , Right y) = pure (x, y) + ex (_x, Left e ) = error $ "Unable to decode root: " <> e isValidPathUncached :: StorePath -> MonadStore Bool isValidPathUncached p = do simpleOpArgs IsValidPath $ putPath p -- | Query valid paths from set, optionally try to use substitutes. -queryValidPaths :: StorePathSet -- ^ Set of `StorePath`s to query - -> SubstituteFlag -- ^ Try substituting missing paths when `True` - -> MonadStore StorePathSet +queryValidPaths + :: StorePathSet -- ^ Set of `StorePath`s to query + -> SubstituteFlag -- ^ Try substituting missing paths when `True` + -> MonadStore StorePathSet queryValidPaths ps substitute = do runOpArgs QueryValidPaths $ do putPaths ps @@ -203,12 +220,10 @@ querySubstitutablePaths :: StorePathSet -> MonadStore StorePathSet querySubstitutablePaths ps = do - runOpArgs QuerySubstitutablePaths $ do - putPaths ps + runOpArgs QuerySubstitutablePaths $ putPaths ps sockGetPaths -queryPathInfoUncached :: StorePath - -> MonadStore StorePathMetadata +queryPathInfoUncached :: StorePath -> MonadStore StorePathMetadata queryPathInfoUncached path = do runOpArgs QueryPathInfo $ do putPath path @@ -219,81 +234,84 @@ deriverPath <- sockGetPathMay narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr - let narHash = case System.Nix.Hash.decodeBase @'System.Nix.Hash.SHA256 Base32 narHashText of - Left e -> error e + let + narHash = + case + System.Nix.Hash.decodeBase @'System.Nix.Hash.SHA256 Base32 narHashText + of + Left e -> error e Right x -> SomeDigest x - references <- sockGetPaths + references <- sockGetPaths registrationTime <- sockGet getTime - narBytes <- Just <$> sockGetInt - ultimate <- sockGetBool + narBytes <- Just <$> sockGetInt + ultimate <- sockGetBool - _sigStrings <- map bsToText <$> sockGetStrings - caString <- sockGetStr + _sigStrings <- fmap bsToText <$> sockGetStrings + caString <- sockGetStr let -- XXX: signatures need pubkey from config sigs = Data.Set.empty contentAddressableAddress = - case System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString of - Left e -> error e + case + System.Nix.Store.Remote.Parsers.parseContentAddressableAddress caString + of + Left e -> error e Right x -> Just x - trust = if ultimate then BuiltLocally - else BuiltElsewhere + trust = if ultimate then BuiltLocally else BuiltElsewhere - return $ StorePathMetadata {..} + pure $ StorePathMetadata{..} queryReferrers :: StorePath -> MonadStore StorePathSet queryReferrers p = do - runOpArgs QueryReferrers $ do - putPath p + runOpArgs QueryReferrers $ putPath p sockGetPaths queryValidDerivers :: StorePath -> MonadStore StorePathSet queryValidDerivers p = do - runOpArgs QueryValidDerivers $ do - putPath p + runOpArgs QueryValidDerivers $ putPath p sockGetPaths queryDerivationOutputs :: StorePath -> MonadStore StorePathSet queryDerivationOutputs p = do - runOpArgs QueryDerivationOutputs $ - putPath p + runOpArgs QueryDerivationOutputs $ putPath p sockGetPaths queryDerivationOutputNames :: StorePath -> MonadStore StorePathSet queryDerivationOutputNames p = do - runOpArgs QueryDerivationOutputNames $ - putPath p + runOpArgs QueryDerivationOutputNames $ putPath p sockGetPaths queryPathFromHashPart :: Digest StorePathHashAlgo -> MonadStore StorePath queryPathFromHashPart storePathHash = do - runOpArgs QueryPathFromHashPart $ - putByteStringLen - $ Data.ByteString.Lazy.fromStrict - $ Data.Text.Encoding.encodeUtf8 - $ System.Nix.Hash.encodeInBase Base32 storePathHash + runOpArgs QueryPathFromHashPart + $ putByteStringLen + $ Data.ByteString.Lazy.fromStrict + $ Data.Text.Encoding.encodeUtf8 + $ System.Nix.Hash.encodeInBase Base32 storePathHash sockGetPath -queryMissing :: StorePathSet - -> MonadStore ( StorePathSet -- Paths that will be built - , StorePathSet -- Paths that have substitutes - , StorePathSet -- Unknown paths - , Integer -- Download size - , Integer) -- Nar size? +queryMissing + :: StorePathSet + -> MonadStore + ( StorePathSet-- Paths that will be built + , StorePathSet -- Paths that have substitutes + , StorePathSet -- Unknown paths + , Integer -- Download size + , Integer -- Nar size? + ) queryMissing ps = do - runOpArgs QueryMissing $ do - putPaths ps + runOpArgs QueryMissing $ putPaths ps willBuild <- sockGetPaths willSubstitute <- sockGetPaths unknown <- sockGetPaths downloadSize' <- sockGetInt narSize' <- sockGetInt - return (willBuild, willSubstitute, unknown, downloadSize', narSize') + pure (willBuild, willSubstitute, unknown, downloadSize', narSize') optimiseStore :: MonadStore () optimiseStore = void $ simpleOp OptimiseStore diff --git a/src/System/Nix/Store/Remote/Binary.hs b/src/System/Nix/Store/Remote/Binary.hs --- a/src/System/Nix/Store/Remote/Binary.hs +++ b/src/System/Nix/Store/Remote/Binary.hs @@ -7,8 +7,8 @@ import Control.Monad import Data.Binary.Get import Data.Binary.Put -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as BSL +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Lazy as BSL putInt :: Integral a => a -> Put putInt = putWord64le . fromIntegral @@ -31,12 +31,11 @@ putByteStringLen x = do putInt len putLazyByteString x - when (len `mod` 8 /= 0) $ - pad $ 8 - (len `mod` 8) - where - len :: Int - len = fromIntegral $ BSL.length x - pad count = sequence_ $ replicate count (putWord8 0) + when (len `mod` 8 /= 0) $ pad $ 8 - (len `mod` 8) + where + len :: Int + len = fromIntegral $ BSL.length x + pad count = sequence_ $ replicate count (putWord8 0) putByteStrings :: Foldable t => t BSL.ByteString -> Put putByteStrings = putMany putByteStringLen @@ -44,11 +43,11 @@ getByteStringLen :: Get ByteString getByteStringLen = do len <- getInt - st <- getLazyByteString len + st <- getLazyByteString len when (len `mod` 8 /= 0) $ do pads <- unpad $ fromIntegral $ 8 - (len `mod` 8) - unless (all (==0) pads) $ fail $ "No zeroes" ++ show (st, len, pads) - return $ BSL.toStrict st + unless (all (== 0) pads) $ fail $ "No zeroes" <> show (st, len, pads) + pure $ BSL.toStrict st where unpad x = sequence $ replicate x getWord8 getByteStrings :: Get [ByteString] diff --git a/src/System/Nix/Store/Remote/Builders.hs b/src/System/Nix/Store/Remote/Builders.hs --- a/src/System/Nix/Store/Remote/Builders.hs +++ b/src/System/Nix/Store/Remote/Builders.hs @@ -4,42 +4,38 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} -module System.Nix.Store.Remote.Builders ( - buildContentAddressableAddress - ) where +module System.Nix.Store.Remote.Builders + ( buildContentAddressableAddress + ) +where -import Data.Text.Lazy (Text) -import System.Nix.Hash ( Digest - , SomeNamedDigest(SomeDigest) - , BaseEncoding(Base32) - ) -import System.Nix.StorePath (ContentAddressableAddress(..)) +import Data.Text.Lazy ( Text ) +import System.Nix.Hash ( Digest + , SomeNamedDigest(SomeDigest) + , BaseEncoding(Base32) + ) +import System.Nix.StorePath ( ContentAddressableAddress(..) + ) -import Data.Text.Lazy.Builder (Builder) +import Data.Text.Lazy.Builder ( Builder ) import qualified Data.Text.Lazy.Builder import qualified System.Nix.Hash -- | Marshall `ContentAddressableAddress` to `Text` -- in form suitable for remote protocol usage. -buildContentAddressableAddress - :: ContentAddressableAddress - -> Text +buildContentAddressableAddress :: ContentAddressableAddress -> Text buildContentAddressableAddress = Data.Text.Lazy.Builder.toLazyText . contentAddressableAddressBuilder -contentAddressableAddressBuilder - :: ContentAddressableAddress - -> Builder +contentAddressableAddressBuilder :: ContentAddressableAddress -> Builder contentAddressableAddressBuilder (Text digest) = - "text:" - <> digestBuilder digest + "text:" <> digestBuilder digest contentAddressableAddressBuilder (Fixed _narHashMode (SomeDigest (digest :: Digest hashAlgo))) = - "fixed:" + "fixed:" <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo) <> digestBuilder digest digestBuilder :: Digest a -> Builder digestBuilder = - Data.Text.Lazy.Builder.fromText - . System.Nix.Hash.encodeInBase Base32 + Data.Text.Lazy.Builder.fromText . System.Nix.Hash.encodeInBase Base32 diff --git a/src/System/Nix/Store/Remote/Logger.hs b/src/System/Nix/Store/Remote/Logger.hs --- a/src/System/Nix/Store/Remote/Logger.hs +++ b/src/System/Nix/Store/Remote/Logger.hs @@ -1,21 +1,25 @@ {-# LANGUAGE RankNTypes #-} -module System.Nix.Store.Remote.Logger ( - Logger(..) + +module System.Nix.Store.Remote.Logger + ( Logger(..) , Field(..) - , processOutput) - where + , processOutput + ) +where + import Control.Monad.Except -import Control.Monad.Reader (ask) -import Control.Monad.State (get) +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( get ) import Data.Binary.Get -import Network.Socket.ByteString (recv) +import Network.Socket.ByteString ( recv ) import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Util + controlParser :: Get Logger controlParser = do ctrl <- getInt @@ -24,43 +28,51 @@ 0x64617461 -> Read <$> getInt 0x64617416 -> Write <$> getByteStringLen 0x616c7473 -> pure Last - 0x63787470 -> flip Error <$> getByteStringLen <*> getInt - 0x53545254 -> StartActivity <$> getInt <*> getInt <*> getInt <*> getByteStringLen <*> getFields <*> getInt + 0x63787470 -> flip Error <$> getByteStringLen + <*> getInt + 0x53545254 -> StartActivity <$> getInt + <*> getInt + <*> getInt + <*> getByteStringLen + <*> getFields + <*> getInt 0x53544f50 -> StopActivity <$> getInt - 0x52534c54 -> Result <$> getInt <*> getInt <*> getFields - x -> fail $ "Invalid control message received:" ++ show x + 0x52534c54 -> Result <$> getInt + <*> getInt + <*> getFields + x -> fail $ "Invalid control message received:" <> show x processOutput :: MonadStore [Logger] processOutput = go decoder - where decoder = runGetIncremental controlParser - go :: Decoder Logger -> MonadStore [Logger] - go (Done _leftover _consumed ctrl) = do - case ctrl of - e@(Error _ _) -> return [e] - Last -> return [Last] - Read _n -> do - (mdata, _) <- get - case mdata of - Nothing -> throwError "No data to read provided" - Just part -> do - -- XXX: we should check/assert part size against n of (Read n) - sockPut $ putByteStringLen part - clearData + where + decoder = runGetIncremental controlParser + go :: Decoder Logger -> MonadStore [Logger] + go (Done _leftover _consumed ctrl) = do + case ctrl of + e@(Error _ _) -> pure [e] + Last -> pure [Last] + Read _n -> do + (mdata, _) <- get + case mdata of + Nothing -> throwError "No data to read provided" + Just part -> do + -- XXX: we should check/assert part size against n of (Read n) + sockPut $ putByteStringLen part + clearData - next <- go decoder - return $ next + next <- go decoder + pure next - -- we should probably handle Read here as well - x -> do - next <- go decoder - return $ x:next - go (Partial k) = do - soc <- storeSocket <$> ask - chunk <- liftIO (Just <$> recv soc 8) - go (k chunk) + -- we should probably handle Read here as well + x -> do + next <- go decoder + pure $ x : next + go (Partial k) = do + soc <- asks storeSocket + chunk <- liftIO (Just <$> recv soc 8) + go (k chunk) - go (Fail _leftover _consumed msg) = do - error msg + go (Fail _leftover _consumed msg) = error msg getFields :: Get [Field] getFields = do @@ -73,4 +85,4 @@ case (typ :: Int) of 0 -> LogInt <$> getInt 1 -> LogStr <$> getByteStringLen - x -> fail $ "Unknown log type: " ++ show x + x -> fail $ "Unknown log type: " <> show x diff --git a/src/System/Nix/Store/Remote/Parsers.hs b/src/System/Nix/Store/Remote/Parsers.hs --- a/src/System/Nix/Store/Remote/Parsers.hs +++ b/src/System/Nix/Store/Remote/Parsers.hs @@ -13,7 +13,7 @@ import Control.Applicative ( (<|>) ) import Data.Attoparsec.ByteString.Char8 import Data.ByteString.Char8 -import Data.Text (Text) +import Data.Text ( Text ) import Data.Text.Encoding ( decodeUtf8 ) import System.Nix.Hash import System.Nix.StorePath ( ContentAddressableAddress(..) @@ -35,7 +35,7 @@ caText = do _ <- "text:sha256:" digest <- decodeBase @'SHA256 Base32 <$> parseHash - either fail return $ Text <$> digest + either fail pure $ Text <$> digest -- | Parser for @fixed:::@ caFixed :: Parser ContentAddressableAddress @@ -43,13 +43,14 @@ _ <- "fixed:" narHashMode <- (pure Recursive <$> "r:") <|> (pure RegularFile <$> "") digest <- parseTypedDigest - either fail return $ Fixed narHashMode <$> digest + either fail pure $ Fixed narHashMode <$> digest parseTypedDigest :: Parser (Either String SomeNamedDigest) parseTypedDigest = mkNamedDigest <$> parseHashType <*> parseHash parseHashType :: Parser Text -parseHashType = decodeUtf8 <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") +parseHashType = + decodeUtf8 <$> ("sha256" <|> "sha512" <|> "sha1" <|> "md5") <* (":" <|> "-") parseHash :: Parser Text parseHash = decodeUtf8 <$> takeWhile1 (/= ':') diff --git a/src/System/Nix/Store/Remote/Protocol.hs b/src/System/Nix/Store/Remote/Protocol.hs --- a/src/System/Nix/Store/Remote/Protocol.hs +++ b/src/System/Nix/Store/Remote/Protocol.hs @@ -1,17 +1,21 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module System.Nix.Store.Remote.Protocol ( - WorkerOp(..) +module System.Nix.Store.Remote.Protocol + ( WorkerOp(..) , simpleOp , simpleOpArgs , runOp , runOpArgs , runOpArgsIO , runStore - , runStoreOpts) where + , runStoreOpts + ) +where -import Control.Exception (bracket) + +import Data.Bool ( bool ) +import Control.Exception ( bracket ) import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State @@ -22,15 +26,18 @@ import qualified Data.ByteString.Char8 import qualified Data.ByteString.Lazy -import Network.Socket (SockAddr(SockAddrUnix)) +import Network.Socket ( SockAddr(SockAddrUnix) ) import qualified Network.Socket -import Network.Socket.ByteString (recv, sendAll) +import Network.Socket.ByteString ( recv + , sendAll + ) import System.Nix.Store.Remote.Binary import System.Nix.Store.Remote.Logger import System.Nix.Store.Remote.Types import System.Nix.Store.Remote.Util + protoVersion :: Int protoVersion = 0x115 -- major protoVersion & 0xFF00 @@ -115,37 +122,42 @@ simpleOp :: WorkerOp -> MonadStore Bool -simpleOp op = do - simpleOpArgs op $ return () +simpleOp op = simpleOpArgs op $ pure () simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool simpleOpArgs op args = do runOpArgs op args err <- gotError - case err of - True -> do + bool + sockGetBool + (do Error _num msg <- head <$> getError throwError $ Data.ByteString.Char8.unpack msg - False -> do - sockGetBool + ) + err runOp :: WorkerOp -> MonadStore () -runOp op = runOpArgs op $ return () +runOp op = runOpArgs op $ pure () runOpArgs :: WorkerOp -> Put -> MonadStore () -runOpArgs op args = runOpArgsIO op (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args) +runOpArgs op args = + runOpArgsIO + op + (\encode -> encode $ Data.ByteString.Lazy.toStrict $ runPut args) -runOpArgsIO :: WorkerOp -> ((Data.ByteString.ByteString -> MonadStore ()) -> MonadStore ()) -> MonadStore () +runOpArgsIO + :: WorkerOp + -> ((Data.ByteString.ByteString -> MonadStore ()) -> MonadStore ()) + -> MonadStore () runOpArgsIO op encoder = do - sockPut $ do - putInt $ opNum op + sockPut $ putInt $ opNum op - soc <- storeSocket <$> ask + soc <- asks storeSocket encoder (liftIO . sendAll soc) out <- processOutput - modify (\(a, b) -> (a, b++out)) + modify (\(a, b) -> (a, b <> out)) err <- gotError when err $ do Error _num msg <- head <$> getError @@ -154,39 +166,44 @@ runStore :: MonadStore a -> IO (Either String a, [Logger]) runStore = runStoreOpts defaultSockPath "/nix/store" -runStoreOpts :: FilePath -> FilePath -> MonadStore a -> IO (Either String a, [Logger]) +runStoreOpts + :: FilePath -> FilePath -> MonadStore a -> IO (Either String a, [Logger]) runStoreOpts sockPath storeRootDir code = do bracket (open sockPath) (Network.Socket.close . storeSocket) run - where - open path = do - soc <- - Network.Socket.socket - Network.Socket.AF_UNIX - Network.Socket.Stream - 0 + where + open path = do + soc <- + Network.Socket.socket + Network.Socket.AF_UNIX + Network.Socket.Stream + 0 - Network.Socket.connect soc (SockAddrUnix path) - return $ StoreConfig { storeSocket = soc - , storeDir = storeRootDir } + Network.Socket.connect soc (SockAddrUnix path) + pure StoreConfig + { storeSocket = soc + , storeDir = storeRootDir + } - greet = do - sockPut $ putInt workerMagic1 - soc <- storeSocket <$> ask - vermagic <- liftIO $ recv soc 16 - let (magic2, _daemonProtoVersion) = - flip runGet (Data.ByteString.Lazy.fromStrict vermagic) - $ (,) <$> (getInt :: Get Int) - <*> (getInt :: Get Int) - unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" + greet = do + sockPut $ putInt workerMagic1 + soc <- asks storeSocket + vermagic <- liftIO $ recv soc 16 + let + (magic2, _daemonProtoVersion) = + flip runGet (Data.ByteString.Lazy.fromStrict vermagic) + $ (,) + <$> (getInt :: Get Int) + <*> (getInt :: Get Int) + unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch" - sockPut $ putInt protoVersion -- clientVersion - sockPut $ putInt (0 :: Int) -- affinity - sockPut $ putInt (0 :: Int) -- obsolete reserveSpace + sockPut $ putInt protoVersion -- clientVersion + sockPut $ putInt (0 :: Int) -- affinity + sockPut $ putInt (0 :: Int) -- obsolete reserveSpace - processOutput + processOutput - run sock = - fmap (\(res, (_data, logs)) -> (res, logs)) - $ flip runReaderT sock - $ flip runStateT (Nothing, []) - $ runExceptT (greet >> code) + run sock = + fmap (\(res, (_data, logs)) -> (res, logs)) + $ (`runReaderT` sock) + $ (`runStateT` (Nothing, [])) + $ runExceptT (greet >> code) diff --git a/src/System/Nix/Store/Remote/Types.hs b/src/System/Nix/Store/Remote/Types.hs --- a/src/System/Nix/Store/Remote/Types.hs +++ b/src/System/Nix/Store/Remote/Types.hs @@ -2,8 +2,8 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} -module System.Nix.Store.Remote.Types ( - MonadStore +module System.Nix.Store.Remote.Types + ( MonadStore , StoreConfig(..) , Logger(..) , Field(..) @@ -14,22 +14,27 @@ , getError , setData , clearData - ) where + ) +where -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as BSL -import Network.Socket (Socket) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Lazy as BSL +import Network.Socket ( Socket ) import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State -data StoreConfig = StoreConfig { - storeDir :: FilePath - , storeSocket :: Socket +data StoreConfig = StoreConfig + { storeDir :: FilePath + , storeSocket :: Socket } -type MonadStore a = ExceptT String (StateT (Maybe BSL.ByteString, [Logger]) (ReaderT StoreConfig IO)) a +type MonadStore a + = ExceptT + String + (StateT (Maybe BSL.ByteString, [Logger]) (ReaderT StoreConfig IO)) + a type ActivityID = Int type ActivityParentID = Int diff --git a/src/System/Nix/Store/Remote/Util.hs b/src/System/Nix/Store/Remote/Util.hs --- a/src/System/Nix/Store/Remote/Util.hs +++ b/src/System/Nix/Store/Remote/Util.hs @@ -8,17 +8,19 @@ import Data.Either import Data.Binary.Get import Data.Binary.Put -import Data.Text (Text) -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TL +import Data.Text ( Text ) +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL import Data.Time import Data.Time.Clock.POSIX -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Lazy as BSL +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as BSL -import Network.Socket.ByteString (recv, sendAll) +import Network.Socket.ByteString ( recv + , sendAll + ) import Nix.Derivation @@ -32,23 +34,21 @@ genericIncremental :: (MonadIO m) => m (Maybe ByteString) -> Get a -> m a genericIncremental getsome parser = go decoder - where - decoder = runGetIncremental parser - go (Done _leftover _consumed x) = do - return x - go (Partial k) = do - chunk <- getsome - go (k chunk) - go (Fail _leftover _consumed msg) = do - error msg + where + decoder = runGetIncremental parser + go (Done _leftover _consumed x ) = pure x + go (Partial k ) = do + chunk <- getsome + go (k chunk) + go (Fail _leftover _consumed msg) = error msg getSocketIncremental :: Get a -> MonadStore a getSocketIncremental = genericIncremental sockGet8 - where - sockGet8 :: MonadStore (Maybe BSC.ByteString) - sockGet8 = do - soc <- asks storeSocket - liftIO $ Just <$> recv soc 8 + where + sockGet8 :: MonadStore (Maybe BSC.ByteString) + sockGet8 = do + soc <- asks storeSocket + liftIO $ Just <$> recv soc 8 sockPut :: Put -> MonadStore () sockPut p = do @@ -72,19 +72,22 @@ sockGetPath :: MonadStore StorePath sockGetPath = do - sd <- getStoreDir + sd <- getStoreDir pth <- getSocketIncremental (getPath sd) - case pth of - Left e -> throwError e - Right x -> return x + either + throwError + pure + pth sockGetPathMay :: MonadStore (Maybe StorePath) sockGetPathMay = do - sd <- getStoreDir + sd <- getStoreDir pth <- getSocketIncremental (getPath sd) - return $ case pth of - Left _e -> Nothing - Right x -> Just x + pure $ + either + (const Nothing) + Just + pth sockGetPaths :: MonadStore StorePathSet sockGetPaths = do @@ -107,26 +110,28 @@ putText = putByteStringLen . textToBSL putTexts :: [Text] -> Put -putTexts = putByteStrings . map textToBSL +putTexts = putByteStrings . fmap textToBSL getPath :: FilePath -> Get (Either String StorePath) getPath sd = parsePath sd <$> getByteStringLen getPaths :: FilePath -> Get StorePathSet -getPaths sd = Data.HashSet.fromList . rights . map (parsePath sd) <$> getByteStrings +getPaths sd = + Data.HashSet.fromList . rights . fmap (parsePath sd) <$> getByteStrings putPath :: StorePath -> Put -putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath +putPath = putByteStringLen . BSL.fromStrict . storePathToRawFilePath putPaths :: StorePathSet -> Put -putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map (BSL.fromStrict . storePathToRawFilePath) +putPaths = putByteStrings . Data.HashSet.toList . Data.HashSet.map + (BSL.fromStrict . storePathToRawFilePath) putBool :: Bool -> Put putBool True = putInt (1 :: Int) putBool False = putInt (0 :: Int) getBool :: Get Bool -getBool = (==1) <$> (getInt :: Get Int) +getBool = (== 1) <$> (getInt :: Get Int) putEnum :: (Enum a) => a -> Put putEnum = putInt . fromEnum @@ -141,22 +146,23 @@ getTime = posixSecondsToUTCTime <$> getEnum getBuildResult :: Get BuildResult -getBuildResult = BuildResult - <$> getEnum - <*> (Just . bsToText <$> getByteStringLen) - <*> getInt - <*> getBool - <*> getTime - <*> getTime +getBuildResult = + BuildResult + <$> getEnum + <*> (Just . bsToText <$> getByteStringLen) + <*> getInt + <*> getBool + <*> getTime + <*> getTime putDerivation :: Derivation StorePath Text -> Put putDerivation Derivation{..} = do flip putMany (Data.Map.toList outputs) $ \(outputName, DerivationOutput{..}) -> do - putText outputName - putPath path - putText hashAlgo - putText hash + putText outputName + putPath path + putText hashAlgo + putText hash putMany putPath inputSrcs putText platform diff --git a/tests/Derivation.hs b/tests/Derivation.hs --- a/tests/Derivation.hs +++ b/tests/Derivation.hs @@ -4,14 +4,21 @@ module Derivation where -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class ( liftIO ) -import Data.Text (Text) -import Nix.Derivation (Derivation(..), DerivationOutput(..)) -import System.Nix.StorePath (StorePath, storePathToText) +import Data.Text ( Text ) +import Nix.Derivation ( Derivation(..) + , DerivationOutput(..) + ) +import System.Nix.StorePath ( StorePath + , storePathToText + ) -import System.Nix.Store.Remote (MonadStore, addToStore, addTextToStore) -import System.Nix.Hash (HashAlgorithm(SHA256)) +import System.Nix.Store.Remote ( MonadStore + , addToStore + , addTextToStore + ) +import System.Nix.Hash ( HashAlgorithm(SHA256) ) import qualified Data.Map import qualified Data.Set @@ -24,13 +31,13 @@ import qualified System.Directory drvSample :: StorePath -> StorePath -> StorePath -> Derivation StorePath Text -drvSample builder' buildScript out = Derivation { - outputs = Data.Map.fromList [ ("out", DerivationOutput out "sha256" "test") ] - , inputDrvs = Data.Map.fromList [ (builder', Data.Set.fromList [ "out" ]) ] - , inputSrcs = Data.Set.fromList [ buildScript ] +drvSample builder' buildScript out = Derivation + { outputs = Data.Map.fromList [("out", DerivationOutput out "sha256" "test")] + , inputDrvs = Data.Map.fromList [(builder', Data.Set.fromList ["out"])] + , inputSrcs = Data.Set.fromList [buildScript] , platform = "x86_64-linux" , builder = storePathToText builder' - , args = Data.Vector.fromList ["-e", storePathToText buildScript ] + , args = Data.Vector.fromList ["-e", storePathToText buildScript] , env = Data.Map.fromList [("testEnv", "true")] } @@ -41,34 +48,35 @@ Nothing -> error "No bash executable found" Just fp -> do let Right n = System.Nix.StorePath.makeStorePathName "bash" - pth <- addToStore @'SHA256 n fp False (pure True) False + pth <- addToStore @ 'SHA256 n fp False (pure True) False action pth withBuildScript :: (StorePath -> MonadStore a) -> MonadStore a withBuildScript action = do - pth <- addTextToStore - "buildScript" - (Data.Text.concat [ "declare -xp", "export > $out" ]) - mempty - False + pth <- addTextToStore "buildScript" + (Data.Text.concat ["declare -xp", "export > $out"]) + mempty + False action pth -withDerivation :: (StorePath -> Derivation StorePath Text -> MonadStore a) -> MonadStore a -withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash -> do - outputPath <- addTextToStore "wannabe-output" "" mempty False +withDerivation + :: (StorePath -> Derivation StorePath Text -> MonadStore a) -> MonadStore a +withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash -> + do + outputPath <- addTextToStore "wannabe-output" "" mempty False - let d = drvSample bash buildScript outputPath + let d = drvSample bash buildScript outputPath - pth <- addTextToStore - "hnix-store-derivation" - (Data.Text.Lazy.toStrict + pth <- addTextToStore + "hnix-store-derivation" + ( Data.Text.Lazy.toStrict $ Data.Text.Lazy.Builder.toLazyText $ System.Nix.Derivation.buildDerivation d - ) - mempty - False + ) + mempty + False - liftIO $ print d - action pth d + liftIO $ print d + action pth d diff --git a/tests/Driver.hs b/tests/Driver.hs --- a/tests/Driver.hs +++ b/tests/Driver.hs @@ -1,4 +1,4 @@ -import NixDaemon +import NixDaemon import qualified Spec -- we run remote tests in diff --git a/tests/NixDaemon.hs b/tests/NixDaemon.hs --- a/tests/NixDaemon.hs +++ b/tests/NixDaemon.hs @@ -5,23 +5,28 @@ module NixDaemon where -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Control.Exception (bracket) -import Control.Concurrent (threadDelay) -import Data.Either (isRight, isLeft) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.HashSet as HS -import qualified Data.Map.Strict as M +import Data.Bool ( bool ) +import Control.Monad ( void ) +import Control.Monad.IO.Class ( liftIO ) +import Control.Exception ( bracket ) +import Control.Concurrent ( threadDelay ) +import Data.Either ( isRight + , isLeft + ) +import Data.Text ( Text ) +import qualified Data.HashSet as HS +import qualified Data.Map.Strict as M import System.Directory import qualified System.Environment import System.IO.Temp -import qualified System.Process as P -import System.Posix.User as U -import System.Linux.Namespaces as NS -import Test.Tasty.Hspec (Spec, describe, context) -import qualified Test.Tasty.Hspec as Hspec +import qualified System.Process as P +import System.Posix.User as U +import System.Linux.Namespaces as NS +import Test.Tasty.Hspec ( Spec + , describe + , context + ) +import qualified Test.Tasty.Hspec as Hspec import Test.Hspec.Expectations.Lifted import System.FilePath @@ -34,39 +39,40 @@ import Derivation -createProcessEnv :: FilePath - -> String - -> [String] - -> IO P.ProcessHandle +createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle createProcessEnv fp proc args = do - mPath <- System.Environment.lookupEnv "PATH" + mPath <- System.Environment.lookupEnv "PATH" - (_, _, _, ph) <- P.createProcess (P.proc proc args) { P.cwd = Just $ fp - , P.env = Just $ mockedEnv mPath fp } - return ph + (_, _, _, ph) <- + P.createProcess (P.proc proc args) + { P.cwd = Just $ fp + , P.env = Just $ mockedEnv mPath fp + } + pure ph mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)] -mockedEnv mEnvPath fp = map (\(a, b) -> (a, b)) [ - ("NIX_STORE_DIR", fp "store") +mockedEnv mEnvPath fp = + [ ("NIX_STORE_DIR" , fp "store") , ("NIX_LOCALSTATE_DIR", fp "var") - , ("NIX_LOG_DIR", fp "var" "log") - , ("NIX_STATE_DIR", fp "var" "nix") - , ("NIX_CONF_DIR", fp "etc") + , ("NIX_LOG_DIR" , fp "var" "log") + , ("NIX_STATE_DIR" , fp "var" "nix") + , ("NIX_CONF_DIR" , fp "etc") -- , ("NIX_REMOTE", "daemon") - ] ++ (maybe [] (\x -> [("PATH", x)]) mEnvPath) + ] <> (maybe [] (\x -> [("PATH", x)]) mEnvPath) waitSocket :: FilePath -> Int -> IO () waitSocket _ 0 = fail "No socket" waitSocket fp x = do ex <- doesFileExist fp - case ex of - True -> return () - False -> threadDelay 100000 >> waitSocket fp (x - 1) + bool + (threadDelay 100000 >> waitSocket fp (x - 1)) + (pure ()) + ex writeConf :: FilePath -> IO () -writeConf fp = do - writeFile fp $ unlines [ - "build-users-group = " +writeConf fp = + writeFile fp $ unlines + [ "build-users-group = " , "trusted-users = root" , "allowed-users = *" , "fsync-metadata = false" @@ -85,14 +91,16 @@ error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e5616122/store': Invalid argument -} -startDaemon :: FilePath -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger])) +startDaemon + :: FilePath + -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger])) startDaemon fp = do writeConf (fp "etc" "nix.conf") p <- createProcessEnv fp "nix-daemon" [] waitSocket sockFp 30 - return (p, runStoreOpts sockFp (fp "store")) - where - sockFp = fp "var/nix/daemon-socket/socket" + pure (p, runStoreOpts sockFp (fp "store")) + where + sockFp = fp "var/nix/daemon-socket/socket" enterNamespaces :: IO () enterNamespaces = do @@ -100,21 +108,20 @@ gid <- getEffectiveGroupID unshare [User, Network, Mount] - -- map our (parent) uid to root + -- fmap our (parent) uid to root writeUserMappings Nothing [UserMapping 0 uid 1] - -- map our (parent) gid to root group + -- fmap our (parent) gid to root group writeGroupMappings Nothing [GroupMapping 0 gid 1] True withNixDaemon :: ((MonadStore a -> IO (Either String a, [Logger])) -> IO a) -> IO a -withNixDaemon action = do +withNixDaemon action = withSystemTempDirectory "test-nix-store" $ \path -> do mapM_ (createDirectory . snd) - (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv Nothing path) + (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv Nothing path) - ini <- createProcessEnv path - "nix-store" ["--init"] + ini <- createProcessEnv path "nix-store" ["--init"] void $ P.waitForProcess ini writeFile (path "dummy") "Hello World" @@ -134,7 +141,8 @@ -> m c -> (a -> Bool) -> Hspec.SpecWith (m () -> IO (a, b)) -it name action check = Hspec.it name $ \run -> (run (action >> return ())) `checks` check +it name action check = + Hspec.it name $ \run -> (run (action >> pure ())) `checks` check itRights :: (Show a, Show b, Show c, Monad m) @@ -160,7 +168,7 @@ dummy = do let Right n = makeStorePathName "dummy" res <- addToStore @'SHA256 n "dummy" False (pure True) False - return res + pure res invalidPath :: StorePath invalidPath = @@ -173,29 +181,29 @@ action path builderSh :: Text -builderSh = T.concat [ "declare -xp", "export > $out" ] +builderSh = "declare -xpexport > $out" spec_protocol :: Spec -spec_protocol = Hspec.around withNixDaemon $ do +spec_protocol = Hspec.around withNixDaemon $ describe "store" $ do - context "syncWithGC" $ do + context "syncWithGC" $ itRights "syncs with garbage collector" syncWithGC context "verifyStore" $ do - itRights "check=False repair=False" $ do + itRights "check=False repair=False" $ verifyStore False False `shouldReturn` False - itRights "check=True repair=False" $ do + itRights "check=True repair=False" $ verifyStore True False `shouldReturn` False --privileged - itRights "check=True repair=True" $ do + itRights "check=True repair=True" $ verifyStore True True `shouldReturn` False - context "addTextToStore" $ do - itRights "adds text to store" $ withPath $ const return () + context "addTextToStore" $ + itRights "adds text to store" $ withPath $ const pure () context "isValidPathUncached" $ do itRights "validates path" $ withPath $ \path -> do @@ -205,18 +213,19 @@ context "queryAllValidPaths" $ do itRights "empty query" $ queryAllValidPaths - itRights "non-empty query" $ withPath $ \path -> queryAllValidPaths `shouldReturn` (HS.fromList [path]) + itRights "non-empty query" $ withPath $ \path -> + queryAllValidPaths `shouldReturn` (HS.fromList [path]) - context "queryPathInfoUncached" $ do + context "queryPathInfoUncached" $ itRights "queries path info" $ withPath $ queryPathInfoUncached - context "ensurePath" $ do + context "ensurePath" $ itRights "simple ensure" $ withPath $ ensurePath - context "addTempRoot" $ do + context "addTempRoot" $ itRights "simple addition" $ withPath $ addTempRoot - context "addIndirectRoot" $ do + context "addIndirectRoot" $ itRights "simple addition" $ withPath $ addIndirectRoot context "buildPaths" $ do @@ -232,27 +241,25 @@ let pathSet = HS.fromList [path] buildPaths pathSet Repair - context "roots" $ do - context "findRoots" $ do + context "roots" $ context "findRoots" $ do itRights "empty roots" $ (findRoots `shouldReturn` M.empty) itRights "path added as a temp root" $ withPath $ \_ -> do roots <- findRoots - roots `shouldSatisfy` ((==1) . M.size) + roots `shouldSatisfy` ((== 1) . M.size) - context "optimiseStore" $ do - itRights "optimises" $ optimiseStore + context "optimiseStore" $ itRights "optimises" $ optimiseStore - context "queryMissing" $ do + context "queryMissing" $ itRights "queries" $ withPath $ \path -> do let pathSet = HS.fromList [path] queryMissing pathSet `shouldReturn` (HS.empty, HS.empty, HS.empty, 0, 0) - context "addToStore" $ do + context "addToStore" $ itRights "adds file to store" $ do fp <- liftIO $ writeSystemTempFile "addition" "lal" let Right n = makeStorePathName "tmp-addition" - res <- addToStore @'SHA256 n fp False (pure True) False + res <- addToStore @ 'SHA256 n fp False (pure True) False liftIO $ print res context "with dummy" $ do @@ -263,8 +270,8 @@ liftIO $ putStrLn $ show path (isValidPathUncached path) `shouldReturn` True - context "derivation" $ do - itRights "build derivation" $ do + context "derivation" $ + itRights "build derivation" $ withDerivation $ \path drv -> do result <- buildDerivation path drv Normal - result `shouldSatisfy` ((==AlreadyValid) . status) + result `shouldSatisfy` ((== AlreadyValid) . status) diff --git a/tests/Util.hs b/tests/Util.hs --- a/tests/Util.hs +++ b/tests/Util.hs @@ -6,9 +6,7 @@ import Test.Tasty.QuickCheck prop_TextToBSLRoundtrip :: Text -> Property -prop_TextToBSLRoundtrip x = - bslToText (textToBSL x) === x +prop_TextToBSLRoundtrip x = bslToText (textToBSL x) === x prop_TextToBSRoundtrip :: Text -> Property -prop_TextToBSRoundtrip x = - bsToText (textToBS x) === x +prop_TextToBSRoundtrip x = bsToText (textToBS x) === x