{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

{-|

This module contains tools for working with Nix, in order to provide Nix-built artifacts to tests.

The Nix package set (Nixpkgs) is one of the largest package sets in the world, and can be a great way to get artifacts reproducibly. All you need is a @nix@ binary available on the PATH.

For example, the following will build a Nix environment based on Nixpkgs release 24.05, containing Emacs and Firefox.

@
introduceNixContext nixpkgsRelease2405 $
  introduceNixEnvironment ["emacs", "firefox"] $ do
    it "uses the environment" $ do
      envPath <- getContext nixEnvironment

      emacsVersion <- readCreateProcess (proc (envPath <\/\> "bin" <\/\> "emacs") ["--version"]) ""
      info [i|Emacs version: #{emacsVersion}|]

      firefoxVersion <- readCreateProcess (proc (envPath <\/\> "bin" <\/\> "firefox") ["--version"]) ""
      info [i|Firefox version: #{firefoxVersion}|]
@

-}

module Test.Sandwich.Contexts.Nix (
  -- * Nix contexts
  introduceNixContext
  , introduceNixContext'
  , introduceNixContext''

  -- * Nix environments
  , introduceNixEnvironment
  , introduceNixEnvironment'
  , buildNixSymlinkJoin
  , buildNixSymlinkJoin'
  , buildNixExpression
  , buildNixExpression'
  , buildNixCallPackageDerivation
  , buildNixCallPackageDerivation'

  -- * Nixpkgs releases
  , nixpkgsReleaseDefault
  , nixpkgsRelease2405
  , nixpkgsRelease2311

  -- * Types
  , nixContext
  , NixContext(..)
  , HasNixContext

  , nixEnvironment
  , HasNixEnvironment

  , NixpkgsDerivation(..)

  , defaultFileContextVisibilityThreshold
  ) where

import Control.Monad.Catch (MonadMask, MonadThrow)
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Data.Aeson as A
import qualified Data.Map as M
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import Relude
import System.FilePath
import System.IO.Temp
import Test.Sandwich
import Test.Sandwich.Contexts.Files.Types
import Test.Sandwich.Contexts.Util.Aeson
import qualified Text.Show
import UnliftIO.Async
import UnliftIO.Directory
import UnliftIO.Environment
import UnliftIO.MVar (modifyMVar)
import UnliftIO.Process

-- * Types

nixContext :: Label "nixContext" NixContext
nixContext :: Label "nixContext" NixContext
nixContext = Label "nixContext" NixContext
forall {k} (l :: Symbol) (a :: k). Label l a
Label

data NixContext = NixContext {
  NixContext -> String
nixContextNixBinary :: FilePath
  , NixContext -> NixpkgsDerivation
nixContextNixpkgsDerivation :: NixpkgsDerivation
  , NixContext -> MVar (Map Text (Async String))
nixContextBuildCache :: MVar (Map Text (Async FilePath))
  }
instance Show NixContext where
  show :: NixContext -> String
show (NixContext {}) = String
"<NixContext>"

type HasNixContext context = HasLabel context "nixContext" NixContext

nixEnvironment :: Label "nixEnvironment" FilePath
nixEnvironment :: Label "nixEnvironment" String
nixEnvironment = Label "nixEnvironment" String
forall {k} (l :: Symbol) (a :: k). Label l a
Label

type HasNixEnvironment context = HasLabel context "nixEnvironment" FilePath

defaultFileContextVisibilityThreshold :: Int
defaultFileContextVisibilityThreshold :: Int
defaultFileContextVisibilityThreshold = Int
150

data NixpkgsDerivation =
  NixpkgsDerivationFetchFromGitHub {
    NixpkgsDerivation -> Text
nixpkgsDerivationOwner :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationRev :: Text
    , NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: Text

    -- | Set the environment variable NIXPKGS_ALLOW_UNFREE=1 when building with this derivation.
    -- Useful when you want to use packages with unfree licenses, like @google-chrome@.
    , NixpkgsDerivation -> Bool
nixpkgsDerivationAllowUnfree :: Bool
    } deriving (Int -> NixpkgsDerivation -> ShowS
[NixpkgsDerivation] -> ShowS
NixpkgsDerivation -> String
(Int -> NixpkgsDerivation -> ShowS)
-> (NixpkgsDerivation -> String)
-> ([NixpkgsDerivation] -> ShowS)
-> Show NixpkgsDerivation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixpkgsDerivation -> ShowS
showsPrec :: Int -> NixpkgsDerivation -> ShowS
$cshow :: NixpkgsDerivation -> String
show :: NixpkgsDerivation -> String
$cshowList :: [NixpkgsDerivation] -> ShowS
showList :: [NixpkgsDerivation] -> ShowS
Show, NixpkgsDerivation -> NixpkgsDerivation -> Bool
(NixpkgsDerivation -> NixpkgsDerivation -> Bool)
-> (NixpkgsDerivation -> NixpkgsDerivation -> Bool)
-> Eq NixpkgsDerivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
== :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
$c/= :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
/= :: NixpkgsDerivation -> NixpkgsDerivation -> Bool
Eq)

-- | Nixpkgs release 24.05, accessed 11\/9\/2024.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-24.05
nixpkgsRelease2405 :: NixpkgsDerivation
nixpkgsRelease2405 :: NixpkgsDerivation
nixpkgsRelease2405 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"bb824c634c812feede9d398c000526401028c0e7"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-xYnWv9kyJyF8rEZ1uJaSek2fmaIowkk/ovE6+MwcP2E="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Nixpkgs release 23.11, accessed 2\/19\/2023.
-- You can compute updated values for this release (or others) by running
-- nix-prefetch-github NixOS nixpkgs --rev release-23.11
nixpkgsRelease2311 :: NixpkgsDerivation
nixpkgsRelease2311 :: NixpkgsDerivation
nixpkgsRelease2311 = NixpkgsDerivationFetchFromGitHub {
  nixpkgsDerivationOwner :: Text
nixpkgsDerivationOwner = Text
"NixOS"
  , nixpkgsDerivationRepo :: Text
nixpkgsDerivationRepo = Text
"nixpkgs"
  , nixpkgsDerivationRev :: Text
nixpkgsDerivationRev = Text
"cc86e0769882886f7831de9c9373b62ea2c06e3f"
  , nixpkgsDerivationSha256 :: Text
nixpkgsDerivationSha256 = Text
"sha256-1eAZINWjTTA8nWJiN979JVSwvCYzUWnMpzMHGUCLgZk="
  , nixpkgsDerivationAllowUnfree :: Bool
nixpkgsDerivationAllowUnfree = Bool
False
  }

-- | Currently set to 'nixpkgsRelease2405'.
nixpkgsReleaseDefault :: NixpkgsDerivation
nixpkgsReleaseDefault :: NixpkgsDerivation
nixpkgsReleaseDefault = NixpkgsDerivation
nixpkgsRelease2405

-- | Introduce a 'NixContext', which contains information about where to find Nix and what
-- version of Nixpkgs to use. This can be leveraged to introduce Nix packages in tests.
--
-- The 'NixContext' contains a build cache, so if you build a given derivation more than
-- once in your tests under this node, runs after the first one will be fast.
--
-- This function requires a @nix@ binary to be in the PATH and will throw an exception if it
-- isn't found.
introduceNixContext :: (
  MonadUnliftIO m, MonadThrow m
  )
  -- | Nixpkgs derivation to use
  => NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext = NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceNixContext', but allows passing custom 'NodeOptions'.
introduceNixContext' :: (
  MonadUnliftIO m, MonadThrow m
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | Nixpkgs derivation to use
  -> NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext' :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m) =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext' NodeOptions
nodeOptions NixpkgsDerivation
nixpkgsDerivation = NodeOptions
-> String
-> Label "nixContext" NixContext
-> ExampleT context m NixContext
-> (HasCallStack => NixContext -> ExampleT context m ())
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions String
"Introduce Nix context" Label "nixContext" NixContext
nixContext ExampleT context m NixContext
getNixContext (ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> NixContext -> ExampleT context m ())
-> ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    getNixContext :: ExampleT context m NixContext
getNixContext = String -> ExampleT context m (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
findExecutable String
"nix" ExampleT context m (Maybe String)
-> (Maybe String -> ExampleT context m NixContext)
-> ExampleT context m NixContext
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe String
Nothing -> String -> ExampleT context m NixContext
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Couldn't find "nix" binary when introducing Nix context. A Nix binary and store must already be available in the environment.|]
      Just String
p -> do
        -- TODO: make sure the Nixpkgs derivation works
        MVar (Map Text (Async String))
buildCache <- Map Text (Async String)
-> ExampleT context m (MVar (Map Text (Async String)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map Text (Async String)
forall a. Monoid a => a
mempty
        NixContext -> ExampleT context m NixContext
forall a. a -> ExampleT context m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
-> NixpkgsDerivation
-> MVar (Map Text (Async String))
-> NixContext
NixContext String
p NixpkgsDerivation
nixpkgsDerivation MVar (Map Text (Async String))
buildCache)

-- | Same as 'introduceNixContext'', but allows specifying the Nix binary via 'HasFile'.
introduceNixContext'' :: (
  MonadUnliftIO m
  , MonadThrow m
  , HasFile context "nix"
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | Nixpkgs derivation to use
  -> NixpkgsDerivation
  -- | Child spec
  -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceNixContext'' :: forall (m :: * -> *) context.
(MonadUnliftIO m, MonadThrow m, HasFile context "nix") =>
NodeOptions
-> NixpkgsDerivation
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
introduceNixContext'' NodeOptions
nodeOptions NixpkgsDerivation
nixpkgsDerivation = NodeOptions
-> String
-> Label "nixContext" NixContext
-> ExampleT context m NixContext
-> (HasCallStack => NixContext -> ExampleT context m ())
-> SpecFree (LabelValue "nixContext" NixContext :> context) m ()
-> SpecFree context m ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions String
"Introduce Nix context" Label "nixContext" NixContext
nixContext ExampleT context m NixContext
getNixContext (ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> NixContext -> ExampleT context m ())
-> ExampleT context m () -> NixContext -> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    getNixContext :: ExampleT context m NixContext
getNixContext = do
      String
nix <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
askFile @"nix"
      -- TODO: make sure the Nixpkgs derivation works
      MVar (Map Text (Async String))
buildCache <- Map Text (Async String)
-> ExampleT context m (MVar (Map Text (Async String)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map Text (Async String)
forall a. Monoid a => a
mempty
      NixContext -> ExampleT context m NixContext
forall a. a -> ExampleT context m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
-> NixpkgsDerivation
-> MVar (Map Text (Async String))
-> NixContext
NixContext String
nix NixpkgsDerivation
nixpkgsDerivation MVar (Map Text (Async String))
buildCache)

-- | Introduce a Nix environment containing the given list of packages, using the current 'NixContext'.
-- These packages are mashed together using the Nix @symlinkJoin@ function. Their binaries will generally
-- be found in "\<environment path\>\/bin".
introduceNixEnvironment :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m
  )
  -- | List of package names to include in the Nix environment
  => [Text]
  -> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
  -> SpecFree context m ()
introduceNixEnvironment :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m) =>
[Text]
-> SpecFree (LabelValue "nixEnvironment" String :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment = NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" String :> context) m ()
-> SpecFree context m ()
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m) =>
NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" String :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold = defaultFileContextVisibilityThreshold })

-- | Same as 'introduceNixEnvironment', but allows passing custom 'NodeOptions'.
introduceNixEnvironment' :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m
  )
  -- | Custom 'NodeOptions'
  => NodeOptions
  -- | List of package names to include in the Nix environment
  -> [Text]
  -> SpecFree (LabelValue "nixEnvironment" FilePath :> context) m ()
  -> SpecFree context m ()
introduceNixEnvironment' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m) =>
NodeOptions
-> [Text]
-> SpecFree (LabelValue "nixEnvironment" String :> context) m ()
-> SpecFree context m ()
introduceNixEnvironment' NodeOptions
nodeOptions [Text]
packageNames = NodeOptions
-> String
-> Label "nixEnvironment" String
-> ExampleT context m String
-> (HasCallStack => String -> ExampleT context m ())
-> SpecFree (LabelValue "nixEnvironment" String :> context) m ()
-> SpecFree context m ()
forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (HasCallStack => intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' NodeOptions
nodeOptions String
"Introduce Nix environment" Label "nixEnvironment" String
nixEnvironment ([Text] -> ExampleT context m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[Text] -> m String
buildNixSymlinkJoin [Text]
packageNames) (ExampleT context m () -> String -> ExampleT context m ()
forall a b. a -> b -> a
const (ExampleT context m () -> String -> ExampleT context m ())
-> ExampleT context m () -> String -> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ () -> ExampleT context m ()
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Build a Nix environment, as in 'introduceNixEnvironment'.
buildNixSymlinkJoin :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Package names
  => [Text] -> m FilePath
buildNixSymlinkJoin :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
[Text] -> m String
buildNixSymlinkJoin [Text]
packageNames = do
  NixContext {String
MVar (Map Text (Async String))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> String
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async String))
nixContextNixBinary :: String
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async String))
..} <- Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext
  Text -> m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m String
buildNixExpression (Text -> m String) -> Text -> m String
forall a b. (a -> b) -> a -> b
$ NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin NixpkgsDerivation
nixContextNixpkgsDerivation [Text]
packageNames

-- | Lower-level version of 'buildNixSymlinkJoin'.
buildNixSymlinkJoin' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix context
  => NixContext
  -- | Package names
  -> [Text]
  -> m FilePath
buildNixSymlinkJoin' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> [Text] -> m String
buildNixSymlinkJoin' nc :: NixContext
nc@(NixContext {String
MVar (Map Text (Async String))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> String
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async String))
nixContextNixBinary :: String
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async String))
..}) [Text]
packageNames = do
  NixContext -> Text -> m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m String
