cachix 1.6 → 1.6.1
raw patch · 30 files changed
+513/−210 lines, 30 filesdep +immortaldep +networkdep −cookiedep −inline-c-cppdep −mmorphdep ~conduitdep ~servant-client-core
Dependencies added: immortal, network
Dependencies removed: cookie, inline-c-cpp, mmorph, network-uri
Dependency ranges changed: conduit, servant-client-core
Files
- CHANGELOG.md +22/−0
- cachix-deployment/Main.hs +1/−0
- cachix.cabal +54/−49
- cachix/Main.hs +1/−0
- src/Cachix/Client.hs +7/−5
- src/Cachix/Client/CNix.hs +1/−1
- src/Cachix/Client/Commands.hs +12/−9
- src/Cachix/Client/Config/Orphans.hs +12/−4
- src/Cachix/Client/Daemon.hs +105/−0
- src/Cachix/Client/Daemon/Client.hs +46/−0
- src/Cachix/Client/Daemon/Listen.hs +112/−0
- src/Cachix/Client/Daemon/Types.hs +32/−0
- src/Cachix/Client/NixVersion.hs +1/−9
- src/Cachix/Client/OptionsParser.hs +25/−2
- src/Cachix/Client/Push.hs +18/−23
- src/Cachix/Client/Push/S3.hs +0/−1
- src/Cachix/Client/PushQueue.hs +10/−12
- src/Cachix/Client/Retry.hs +1/−3
- src/Cachix/Client/Secrets.hs +0/−1
- src/Cachix/Client/Servant.hs +0/−1
- src/Cachix/Client/URI.hs +1/−1
- src/Cachix/Client/WatchStore.hs +5/−5
- src/Cachix/Deploy/Activate.hs +3/−3
- src/Cachix/Deploy/ActivateCommand.hs +1/−1
- src/Cachix/Deploy/Agent.hs +23/−20
- src/Cachix/Deploy/Websocket.hs +1/−2
- src/Data/Conduit/ByteString.hs +1/−1
- src/System/Nix/Base32.hs +0/−39
- test/NetRcSpec.hs +5/−3
- test/URISpec.hs +13/−15
CHANGELOG.md view
@@ -5,6 +5,28 @@ 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.1] - 2023-09-25++## Fixed++- deploy: Correctly format `cachix deploy agent` exception messages++- deploy: use high-level activate script for Darwin++- deploy: Support darwin-version.json++- #547: Filter invalid paths when watching the store++- Filter out existing upstream paths when using watch-exec++- Retrying is now printed as stderr, which is important for watch-exec automation++- Set the file system encoding to utf8 to fix some hash mismatch errors++## Added++- Implement a daemon for pushing store paths (more on this feature later on blog.cachix.org)+ ## [1.6] - 2023-06-27 ## Added
cachix-deployment/Main.hs view
@@ -41,6 +41,7 @@ main :: IO () main = do setLocaleEncoding utf8+ setFileSystemEncoding utf8 hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering
cachix.cabal view
@@ -1,25 +1,33 @@ cabal-version: 2.2 name: cachix-version: 1.6-license: Apache-2.0-license-file: LICENSE-copyright: 2018 Domen Kozar-category: Nix-maintainer: domen@cachix.org-author: Domen Kozar-homepage: https://github.com/cachix/cachix#readme-bug-reports: https://github.com/cachix/cachix/issues+version: 1.6.1 synopsis:- Command line client for Nix binary cache hosting https://cachix.org+ Command-line client for Nix binary cache hosting https://cachix.org +homepage: https://github.com/cachix/cachix#readme+bug-reports: https://github.com/cachix/cachix/issues+author: Domen Kozar+maintainer: domen@cachix.org+copyright: 2018 Domen Kozar+category: Nix+license: Apache-2.0+license-file: LICENSE build-type: Simple-extra-source-files:+extra-doc-files: CHANGELOG.md README.md++extra-source-files: test/data/*.input test/data/*.output +source-repository head+ type: git+ location: https://github.com/cachix/cachix+ subdir: cachix+ common defaults+ build-depends: base >=4.7 && <5 default-extensions: NoImplicitPrelude NoImportQualifiedPost@@ -38,12 +46,18 @@ -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns - default-language: Haskell2010+ -- TODO: address partial record fields in Cachix Deploy+ -- if impl(ghc >= 8.4)+ -- ghc-options: -Wpartial-fields -source-repository head- type: git- location: https://github.com/cachix/cachix+ if impl(ghc >=8.10)+ ghc-options: -Wunused-packages + if impl(ghc >=9.2)+ ghc-options: -Wredundant-bang-patterns++ default-language: Haskell2010+ library import: defaults exposed-modules:@@ -52,6 +66,10 @@ Cachix.Client.Commands Cachix.Client.Config Cachix.Client.Config.Orphans+ Cachix.Client.Daemon+ Cachix.Client.Daemon.Client+ Cachix.Client.Daemon.Listen+ Cachix.Client.Daemon.Types Cachix.Client.Env Cachix.Client.Exception Cachix.Client.HumanSize@@ -80,7 +98,6 @@ Cachix.Deploy.Websocket Cachix.Deploy.WebsocketPong Data.Conduit.ByteString- System.Nix.Base32 hs-source-dirs: src other-modules: Paths_cachix@@ -89,7 +106,6 @@ , aeson , ascii-progress , async- , base >=4.7 && <5 , base64-bytestring , bytestring , cachix-api@@ -99,7 +115,6 @@ , conduit-extra , conduit-zstd , containers- , cookie , cryptonite , deepseq , dhall >=1.28.0@@ -116,15 +131,14 @@ , http-client-tls , http-conduit , http-types- , inline-c-cpp+ , immortal , katip , lukko , lzma-conduit , megaparsec >=7.0.0 , memory- , mmorph , netrc- , network-uri+ , network , optparse-applicative , pretty-terminal , prettyprinter@@ -137,7 +151,6 @@ , servant-auth , servant-auth-client >=0.3.3.0 , servant-client >=0.16- , servant-client-core >=0.16 , servant-conduit , stm , stm-chans@@ -159,52 +172,43 @@ pkgconfig-depends: nix-main, nix-store executable cachix- import: defaults- main-is: Main.hs- build-tool-depends: hspec-discover:hspec-discover- ghc-options: -threaded -rtsopts -with-rtsopts=-maxN8- hs-source-dirs: cachix- other-modules: Paths_cachix- autogen-modules: Paths_cachix+ import: defaults+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-maxN8+ hs-source-dirs: cachix+ other-modules: Paths_cachix+ autogen-modules: Paths_cachix build-depends:- , base >=4.7 && <5 , cachix- , cachix-api , safe-exceptions executable .cachix-deployment- import: defaults- main-is: Main.hs- build-tool-depends: hspec-discover:hspec-discover- ghc-options: -g -threaded -rtsopts -with-rtsopts=-maxN8- hs-source-dirs: cachix-deployment- other-modules: Paths_cachix- autogen-modules: Paths_cachix+ import: defaults+ main-is: Main.hs+ ghc-options: -g -threaded -rtsopts -with-rtsopts=-maxN8+ hs-source-dirs: cachix-deployment+ other-modules: Paths_cachix+ autogen-modules: Paths_cachix build-depends: , aeson , async- , base >=4.7 && <5 , cachix , cachix-api- , conduit- , http-conduit , katip , protolude , safe-exceptions- , stm , stm-chans , stm-conduit , time , uuid , websockets- , wuss test-suite cachix-test- import: defaults- type: exitcode-stdio-1.0- ghc-options: -threaded -rtsopts -with-rtsopts=-N- main-is: Main.hs- hs-source-dirs: test+ import: defaults+ type: exitcode-stdio-1.0+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ main-is: Main.hs+ hs-source-dirs: test other-modules: InstallationModeSpec NetRcSpec@@ -215,7 +219,6 @@ build-depends: , aeson- , base >=4.7 && <5 , bytestring , cachix , cachix-api@@ -228,3 +231,5 @@ , servant-auth-client , servant-client-core , temporary++ build-tool-depends: hspec-discover:hspec-discover
cachix/Main.hs view
@@ -10,6 +10,7 @@ main :: IO () main = do setLocaleEncoding utf8+ setFileSystemEncoding utf8 hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering handleExceptions CC.main
src/Cachix/Client.hs view
@@ -5,8 +5,9 @@ import Cachix.Client.Commands as Commands import qualified Cachix.Client.Config as Config+import qualified Cachix.Client.Daemon as Daemon import Cachix.Client.Env (cachixoptions, mkEnv)-import Cachix.Client.OptionsParser (CachixCommand (..), getOpts)+import Cachix.Client.OptionsParser (CachixCommand (..), DaemonCommand (..), getOpts) import Cachix.Client.Version (cachixVersion) import Cachix.Deploy.ActivateCommand as ActivateCommand import qualified Cachix.Deploy.Agent as AgentCommand@@ -22,6 +23,9 @@ case command of AuthToken token -> Commands.authtoken env token Config configCommand -> Config.run cachixOptions configCommand+ Daemon (DaemonRun daemonOptions pushOptions) -> Daemon.run env daemonOptions pushOptions+ Daemon (DaemonStop daemonOptions) -> Daemon.stop env daemonOptions+ Daemon (DaemonPushPaths daemonOptions cacheName storePaths) -> Daemon.push env daemonOptions cacheName storePaths GenerateKeypair name -> Commands.generateKeypair env name Push pushArgs -> Commands.push env pushArgs Pin pingArgs -> Commands.pin env pingArgs@@ -30,7 +34,5 @@ Use name useOptions -> Commands.use env name useOptions Remove name -> Commands.remove env name Version -> putText cachixVersion- DeployCommand deployCommand ->- case deployCommand of- DeployOptions.Agent opts -> AgentCommand.run cachixOptions opts- DeployOptions.Activate opts -> ActivateCommand.run env opts+ DeployCommand (DeployOptions.Agent opts) -> AgentCommand.run cachixOptions opts+ DeployCommand (DeployOptions.Activate opts) -> ActivateCommand.run env opts
src/Cachix/Client/CNix.hs view
@@ -15,5 +15,5 @@ then return $ Just storePath else do path <- storePathToPath store storePath- hPutStrLn stderr $ color Yellow $ "Warning: " <> decodeUtf8With lenientDecode path <> " is not valid, skipping"+ putErrText $ color Yellow $ "Warning: " <> decodeUtf8With lenientDecode path <> " is not valid, skipping" return Nothing
src/Cachix/Client/Commands.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module Cachix.Client.Commands@@ -12,6 +11,7 @@ use, remove, pin,+ withPushParams, ) where @@ -194,16 +194,13 @@ pushParams (catMaybes normalized) case (length normalized, length pushedPaths) of- (0, _) -> putTextError "Nothing to push."- (_, 0) -> putTextError "Nothing to push - all store paths are already on Cachix."- _ -> putTextError "\nAll done."+ (0, _) -> putErrText "Nothing to push."+ (_, 0) -> putErrText "Nothing to push - all store paths are already on Cachix."+ _ -> putErrText "\nAll done." push _ _ = throwIO $ DeprecatedCommand "DEPRECATED: cachix watch-store has replaced cachix push --watch-store." -putTextError :: Text -> IO ()-putTextError = hPutStrLn stderr- pin :: Env -> PinOptions -> IO () pin env pinOpts = do authToken <- Config.getAuthTokenRequired (config env)@@ -312,7 +309,7 @@ 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"+ appendErrText $ retryText retryStatus <> "Pushing " <> path <> " (" <> toS hSize <> ")\n" return $ const pass Conduit.awaitForever $ \chunk -> do@@ -342,8 +339,14 @@ 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"+ putErrText $ "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 }++-- | Put text to stderr without a new line.+--+-- This is safe to use when printing from multiple threads, unlike hPutStrLn which may fail to insert the newline at the right place.+appendErrText :: (MonadIO m) => Text -> m ()+appendErrText = hPutStr stderr
src/Cachix/Client/Config/Orphans.hs view
@@ -2,6 +2,7 @@ module Cachix.Client.Config.Orphans where +import qualified Data.Aeson as Aeson import qualified Dhall import qualified Dhall.Core import Protolude hiding (toS)@@ -15,7 +16,14 @@ ex _ = panic "Unexpected Dhall value. Did it typecheck?" instance Dhall.ToDhall Token where- injectWith _ = Dhall.Encoder- { Dhall.embed = Dhall.Core.TextLit . Dhall.Core.Chunks [] . toS . getToken,- Dhall.declared = Dhall.Core.Text- }+ injectWith _ =+ Dhall.Encoder+ { Dhall.embed = Dhall.Core.TextLit . Dhall.Core.Chunks [] . toS . getToken,+ Dhall.declared = Dhall.Core.Text+ }++instance Aeson.FromJSON Token where+ parseJSON = Aeson.withText "Token" $ pure . Token . toS++instance Aeson.ToJSON Token where+ toJSON = Aeson.String . toS . getToken
+ src/Cachix/Client/Daemon.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE QuasiQuotes #-}++module Cachix.Client.Daemon+ ( run,+ runWithSocket,+ push,+ stop,+ )+where++import Cachix.Client.CNix (filterInvalidStorePath)+import qualified Cachix.Client.Commands as Commands+import Cachix.Client.Config.Orphans ()+import Cachix.Client.Daemon.Client (push, stop)+import Cachix.Client.Daemon.Listen as Daemon+import Cachix.Client.Daemon.Types+import Cachix.Client.Env as Env+import Cachix.Client.OptionsParser as Options+import Cachix.Client.Push+import Control.Concurrent.Extra (once)+import Control.Concurrent.STM.TBMQueue+import qualified Control.Immortal as Immortal+import Data.String.Here (i)+import qualified Data.Text as T+import qualified Hercules.CNix.Store as Store+import qualified Network.Socket as Socket+import Protolude+import System.Posix.Process (getProcessID)++run :: Env -> DaemonOptions -> PushOptions -> IO ()+run env daemonOptions pushOptions = do+ socketPath <- maybe getSocketPath pure (daemonSocketPath daemonOptions)+ runWithSocket env pushOptions socketPath+ `finally` putErrText "Daemon shut down."++runWithSocket :: Env -> PushOptions -> FilePath -> IO ()+runWithSocket env pushOptions socketPath = do+ -- Create a queue of push requests for the workers to process+ queue <- newTBMQueueIO 1000++ bracketOnError (startWorker queue) identity $ \shutdownWorker -> do+ -- TODO: retry the connection on socket errors+ bracketOnError (Daemon.openSocket socketPath) Socket.close $ \sock -> do+ Socket.listen sock Socket.maxListenQueue++ putText =<< readyMessage socketPath+ clientStopConn <- Daemon.listen queue sock++ -- Gracefully shutdown the worker before closing the socket+ -- TODO: consider shutdown from Network.Socket+ shutdownWorker++ Socket.gracefulClose clientStopConn 5000+ where+ startWorker queue = do+ worker <- Immortal.create $ \thread ->+ Immortal.onUnexpectedFinish thread logWorkerException $+ runWorker env pushOptions queue++ once $ do+ putErrText "Shutting down daemon..."+ atomically $ closeTBMQueue queue+ Immortal.mortalize worker+ putErrText "Waiting for worker to finish..."+ Immortal.wait worker++logWorkerException :: Either SomeException () -> IO ()+logWorkerException (Left err) =+ putErrText $ "Exception in daemon worker thread: " <> show err+logWorkerException _ = return ()++runWorker :: Env -> PushOptions -> TBMQueue QueuedPushRequest -> IO ()+runWorker env pushOptions queue = loop+ where+ loop =+ atomically (readTBMQueue queue) >>= \case+ Nothing -> return ()+ Just msg -> do+ handleRequest env pushOptions msg+ loop++handleRequest :: Env -> PushOptions -> QueuedPushRequest -> IO ()+handleRequest env pushOptions (QueuedPushRequest {..}) = do+ Commands.withPushParams env pushOptions (binaryCacheName pushRequest) $ \pushParams -> do+ normalized <-+ for (storePaths pushRequest) $ \fp -> do+ storePath <- Store.followLinksToStorePath (pushParamsStore pushParams) (encodeUtf8 $ T.pack fp)+ filterInvalidStorePath (pushParamsStore pushParams) storePath++ void $+ pushClosure+ (mapConcurrentlyBounded (numJobs pushOptions))+ pushParams+ (catMaybes normalized)++readyMessage :: FilePath -> IO Text+readyMessage socketPath = do+ -- Get the PID of the process+ pid <- getProcessID+ return+ [i|+Cachix Daemon is ready to push store paths.+PID: ${show pid :: Text}+Listening on socket: ${socketPath}+ |]
+ src/Cachix/Client/Daemon/Client.hs view
@@ -0,0 +1,46 @@+module Cachix.Client.Daemon.Client (push, stop) where++import Cachix.Client.Config as Config+import Cachix.Client.Daemon.Listen (getSocketPath)+import Cachix.Client.Daemon.Types (ClientMessage (..), PushRequest (..))+import Cachix.Client.Env as Env+import Cachix.Client.OptionsParser (DaemonOptions (..))+import Cachix.Types.BinaryCache (BinaryCacheName)+import qualified Data.Aeson as Aeson+import qualified Network.Socket as Socket+import qualified Network.Socket.ByteString.Lazy as Socket.LBS+import Protolude+import qualified System.Posix.IO as Posix++-- | Queue up push requests with the daemon+--+-- TODO: wait for the daemon to respond that it has received the request+push :: Env -> DaemonOptions -> BinaryCacheName -> [FilePath] -> IO ()+push Env {config, cachixoptions} daemonOptions cacheName storePaths = do+ sock <- connectToDaemon (daemonSocketPath daemonOptions)+ Socket.LBS.sendAll sock (Aeson.encode pushRequest)+ where+ pushRequest =+ ClientPushRequest $+ PushRequest (Config.authToken config) cacheName (Config.host cachixoptions) storePaths++-- | Tell the daemon to stop and wait for it gracefully exit+stop :: Env -> DaemonOptions -> IO ()+stop _env daemonOptions = do+ sock <- connectToDaemon (daemonSocketPath daemonOptions)+ Socket.LBS.sendAll sock (Aeson.encode ClientStop)++ -- Wait for the socket to close+ void $ Socket.LBS.recv sock 1++connectToDaemon :: Maybe FilePath -> IO Socket.Socket+connectToDaemon optionalSocketPath = do+ socketPath <- maybe getSocketPath pure optionalSocketPath+ sock <- Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol+ Socket.connect sock (Socket.SockAddrUnix socketPath)++ -- Network.Socket.accept sets the socket to non-blocking by default.+ Socket.withFdSocket sock $ \fd ->+ Posix.setFdOption (fromIntegral fd) Posix.NonBlockingRead False++ return sock
+ src/Cachix/Client/Daemon/Listen.hs view
@@ -0,0 +1,112 @@+module Cachix.Client.Daemon.Listen+ ( listen,+ getSocketPath,+ openSocket,+ )+where++import Cachix.Client.Config.Orphans ()+import Cachix.Client.Daemon.Types+import Control.Concurrent.STM.TBMQueue+import qualified Control.Exception.Safe as Safe+import qualified Data.Aeson as Aeson+import qualified Network.Socket as Socket+import qualified Network.Socket.ByteString as Socket.BS+import Protolude+import System.Directory+ ( XdgDirectory (..),+ createDirectoryIfMissing,+ getXdgDirectory,+ removeFile,+ )+import qualified System.Environment as System+import System.FilePath ((</>))+import System.IO.Error (isDoesNotExistError)++data ListenError+ = SocketError SomeException+ | DecodingError Text+ deriving stock (Show)++instance Exception ListenError where+ displayException = \case+ SocketError err -> "Failed to read from the daemon socket: " <> show err+ DecodingError err -> "Failed to decode request: " <> toS err++-- | The main daemon server loop.+--+-- The daemon listens for incoming push requests on the provided socket and queues them up for the worker thread.+listen :: TBMQueue QueuedPushRequest -> Socket.Socket -> IO Socket.Socket+listen queue sock = loop+ where+ loop = do+ result <- runExceptT $ readPushRequest sock++ case result of+ Right (ClientStop, clientConn) -> do+ putText "Received stop request, shutting down..."+ return clientConn+ Right (ClientPushRequest pushRequest, clientConn) -> do+ let queuedRequest = QueuedPushRequest pushRequest clientConn+ atomically $ writeTBMQueue queue queuedRequest+ loop+ Left (DecodingError err) -> do+ putErrText $ "Failed to decode request: " <> err+ loop+ Left err -> throwIO err++-- | Try to read and decode a push request.+readPushRequest :: Socket.Socket -> ExceptT ListenError IO (ClientMessage, Socket.Socket)+readPushRequest sock = do+ (bs, clientConn) <- readFromSocket `mapSyncException` SocketError+ decodeMessage clientConn bs+ where+ readFromSocket = liftIO $ do+ -- NOTE: this sets up a non-blocking socket to the client+ (conn, _peerAddr) <- Socket.accept sock+ bs <- Socket.BS.recv conn 4096+ return (bs, conn)++ decodeMessage conn bs =+ case Aeson.eitherDecodeStrict bs of+ Left err -> throwE $ DecodingError (toS err)+ Right pushRequest -> return (pushRequest, conn)++mapSyncException :: (Exception e1, Exception e2, Safe.MonadCatch m) => m a -> (e1 -> e2) -> m a+mapSyncException a f = a `Safe.catch` (Safe.throwM . f)++getSocketPath :: IO FilePath+getSocketPath = do+ socketDir <- getSocketDir+ return $ socketDir </> "cachix-daemon.sock"++getSocketDir :: IO FilePath+getSocketDir = do+ xdgRuntimeDir <- getXdgRuntimeDir+ let socketDir = xdgRuntimeDir </> "cachix"+ createDirectoryIfMissing True socketDir+ return socketDir++-- On systems with systemd: /run/user/$UID+-- Otherwise, fall back to XDG_CACHE_HOME+getXdgRuntimeDir :: IO FilePath+getXdgRuntimeDir = do+ xdgRuntimeDir <- System.lookupEnv "XDG_RUNTIME_DIR"+ cacheFallback <- getXdgDirectory XdgCache ""+ return $ fromMaybe cacheFallback xdgRuntimeDir++-- TODO: lock the socket+openSocket :: FilePath -> IO Socket.Socket+openSocket socketFilePath = do+ deleteSocketFileIfExists socketFilePath+ sock <- Socket.socket Socket.AF_UNIX Socket.Stream Socket.defaultProtocol+ Socket.bind sock $ Socket.SockAddrUnix socketFilePath+ -- setFileMode socketFilePath socketFileMode+ return sock+ where+ deleteSocketFileIfExists path =+ removeFile path `catch` handleDoesNotExist++ handleDoesNotExist e+ | isDoesNotExistError e = return ()+ | otherwise = throwIO e
+ src/Cachix/Client/Daemon/Types.hs view
@@ -0,0 +1,32 @@+module Cachix.Client.Daemon.Types where++import Cachix.Client.Config.Orphans ()+import Cachix.Client.URI+import qualified Data.Aeson as Aeson+import qualified Network.Socket as Socket+import Protolude+import Servant.Auth.Client (Token)++-- | JSON messages that the client can send to the daemon+data ClientMessage+ = ClientPushRequest PushRequest+ | ClientStop+ deriving stock (Generic)+ deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)++-- | A request for the daemon to push store paths to a binary cache+data PushRequest = PushRequest+ { authToken :: Token,+ binaryCacheName :: Text,+ host :: URI, -- TODO: host is not currently supported+ storePaths :: [FilePath]+ }+ deriving stock (Generic)+ deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)++data QueuedPushRequest = QueuedPushRequest+ { -- | The original push request+ pushRequest :: PushRequest,+ -- | An open socket to the client that sent the push request.+ clientConnection :: Socket.Socket+ }
src/Cachix/Client/NixVersion.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- module Cachix.Client.NixVersion ( assertNixVersion, parseNixVersion,@@ -32,10 +30,4 @@ minimalVersion :: SemVer minimalVersion =- SemVer 2 0 1 []--#if MIN_VERSION_versions(0,5,0)- Nothing-#else- []-#endif+ semver "2.0.1" & fromRight (panic "Couldn't parse minimalVersion")
src/Cachix/Client/OptionsParser.hs view
@@ -2,6 +2,8 @@ module Cachix.Client.OptionsParser ( CachixCommand (..),+ DaemonCommand (..),+ DaemonOptions (..), PushArguments (..), PushOptions (..), PinOptions (..),@@ -16,6 +18,7 @@ import Cachix.Client.URI (URI) import qualified Cachix.Client.URI as URI import qualified Cachix.Deploy.OptionsParser as DeployOptions+import Cachix.Types.BinaryCache (BinaryCacheName) import qualified Cachix.Types.BinaryCache as BinaryCache import Cachix.Types.PinCreate (Keep (..)) import qualified Data.Text as T@@ -72,11 +75,10 @@ uriOption = eitherReader $ \s -> first show $ URI.parseURI (toS s) -type BinaryCacheName = Text- data CachixCommand = AuthToken (Maybe Text) | Config Config.Command+ | Daemon DaemonCommand | GenerateKeypair BinaryCacheName | Push PushArguments | Pin PinOptions@@ -110,11 +112,23 @@ } deriving (Show) +data DaemonCommand+ = DaemonPushPaths DaemonOptions BinaryCacheName [FilePath]+ | DaemonRun DaemonOptions PushOptions+ | DaemonStop DaemonOptions+ deriving (Show)++data DaemonOptions = DaemonOptions+ { daemonSocketPath :: Maybe FilePath+ }+ deriving (Show)+ commandParser :: Parser CachixCommand commandParser = subparser $ command "authtoken" (infoH authtoken (progDesc "Configure authentication token for communication to HTTP API")) <> command "config" (Config <$> Config.parser)+ <> (hidden <> command "daemon" (infoH (Daemon <$> daemon) (progDesc "Run a daemon that listens push requests over a unix socket"))) <> command "generate-keypair" (infoH generateKeypair (progDesc "Generate signing key pair for a binary cache")) <> command "push" (infoH push (progDesc "Upload Nix store paths to a binary cache")) <> command "pin" (infoH pin (progDesc "Pin a store path to prevent it from being garbage collected"))@@ -187,6 +201,15 @@ <*> many (strOption (metavar "ARTIFACTS..." <> long "artifact" <> short 'a')) <*> keepParser pin = Pin <$> pinOptions+ daemon =+ subparser $+ command "push" (infoH daemonPush (progDesc "Push store paths to the daemon"))+ <> command "run" (infoH daemonRun (progDesc "Launch the daemon"))+ <> command "stop" (infoH daemonStop (progDesc "Stop the daemon and wait for any queued paths to be pushed"))+ daemonPush = DaemonPushPaths <$> daemonOptions <*> nameArg <*> many (strArgument (metavar "PATHS..."))+ daemonRun = DaemonRun <$> daemonOptions <*> pushOptions+ daemonStop = DaemonStop <$> daemonOptions+ daemonOptions = DaemonOptions <$> optional (strOption (long "socket" <> short 's' <> metavar "SOCKET")) watchExec = WatchExec <$> pushOptions <*> nameArg <*> strArgument (metavar "CMD") <*> many (strArgument (metavar "-- ARGS")) watchStore = WatchStore <$> pushOptions <*> nameArg pushWatchStore =
src/Cachix/Client/Push.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {- This is a standalone module so it shouldn't depend on any CLI state like Env -}@@ -277,32 +276,28 @@ let store = pushParamsStore pushParams clientEnv = pushParamsClientEnv pushParams -- Get the transitive closure of dependencies- (paths :: [Store.StorePath]) <-- liftIO $ do- inputs <- Std.Set.new- for_ inputPaths $ \path -> do- Std.Set.insertFP inputs path- closure <- Store.computeFSClosure store Store.defaultClosureParams inputs- Std.Set.toListFP closure- hashes <- for paths (liftIO . fmap (decodeUtf8With lenientDecode) . Store.getStorePathHash)+ paths <- liftIO $ do+ inputs <- Std.Set.new+ for_ inputPaths $ Std.Set.insertFP inputs+ closure <- Store.computeFSClosure store Store.defaultClosureParams inputs+ Std.Set.toListFP closure+ hashes <- liftIO $ for paths (fmap (decodeUtf8With lenientDecode) . Store.getStorePathHash) -- Check what store paths are missing missingHashesList <- retryAll $ \_ ->- escalate- =<< liftIO- ( (`runClientM` clientEnv) $- API.narinfoBulk- cachixClient- (getCacheAuthToken (pushParamsSecret pushParams))- (pushParamsName pushParams)- hashes- )+ liftIO $+ escalate+ =<< API.narinfoBulk+ cachixClient+ (getCacheAuthToken (pushParamsSecret pushParams))+ (pushParamsName pushParams)+ hashes+ `runClientM` clientEnv let missingHashes = Set.fromList (encodeUtf8 <$> missingHashesList) pathsAndHashes <- liftIO $- for paths $- \path -> do- hash_ <- Store.getStorePathHash path- pure (hash_, path)+ for paths $ \path -> do+ hash_ <- Store.getStorePathHash path+ pure (hash_, path) let missing = map snd $ filter (\(hash_, _path) -> Set.member hash_ missingHashes) pathsAndHashes return (paths, missing) @@ -340,7 +335,7 @@ Read https://mycache.cachix.org for instructions how to push to your binary cache. |] -mapConcurrentlyBounded :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)+mapConcurrentlyBounded :: (Traversable t) => Int -> (a -> IO b) -> t a -> IO (t b) mapConcurrentlyBounded bound action items = do qs <- QSem.newQSem bound let wrapped x = bracket_ (QSem.waitQSem qs) (QSem.signalQSem qs) (action x)
src/Cachix/Client/Push/S3.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-} module Cachix.Client.Push.S3 where
src/Cachix/Client/PushQueue.hs view
@@ -13,6 +13,7 @@ where import Cachix.Client.CNix (filterInvalidStorePath)+import Cachix.Client.Push (getMissingPathsForClosure) import qualified Cachix.Client.Push as Push import Cachix.Client.Retry (retryAll) import Control.Concurrent.Async@@ -42,12 +43,12 @@ worker :: Push.PushParams IO () -> PushWorkerState -> IO () worker pushParams workerState = forever $ do storePath <- atomically $ TBQueue.readTBQueue $ pushQueue workerState- bracket_ (inProgressModify (+ 1)) (inProgressModify (\x -> x - 1)) $- retryAll $- \retrystatus -> do- maybeStorePath <- filterInvalidStorePath (Push.pushParamsStore pushParams) storePath- for_ maybeStorePath $ \validatedStorePath ->- Push.uploadStorePath pushParams validatedStorePath retrystatus+ bracket_ (inProgressModify (+ 1)) (inProgressModify (\x -> x - 1)) $ do+ maybeStorePath <- filterInvalidStorePath (Push.pushParamsStore pushParams) storePath+ for_ maybeStorePath $ \validStorePath -> do+ (_, missingPaths) <- getMissingPathsForClosure pushParams [validStorePath]+ for_ missingPaths $ \missingPath ->+ retryAll $ Push.uploadStorePath pushParams missingPath where inProgressModify f = atomically $ modifyTVar' (inProgress workerState) f@@ -110,7 +111,7 @@ exitOnceQueueIsEmpty :: IO () -> Async () -> Async () -> QueryWorkerState -> PushWorkerState -> IO () exitOnceQueueIsEmpty stopProducerCallback pushWorker queryWorker queryWorkerState pushWorkerState = join . once $ do- putTextError "Stopped watching /nix/store and waiting for queue to empty ..."+ putErrText "Stopped watching /nix/store and waiting for queue to empty ..." -- Skip uploading the remaining paths when run in an interruptible mask to avoid hanging on IO. getMaskingState >>= \case@@ -138,13 +139,10 @@ if isDone then do stopWorkers- putTextError "Done."+ putErrText "Done." else do -- extend shutdown for another 90s void $ Systemd.notify False $ "EXTEND_TIMEOUT_USEC=" <> show (90 * 1000 * 1000 :: Int)- putTextError $ "Waiting to finish: " <> show inprogress <> " pushing, " <> show queueLength <> " in queue"+ putErrText $ "Waiting to finish: " <> show inprogress <> " pushing, " <> show queueLength <> " in queue" threadDelay (1000 * 1000) go--putTextError :: Text -> IO ()-putTextError = hPutStrLn stderr
src/Cachix/Client/Retry.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}- module Cachix.Client.Retry ( retryAll, retryAllWithLogging,@@ -21,7 +19,7 @@ retryAllWithLogging retryPolicy logger action = recovering retryPolicy handlers $ const action where handlers = skipAsyncExceptions ++ [exitSuccessHandler, loggingHandler]- exitSuccessHandler :: MonadIO m => RetryStatus -> Handler m Bool+ exitSuccessHandler :: (MonadIO m) => RetryStatus -> Handler m Bool exitSuccessHandler _ = Handler $ \(_ :: ExitCode) -> return False loggingHandler = logRetries exceptionPredicate logger exceptionPredicate = return . isSyncException
src/Cachix/Client/Secrets.hs view
@@ -12,7 +12,6 @@ import Crypto.Sign.Ed25519 import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as BC-import Data.Char (isSpace) import Protolude hiding (toS) import Protolude.Conv
src/Cachix/Client/Servant.hs view
@@ -19,7 +19,6 @@ import Servant.API.Generic import Servant.Auth.Client () import qualified Servant.Client-import Servant.Client.Generic (AsClientT) import Servant.Client.Streaming import Servant.Conduit ()
src/Cachix/Client/URI.hs view
@@ -89,7 +89,7 @@ parseURI :: ByteString -> Either UBS.URIParseError URI parseURI bs = fromURIRef <$> UBS.parseURI UBS.strictURIParserOptions bs -serialize :: StringConv BS.ByteString s => URI -> s+serialize :: (StringConv BS.ByteString s) => URI -> s serialize = toS . UBS.serializeURIRef' . getUri instance IsString URI where
src/Cachix/Client/WatchStore.hs view
@@ -3,6 +3,7 @@ ) where +import Cachix.Client.CNix (filterInvalidStorePath) import Cachix.Client.Push import qualified Cachix.Client.PushQueue as PushQueue import qualified Control.Concurrent.STM.TBQueue as TBQueue@@ -19,13 +20,15 @@ producer :: Store -> WatchManager -> PushQueue.Queue -> IO (IO ()) producer store mgr queue = do- putTextError "Watching /nix/store for new store paths ..."+ putErrText "Watching /nix/store for new store paths ..." watchDir mgr "/nix/store" filterOnlyStorePaths (queueStorePathAction store queue) queueStorePathAction :: Store -> PushQueue.Queue -> Event -> IO () queueStorePathAction store queue (Removed lockFile _ _) = do sp <- Store.parseStorePath store (encodeUtf8 $ toS $ dropLast 5 lockFile)- atomically $ TBQueue.writeTBQueue queue sp+ filterInvalidStorePath store sp >>= \case+ Nothing -> return ()+ Just p -> atomically $ TBQueue.writeTBQueue queue p queueStorePathAction _ _ _ = return () dropLast :: Int -> [a] -> [a]@@ -37,6 +40,3 @@ | ".drv.lock" `isSuffixOf` fp = False | ".lock" `isSuffixOf` fp = True filterOnlyStorePaths _ = False--putTextError :: Text -> IO ()-putTextError = hPutStrLn stderr
src/Cachix/Deploy/Activate.hs view
@@ -120,6 +120,7 @@ let checkPath p = Directory.doesPathExist $ toS storePath </> p isNixOS <- checkPath "nixos-version" isNixDarwin <- checkPath "darwin-version"+ isNixDarwinJSON <- checkPath "darwin-version.json" isHomeManager <- checkPath "hm-version" user <- InstallationMode.getUser let systemProfileDir = "/nix/var/nix/profiles"@@ -131,7 +132,7 @@ -- TODO: document what happens if the wrong user is used for the agent let setNewProfile profilePath = ("nix-env", ["-p", profilePath, "--set", storePath])- return $ case (isNixOS, isNixDarwin, isHomeManager) of+ return $ case (isNixOS, isNixDarwin || isNixDarwinJSON, isHomeManager) of (True, _, _) -> let profilePath = mkProfilePath systemProfileDir "system" in ( profilePath,@@ -145,8 +146,7 @@ in ( profilePath, [ ("mkdir", ["-p", "-m", "0755", "/nix/var/nix/profiles/system-profiles"]), setNewProfile profilePath,- (toS storePath </> "activate-user", []),- (toS storePath </> "activate", [])+ (toS storePath </> "sw/bin/darwin-rebuild", ["activate"]) ] ) (_, _, True) ->
src/Cachix/Deploy/ActivateCommand.hs view
@@ -40,7 +40,7 @@ agentToken <- toS <$> getEnv "CACHIX_ACTIVATE_TOKEN" Aeson.eitherDecodeFileStrict' payloadPath >>= \case Left err -> do- hPutStrLn stderr $ "Error parsing the deployment spec: " <> err+ putErrText $ "Error parsing the deployment spec: " <> toS err exitFailure Right deploySpec -> do activate env deployAsync agentToken (filterAgents agents deploySpec)
src/Cachix/Deploy/Agent.hs view
@@ -17,7 +17,7 @@ import qualified Control.Concurrent.Async as Async import Control.Concurrent.Extra (once) import qualified Control.Concurrent.MVar as MVar-import Control.Exception.Safe (onException, throwString, withException)+import Control.Exception.Safe (onException, throwString) import qualified Control.Exception.Safe as Safe import qualified Control.Retry as Retry import qualified Data.Aeson as Aeson@@ -120,18 +120,24 @@ environment = "production" } -logExceptions :: Log.WithLog -> IO a -> IO a-logExceptions withLog action = withException action $ \someE -> do- case fromException someE of- Just ExitSuccess -> exitSuccess- Just e -> do+logExceptions :: Log.WithLog -> IO () -> IO ()+logExceptions withLog action =+ action `catches` [agentHandler, exceptionHandler]+ where+ -- Pretty-print any errors thrown by the agent+ agentHandler =+ Handler $ \(e :: AgentError) -> do+ withLog . K.logLocM K.ErrorS . K.ls $ displayException e+ exitFailure++ -- Handle any unexcepted exceptions+ exceptionHandler = Handler $ \(e :: SomeException) -> do withLog . K.logLocM K.ErrorS . K.ls $ unlines [ "The agent encountered an exception:", toS (displayException e) ] exitFailure- Nothing -> exitFailure lockFilename :: Text -> FilePath lockFilename agentName = "agent-" <> toS agentName@@ -255,14 +261,9 @@ when (userId /= Posix.Files.fileOwner stat) $ do userName <- Posix.User.userName <$> Posix.User.getUserEntryForID userId sudoUser <- lookupEnv "SUDO_USER"- throwIO $- UserDoesNotOwnHome- { userName = userName,- sudoUser = sudoUser,- home = home- }+ throwIO $ UserDoesNotOwnHome userName sudoUser home -data Error+data AgentError = -- | An agent with the same name is already running. AgentAlreadyRunning Text | -- | No home directory.@@ -270,17 +271,19 @@ | -- | Safeguard against creating root-owned files in user directories. -- This is an issue on macOS, where, by default, sudo does not reset $HOME. UserDoesNotOwnHome- { userName :: String,- sudoUser :: Maybe String,- home :: FilePath- }+ String+ -- ^ The current user name+ (Maybe String)+ -- ^ The sudo user name, if any+ FilePath+ -- ^ The home directory deriving (Show) -instance Exception Error where+instance Exception AgentError where displayException = \case AgentAlreadyRunning agentName -> toS $ unwords ["The agent", agentName, "is already running."] NoHomeFound -> "Could not find the user’s home directory. Make sure to set the $HOME variable."- UserDoesNotOwnHome {userName = userName, sudoUser = sudoUser, home = home} ->+ UserDoesNotOwnHome userName sudoUser home -> if isJust sudoUser then toS $ unlines [warningMessage, suggestSudoFlagH] else toS warningMessage
src/Cachix/Deploy/Websocket.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE ScopedTypeVariables #-} -- | A high-level, multiple reader, single writer interface for Websocket clients. module Cachix.Deploy.Websocket where@@ -233,7 +232,7 @@ broadcast (ControlMessage controlMsg) -handleOutgoingJSON :: forall tx rx. Aeson.ToJSON tx => WebSocket tx rx -> IO ()+handleOutgoingJSON :: forall tx rx. (Aeson.ToJSON tx) => WebSocket tx rx -> IO () handleOutgoingJSON WebSocket {connection, tx} = do activeConnection <- MVar.readMVar connection Conduit.runConduit $
src/Data/Conduit/ByteString.hs view
@@ -57,7 +57,7 @@ loop (front . (bs :)) idxIn' s' else loop front idxIn' (S fptr ptr idxOut') -processAndChunkOutputRaw :: MonadIO m => ChunkSize -> ConduitT ByteString ByteString m ()+processAndChunkOutputRaw :: (MonadIO m) => ChunkSize -> ConduitT ByteString ByteString m () processAndChunkOutputRaw chunkSize = liftIO (newS chunkSize) >>= loop where
− src/System/Nix/Base32.hs
@@ -1,39 +0,0 @@-module System.Nix.Base32 (encode) where---- Copied from hnix-store-core until there's a new release--import qualified Data.ByteString as BS-import qualified Data.Text as T-import qualified Data.Vector as V-import Protolude---- | Encode a 'BS.ByteString' in Nix's base32 encoding-encode :: BS.ByteString -> T.Text-encode c = T.pack $ map char32 [nChar - 1, nChar - 2 .. 0]- where- digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"- -- Each base32 character gives us 5 bits of information, while- -- each byte gives is 8. Because 'div' rounds down, we need to add- -- one extra character to the result, and because of that extra 1- -- we need to subtract one from the number of bits in the- -- bytestring to cover for the case where the number of bits is- -- already a factor of 5. Thus, the + 1 outside of the 'div' and- -- the - 1 inside of it.- nChar = fromIntegral $ ((BS.length c * 8 - 1) `div` 5) + 1- byte = BS.index c . fromIntegral- -- May need to switch to a more efficient calculation at some- -- point.- bAsInteger :: Integer- bAsInteger =- sum- [ fromIntegral (byte j) * (256 ^ j)- | j <- [0 .. BS.length c - 1]- ]- char32 :: Integer -> Char- char32 i = digits32 V.! digitInd- where- digitInd =- fromIntegral $- bAsInteger- `div` (32 ^ i)- `mod` 32
test/NetRcSpec.hs view
@@ -1,7 +1,7 @@ module NetRcSpec where import qualified Cachix.Client.NetRc as NetRc-import Cachix.Types.BinaryCache (BinaryCache (..))+import Cachix.Types.BinaryCache (BinaryCache (..), CompressionMethod (..)) import Cachix.Types.Permission (Permission (..)) import Protolude import Servant.Auth.Client (Token (..))@@ -17,7 +17,8 @@ publicSigningKeys = ["pub"], isPublic = False, githubUsername = "foobar",- permission = Read+ permission = Read,+ preferredCompressionMethod = ZSTD } bc2 :: BinaryCache@@ -28,7 +29,8 @@ publicSigningKeys = ["pub2"], isPublic = False, githubUsername = "foobar2",- permission = Read+ permission = Read,+ preferredCompressionMethod = ZSTD } -- TODO: poor man's golden tests, use https://github.com/stackbuilders/hspec-golden
test/URISpec.hs view
@@ -2,7 +2,6 @@ import qualified Cachix.Client.URI as URI import qualified Data.Aeson as Aeson-import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy as BL import Data.Either.Extra import qualified Dhall@@ -45,27 +44,26 @@ it "re-serializes a URI" $ URI.serialize <$> URI.parseURI secureUri `shouldBe` Right secureUri - it "appends a subdomain" $+ it "appends a subdomain" $ do let parsedURI = parseURI' secureUri newURI = URI.appendSubdomain subdomain parsedURI- in URI.serialize newURI `shouldBe` secureUriWithSubdomain+ URI.serialize newURI `shouldBe` secureUriWithSubdomain it "returns the hostname" $ URI.getHostname (parseURI' secureUri) `shouldBe` URI.Host host - it "returns port 80 for HTTP URIs" $+ it "returns port 80 for HTTP URIs" $ do let scheme = URI.getScheme (parseURI' unsecureUri)- in URI.getPortFor scheme `shouldBe` Just (URI.Port 80)+ URI.getPortFor scheme `shouldBe` Just (URI.Port 80) - it "returns port 443 for HTTPS URIs" $+ it "returns port 443 for HTTPS URIs" $ do let scheme = URI.getScheme (parseURI' secureUri)- in URI.getPortFor scheme `shouldBe` Just (URI.Port 443)+ URI.getPortFor scheme `shouldBe` Just (URI.Port 443) - it "detects if SSL is required" $+ it "detects if SSL is required" $ do let getScheme = URI.getScheme . parseURI'- in do- URI.requiresSSL (getScheme secureUri) `shouldBe` True- URI.requiresSSL (getScheme unsecureUri) `shouldBe` False+ URI.requiresSSL (getScheme secureUri) `shouldBe` True+ URI.requiresSSL (getScheme unsecureUri) `shouldBe` False it "converts to JSON" $ Aeson.encode (parseURI' secureUri) `shouldBe` "\"" <> BL.fromStrict secureUri <> "\""@@ -73,15 +71,15 @@ it "converts from JSON" $ Aeson.decodeStrict' ("\"" <> secureUri <> "\"") `shouldBe` Just (parseURI' secureUri) - it "converts to Dhall" $+ it "converts to Dhall" $ do let asDhall = Dhall.embed Dhall.inject (parseURI' secureUri)- in Dhall.Core.pretty asDhall `shouldBe` "\"" <> decodeUtf8 secureUri <> "\""+ Dhall.Core.pretty asDhall `shouldBe` "\"" <> decodeUtf8 secureUri <> "\"" it "converts from Dhall" $ Dhall.input Dhall.auto ("\"" <> decodeUtf8 secureUri <> "\"") `shouldReturn` parseURI' secureUri -- https://github.com/cachix/cachix/issues/462- it "converts to a Servant BaseUrl without trailing slashes" $+ it "converts to a Servant BaseUrl without trailing slashes" $ do let uriWithTrailingSlash = secureUri <> "/" uri = parseURI' uriWithTrailingSlash- in Servant.baseUrlPath (URI.getBaseUrl uri) `shouldBe` ""+ Servant.baseUrlPath (URI.getBaseUrl uri) `shouldBe` ""