{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Cachix.Client.Commands
( authtoken,
create,
generateKeypair,
push,
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.Secrets
( SigningKey (SigningKey),
exportSigningKey,
parseSigningKeyLenient,
)
import Cachix.Client.Servant
import qualified Cachix.Types.SigningKeyCreate as SigningKeyCreate
import Control.Exception.Safe (handle, throwM)
import Control.Retry (RetryStatus (rsIterNumber))
import Crypto.Sign.Ed25519
import qualified Data.ByteString.Base64 as B64
import Data.List (isSuffixOf)
import Data.String.Here
import qualified Data.Text as T
import Network.HTTP.Types (status401, status404)
import Protolude
import Servant.API (NoContent)
import Servant.Auth.Client
import Servant.Client.Streaming
import Servant.Conduit ()
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import System.FSNotify
import System.IO (hIsTerminalDevice)
authtoken :: Env -> Text -> IO ()
authtoken :: Env -> Text -> IO ()
authtoken env :: Env
env token :: Text
token = do
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 cfg :: Config
cfg -> Config
cfg {authToken :: Token
authToken = ByteString -> Token
Token (Text -> ByteString
forall a b. StringConv a b => a -> b
toS Text
token)}
Nothing -> Text -> Config
mkConfig Text
token
create :: Env -> Text -> IO ()
create :: Env -> Text -> IO ()
create _ _ =
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 "Create command has been deprecated. Please visit https://cachix.org to create a binary cache."
generateKeypair :: Env -> Text -> IO ()
generateKeypair :: Env -> Text -> IO ()
generateKeypair Env {config :: Env -> Maybe Config
config = Maybe Config
Nothing} _ = 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
NoConfig "Start with visiting https://cachix.org and copying the token to $ cachix authtoken <token>"
generateKeypair env :: Env
env@Env {config :: Env -> Maybe Config
config = Just cfg :: Config
cfg} name :: Text
name = do
(PublicKey pk :: ByteString
pk, sk :: 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
(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)
-> (ClientM NoContent -> IO (Either ClientError NoContent))
-> ClientM NoContent
-> IO NoContent
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (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 NoContent)
-> ClientM NoContent -> IO NoContent
forall a b. (a -> b) -> a -> b
$
BinaryCacheAPI (AsClientT ClientM)
-> Token -> SigningKeyCreate -> ClientM NoContent
forall route.
BinaryCacheAPI route
-> route
:- (CachixAuth
:> ("key"
:> (ReqBody '[JSON] SigningKeyCreate :> Post '[JSON] NoContent)))
Api.createKey (Text -> BinaryCacheAPI (AsClientT ClientM)
cachixBCClient Text
name) (Config -> Token
authToken Config
cfg) SigningKeyCreate
signingKeyCreate
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
)
envToToken :: Env -> Token
envToToken :: Env -> Token
envToToken env :: Env
env =
Token -> (Config -> Token) -> Maybe Config -> Token
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Token
Token "") Config -> Token
authToken (Env -> Maybe Config
config Env
env)
notAuthenticatedBinaryCache :: CachixException
notAuthenticatedBinaryCache :: CachixException
notAuthenticatedBinaryCache =
Text -> CachixException
AccessDeniedBinaryCache "You must first authenticate using: $ cachix authtoken <token>"
accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache :: Text -> CachixException
accessDeniedBinaryCache name :: Text
name =
Text -> CachixException
AccessDeniedBinaryCache (Text -> CachixException) -> Text -> CachixException
forall a b. (a -> b) -> a -> b
$ "You don't seem to have API access to binary cache " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
use :: Env -> Text -> InstallationMode.UseOptions -> IO ()
use :: Env -> Text -> UseOptions -> IO ()
use env :: Env
env name :: Text
name useOptions :: UseOptions
useOptions = do
Either ClientError BinaryCache
res <- (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 -> ClientM BinaryCache
forall route.
BinaryCacheAPI route
-> route :- (CachixAuth :> Get '[JSON] BinaryCache)
Api.get (Text -> BinaryCacheAPI (AsClientT ClientM)
cachixBCClient Text
name) (Env -> Token
envToToken Env
env)
case Either ClientError BinaryCache
res of
Left err :: 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
notAuthenticatedBinaryCache
| 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
$ "Binary cache" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " does not exist."
| Bool
otherwise -> ClientError -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ClientError
err
Right binaryCache :: 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 "/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
== "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
$
InstallationMode -> Maybe InstallationMode -> InstallationMode
forall a. a -> Maybe a -> a
fromMaybe (NixEnv -> InstallationMode
InstallationMode.getInstallationMode NixEnv
nixEnv) (UseOptions -> Maybe InstallationMode
InstallationMode.useMode UseOptions
useOptions)
push :: Env -> PushArguments -> IO ()
push :: Env -> PushArguments -> IO ()
push env :: Env
env (PushPaths opts :: PushOptions
opts name :: Text
name cliPaths :: [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
(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 "You need to specify store paths either as stdin or as an command argument"
(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
(_, paths :: [Text]
paths) -> [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
paths
SigningKey
sk <- Env -> Text -> IO SigningKey
findSigningKey Env
env Text
name
Store
store <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
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])
-> ClientEnv
-> Store
-> PushCache
-> (Text -> PushStrategy IO ())
-> [Text]
-> IO [()]
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
(forall a b. (a -> m b) -> [a] -> m [b])
-> ClientEnv
-> Store
-> PushCache
-> (Text -> PushStrategy m r)
-> [Text]
-> 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))
(Env -> ClientEnv
clientenv Env
env)
Store
store
PushCache :: Text -> SigningKey -> Token -> PushCache
PushCache
{ pushCacheToken :: Token
pushCacheToken = Env -> Token
envToToken Env
env,
pushCacheName :: Text
pushCacheName = Text
name,
pushCacheSigningKey :: SigningKey
pushCacheSigningKey = SigningKey
sk
}
(Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy Env
env PushOptions
opts Text
name)
[Text]
inputStorePaths
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText "All done."
push env :: Env
env (PushWatchStore opts :: PushOptions
opts name :: Text
name) = (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \mgr :: WatchManager
mgr -> do
IO ()
_ <- WatchManager
-> ConfigPath -> ActionPredicate -> Action -> IO (IO ())
watchDir WatchManager
mgr "/nix/store" ActionPredicate
filterF Action
action
Store
_ <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText "Watching /nix/store for new builds ..."
IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay 1000000
where
logErr :: FilePath -> SomeException -> IO ()
logErr :: ConfigPath -> SomeException -> IO ()
logErr fp :: ConfigPath
fp e :: SomeException
e = Handle -> ConfigPath -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStrLn Handle
stderr (ConfigPath -> IO ()) -> ConfigPath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Exception occured while pushing " ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> ConfigPath
fp ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> ": " ConfigPath -> ConfigPath -> ConfigPath
forall a. Semigroup a => a -> a -> a
<> SomeException -> ConfigPath
forall a b. (Show a, StringConv ConfigPath b) => a -> b
show SomeException
e
action :: Action
action :: Action
action (Removed fp :: ConfigPath
fp _ _) =
(SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Control.Exception.Safe.handle (ConfigPath -> SomeException -> IO ()
logErr ConfigPath
fp)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath Env
env PushOptions
opts Text
name
(Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ ConfigPath -> Text
forall a b. StringConv a b => a -> b
toS
(ConfigPath -> Text) -> ConfigPath -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ConfigPath -> ConfigPath
forall a. Int -> [a] -> [a]
dropEnd 5 ConfigPath
fp
action _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
filterF :: ActionPredicate
filterF :: ActionPredicate
filterF (Removed fp :: ConfigPath
fp _ _)
| ".lock" ConfigPath -> ConfigPath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` ConfigPath
fp = Bool
True
filterF _ = Bool
False
dropEnd :: Int -> [a] -> [a]
dropEnd :: Int -> [a] -> [a]
dropEnd index :: Int
index xs :: [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
index) [a]
xs
findSigningKey ::
Env ->
Text ->
IO SigningKey
findSigningKey :: Env -> Text -> IO SigningKey
findSigningKey env :: Env
env name :: Text
name = do
Maybe ConfigPath
maybeEnvSK <- ConfigPath -> IO (Maybe ConfigPath)
lookupEnv "CACHIX_SIGNING_KEY"
let matches :: Config -> [BinaryCacheConfig]
matches c :: Config
c = (BinaryCacheConfig -> Bool)
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter (\bc :: BinaryCacheConfig
bc -> BinaryCacheConfig -> Text
Config.name BinaryCacheConfig
bc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) ([BinaryCacheConfig] -> [BinaryCacheConfig])
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a b. (a -> b) -> a -> b
$ [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a. [a] -> [a]
reverse ([BinaryCacheConfig] -> [BinaryCacheConfig])
-> [BinaryCacheConfig] -> [BinaryCacheConfig]
forall a b. (a -> b) -> a -> b
$ Config -> [BinaryCacheConfig]
binaryCaches Config
c
maybeBCSK :: Maybe Text
maybeBCSK = case Env -> Maybe Config
config Env
env of
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just c :: Config
c -> BinaryCacheConfig -> Text
Config.secretKey (BinaryCacheConfig -> Text)
-> Maybe BinaryCacheConfig -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BinaryCacheConfig] -> Maybe BinaryCacheConfig
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head (Config -> [BinaryCacheConfig]
matches Config
c)
Text
signingKey <- case Maybe Text
maybeBCSK Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfigPath -> Text
forall a b. StringConv a b => a -> b
toS (ConfigPath -> Text) -> Maybe ConfigPath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ConfigPath
maybeEnvSK of
Just key :: Text
key -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
key
Nothing -> 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
NoSigningKey Text
msg
(Text -> FatalError) -> Either Text SigningKey -> IO SigningKey
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs Text -> FatalError
FatalError (Either Text SigningKey -> IO SigningKey)
-> Either Text SigningKey -> IO SigningKey
forall a b. (a -> b) -> a -> b
$ Text -> Either Text SigningKey
parseSigningKeyLenient Text
signingKey
where
msg :: Text
msg :: Text
msg =
[iTrim|
Signing key not found.
It is generated by `cachix generate-keypair <name>` and stored in ~/config/cachix/cachix.dhall
There are a few options why this happened:
a) You haven't generated signing key yet for your cache
b) You have the key but you're pushing from a different machine.
You can set it via $CACHIX_SIGNING_KEY environment variable.
c) You've lost the signing key. In that case it's best to delete the cache and start again.
Note that everyone that configured the binary cache will have to do it again to set the new
public key.
|]
retryText :: RetryStatus -> Text
retryText :: RetryStatus -> Text
retryText retrystatus :: RetryStatus
retrystatus =
if RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then ""
else "(retry #" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv ConfigPath b) => a -> b
show (RetryStatus -> Int
rsIterNumber RetryStatus
retrystatus) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ") "
pushStrategy :: Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy :: Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy env :: Env
env opts :: PushOptions
opts name :: Text
name storePath :: Text
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
notAuthenticatedBinaryCache,
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
retrystatus size :: Int64
size ->
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
<> "compressing and pushing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
storePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " (" 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
<> ")\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
}
pushStorePath :: Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath :: Env -> PushOptions -> Text -> Text -> IO ()
pushStorePath env :: Env
env opts :: PushOptions
opts name :: Text
name storePath :: Text
storePath = do
SigningKey
sk <- Env -> Text -> IO SigningKey
findSigningKey Env
env Text
name
Store
store <- Async Store -> IO Store
forall a. Async a -> IO a
wait (Env -> Async Store
storeAsync Env
env)
ClientEnv
-> Store -> PushCache -> PushStrategy IO () -> Text -> IO ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
ClientEnv -> Store -> PushCache -> PushStrategy m r -> Text -> m r
pushSingleStorePath
(Env -> ClientEnv
clientenv Env
env)
Store
store
PushCache :: Text -> SigningKey -> Token -> PushCache
PushCache
{ pushCacheToken :: Token
pushCacheToken = Env -> Token
envToToken Env
env,
pushCacheName :: Text
pushCacheName = Text
name,
pushCacheSigningKey :: SigningKey
pushCacheSigningKey = SigningKey
sk
}
(Env -> PushOptions -> Text -> Text -> PushStrategy IO ()
pushStrategy Env
env PushOptions
opts Text
name Text
storePath)
Text
storePath