buildNixExpression' NixContext
nc (Text -> m String) -> Text -> m String
forall a b. (a -> b) -> a -> b
$ NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin NixpkgsDerivation
nixContextNixpkgsDerivation [Text]
packageNames

-- | Build a Nix environment expressed as a derivation expecting a list of dependencies, as in the
-- Nix "callPackage" design pattern. I.e.
-- "{ git, gcc, stdenv, ... }: stdenv.mkDerivation {...}"
buildNixCallPackageDerivation :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m, MonadMask m
  )
  -- | Nix derivation
  => Text
  -> m FilePath
buildNixCallPackageDerivation :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m, MonadMask m) =>
Text -> m String
buildNixCallPackageDerivation Text
derivation = do
  NixContext
nc <- Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext
  NixContext -> Text -> m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m,
 MonadMask m) =>
NixContext -> Text -> m String
buildNixCallPackageDerivation' NixContext
nc Text
derivation

-- | Lower-level version of 'buildNixCallPackageDerivation'
buildNixCallPackageDerivation' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m, MonadMask m
  )
  -- | Nix context.
  => NixContext
  -- | Nix derivation.
  -> Text
  -> m FilePath
buildNixCallPackageDerivation' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m,
 MonadMask m) =>
NixContext -> Text -> m String
buildNixCallPackageDerivation' nc :: NixContext
nc@(NixContext {String
MVar (Map Text (Async String))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> String
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async String))
nixContextNixBinary :: String
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async String))
..}) Text
derivation = do
  Async String -> m String
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait (Async String -> m String) -> m (Async String) -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar (Map Text (Async String))
-> (Map Text (Async String)
    -> m (Map Text (Async String), Async String))
