{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Cachix.Client.Commands
  ( authtoken,
    generateKeypair,
    push,
    watchStore,
    watchExec,
    use,
  )
where

import qualified Cachix.API as API
import Cachix.API.Error
import Cachix.Client.Config
  ( BinaryCacheConfig (BinaryCacheConfig),
    Config (..),
    mkConfig,
    writeConfig,
  )
import qualified Cachix.Client.Config as Config
import Cachix.Client.Env (Env (..))
import Cachix.Client.Exception (CachixException (..))
import Cachix.Client.HumanSize (humanSize)
import qualified Cachix.Client.InstallationMode as InstallationMode
import qualified Cachix.Client.NixConf as NixConf
import Cachix.Client.NixVersion (assertNixVersion)
import Cachix.Client.OptionsParser
  ( CachixOptions (..),
    PushArguments (..),
    PushOptions (..),
  )
import Cachix.Client.Push
import Cachix.Client.Retry (retryAll)
import Cachix.Client.Secrets
  ( SigningKey (SigningKey),
    exportSigningKey,
  )
import Cachix.Client.Servant
import qualified Cachix.Client.WatchStore as WatchStore
import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate
import Control.Exception.Safe (throwM)
import Control.Retry (RetryStatus (rsIterNumber))
import Crypto.Sign.Ed25519 (PublicKey (PublicKey), createKeypair)
import qualified Data.ByteString.Base64 as B64
import Data.String.Here
import qualified Data.Text as T
import qualified Data.Text.IO as T.IO
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
import Hercules.CNix.Store (Store, StorePath, followLinksToStorePath, storePathToPath)
import Network.HTTP.Types (status401, status404)
import Protolude hiding (toS)
import Protolude.Conv
import Servant.API (NoContent)
import Servant.Auth.Client
import Servant.Client.Streaming
import Servant.Conduit ()
import System.Directory (doesFileExist)
import System.IO (hIsTerminalDevice)
import qualified System.Posix.Signals as Signals
import qualified System.Process

authtoken :: Env -> Maybe Text -> IO ()
authtoken :: Env -> Maybe Text -> IO ()
authtoken Env
env (Just Text
token) = do
  -- TODO: check that token actually authenticates!
  ConfigPath -> Config -> IO ()
writeConfig (CachixOptions -> ConfigPath
configPath (Env -> CachixOptions
cachixoptions Env
env)) (Config -> IO ()) -> Config -> IO ()
forall a b. (a -> b) -> a -> b
$ case Env -> Maybe Config
config Env
env of
    Just Config
cfg -> Config -> Token -> Config
Config.setAuthToken Config
cfg (Token -> Config) -> Token -> Config
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
Token (Text -> ByteString
forall a b. StringConv a b => a -> b
toS Text
token)
    Maybe Config
Nothing -> Text -> Config
mkConfig Text
token
authtoken Env
env Maybe Text
Nothing = Env -> Maybe Text -> IO ()
authtoken Env
env (Maybe Text -> IO ()) -> (Text -> Maybe Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text
T.IO.getContents

generateKeypair :: Env -> Text -> IO ()
generateKeypair :: Env -> Text -> IO ()
generateKeypair Env
env Text
name = do
  Token
cachixAuthToken <- Maybe Config -> IO Token
Config.getAuthTokenRequired (Env -> Maybe Config
config Env
env)
  (PublicKey ByteString
pk, SecretKey
sk) <- IO (PublicKey, SecretKey)
createKeypair
  let signingKey :: Text
signingKey = SigningKey -> Text
exportSigningKey (SigningKey -> Text) -> SigningKey -> Text
forall a b. (a -> b) -> a -> b
$ SecretKey -> SigningKey
SigningKey SecretKey
sk
      signingKeyCreate :: SigningKeyCreate
signingKeyCreate = Text -> SigningKeyCreate
SigningKeyCreate.SigningKeyCreate (ByteString -> Text
forall a b. StringConv a b => a -> b
toS (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
pk)
      bcc :: BinaryCacheConfig
bcc = Text -> Text -> BinaryCacheConfig
BinaryCacheConfig Text
name Text
signingKey
  -- we first validate if key can be added to the binary cache
  (NoContent
_ :: NoContent) <-
    Either ClientError NoContent -> IO NoContent
forall exc (m :: * -> *) a.
(Exception exc, MonadThrow m) =>
Either exc a -> m a
escalate (Either ClientError NoContent -> IO NoContent)
-> ((RetryStatus -> IO (Either ClientError NoContent))
    -> IO (Either ClientError NoContent))
-> (RetryStatus -> IO (Either ClientError NoContent))
-> IO NoContent
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (RetryStatus -> IO (Either ClientError NoContent))
-> IO (Either ClientError NoContent)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(RetryStatus -> m a) -> m a
retryAll ((RetryStatus -> IO (Either ClientError NoContent))
 -> IO NoContent)
-> (RetryStatus -> IO (Either ClientError NoContent))
-> IO NoContent
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ ->
      (ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` Env -> ClientEnv
clientenv Env
env) (ClientM NoContent -> IO (Either ClientError NoContent))
-> ClientM NoContent -> IO (Either ClientError NoContent)
forall a b. (a -> b) -> a -> b
$
        BinaryCacheAPI (AsClientT ClientM)
-> Token -> Text -> SigningKeyCreate -> ClientM NoContent
forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache"
           :> (Capture "name" Text
               :> ("key"
                   :> (ReqBody '[JSON] SigningKeyCreate :> Post '[JSON] NoContent)))))
API.createKey BinaryCacheAPI (AsClientT ClientM)
cachixClient Token
cachixAuthToken Text
name SigningKeyCreate
signingKeyCreate
  -- if key was successfully added, write it to the config
  -- TODO: warn if binary cache with the same key already exists
  let cfg :: Config
cfg = case Env -> Maybe Config
config Env
env of
        Just Config
it -> Config
it
        Maybe Config
Nothing -> Text -> Config
Config.mkConfig (Text -> Config) -> Text -> Config
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. StringConv a b => a -> b
toS (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Token -> ByteString
getToken Token
cachixAuthToken
  ConfigPath -> Config -> IO ()
writeConfig (CachixOptions -> ConfigPath
configPath (Env -> CachixOptions
cachixoptions Env
env)) (Config -> IO ()) -> Config -> IO ()
forall a b. (a -> b) -> a -> b
$
    Config
cfg {binaryCaches :: [BinaryCacheConfig]
binaryCaches = Config -> [BinaryCacheConfig]
binaryCaches Config
cfg [BinaryCacheConfig] -> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. Semigroup a => a -> a -> a
<> [BinaryCacheConfig
bcc]}
  Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn
    ( [iTrim|
Secret signing key has been saved in the file above. To populate
your binary cache:

    $ nix-build | cachix push ${name}

Or if you'd like to use the signing key on another machine or CI:

    $ export CACHIX_SIGNING_KEY=${signingKey}
    $ nix-build | cachix push ${name}

To instruct Nix to use the binary cache:

    $ cachix use ${name}

IMPORTANT: Make sure to make a backup for the signing key above, as you have the only copy.
  |] ::
        Text
    )

notAuthenticatedBinaryCache :: Text -> CachixException
notAuthenticatedBinaryCache :: Text -> CachixException
notAuthenticatedBinaryCache Text
name =
  Text -> CachixException
AccessDeniedBinaryCache (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$
    Text
"Binary cache " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist or it's private. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
Config.noAuthTokenError

accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache Text
name =
  Text -> CachixException
AccessDeniedBinaryCache (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ Text
"Binary cache " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist or it's private and you don't have access it"

use :: Env -> Text -> InstallationMode.UseOptions -> IO ()
use :: Env -> Text -> UseOptions -> IO ()
use Env
env Text
name UseOptions
useOptions = do
  Token
cachixAuthToken <- Maybe Config -> IO Token
Config.getAuthTokenOptional (Env -> Maybe Config
config Env
env)
  -- 1. get cache public key
  Either ClientError BinaryCache
res <- (RetryStatus -> IO (Either ClientError BinaryCache))
-> IO (Either ClientError BinaryCache)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(RetryStatus -> m a) -> m a
retryAll ((RetryStatus -> IO (Either ClientError BinaryCache))
 -> IO (Either ClientError BinaryCache))
-> (RetryStatus -> IO (Either ClientError BinaryCache))
-> IO (Either ClientError BinaryCache)
forall a b. (a -> b) -> a -> b
$ \RetryStatus
_ -> (ClientM BinaryCache
-> ClientEnv -> IO (Either ClientError BinaryCache)
forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` Env -> ClientEnv
clientenv Env
env) (ClientM BinaryCache -> IO (Either ClientError BinaryCache))
-> ClientM BinaryCache -> IO (Either ClientError BinaryCache)
forall a b. (a -> b) -> a -> b
$ BinaryCacheAPI (AsClientT ClientM)
-> Token -> Text -> ClientM BinaryCache
forall route.
BinaryCacheAPI route
-> route
   :- (CachixAuth
       :> ("cache" :> (Capture "name" Text :> Get '[JSON] BinaryCache)))
API.getCache BinaryCacheAPI (AsClientT ClientM)
cachixClient Token
cachixAuthToken Text
name
  case Either ClientError BinaryCache
res of
    Left ClientError
err
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status401 Bool -> Bool -> Bool
&& Maybe Config -> Bool
forall a. Maybe a -> Bool
isJust (Env -> Maybe Config
config Env
env) -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
accessDeniedBinaryCache Text
name
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status401 -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
notAuthenticatedBinaryCache Text
name
      | ClientError -> Status -> Bool
isErr ClientError
err Status
status404 -> CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
BinaryCacheNotFound (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ Text
"Binary cache" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist."
      | Bool
otherwise -> ClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
    Right BinaryCache
binaryCache -> do
      () <- (Text -> CachixException) -> Either Text () -> IO ()
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> CachixException
UnsupportedNixVersion (Either Text () -> IO ()) -> IO (Either Text ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either Text ())
assertNixVersion
      Text
user <- IO Text
InstallationMode.getUser
      Maybe NixConf
nc <- NixConfLoc -> IO (Maybe NixConf)
NixConf.read NixConfLoc
NixConf.Global
      Bool
isTrusted <- [Text] -> IO Bool
InstallationMode.isTrustedUser ([Text] -> IO Bool) -> [Text] -> IO Bool
forall a b. (a -> b) -> a -> b
$ [NixConf] -> (NixConfLine -> Maybe [Text]) -> [Text]
NixConf.readLines ([Maybe NixConf] -> [NixConf]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NixConf
nc]) NixConfLine -> Maybe [Text]
NixConf.isTrustedUsers
      Bool
isNixOS <- ConfigPath -> IO Bool
doesFileExist ConfigPath
"/etc/NIXOS"
      let nixEnv :: NixEnv
nixEnv =
            NixEnv :: Bool -> Bool -> Bool -> NixEnv
InstallationMode.NixEnv
              { isRoot :: Bool
InstallationMode.isRoot = Text
user Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"root",
                isTrusted :: Bool
InstallationMode.isTrusted = Bool
isTrusted,
                isNixOS :: Bool
InstallationMode.isNixOS = Bool
isNixOS
              }
      Maybe Config
-> BinaryCache -> UseOptions -> InstallationMode -> IO ()
InstallationMode.addBinaryCache (Env -> Maybe Config
config Env
env) BinaryCache
binaryCache UseOptions
useOptions (InstallationMode -> IO ()) -> InstallationMode -> IO ()
forall a b. (a -> b) -> a -> b
$
        NixEnv -> UseOptions -> InstallationMode
InstallationMode.getInstallationMode NixEnv
nixEnv UseOptions
useOptions

push :: Env -> PushArguments -> IO ()
push :: Env -> PushArguments -> IO ()
push Env
env (PushPaths PushOptions
opts Text
name [Text]
cliPaths) = do
  Bool
hasStdin <- Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsTerminalDevice Handle
stdin
  [Text]
inputStorePaths <-
    case (Bool
hasStdin, [Text]
cliPaths) of
      (Bool
False, []) -> CachixException -> IO [Text]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO [Text]) -> CachixException -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
NoInput Text
"You need to specify store paths either as stdin or as an command argument"
      (Bool
True, []) -> Text -> [Text]
T.words (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
getContents
      -- If we get both stdin and cli args, prefer cli args.
      -- This avoids hangs in cases where stdin is non-interactive but unused by caller
      -- some programming environments always create a (non-interactive) stdin
      -- that may or may not be written to by the caller.
      -- This is somewhat like the behavior of `cat` for example.
      (Bool
_, [Text]
paths) -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
paths
  PushParams IO ()
pushParams <- Env -> PushOptions -> Text -> IO (PushParams IO ())
getPushParams Env
env PushOptions
opts Text
name
  [StorePath]
normalized <- IO [StorePath] -> IO [StorePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StorePath] -> IO [StorePath])
-> IO [StorePath] -> IO [StorePath]
forall a b. (a -> b) -> a -> b
$ [Text] -> (Text -> IO StorePath) -> IO [StorePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Text]
inputStorePaths (Store -> ByteString -> IO StorePath
followLinksToStorePath (PushParams IO () -> Store
forall (m :: * -> *) r. PushParams m r -> Store
pushParamsStore PushParams IO ()
pushParams) (ByteString -> IO StorePath)
-> (Text -> ByteString) -> Text -> IO StorePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8)
  IO [()] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [()] -> IO ()) -> IO [()] -> IO ()
forall a b. (a -> b) -> a -> b
$
    (forall a b. (a -> IO b) -> [a] -> IO [b])
-> PushParams IO () -> [StorePath] -> IO [()]
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
(forall a b. (a -> m b) -> [a] -> m [b])
-> PushParams m r -> [StorePath] -> m [r]
pushClosure
      (Int -> (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
mapConcurrentlyBounded (PushOptions -> Int
numJobs PushOptions
opts))
      PushParams IO ()
pushParams
      [StorePath]
normalized
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
"All done."
push Env
_ PushArguments
_ = do
  CachixException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
DeprecatedCommand Text
"DEPRECATED: cachix watch-store has replaced cachix push --watch-store."

watchStore :: Env -> PushOptions -> Text -> IO ()
watchStore :: Env -> PushOptions -> Text -> IO ()
watchStore Env
env PushOptions
opts Text
name = do
  PushParams IO ()
pushParams <- Env -> PushOptions -> Text -> IO (PushParams IO ())
getPushParams Env
env PushOptions
opts Text
name
  Store -> Int -> PushParams IO () -> IO ()
WatchStore.startWorkers (PushParams IO () -> Store
forall (m :: * -> *) r. PushParams m r -> Store
pushParamsStore PushParams IO ()
pushParams) (PushOptions -> Int
numJobs PushOptions
opts) PushParams IO ()
pushParams

watchExec :: Env -> PushOptions -> Text -> Text -> [Text] -> IO ()
watchExec :: Env -> PushOptions -> Text -> Text -> [Text] -> IO ()
watchExec Env
env PushOptions
pushOpts Text
name Text
cmd [Text]
args = do
  PushParams IO ()
pushParams <- Env -> PushOptions -> Text -> IO (PushParams IO ())
getPushParams Env
env PushOptions
pushOpts Text
name
  Handle
stdoutOriginal <- Handle -> IO Handle
hDuplicate Handle
stdout
  let process :: CreateProcess
process = (ConfigPath -> [ConfigPath] -> CreateProcess
System.Process.proc (Text -> ConfigPath
forall a b. StringConv a b => a -> b
toS Text
cmd) (Text -> ConfigPath
forall a b. StringConv a b => a -> b
toS (Text -> ConfigPath) -> [Text] -> [ConfigPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
args)) {std_out :: StdStream
System.Process.std_out = Handle -> StdStream
System.Process.UseHandle Handle
stdoutOriginal}
      watch :: IO ()
watch = do
        Handle -> Handle -> IO ()
hDuplicateTo Handle
stderr Handle
stdout -- redirect all stdout to stderr
        Store -> Int -> PushParams IO () -> IO ()
WatchStore.startWorkers (PushParams IO () -> Store
forall (m :: * -> *) r. PushParams m r -> Store
pushParamsStore PushParams IO ()
pushParams) (PushOptions -> Int
numJobs PushOptions
pushOpts) PushParams IO ()
pushParams

  (()
_, ExitCode
exitCode) <- IO () -> IO ExitCode -> IO ((), ExitCode)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO ()
watch (IO ExitCode -> IO ((), ExitCode))
-> IO ExitCode -> IO ((), ExitCode)
forall a b. (a -> b) -> a -> b
$ do
    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
processHandle) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
System.Process.createProcess CreateProcess
process
    ExitCode
exitCode <- ProcessHandle -> IO ExitCode
System.Process.waitForProcess ProcessHandle
processHandle
    Signal -> IO ()
Signals.raiseSignal Signal
Signals.sigINT
    ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode
  ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
exitCode

retryText :: RetryStatus -> Text
retryText :: RetryStatus -> Text
retryText RetryStatus
retrystatus =
  if RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Text
""
    else Text
"(retry #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText ConfigPath b) => a -> b
show (RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") "

pushStrategy :: Store -> Env -> PushOptions -> Text -> StorePath -> PushStrategy IO ()
pushStrategy :: Store
-> Env -> PushOptions -> Text -> StorePath -> PushStrategy IO ()
pushStrategy Store
store Env
env PushOptions
opts Text
name StorePath
storePath =
  PushStrategy :: forall (m :: * -> *) r.
m r
-> (RetryStatus -> Int64 -> m ())
-> m r
-> (ClientError -> m r)
-> m r
-> (forall a.
    (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a)
-> Bool
-> PushStrategy m r
PushStrategy
    { onAlreadyPresent :: IO ()
onAlreadyPresent = IO ()
forall (f :: * -> *). Applicative f => f ()
pass,
      on401 :: IO ()
on401 =
        if Maybe Config -> Bool
forall a. Maybe a -> Bool
isJust (Env -> Maybe Config
config Env
env)
          then CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
accessDeniedBinaryCache Text
name
          else CachixException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CachixException -> IO ()) -> CachixException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> CachixException
notAuthenticatedBinaryCache Text
name,
      onError :: ClientError -> IO ()
onError = ClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM,
      onAttempt :: RetryStatus -> Int64 -> IO ()
onAttempt = \RetryStatus
retrystatus Int64
size -> do
        Text
path <- OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Store -> StorePath -> IO ByteString
storePathToPath Store
store StorePath
storePath
        -- we append newline instead of putStrLn due to https://github.com/haskell/text/issues/242
        Text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ RetryStatus -> Text
retryText RetryStatus
retrystatus Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"compressing and pushing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
humanSize (Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
size) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n",
      onDone :: IO ()
onDone = IO ()
forall (f :: * -> *). Applicative f => f ()
pass,
      withXzipCompressor :: forall a.
(ConduitM ByteString ByteString (ResourceT IO) () -> IO a) -> IO a
withXzipCompressor = Int
-> forall (m :: * -> *) a.
   (ConduitM ByteString ByteString (ResourceT IO) () -> m a) -> m a
defaultWithXzipCompressorWithLevel (PushOptions -> Int
compressionLevel PushOptions
opts),
      omitDeriver :: Bool
Cachix.Client.Push.omitDeriver = PushOptions -> Bool
Cachix.Client.OptionsParser.omitDeriver PushOptions
opts
    }

getPushParams :: Env -> PushOptions -> Text -> IO (PushParams IO ())
getPushParams :: Env -> PushOptions -> Text -> IO (PushParams IO ())
getPushParams Env
env PushOptions
pushOpts Text
name = do
  PushSecret
pushSecret <- Maybe Config -> Text -> IO PushSecret
findPushSecret (Env -> Maybe Config
config Env
env) Text
name
  Store
store <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
  PushParams IO () -> IO (PushParams IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (PushParams IO () -> IO (PushParams IO ()))
-> PushParams IO () -> IO (PushParams IO ())
forall a b. (a -> b) -> a -> b
$
    PushParams :: forall (m :: * -> *) r.
Text
-> PushSecret
-> (StorePath -> PushStrategy m r)
-> ClientEnv
-> Store
-> PushParams m r
PushParams
      { pushParamsName :: Text
pushParamsName = Text
name,
        pushParamsSecret :: PushSecret
pushParamsSecret = PushSecret
pushSecret,
        pushParamsClientEnv :: ClientEnv
pushParamsClientEnv = Env -> ClientEnv
clientenv Env
env,
        pushParamsStrategy :: StorePath -> PushStrategy IO ()
pushParamsStrategy = Store
-> Env -> PushOptions -> Text -> StorePath -> PushStrategy IO ()
pushStrategy Store
store Env
env PushOptions
pushOpts Text
name,
        pushParamsStore :: Store
pushParamsStore = Store
store
      }