diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,16 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [1.6] - 2023-06-27 + +## Added + +- `cachix remove MYCACHE`: reverses `cachix use MYCACHE`. + +## Changed + +- `cachix push` now displays a progress bar and summary before pushing. + ## [1.5] - 2023-05-17 ### Added diff --git a/cachix.cabal b/cachix.cabal --- a/cachix.cabal +++ b/cachix.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cachix -version: 1.5 +version: 1.6 license: Apache-2.0 license-file: LICENSE copyright: 2018 Domen Kozar @@ -87,6 +87,7 @@ autogen-modules: Paths_cachix build-depends: , aeson + , ascii-progress , async , base >=4.7 && <5 , base64-bytestring diff --git a/src/Cachix/Client.hs b/src/Cachix/Client.hs --- a/src/Cachix/Client.hs +++ b/src/Cachix/Client.hs @@ -12,9 +12,10 @@ import qualified Cachix.Deploy.Agent as AgentCommand import qualified Cachix.Deploy.OptionsParser as DeployOptions import Protolude +import System.Console.AsciiProgress (displayConsoleRegions) main :: IO () -main = do +main = displayConsoleRegions $ do (flags, command) <- getOpts env <- mkEnv flags let cachixOptions = cachixoptions env @@ -27,6 +28,7 @@ WatchStore watchArgs name -> Commands.watchStore env watchArgs name WatchExec pushArgs name cmd args -> Commands.watchExec env pushArgs name cmd args Use name useOptions -> Commands.use env name useOptions + Remove name -> Commands.remove env name Version -> putText cachixVersion DeployCommand deployCommand -> case deployCommand of diff --git a/src/Cachix/Client/Commands.hs b/src/Cachix/Client/Commands.hs --- a/src/Cachix/Client/Commands.hs +++ b/src/Cachix/Client/Commands.hs @@ -10,6 +10,7 @@ watchStore, watchExec, use, + remove, pin, ) where @@ -44,7 +45,9 @@ import Control.Exception.Safe (throwM) import Control.Retry (RetryStatus (rsIterNumber)) import Crypto.Sign.Ed25519 (PublicKey (PublicKey), createKeypair) +import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 +import qualified Data.Conduit as Conduit import Data.String.Here import qualified Data.Text as T import qualified Data.Text.IO as T.IO @@ -57,6 +60,8 @@ import Servant.Auth.Client import Servant.Client.Streaming import Servant.Conduit () +import System.Console.AsciiProgress +import System.Console.Pretty import System.Directory (doesFileExist) import System.IO (hIsTerminalDevice) import qualified System.Posix.Signals as Signals @@ -119,6 +124,19 @@ context Nothing = "" context (Just body) = " Error: " <> toS body +getNixEnv :: IO InstallationMode.NixEnv +getNixEnv = do + user <- InstallationMode.getUser + nc <- NixConf.read NixConf.Global + isTrusted <- InstallationMode.isTrustedUser $ NixConf.readLines (catMaybes [nc]) NixConf.isTrustedUsers + isNixOS <- doesFileExist "/run/current-system/nixos-version" + return $ + InstallationMode.NixEnv + { InstallationMode.isRoot = user == "root", + InstallationMode.isTrusted = isTrusted, + InstallationMode.isNixOS = isNixOS + } + use :: Env -> Text -> InstallationMode.UseOptions -> IO () use env name useOptions = do optionalAuthToken <- Config.getAuthTokenMaybe (config env) @@ -129,19 +147,16 @@ Left err -> handleCacheResponse name optionalAuthToken err Right binaryCache -> do () <- escalateAs UnsupportedNixVersion =<< assertNixVersion - user <- InstallationMode.getUser - nc <- NixConf.read NixConf.Global - isTrusted <- InstallationMode.isTrustedUser $ NixConf.readLines (catMaybes [nc]) NixConf.isTrustedUsers - isNixOS <- doesFileExist "/run/current-system/nixos-version" - let nixEnv = - InstallationMode.NixEnv - { InstallationMode.isRoot = user == "root", - InstallationMode.isTrusted = isTrusted, - InstallationMode.isNixOS = isNixOS - } + nixEnv <- getNixEnv InstallationMode.addBinaryCache (config env) binaryCache useOptions $ InstallationMode.getInstallationMode nixEnv useOptions +remove :: Env -> Text -> IO () +remove env name = do + nixEnv <- getNixEnv + InstallationMode.removeBinaryCache (Config.hostname $ config env) name $ + InstallationMode.getInstallationMode nixEnv InstallationMode.defaultUseOptions + handleCacheResponse :: Text -> Maybe Token -> ClientError -> IO a handleCacheResponse name optionalAuthToken err | isErr err status401 && isJust optionalAuthToken = throwM $ accessDeniedBinaryCache name (failureResponseBody err) @@ -181,7 +196,7 @@ case (length normalized, length pushedPaths) of (0, _) -> putTextError "Nothing to push." (_, 0) -> putTextError "Nothing to push - all store paths are already on Cachix." - _ -> putTextError "All done." + _ -> putTextError "\nAll done." push _ _ = throwIO $ DeprecatedCommand "DEPRECATED: cachix watch-store has replaced cachix push --watch-store." @@ -252,28 +267,58 @@ where getProcessHandle (_, _, _, processHandle) = processHandle -retryText :: RetryStatus -> Text -retryText retrystatus = - if rsIterNumber retrystatus == 0 - then "" - else "(retry #" <> show (rsIterNumber retrystatus) <> ") " - pushStrategy :: Store -> Maybe Token -> PushOptions -> Text -> BinaryCache.CompressionMethod -> StorePath -> PushStrategy IO () pushStrategy store authToken opts name compressionMethod storePath = PushStrategy { onAlreadyPresent = pass, on401 = handleCacheResponse name authToken, onError = throwM, - onAttempt = \retrystatus size -> do - path <- decodeUtf8With lenientDecode <$> storePathToPath store storePath - -- we append newline instead of putStrLn due to https://github.com/haskell/text/issues/242 - putStr $ retryText retrystatus <> "compressing using " <> T.toLower (show compressionMethod) <> " and pushing " <> path <> " (" <> humanSize (fromIntegral size) <> ")\n", + onAttempt = \_ _ -> pass, + onUncompressedNARStream = showUploadProgress, onDone = pass, Cachix.Client.Push.compressionMethod = compressionMethod, Cachix.Client.Push.compressionLevel = Cachix.Client.OptionsParser.compressionLevel opts, Cachix.Client.Push.omitDeriver = Cachix.Client.OptionsParser.omitDeriver opts } + where + retryText :: RetryStatus -> Text + retryText retryStatus = + if rsIterNumber retryStatus == 0 + then "" + else color Yellow $ "retry #" <> show (rsIterNumber retryStatus) <> " " + showUploadProgress retryStatus size = do + let hSize = toS $ humanSize $ fromIntegral size + path <- liftIO $ decodeUtf8With lenientDecode <$> storePathToPath store storePath + + isTerminal <- liftIO $ hIsTerminalDevice stdout + onTick <- + if isTerminal + then do + let bar = color Blue "[:bar] " <> toS (retryText retryStatus) <> toS path <> " (:percent of " <> hSize <> ")" + barLength = T.length $ T.replace ":percent" " 0%" (T.replace "[:bar]" "" (toS bar)) + + progressBar <- + liftIO $ + newProgressBar + def + { pgTotal = fromIntegral size, + -- https://github.com/yamadapc/haskell-ascii-progress/issues/24 + pgWidth = 20 + barLength, + pgOnCompletion = Just $ color Green "✓ " <> toS path <> " (" <> hSize <> ")", + pgFormat = bar + } + + return $ liftIO . tickN progressBar . BS.length + else do + -- we append newline instead of putStrLn due to https://github.com/haskell/text/issues/242 + putStr $ retryText retryStatus <> "Pushing " <> path <> " (" <> toS hSize <> ")\n" + return $ const pass + + Conduit.awaitForever $ \chunk -> do + Conduit.yield chunk + onTick chunk + withPushParams :: Env -> PushOptions -> Text -> (PushParams IO () -> IO ()) -> IO () withPushParams env pushOpts name m = do pushSecret <- findPushSecret (config env) name @@ -293,6 +338,12 @@ { pushParamsName = name, pushParamsSecret = pushSecret, pushParamsClientEnv = clientenv env, + pushOnClosureAttempt = \full missing -> do + unless (null missing) $ do + let numMissing = length missing + numCached = length full - numMissing + putTextError $ "Pushing " <> show numMissing <> " paths (" <> show numCached <> " are already present) using " <> T.toLower (show compressionMethod) <> " to cache " <> name <> " ⏳\n" + return missing, pushParamsStrategy = pushStrategy store authToken pushOpts name compressionMethod, pushParamsStore = store } diff --git a/src/Cachix/Client/InstallationMode.hs b/src/Cachix/Client/InstallationMode.hs --- a/src/Cachix/Client/InstallationMode.hs +++ b/src/Cachix/Client/InstallationMode.hs @@ -5,11 +5,13 @@ NixEnv (..), getInstallationMode, addBinaryCache, + removeBinaryCache, isTrustedUser, getUser, fromString, toString, UseOptions (..), + defaultUseOptions, ) where @@ -18,11 +20,13 @@ import Cachix.Client.Exception (CachixException (..)) import qualified Cachix.Client.NetRc as NetRc import qualified Cachix.Client.NixConf as NixConf +import qualified Cachix.Client.URI as URI import qualified Cachix.Types.BinaryCache as BinaryCache import qualified Data.Maybe import Data.String.Here import qualified Data.Text as T -import Protolude +import Protolude hiding (toS) +import Protolude.Conv (toS) import System.Directory (Permissions, createDirectoryIfMissing, getPermissions, writable) import System.Environment (lookupEnv) import System.FilePath (replaceFileName, ()) @@ -50,6 +54,14 @@ } deriving (Show) +defaultUseOptions :: UseOptions +defaultUseOptions = + UseOptions + { useMode = Nothing, + useNixOSFolder = "/etc/nixos", + useOutputDirectory = Nothing + } + fromString :: String -> Maybe InstallationMode fromString "root-nixconf" = Just $ Install NixConf.Global fromString "user-nixconf" = Just $ Install NixConf.Local @@ -111,6 +123,21 @@ addBinaryCache config bc useOptions WriteNixOS = nixosBinaryCache config bc useOptions addBinaryCache config bc _ (Install ncl) = do + (input, output) <- prepareNixConf ncl + netrcLocMaybe <- forM (guard $ not (BinaryCache.isPublic bc)) $ const $ addPrivateBinaryCacheNetRC config bc ncl + let addNetRCLine :: NixConf.NixConf -> NixConf.NixConf + addNetRCLine = fromMaybe identity $ do + netrcLoc <- netrcLocMaybe :: Maybe FilePath + -- We only add the netrc line for local user configs for now. + -- On NixOS we assume it will be picked up from the default location. + guard (ncl == NixConf.Local) + pure (NixConf.setNetRC $ toS netrcLoc) + NixConf.write ncl $ addNetRCLine $ NixConf.add bc input output + filename <- NixConf.getFilename ncl + putStrLn $ "Configured " <> BinaryCache.uri bc <> " binary cache in " <> toS filename + +prepareNixConf :: NixConf.NixConfLoc -> IO ([NixConf.NixConf], NixConf.NixConf) +prepareNixConf ncl = do -- TODO: might need locking one day gnc <- NixConf.read NixConf.Global (input, output) <- @@ -122,18 +149,21 @@ NixConf.Custom _ -> do lnc <- NixConf.read ncl return ([lnc], lnc) - let nixconf = fromMaybe (NixConf.NixConf []) output - netrcLocMaybe <- forM (guard $ not (BinaryCache.isPublic bc)) $ const $ addPrivateBinaryCacheNetRC config bc ncl - let addNetRCLine :: NixConf.NixConf -> NixConf.NixConf - addNetRCLine = fromMaybe identity $ do - netrcLoc <- netrcLocMaybe :: Maybe FilePath - -- We only add the netrc line for local user configs for now. - -- On NixOS we assume it will be picked up from the default location. - guard (ncl == NixConf.Local) - pure (NixConf.setNetRC $ toS netrcLoc) - NixConf.write ncl $ addNetRCLine $ NixConf.add bc (catMaybes input) nixconf + return (catMaybes input, fromMaybe (NixConf.NixConf []) output) + +removeBinaryCache :: URI.URI -> Text -> InstallationMode -> IO () +removeBinaryCache uri name (Install ncl) = do + contents <- fromMaybe (NixConf.NixConf []) <$> NixConf.read ncl + let (final, removed) = NixConf.remove uri name [contents] contents + NixConf.write ncl final filename <- NixConf.getFilename ncl - putStrLn $ "Configured " <> BinaryCache.uri bc <> " binary cache in " <> toS filename + if removed + then putStrLn $ "Removed " <> host <> " binary cache in " <> toS filename + else putStrLn $ "No " <> host <> " binary cache found in " <> toS filename + where + host = URI.toByteString (URI.appendSubdomain name uri) +removeBinaryCache _ _ _ = do + putText "Removing binary caches is only supported for nix.conf" nixosBinaryCache :: Config -> BinaryCache.BinaryCache -> UseOptions -> IO () nixosBinaryCache config bc UseOptions {useNixOSFolder = baseDirectory} = do diff --git a/src/Cachix/Client/NixConf.hs b/src/Cachix/Client/NixConf.hs --- a/src/Cachix/Client/NixConf.hs +++ b/src/Cachix/Client/NixConf.hs @@ -17,6 +17,7 @@ NixConfLoc (..), render, add, + remove, read, update, write, @@ -32,11 +33,12 @@ ) where +import qualified Cachix.Client.URI as URI import qualified Cachix.Types.BinaryCache as BinaryCache -import Data.Char (isSpace) import Data.List (nub) import qualified Data.Text as T -import Protolude +import Protolude hiding (toS) +import Protolude.Conv (toS) import System.Directory ( XdgDirectory (..), createDirectoryIfMissing, @@ -93,6 +95,19 @@ -- Note: some defaults are always appended since overriding some setttings in nix.conf overrides defaults otherwise substituters = (defaultPublicURI : readLines toRead isSubstituter) <> [BinaryCache.uri bc] publicKeys = (defaultSigningKey : readLines toRead isPublicKey) <> BinaryCache.publicSigningKeys bc + +remove :: URI.URI -> Text -> [NixConf] -> NixConf -> (NixConf, Bool) +remove uri name toRead toWrite = + (newconf, oldsubstituters /= substituters) + where + newconf = + writeLines isPublicKey (TrustedPublicKeys $ nub publicKeys) $ + writeLines isSubstituter (Substituters $ nub substituters) toWrite + oldsubstituters = readLines toRead isSubstituter + substituters = filter (toS (URI.toByteString fulluri) /=) oldsubstituters + oldpublicKeys = readLines toRead isPublicKey + publicKeys = filter (not . T.isPrefixOf (toS $ URI.hostBS $ URI.getHostname fulluri)) oldpublicKeys + fulluri = URI.appendSubdomain name uri defaultPublicURI :: Text defaultPublicURI = "https://cache.nixos.org" diff --git a/src/Cachix/Client/OptionsParser.hs b/src/Cachix/Client/OptionsParser.hs --- a/src/Cachix/Client/OptionsParser.hs +++ b/src/Cachix/Client/OptionsParser.hs @@ -83,6 +83,7 @@ | WatchStore PushOptions Text | WatchExec PushOptions Text Text [Text] | Use BinaryCacheName InstallationMode.UseOptions + | Remove BinaryCacheName | DeployCommand DeployOptions.DeployCommand | Version deriving (Show) @@ -120,6 +121,7 @@ <> command "watch-exec" (infoH watchExec (progDesc "Run a command while it's running watch /nix/store for newly added store paths and upload them to a binary cache")) <> command "watch-store" (infoH watchStore (progDesc "Indefinitely watch /nix/store for newly added store paths and upload them to a binary cache")) <> command "use" (infoH use (progDesc "Configure a binary cache by writing nix.conf and netrc files")) + <> command "remove" (infoH remove (progDesc "Remove a binary cache from nix.conf")) <> command "deploy" (infoH (DeployCommand <$> DeployOptions.parser) (progDesc "Cachix Deploy commands")) where nameArg = strArgument (metavar "CACHE-NAME") @@ -195,6 +197,7 @@ <> short 'w' <> help "DEPRECATED: use watch-store command instead." ) + remove = Remove <$> nameArg use = Use <$> nameArg diff --git a/src/Cachix/Client/Push.hs b/src/Cachix/Client/Push.hs --- a/src/Cachix/Client/Push.hs +++ b/src/Cachix/Client/Push.hs @@ -38,6 +38,7 @@ import qualified Cachix.Types.MultipartUpload as Multipart import qualified Cachix.Types.NarInfoCreate as Api import qualified Cachix.Types.NarInfoHash as NarInfoHash +import Conduit (MonadUnliftIO) import Control.Concurrent.Async (mapConcurrently) import qualified Control.Concurrent.QSem as QSem import Control.Exception.Safe (MonadMask, throwM) @@ -72,42 +73,62 @@ = PushToken Token | PushSigningKey Token SigningKey +-- | Parameters for pushing a closure of store paths, to be passed to 'pushClosure'. +-- This also contains the parameters for pushing a single path, in 'pushParamStrategy'. data PushParams m r = PushParams { pushParamsName :: Text, pushParamsSecret :: PushSecret, - -- | how to report results, (some) errors, and do some things + -- | An action to run on each closure push attempt. + -- It receives a list of all paths in the closure and a subset of those paths missing from the cache. + -- It should return a list of paths to push to the cache. + pushOnClosureAttempt :: + -- All paths in the closure + [StorePath] -> + -- Paths that are missing in the cache + [StorePath] -> + -- Paths to push to the cache + m [StorePath], + -- | Hooks into different stages of the single path push process. pushParamsStrategy :: StorePath -> PushStrategy m r, -- | cachix base url, connection manager, see 'Cachix.Client.URI.defaultCachixBaseUrl', 'Servant.Client.mkClientEnv' pushParamsClientEnv :: ClientEnv, pushParamsStore :: Store } +-- | Parameters for pushing a single store path. See 'pushSingleStorePath' data PushStrategy m r = PushStrategy - { -- | Called when a path is already in the cache. + { -- | An action to call when a path is already in the cache. onAlreadyPresent :: m r, + -- | An action to run on each push attempt. onAttempt :: RetryStatus -> Int64 -> m (), + -- | A conduit to inspect the NAR stream before compression. + -- This is useful for tracking progress and computing hashes. The conduit must not modify the stream. + onUncompressedNARStream :: RetryStatus -> Int64 -> ConduitT ByteString ByteString (ResourceT m) (), + -- | An action to run when authentication fails. on401 :: ClientError -> m r, + -- | An action to run when an error occurs. onError :: ClientError -> m r, + -- | An action to run after the path is pushed successfully. onDone :: m r, compressionMethod :: BinaryCache.CompressionMethod, compressionLevel :: Int, omitDeriver :: Bool } -defaultWithXzipCompressor :: forall m a. (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a +defaultWithXzipCompressor :: (MonadIO m) => (ConduitT ByteString ByteString m () -> b) -> b defaultWithXzipCompressor = ($ Lzma.compress (Just 2)) -defaultWithXzipCompressorWithLevel :: Int -> forall m a. (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a +defaultWithXzipCompressorWithLevel :: (MonadIO m) => Int -> (ConduitT ByteString ByteString m () -> b) -> b defaultWithXzipCompressorWithLevel l = ($ Lzma.compress (Just l)) -defaultWithZstdCompressor :: forall m a. (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a +defaultWithZstdCompressor :: (MonadIO m) => (ConduitT ByteString ByteString m () -> b) -> b defaultWithZstdCompressor = ($ Zstd.compress 8) -defaultWithZstdCompressorWithLevel :: Int -> forall m a. (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a +defaultWithZstdCompressorWithLevel :: (MonadIO m) => Int -> (ConduitT ByteString ByteString m () -> b) -> b defaultWithZstdCompressorWithLevel l = ($ Zstd.compress l) pushSingleStorePath :: - (MonadMask m, MonadIO m) => + (MonadMask m, MonadUnliftIO m) => -- | details for pushing to cache PushParams m r -> -- | store path @@ -139,7 +160,7 @@ getCacheAuthToken (PushSigningKey token _) = token uploadStorePath :: - (MonadIO m) => + (MonadUnliftIO m) => -- | details for pushing to cache PushParams m r -> StorePath -> @@ -174,12 +195,13 @@ let storePathSize = Store.validPathInfoNarSize pathinfo onAttempt strategy retrystatus storePathSize - withCompressor $ \compressor -> liftIO $ do + withCompressor $ \compressor -> do uploadResult <- runConduitRes $ streamNarIO narEffectsIO (toS storePathText) Data.Conduit.yield .| passthroughSizeSink narSizeRef .| passthroughHashSink narHashRef + .| onUncompressedNARStream strategy retrystatus storePathSize .| compressor .| passthroughSizeSink fileSizeRef .| passthroughHashSinkB16 fileHashRef @@ -187,7 +209,7 @@ case uploadResult of Left err -> throwIO err - Right (narId, uploadId, parts) -> do + Right (narId, uploadId, parts) -> liftIO $ do narSize <- readIORef narSizeRef narHash <- ("sha256:" <>) . System.Nix.Base32.encode <$> readIORef narHashRef narHashNix <- Store.validPathInfoNarHash32 pathinfo @@ -235,7 +257,7 @@ -- -- Note: 'onAlreadyPresent' will be called less often in the future. pushClosure :: - (MonadIO m, MonadMask m) => + (MonadMask m, MonadUnliftIO m) => -- | Traverse paths, responsible for bounding parallel processing of paths -- -- For example: @'mapConcurrentlyBounded' 4@ @@ -246,10 +268,11 @@ -- | Every @r@ per store path of the entire closure of store paths m [r] pushClosure traversal pushParams inputStorePaths = do - missingPaths <- getMissingPathsForClosure pushParams inputStorePaths - traversal (\path -> retryAll $ \retrystatus -> uploadStorePath pushParams path retrystatus) missingPaths + (allPaths, missingPaths) <- getMissingPathsForClosure pushParams inputStorePaths + paths <- pushOnClosureAttempt pushParams allPaths missingPaths + traversal (\storePath -> retryAll $ \retrystatus -> uploadStorePath pushParams storePath retrystatus) paths -getMissingPathsForClosure :: (MonadIO m, MonadMask m) => PushParams m r -> [StorePath] -> m [StorePath] +getMissingPathsForClosure :: (MonadIO m, MonadMask m) => PushParams m r -> [StorePath] -> m ([StorePath], [StorePath]) getMissingPathsForClosure pushParams inputPaths = do let store = pushParamsStore pushParams clientEnv = pushParamsClientEnv pushParams @@ -280,7 +303,8 @@ \path -> do hash_ <- Store.getStorePathHash path pure (hash_, path) - return $ map snd $ filter (\(hash_, _path) -> Set.member hash_ missingHashes) pathsAndHashes + let missing = map snd $ filter (\(hash_, _path) -> Set.member hash_ missingHashes) pathsAndHashes + return (paths, missing) -- TODO: move to a separate module specific to cli diff --git a/src/Cachix/Client/PushQueue.hs b/src/Cachix/Client/PushQueue.hs --- a/src/Cachix/Client/PushQueue.hs +++ b/src/Cachix/Client/PushQueue.hs @@ -99,7 +99,7 @@ if isEmpty then return S.empty else return $ alreadyQueued workerState - missingStorePaths <- Push.getMissingPathsForClosure pushParams storePaths + (missingStorePaths, _) <- Push.getMissingPathsForClosure pushParams storePaths let missingStorePathsSet = S.fromList missingStorePaths uncachedMissingStorePaths = S.difference missingStorePathsSet alreadyQueuedSet atomically $ for_ uncachedMissingStorePaths $ TBQueue.writeTBQueue pushqueue diff --git a/src/Cachix/Client/URI.hs b/src/Cachix/Client/URI.hs --- a/src/Cachix/Client/URI.hs +++ b/src/Cachix/Client/URI.hs @@ -13,6 +13,7 @@ requiresSSL, parseURI, serialize, + toByteString, getBaseUrl, defaultCachixURI, defaultCachixBaseUrl, @@ -29,6 +30,7 @@ import Data.Either.Validation (Validation (Failure, Success)) import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) +import Data.String import qualified Dhall import qualified Dhall.Core import Protolude hiding (toS) @@ -51,6 +53,9 @@ fromURIRef :: UBS.URIRef UBS.Absolute -> URI fromURIRef = URI +toByteString :: URI -> ByteString +toByteString = UBS.serializeURIRef' . getUri + getScheme :: URI -> UBS.Scheme getScheme = UBS.uriScheme . getUri @@ -86,6 +91,9 @@ serialize :: StringConv BS.ByteString s => URI -> s serialize = toS . UBS.serializeURIRef' . getUri + +instance IsString URI where + fromString = either (panic . show) identity . parseURI . toS instance Aeson.ToJSON URI where toJSON (URI uri) = Aeson.String . toS . UBS.serializeURIRef' $ uri diff --git a/test/NixConfSpec.hs b/test/NixConfSpec.hs --- a/test/NixConfSpec.hs +++ b/test/NixConfSpec.hs @@ -3,7 +3,7 @@ module NixConfSpec where import Cachix.Client.NixConf as NixConf -import Cachix.Types.BinaryCache (BinaryCache (..)) +import Cachix.Types.BinaryCache (BinaryCache (..), CompressionMethod (..)) import Cachix.Types.Permission (Permission (..)) import Data.String.Here import Protolude @@ -20,7 +20,8 @@ isPublic = True, permission = Admin, publicSigningKeys = ["pub"], - githubUsername = "foobar" + githubUsername = "foobar", + preferredCompressionMethod = ZSTD } spec :: Spec @@ -112,6 +113,28 @@ TrustedPublicKeys [defaultSigningKey, "pub"] ] in add bc [globalConf, localConf] localConf `shouldBe` result + describe "remove" $ do + it "removes a binary cache" $ + let localConf = + NixConf + [ Substituters [defaultPublicURI, "https://name.cachix.org"], + TrustedPublicKeys [defaultSigningKey, "name.cachix.org-1:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa="] + ] + result = + NixConf + [ Substituters [defaultPublicURI], + TrustedPublicKeys [defaultSigningKey] + ] + in remove "https://cachix.org" "name" [localConf] localConf `shouldBe` (result, True) + it "removes nothing if the binary cache is missing" $ + let globalConf = + NixConf + [ Substituters [defaultPublicURI], + TrustedPublicKeys [defaultSigningKey] + ] + localConf = globalConf + result = localConf + in remove "https://cachix.org" "name" [globalConf, localConf] localConf `shouldBe` (result, False) describe "parse" $ do it "parses substituters" $ parse "substituters = a\n"