-> m (Async String)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Text (Async String))
nixContextBuildCache (\Map Text (Async String)
m ->
    case Text -> Map Text (Async String) -> Maybe (Async String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
derivation Map Text (Async String)
m of
      Just Async String
x -> (Map Text (Async String), Async String)
-> m (Map Text (Async String), Async String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Async String)
m, Async String
x)
      Maybe (Async String)
Nothing -> do
        Async String
asy <- m String -> m (Async String)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m String -> m (Async String)) -> m String -> m (Async String)
forall a b. (a -> b) -> a -> b
$ do
          Maybe String
maybeNixExpressionDir <- m (Maybe String)
forall context (m :: * -> *).
HasBaseContextMonad context m =>
m (Maybe String)
getCurrentFolder m (Maybe String)
-> (Maybe String -> m (Maybe String)) -> m (Maybe String)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just String
dir -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> m String -> m (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m String -> m (Maybe String)) -> m String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
createTempDirectory String
dir String
"nix-expression"
            Maybe String
Nothing -> Maybe String -> m (Maybe String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

          Maybe String -> (String -> m String) -> m String
forall {m :: * -> *} {a}.
(MonadIO m, MonadMask m) =>
Maybe String -> (String -> m a) -> m a
withDerivationPath Maybe String
maybeNixExpressionDir ((String -> m String) -> m String)
-> (String -> m String) -> m String
forall a b. (a -> b) -> a -> b
$ \String
derivationPath -> do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
derivationPath Text
derivation
            NixContext -> Text -> Maybe String -> m String
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe String -> m String
runNixBuild' NixContext
nc (NixpkgsDerivation -> String -> Text
renderCallPackageDerivation NixpkgsDerivation
nixContextNixpkgsDerivation String
derivationPath) ((String -> ShowS
</> String
"gcroot") ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybeNixExpressionDir)

        (Map Text (Async String), Async String)
-> m (Map Text (Async String), Async String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> Async String
-> Map Text (Async String)
-> Map Text (Async String)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
derivation Async String
asy Map Text (Async String)
m, Async String
asy)
    )
  where
    withDerivationPath :: Maybe String -> (String -> m a) -> m a
withDerivationPath (Just String
nixExpressionDir) String -> m a
action = String -> m a
action (String
nixExpressionDir String -> ShowS
</> String
"default.nix")
    withDerivationPath Maybe String
Nothing String -> m a
action = String -> (String -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"nix-expression" ((String -> m a) -> m a) -> (String -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \String
dir -> String -> m a
action (String
dir String -> ShowS
</> String
"default.nix")


-- | Build a Nix environment containing the given list of packages, using the current 'NixContext'.
-- These packages are mashed together using the Nix "symlinkJoin" function. Their binaries will generally
-- be found in "\<environment path\>\/bin".
buildNixExpression :: (
  HasBaseContextMonad context m, HasNixContext context
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix expression
  => Text -> m FilePath
buildNixExpression :: forall context (m :: * -> *).
(HasBaseContextMonad context m, HasNixContext context,
 MonadUnliftIO m, MonadLogger m) =>
Text -> m String
buildNixExpression Text
expr = Label "nixContext" NixContext -> m NixContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "nixContext" NixContext
nixContext m NixContext -> (NixContext -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NixContext -> Text -> m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m String
`buildNixExpression'` Text
expr)

-- | Lower-level version of 'buildNixExpression'.
buildNixExpression' :: (
  HasBaseContextMonad context m
  , MonadUnliftIO m, MonadLogger m
  )
  -- | Nix expression
  => NixContext -> Text -> m FilePath
buildNixExpression' :: forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m String
buildNixExpression' nc :: NixContext
nc@(NixContext {String
MVar (Map Text (Async String))
NixpkgsDerivation
nixContextNixBinary :: NixContext -> String
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextBuildCache :: NixContext -> MVar (Map Text (Async String))
nixContextNixBinary :: String
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextBuildCache :: MVar (Map Text (Async String))
..}) Text
expr = do
  Async String -> m String
forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait (Async String -> m String) -> m (Async String) -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar (Map Text (Async String))
-> (Map Text (Async String)
    -> m (Map Text (Async String), Async String))
-> m (Async String)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Text (Async String))
nixContextBuildCache (\Map Text (Async String)
m ->
    case Text -> Map Text (Async String) -> Maybe (Async String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
expr Map Text (Async String)
m of
      Just Async String
x -> (Map Text (Async String), Async String)
-> m (Map Text (Async String), Async String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Async String)
m, Async String
x)
      Maybe (Async String)
Nothing -> do
        Async String
asy <- m String -> m (Async String)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m String -> m (Async String)) -> m String -> m (Async String)
forall a b. (a -> b) -> a -> b
$ do
          Maybe String
maybeNixExpressionDir <- m (Maybe String)
forall context (m :: * -> *).
HasBaseContextMonad context m =>
m (Maybe String)
getCurrentFolder m (Maybe String)
-> (Maybe String -> m (Maybe String)) -> m (Maybe String)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just String
dir -> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> m String -> m (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m String -> m (Maybe String)) -> m String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
createTempDirectory String
dir String
"nix-expression"
            Maybe String
Nothing -> Maybe String -> m (Maybe String)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
          NixContext -> Text -> Maybe String -> m String
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe String -> m String
runNixBuild' NixContext
nc Text
expr ((String -> ShowS
</> String
"gcroot") ShowS -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybeNixExpressionDir)

        (Map Text (Async String), Async String)
-> m (Map Text (Async String), Async String)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
-> Async String
-> Map Text (Async String)
-> Map Text (Async String)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
expr Async String
asy Map Text (Async String)
m, Async String
asy)
    )

-- runNixBuild :: (MonadUnliftIO m, MonadLogger m, MonadReader context m, HasNixContext context) => Text -> String -> m String
-- runNixBuild expr outputPath = do
--   nc <- getContext nixContext
--   runNixBuild' nc expr outputPath

runNixBuild' :: (MonadUnliftIO m, MonadLogger m) => NixContext -> Text -> Maybe String -> m String
runNixBuild' :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> Maybe String -> m String
runNixBuild' (NixContext {NixpkgsDerivation
nixContextNixpkgsDerivation :: NixContext -> NixpkgsDerivation
nixContextNixpkgsDerivation :: NixpkgsDerivation
nixContextNixpkgsDerivation}) Text
expr Maybe String
maybeOutputPath = do
  Maybe [(String, String)]
maybeEnv <- case NixpkgsDerivation -> Bool
nixpkgsDerivationAllowUnfree NixpkgsDerivation
nixContextNixpkgsDerivation of
    Bool
False -> Maybe [(String, String)] -> m (Maybe [(String, String)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [(String, String)]
forall a. Maybe a
Nothing
    Bool
True -> do
      [(String, String)]
env <- m [(String, String)]
forall (m :: * -> *). MonadIO m => m [(String, String)]
getEnvironment
      Maybe [(String, String)] -> m (Maybe [(String, String)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [(String, String)] -> m (Maybe [(String, String)]))
-> Maybe [(String, String)] -> m (Maybe [(String, String)])
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ((String
"NIXPKGS_ALLOW_UNFREE", String
"1") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
env)

  -- TODO: switch this to using nix-build so we can avoid the "--impure" flag?
  String
output <- CreateProcess -> String -> m String
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> String -> m String
readCreateProcessWithLogging (
    (String -> [String] -> CreateProcess
proc String
"nix" ([String
"build"
                 , String
"--impure"
                 , String
"--extra-experimental-features", String
"nix-command"
                 , String
"--expr", Text -> String
forall a. ToString a => a -> String
toString Text
expr
                 , String
"--json"
                 ] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (case Maybe String
maybeOutputPath of Maybe String
Nothing -> []; Just String
p -> [String
"-o", String
p])
                )) { env = maybeEnv }
    ) String
""

  case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict (String -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 String
output) of
    Right (A.Array (Array -> [Value]
forall a. Vector a -> [a]
V.toList -> ((A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"outputs" -> Just (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"out" -> Just (A.String Text
p))))):[Value]
_))) -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
forall a. ToString a => a -> String
toString Text
p)
    Right (A.Array (Array -> [Value]
forall a. Vector a -> [a]
V.toList -> ((A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"outputs" -> Just (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"bin" -> Just (A.String Text
p))))):[Value]
_))) -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
forall a. ToString a => a -> String
toString Text
p)
    Either String Value
x -> String -> m String
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Couldn't parse Nix build JSON output: #{x} (output was #{A.encode output})|]

renderNixSymlinkJoin :: NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin :: NixpkgsDerivation -> [Text] -> Text
renderNixSymlinkJoin (NixpkgsDerivationFetchFromGitHub {Bool
Text
nixpkgsDerivationOwner :: NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: NixpkgsDerivation -> Text
nixpkgsDerivationRev :: NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: NixpkgsDerivation -> Text
nixpkgsDerivationAllowUnfree :: NixpkgsDerivation -> Bool
nixpkgsDerivationOwner :: Text
nixpkgsDerivationRepo :: Text
nixpkgsDerivationRev :: Text
nixpkgsDerivationSha256 :: Text
nixpkgsDerivationAllowUnfree :: Bool
..}) [Text]
packageNames = [i|
\# Use the ambient <nixpkgs> channel to bootstrap
with {
  inherit (import (<nixpkgs>) {})
  fetchgit fetchFromGitHub;
};

let
  nixpkgs = fetchFromGitHub {
    owner = "#{nixpkgsDerivationOwner}";
    repo = "#{nixpkgsDerivationRepo}";
    rev = "#{nixpkgsDerivationRev}";
    sha256 = "#{nixpkgsDerivationSha256}";
  };

  pkgs = import nixpkgs {};
in

pkgs.symlinkJoin { name = "test-contexts-environment"; paths = with pkgs; [#{T.intercalate " " packageNames}]; }
|]

renderCallPackageDerivation :: NixpkgsDerivation -> FilePath -> Text
renderCallPackageDerivation :: NixpkgsDerivation -> String -> Text
renderCallPackageDerivation (NixpkgsDerivationFetchFromGitHub {Bool
Text
nixpkgsDerivationOwner :: NixpkgsDerivation -> Text
nixpkgsDerivationRepo :: NixpkgsDerivation -> Text
nixpkgsDerivationRev :: NixpkgsDerivation -> Text
nixpkgsDerivationSha256 :: NixpkgsDerivation -> Text
nixpkgsDerivationAllowUnfree :: NixpkgsDerivation -> Bool
nixpkgsDerivationOwner :: Text
nixpkgsDerivationRepo :: Text
nixpkgsDerivationRev :: Text
nixpkgsDerivationSha256 :: Text
nixpkgsDerivationAllowUnfree :: Bool
..}) String
derivationPath = [i|
\# Use the ambient <nixpkgs> channel to bootstrap
with {
  inherit (import (<nixpkgs>) {})
  fetchgit fetchFromGitHub;
};

let
  nixpkgs = fetchFromGitHub {
    owner = "#{nixpkgsDerivationOwner}";
    repo = "#{nixpkgsDerivationRepo}";
    rev = "#{nixpkgsDerivationRev}";
    sha256 = "#{nixpkgsDerivationSha256}";
  };

  pkgs = import nixpkgs {};
in

pkgs.callPackage #{show derivationPath :: String} {}
|]