From 06b0fca9fd607eb2e995f003424e797a41ffa5b7 Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Wed, 30 Dec 2020 14:35:48 +0200
Subject: [PATCH 1/9] cabal.project: override the cryptohash-sha512

This should be temporary.
---
 cabal.project | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/cabal.project b/cabal.project
index ea0721169..e38ef5005 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,2 +1,8 @@
 packages:
   ./hnix.cabal
+
+source-repository-package
+    type: git
+    location: https://github.com/Anton-Latukha/cryptohash-sha512
+    tag: 48f827eb09a73ad5ee43dd397a06ebdbf51ab856
+

From a8e6d28fdb98a1c34f425c8395338fdabe96becc Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Mon, 26 Oct 2020 17:46:51 +0100
Subject: [PATCH 2/9] Allow custom computations inside string contexts

---
 src/Nix/String.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/src/Nix/String.hs b/src/Nix/String.hs
index ae0679e86..126f37257 100644
--- a/src/Nix/String.hs
+++ b/src/Nix/String.hs
@@ -32,7 +32,9 @@ module Nix.String
   , addStringContext
   , addSingletonStringContext
   , runWithStringContextT
+  , runWithStringContextT'
   , runWithStringContext
+  , runWithStringContext'
   )
 where
 
@@ -231,6 +233,16 @@ runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString
 runWithStringContextT (WithStringContextT m) =
   uncurry NixString <$> runWriterT m
 
+-- | Run an action that manipulates nix strings, and collect the contexts encountered.
+-- Warning: this may be unsafe, depending on how you handle the resulting context list.
+runWithStringContextT' :: Monad m => WithStringContextT m a -> m (a, S.HashSet StringContext)
+runWithStringContextT' (WithStringContextT m) = runWriterT m
+
 -- | Run an action producing a string with a context and put those into a 'NixString'.
 runWithStringContext :: WithStringContextT Identity Text -> NixString
 runWithStringContext = runIdentity . runWithStringContextT
+
+-- | Run an action that manipulates nix strings, and collect the contexts encountered.
+-- Warning: this may be unsafe, depending on how you handle the resulting context list.
+runWithStringContext' :: WithStringContextT Identity a -> (a, S.HashSet StringContext)
+runWithStringContext' = runIdentity . runWithStringContextT'

From 9bcfbbe88ff0bd8d803296193ee1d8603dc5289e Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Mon, 26 Oct 2020 17:46:51 +0100
Subject: [PATCH 3/9] Principled nvpath -> nvstring coercion

---
 src/Nix/Convert.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Nix/Convert.hs b/src/Nix/Convert.hs
index 4dbf7f595..93192da56 100644
--- a/src/Nix/Convert.hs
+++ b/src/Nix/Convert.hs
@@ -151,7 +151,7 @@ instance ( Convertible e t f m
     NVStr' ns -> pure $ Just ns
     NVPath' p ->
       Just
-        .   hackyMakeNixStringWithoutContext
+        .   (\s -> principledMakeNixStringWithSingletonContext s (StringContext s DirectPath))
         .   Text.pack
         .   unStorePath
         <$> addPath p

From 3bba5549273c892c60aad5dd6d5058a8db40efbf Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Mon, 26 Oct 2020 17:46:51 +0100
Subject: [PATCH 4/9] Implement derivationStrict primOp

---
 hnix.cabal                    |   6 +-
 src/Nix/Effects.hs            |  81 ++++---
 src/Nix/Effects/Basic.hs      |  49 +----
 src/Nix/Effects/Derivation.hs | 388 ++++++++++++++++++++++++++++++++++
 src/Nix/Fresh/Basic.hs        |   4 +-
 src/Nix/Standard.hs           |   5 +-
 6 files changed, 453 insertions(+), 80 deletions(-)
 create mode 100644 src/Nix/Effects/Derivation.hs

diff --git a/hnix.cabal b/hnix.cabal
index 383472a7b..716ae1705 100644
--- a/hnix.cabal
+++ b/hnix.cabal
@@ -341,6 +341,7 @@ library
       Nix.Convert
       Nix.Effects
       Nix.Effects.Basic
+      Nix.Effects.Derivation
       Nix.Eval
       Nix.Exec
       Nix.Expr
@@ -401,8 +402,9 @@ library
     , gitrev >= 1.1.0 && < 1.4
     , hashable >= 1.2.5 && < 1.4
     , hashing >= 0.1.0 && < 0.2
-    , hnix-store-core >= 0.1.0 && < 0.3
-    , http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.8
+    , hnix-store-core >= 0.3.0 && < 0.4
+    , hnix-store-remote >= 0.2.0 && < 0.3
+    , http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.7
     , http-client-tls >= 0.3.5 && < 0.4
     , http-types >= 0.12.2 && < 0.13
     , lens-family >= 1.2.2 && < 2.2
diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index 1c9583637..c1df93300 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -7,6 +7,8 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Nix.Effects where
 
@@ -17,24 +19,31 @@ import           Prelude                 hiding ( putStr
 import qualified Prelude
 
 import           Control.Monad.Trans
+import qualified Data.HashSet                  as HS
 import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
-import           Network.HTTP.Client     hiding ( path )
+import qualified Data.Text.Encoding            as T
+import           Network.HTTP.Client     hiding ( path, Proxy )
 import           Network.HTTP.Client.TLS
 import           Network.HTTP.Types
 import           Nix.Expr
-import           Nix.Frames
+import           Nix.Frames              hiding ( Proxy )
 import           Nix.Parser
 import           Nix.Render
 import           Nix.Utils
 import           Nix.Value
 import qualified Paths_hnix
-import qualified System.Directory              as S
 import           System.Environment
 import           System.Exit
+import           System.FilePath                ( takeFileName )
 import qualified System.Info
 import           System.Process
 
+import qualified System.Nix.Hash               as Store
+import qualified System.Nix.Store.Remote       as Store
+import qualified System.Nix.Store.Remote.Types as Store
+import qualified System.Nix.StorePath          as Store
+
 -- | A path into the nix store
 newtype StorePath = StorePath { unStorePath :: FilePath }
 
@@ -226,36 +235,54 @@ print = putStrLn . show
 instance MonadPutStr IO where
   putStr = Prelude.putStr
 
+
+type RecursiveFlag = Bool
+type RepairFlag = Bool
+type StorePathName = Text
+type FilePathFilter m = FilePath -> m Bool
+type StorePathSet = HS.HashSet StorePath
+
 class Monad m => MonadStore m where
-    -- | Import a path into the nix store, and return the resulting path
-    addPath' :: FilePath -> m (Either ErrorCall StorePath)
 
-    -- | Add a file with the given name and contents to the nix store
-    toFile_' :: FilePath -> String -> m (Either ErrorCall StorePath)
+    -- | Add a path to the store, with bells and whistles
+    addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
+    default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
+    addToStore a b c d = lift $ addToStore a b c d
+
+    -- | Add a nar (action) to the store
+    -- addToStore' :: StorePathName -> IO Nar -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
+
+    addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
+    default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
+    addTextToStore' a b c d = lift $ addTextToStore' a b c d
+
+parseStoreResult :: Monad m => String -> (Either String a, [Store.Logger]) -> m (Either ErrorCall a)
+parseStoreResult name res = case res of
+  (Left msg, logs) -> return $ Left $ ErrorCall $ "Failed to execute '" ++ name ++ "': " ++ msg ++ "\n" ++ show logs
+  (Right result, _) -> return $ Right result
 
 instance MonadStore IO where
-  addPath' path = do
-    (exitCode, out, _) <- readProcessWithExitCode "nix-store" ["--add", path] ""
-    case exitCode of
-      ExitSuccess -> do
-        let dropTrailingLinefeed p = take (length p - 1) p
-        pure $ Right $ StorePath $ dropTrailingLinefeed out
-      _ ->
-        pure
-          $  Left
-          $  ErrorCall
-          $  "addPath: failed: nix-store --add "
-          ++ show path
 
-  --TODO: Use a temp directory so we don't overwrite anything important
-  toFile_' filepath content = do
-    writeFile filepath content
-    storepath <- addPath' filepath
-    S.removeFile filepath
-    pure storepath
+  addToStore name path recursive repair = case Store.makeStorePathName name of
+    Left err -> return $ Left $ ErrorCall $ "String '" ++ show name ++ "' is not a valid path name: " ++ err
+    Right pathName -> do
+      -- TODO: redesign the filter parameter
+      res <- Store.runStore $ Store.addToStore @'Store.SHA256 pathName path recursive (const False) repair
+      parseStoreResult "addToStore" res >>= \case
+        Left err -> return $ Left err
+        Right storePath -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath storePath
+
+  addTextToStore' name text references repair = do
+    res <- Store.runStore $ Store.addTextToStore name text references repair
+    parseStoreResult "addTextToStore" res >>= \case
+      Left err -> return $ Left err
+      Right path -> return $ Right $ StorePath $ T.unpack $ T.decodeUtf8 $ Store.storePathToRawFilePath path
+
+addTextToStore :: (Framed e m, MonadStore m) => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m StorePath
+addTextToStore a b c d = either throwError return =<< addTextToStore' a b c d
 
 addPath :: (Framed e m, MonadStore m) => FilePath -> m StorePath
-addPath p = either throwError pure =<< addPath' p
+addPath p = either throwError return =<< addToStore (T.pack $ takeFileName p) p True False
 
 toFile_ :: (Framed e m, MonadStore m) => FilePath -> String -> m StorePath
-toFile_ p contents = either throwError pure =<< toFile_' p contents
+toFile_ p contents = addTextToStore (T.pack p) (T.pack contents) HS.empty False
diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs
index 1aa86217c..d9916cd4b 100644
--- a/src/Nix/Effects/Basic.hs
+++ b/src/Nix/Effects/Basic.hs
@@ -8,10 +8,6 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
 module Nix.Effects.Basic where
 
 import           Control.Monad
@@ -20,30 +16,24 @@ import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
 import           Data.List
 import           Data.List.Split
-import           Data.Maybe                     ( maybeToList )
 import           Data.Text                      ( Text )
 import qualified Data.Text                     as Text
-import           Nix.Atoms
+import           Data.Text.Prettyprint.Doc
 import           Nix.Convert
 import           Nix.Effects
 import           Nix.Exec                       ( MonadNix
-                                                , callFunc
                                                 , evalExprLoc
                                                 , nixInstantiateExpr
                                                 )
 import           Nix.Expr
 import           Nix.Frames
-import           Nix.Normal
 import           Nix.Parser
-import           Nix.Pretty
 import           Nix.Render
 import           Nix.Scope
 import           Nix.String
-import           Nix.String.Coerce
 import           Nix.Utils
 import           Nix.Value
 import           Nix.Value.Monad
-import           Prettyprinter
 import           System.FilePath
 
 #ifdef MIN_VERSION_ghc_datasize
@@ -126,8 +116,8 @@ findPathBy
   -> [NValue t f m]
   -> FilePath
   -> m FilePath
-findPathBy finder l name = do
-  mpath <- foldM go Nothing l
+findPathBy finder ls name = do
+  mpath <- foldM go Nothing ls
   case mpath of
     Nothing ->
       throwError
@@ -264,38 +254,5 @@ pathToDefaultNixFile p = do
   isDir <- doesDirectoryExist p
   pure $ if isDir then p </> "default.nix" else p
 
-defaultDerivationStrict
-  :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
-defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
-  nn <- maybe (pure False) (demand ?? fromValue) (M.lookup "__ignoreNulls" s)
-  s' <- M.fromList <$> mapMaybeM (handleEntry nn) (M.toList s)
-  v' <- normalForm =<< toValue @(AttrSet (NValue t f m)) @_ @(NValue t f m) s'
-  nixInstantiateExpr $ "derivationStrict " ++ show (prettyNValue v')
- where
-  mapMaybeM :: (a -> m (Maybe b)) -> [a] -> m [b]
-  mapMaybeM op = foldr f (pure [])
-    where f x xs = op x >>= (<$> xs) . (++) . maybeToList
-
-  handleEntry :: Bool -> (Text, NValue t f m) -> m (Maybe (Text, NValue t f m))
-  handleEntry ignoreNulls (k, v) = fmap (k, ) <$> case k of
-      -- The `args' attribute is special: it supplies the command-line
-      -- arguments to the builder.
-      -- TODO This use of coerceToString is probably not right and may
-      -- not have the right arguments.
-    "args"          -> demand v $ fmap Just . coerceNixList
-    "__ignoreNulls" -> pure Nothing
-    _               -> demand v $ \case
-      NVConstant NNull | ignoreNulls -> pure Nothing
-      v'                             -> Just <$> coerceNix v'
-   where
-    coerceNix :: NValue t f m -> m (NValue t f m)
-    coerceNix = toValue <=< coerceToString callFunc CopyToStore CoerceAny
-
-    coerceNixList :: NValue t f m -> m (NValue t f m)
-    coerceNixList v = do
-      xs <- fromValue @[NValue t f m] v
-      ys <- traverse (`demand` coerceNix) xs
-      toValue @[NValue t f m] ys
-
 defaultTraceEffect :: MonadPutStr m => String -> m ()
 defaultTraceEffect = Nix.Effects.putStrLn
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
new file mode 100644
index 000000000..b16486ab4
--- /dev/null
+++ b/src/Nix/Effects/Derivation.hs
@@ -0,0 +1,388 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+ 
+
+module Nix.Effects.Derivation ( defaultDerivationStrict ) where
+
+import           Prelude                 hiding ( readFile )
+
+import           Control.Arrow                  ( first, second )
+import           Control.Monad                  ( (>=>), forM, when )
+import           Control.Monad.Writer           ( join, lift )
+
+import           Data.Char                      ( isAscii, isAlphaNum )
+import qualified Data.HashMap.Lazy             as M
+import qualified Data.HashSet                  as S
+import           Data.List
+import qualified Data.Map.Strict               as Map
+import           Data.Map.Strict                ( Map )
+import qualified Data.Set                      as Set
+import           Data.Set                       ( Set )
+import           Data.Text                      ( Text )
+import qualified Data.Text                     as Text
+import qualified Data.Text.Encoding            as Text
+
+import           Nix.Atoms
+import           Nix.Convert
+import           Nix.Effects
+import           Nix.Exec                       ( MonadNix , callFunc)
+import           Nix.Frames
+import           Nix.Json                       ( nvalueToJSONNixString )
+import           Nix.Render
+import           Nix.String
+import           Nix.String.Coerce
+import           Nix.Utils               hiding ( readFile )
+import           Nix.Value
+import           Nix.Value.Monad
+
+import qualified System.Nix.ReadonlyStore      as Store
+import qualified System.Nix.Hash               as Store
+import qualified System.Nix.StorePath          as Store
+
+import           Text.Megaparsec
+import           Text.Megaparsec.Char
+
+
+data Derivation = Derivation
+  { name :: Text
+  , outputs :: Map Text Text
+  , inputs :: (Set Text, Map Text [Text])
+  , platform :: Text
+  , builder :: Text -- should be typed as a store path
+  , args :: [ Text ]
+  , env :: Map Text Text
+  , mFixed :: Maybe Store.SomeNamedDigest
+  , hashMode :: HashMode
+  , useJson :: Bool
+  }
+  deriving Show
+
+defaultDerivation :: Derivation
+defaultDerivation = Derivation
+  { name        = undefined
+  , outputs     = Map.empty
+  , inputs      = (Set.empty, Map.empty)
+  , platform    = undefined
+  , builder     = undefined
+  , args        = []
+  , env         = Map.empty
+  , mFixed      = Nothing
+  , hashMode    = Flat
+  , useJson     = False
+  }
+
+data HashMode = Flat | Recursive
+  deriving (Show, Eq)
+
+makeStorePathName :: (Framed e m) => Text -> m Store.StorePathName
+makeStorePathName name = case Store.makeStorePathName name of
+  Left err -> throwError $ ErrorCall $ "Invalid name '" ++ show name ++ "' for use in a store path: " ++ err
+  Right spname -> return spname
+
+parsePath :: (Framed e m) => Text -> m Store.StorePath
+parsePath p = case Store.parsePath "/nix/store" (Text.encodeUtf8 p) of
+  Left err -> throwError $ ErrorCall $ "Cannot parse store path " ++ show p ++ ":\n" ++ show err
+  Right path -> return path
+
+writeDerivation :: (Framed e m, MonadStore m) => Derivation -> m Store.StorePath
+writeDerivation (drv@Derivation {inputs, name}) = do
+  let (inputSrcs, inputDrvs) = inputs
+  references <- Set.fromList <$> (mapM parsePath $ Set.toList $ inputSrcs `Set.union` (Set.fromList $ Map.keys inputDrvs))
+  path <- addTextToStore (Text.append name ".drv") (unparseDrv drv) (S.fromList $ Set.toList references) False
+  parsePath $ Text.pack $ unStorePath path
+
+-- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash.
+-- this avoids propagating changes to their .drv when the output hash stays the same.
+hashDerivationModulo :: (Framed e m, MonadFile m) => Derivation -> m (Store.Digest 'Store.SHA256)
+hashDerivationModulo (Derivation {
+    mFixed = Just (Store.SomeDigest (digest :: Store.Digest hashType)),
+    outputs,
+    hashMode
+  }) = case Map.toList outputs of
+    [("out", path)] -> return $ Store.hash @'Store.SHA256 $ Text.encodeUtf8
+      $  "fixed:out"
+      <> (if hashMode == Recursive then ":r" else "")
+      <> ":" <> (Store.algoName @hashType)
+      <> ":" <> (Store.encodeBase16 digest)
+      <> ":" <> path
+    outputsList -> throwError $ ErrorCall $ "This is weird. A fixed output drv should only have one output named 'out'. Got " ++ show outputsList
+hashDerivationModulo drv@(Derivation {inputs = (inputSrcs, inputDrvs)}) = do
+  inputsModulo <- Map.fromList <$> forM (Map.toList inputDrvs) (\(path, outs) -> do
+    drv' <- readDerivation $ Text.unpack path
+    hash <- Store.encodeBase16 <$> hashDerivationModulo drv'
+    return (hash, outs)
+    )
+  return $ Store.hash @'Store.SHA256 $ Text.encodeUtf8 $ unparseDrv (drv {inputs = (inputSrcs, inputsModulo)})
+
+unparseDrv :: Derivation -> Text
+unparseDrv (Derivation {..}) = Text.append "Derive" $ parens
+    [ -- outputs: [("out", "/nix/store/.....-out", "", ""), ...]
+      list $ flip map (Map.toList outputs) (\(outputName, outputPath) ->
+        let prefix = if hashMode == Recursive then "r:" else "" in
+        case mFixed of
+          Nothing -> parens [s outputName, s outputPath, s "", s ""]
+          Just (Store.SomeDigest (digest :: Store.Digest hashType)) ->
+            parens [s outputName, s outputPath, s $ prefix <> Store.algoName @hashType, s $ Store.encodeBase16 digest]
+        )
+    , -- inputDrvs
+      list $ flip map (Map.toList $ snd inputs) (\(path, outs) ->
+        parens [s path, list $ map s $ sort outs])
+    , -- inputSrcs
+      list (map s $ Set.toList $ fst inputs)
+    , s platform
+    , s builder
+    , -- run script args
+      list $ map s args
+    , -- env (key value pairs)
+      list $ flip map (Map.toList env) (\(k, v) ->
+        parens [s k, s v])
+    ]
+  where
+    parens :: [Text] -> Text
+    parens ts = Text.concat ["(", Text.intercalate "," ts, ")"]
+    list   :: [Text] -> Text
+    list   ls = Text.concat ["[", Text.intercalate "," ls, "]"]
+    s = (Text.cons '\"') . (flip Text.snoc '\"') . Text.concatMap escape
+    escape :: Char -> Text
+    escape '\\' = "\\\\"
+    escape '\"' = "\\\""
+    escape '\n' = "\\n"
+    escape '\r' = "\\r"
+    escape '\t' = "\\t"
+    escape c = Text.singleton c
+
+readDerivation :: (Framed e m, MonadFile m) => FilePath -> m Derivation
+readDerivation path = do
+  content <- Text.decodeUtf8 <$> readFile path
+  case parse derivationParser path content of
+    Left err -> throwError $ ErrorCall $ "Failed to parse " ++ show path ++ ":\n" ++ show err
+    Right drv -> return drv
+
+derivationParser :: Parsec () Text Derivation
+derivationParser = do
+  _ <- "Derive("
+  fullOutputs <- list $
+    fmap (\[n, p, ht, h] -> (n, p, ht, h)) $ parens s
+  _ <- ","
+  inputDrvs   <- fmap Map.fromList $ list $
+    fmap (,) ("(" *> s <* ",") <*> (list s <* ")")
+  _ <- ","
+  inputSrcs   <- fmap Set.fromList $ list s
+  _ <- ","
+  platform    <- s
+  _ <- ","
+  builder     <- s
+  _ <- ","
+  args        <- list s
+  _ <- ","
+  env         <- fmap Map.fromList $ list $ fmap (\[a, b] -> (a, b)) $ parens s
+  _ <- ")"
+  eof
+
+  let outputs = Map.fromList $ map (\(a, b, _, _) -> (a, b)) fullOutputs
+  let (mFixed, hashMode) = parseFixed fullOutputs
+  let name = "" -- FIXME (extract from file path ?)
+  let useJson = ["__json"] == Map.keys env
+
+  return $ Derivation {inputs = (inputSrcs, inputDrvs), ..}
+ where
+  s :: Parsec () Text Text
+  s = fmap Text.pack $ string "\"" *> manyTill (escaped <|> regular) (string "\"")
+  escaped = char '\\' *>
+    (   '\n' <$ string "n"
+    <|> '\r' <$ string "r"
+    <|> '\t' <$ string "t"
+    <|> anySingle
+    )
+  regular = noneOf ['\\', '"']
+
+  parens :: Parsec () Text a -> Parsec () Text [a]
+  parens p = (string "(") *> sepBy p (string ",") <* (string ")")
+  list   p = (string "[") *> sepBy p (string ",") <* (string "]")
+
+  parseFixed :: [(Text, Text, Text, Text)] -> (Maybe Store.SomeNamedDigest, HashMode)
+  parseFixed fullOutputs = case fullOutputs of
+    [("out", _path, rht, hash)] | rht /= "" && hash /= "" ->
+      let (hashType, hashMode) = case Text.splitOn ":" rht of
+            ["r", ht] -> (ht, Recursive)
+            [ht] ->      (ht, Flat)
+            _ -> undefined -- What ?! -- TODO: Throw a proper error
+      in case Store.mkNamedDigest hashType hash of
+        Right digest -> (Just digest, hashMode)
+        Left _err -> undefined -- TODO: Raise a proper parse error.
+    _ -> (Nothing, Flat)
+
+
+defaultDerivationStrict :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
+defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
+    (drv, ctx) <- runWithStringContextT' $ buildDerivationWithContext s
+    drvName <- makeStorePathName $ name drv
+    let inputs = toStorePaths ctx
+
+    -- Compute the output paths, and add them to the environment if needed.
+    -- Also add the inputs, just computed from the strings contexts.
+    drv' <- case mFixed drv of
+      Just (Store.SomeDigest digest) -> do
+        let out = pathToText $ Store.makeFixedOutputPath "/nix/store" (hashMode drv == Recursive) digest drvName
+        let env' = if useJson drv then env drv else Map.insert "out" out (env drv)
+        return $ drv { inputs, env = env', outputs = Map.singleton "out" out }
+
+      Nothing -> do
+        hash <- hashDerivationModulo $ drv
+          { inputs
+        --, outputs = Map.map (const "") (outputs drv)  -- not needed, this is already the case
+          , env = if useJson drv then env drv
+                  else foldl' (\m k -> Map.insert k "" m) (env drv) (Map.keys $ outputs drv)
+          }
+        outputs' <- sequence $ Map.mapWithKey (\o _ -> makeOutputPath o hash drvName) (outputs drv)
+        return $ drv
+          { inputs
+          , outputs = outputs'
+          , env = if useJson drv then env drv else Map.union outputs' (env drv)
+          }
+
+    drvPath <- writeDerivation drv'
+
+    -- TODO: memoize this result here.
+    -- _ <- hashDerivationModulo drv'
+
+    let outputsWithContext = Map.mapWithKey (\out path -> principledMakeNixStringWithSingletonContext path (StringContext (pathToText drvPath) (DerivationOutput out))) (outputs drv')
+        drvPathWithContext = principledMakeNixStringWithSingletonContext (pathToText drvPath) (StringContext (pathToText drvPath) AllOutputs)
+        attrSet = M.map nvStr $ M.fromList $ ("drvPath", drvPathWithContext): Map.toList outputsWithContext
+    -- TODO: Add location information for all the entries.
+    --              here --v
+    return $ nvSet attrSet M.empty
+
+  where
+
+    pathToText = Text.decodeUtf8 . Store.storePathToRawFilePath
+
+    makeOutputPath o h n = do
+      name <- makeStorePathName (Store.unStorePathName n <> if o == "out" then "" else "-" <> o)
+      return $ pathToText $ Store.makeStorePath "/nix/store" ("output:" <> Text.encodeUtf8 o) h name
+
+    toStorePaths ctx = foldl (flip addToInputs) (Set.empty, Map.empty) ctx
+    addToInputs (StringContext path kind) = case kind of
+      DirectPath -> first (Set.insert path)
+      DerivationOutput o -> second (Map.insertWith (++) path [o])
+      AllOutputs ->
+        -- TODO: recursive lookup. See prim_derivationStrict
+        -- XXX: When is this really used ?
+        undefined
+
+
+-- | Build a derivation in a context collecting string contexts.
+-- This is complex from a typing standpoint, but it allows to perform the
+-- full computation without worrying too much about all the string's contexts.
+buildDerivationWithContext :: forall e t f m. (MonadNix e t f m) => AttrSet (NValue t f m) -> WithStringContextT m Derivation
+buildDerivationWithContext drvAttrs = do
+    -- Parse name first, so we can add an informative frame
+    drvName     <- getAttr   "name"                      $ extractNixString >=> assertDrvStoreName
+    withFrame' Info (ErrorCall $ "While evaluating derivation " ++ show drvName) $ do
+
+      useJson     <- getAttrOr "__structuredAttrs" False   $ return
+      ignoreNulls <- getAttrOr "__ignoreNulls"     False   $ return
+
+      args        <- getAttrOr "args"              []      $ mapM (fromValue' >=> extractNixString)
+      builder     <- getAttr   "builder"                   $ extractNixString
+      platform    <- getAttr   "system"                    $ extractNoCtx >=> assertNonNull
+      mHash       <- getAttrOr "outputHash"        Nothing $ extractNoCtx >=> (return . Just)
+      hashMode    <- getAttrOr "outputHashMode"    Flat    $ extractNoCtx >=> parseHashMode
+      outputs     <- getAttrOr "outputs"           ["out"] $ mapM (fromValue' >=> extractNoCtx)
+
+      mFixedOutput <- case mHash of
+        Nothing -> return Nothing
+        Just hash -> do
+          when (outputs /= ["out"]) $ lift $ throwError $ ErrorCall $ "Multiple outputs are not supported for fixed-output derivations"
+          hashType <- getAttr "outputHashAlgo" $ extractNoCtx
+          digest <- lift $ either (throwError . ErrorCall) return $ Store.mkNamedDigest hashType hash
+          return $ Just digest
+
+      -- filter out null values if needed.
+      attrs <- if not ignoreNulls
+        then return drvAttrs
+        else M.mapMaybe id <$> forM drvAttrs (demand' ?? (\case
+            NVConstant NNull -> return Nothing
+            value -> return $ Just value
+          ))
+
+      env <- if useJson
+        then do
+          jsonString :: NixString <- lift $ nvalueToJSONNixString $ flip nvSet M.empty $
+            deleteKeys [ "args", "__ignoreNulls", "__structuredAttrs" ] attrs
+          rawString :: Text <- extractNixString jsonString
+          return $ Map.singleton "__json" rawString
+        else
+          mapM (lift . coerceToString callFunc CopyToStore CoerceAny >=> extractNixString) $
+            Map.fromList $ M.toList $ deleteKeys [ "args", "__ignoreNulls" ] attrs
+
+      return $ defaultDerivation { platform, builder, args, env,  hashMode, useJson
+        , name = drvName
+        , outputs = Map.fromList $ map (\o -> (o, "")) outputs
+        , mFixed = mFixedOutput
+        }
+  where
+    -- common functions, lifted to WithStringContextT
+
+    demand' :: NValue t f m -> (NValue t f m -> WithStringContextT m a) -> WithStringContextT m a
+    demand' v f = join $ lift $ demand v (return . f)
+
+    fromValue' :: (FromValue a m (NValue' t f m (NValue t f m)), MonadNix e t f m) => NValue t f m -> WithStringContextT m a
+    fromValue' = lift . fromValue
+
+    withFrame' :: (Framed e m, Exception s) => NixLevel -> s -> WithStringContextT m a -> WithStringContextT m a
+    withFrame' level f = join . lift . withFrame level f . return
+
+    -- shortcuts to get the (forced) value of an AttrSet field
+
+    getAttrOr' :: forall v a. (MonadNix e t f m, FromValue v m (NValue' t f m (NValue t f m)))
+      => Text -> m a -> (v -> WithStringContextT m a) -> WithStringContextT m a
+    getAttrOr' n d f = case M.lookup n drvAttrs of
+      Nothing -> lift d
+      Just v  -> withFrame' Info (ErrorCall $ "While evaluating attribute '" ++ show n ++ "'") $
+                   fromValue' v >>= f
+
+    getAttrOr n d f = getAttrOr' n (return d) f
+
+    getAttr n = getAttrOr' n (throwError $ ErrorCall $ "Required attribute '" ++ show n ++ "' not found.")
+
+    -- Test validity for fields
+
+    assertDrvStoreName :: MonadNix e t f m => Text -> WithStringContextT m Text
+    assertDrvStoreName name = lift $ do
+      let invalid c = not $ isAscii c && (isAlphaNum c || c `elem` ("+-._?=" :: String)) -- isAlphaNum allows non-ascii chars.
+      let failWith reason = throwError $ ErrorCall $ "Store name " ++ show name ++ " " ++ reason
+      when ("." `Text.isPrefixOf` name)    $ failWith "cannot start with a period"
+      when (Text.length name > 211)        $ failWith "must be no longer than 211 characters"
+      when (Text.any invalid name)         $ failWith "contains some invalid character"
+      when (".drv" `Text.isSuffixOf` name) $ failWith "is not allowed to end in '.drv'"
+      return name
+
+    extractNoCtx :: MonadNix e t f m => NixString -> WithStringContextT m Text
+    extractNoCtx ns = case principledGetStringNoContext ns of
+      Nothing -> lift $ throwError $ ErrorCall $ "The string " ++ show ns ++ " is not allowed to have a context."
+      Just v -> return v
+
+    assertNonNull :: MonadNix e t f m => Text -> WithStringContextT m Text
+    assertNonNull t = do
+      when (Text.null t) $ lift $ throwError $ ErrorCall "Value must not be empty"
+      return t
+
+    parseHashMode :: MonadNix e t f m => Text -> WithStringContextT m HashMode
+    parseHashMode = \case
+      "flat" ->      return Flat
+      "recursive" -> return Recursive
+      other -> lift $ throwError $ ErrorCall $ "Hash mode " ++ show other ++ " is not valid. It must be either 'flat' or 'recursive'"
+
+    -- Other helpers
+
+    deleteKeys :: [Text] -> AttrSet a -> AttrSet a
+    deleteKeys keys attrSet = foldl' (flip M.delete) attrSet keys
+
diff --git a/src/Nix/Fresh/Basic.hs b/src/Nix/Fresh/Basic.hs
index 2c0e96ed2..7f24b4c70 100644
--- a/src/Nix/Fresh/Basic.hs
+++ b/src/Nix/Fresh/Basic.hs
@@ -22,9 +22,7 @@ type StdIdT = FreshIdT Int
 
 instance (MonadFail m, MonadFile m) => MonadFile (StdIdT m)
 instance MonadIntrospect m => MonadIntrospect (StdIdT m)
-instance MonadStore m => MonadStore (StdIdT m) where
-  addPath' = lift . addPath'
-  toFile_' = (lift .) . toFile_'
+instance MonadStore m => MonadStore (StdIdT m)
 instance MonadPutStr m => MonadPutStr (StdIdT m)
 instance MonadHttp m => MonadHttp (StdIdT m)
 instance MonadEnv m => MonadEnv (StdIdT m)
diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs
index 56ab09157..ad483e66d 100644
--- a/src/Nix/Standard.hs
+++ b/src/Nix/Standard.hs
@@ -37,6 +37,7 @@ import           Nix.Cited.Basic
 import           Nix.Context
 import           Nix.Effects
 import           Nix.Effects.Basic
+import           Nix.Effects.Derivation
 import           Nix.Expr.Types.Annotated
 import           Nix.Fresh
 import           Nix.Fresh.Basic
@@ -82,8 +83,8 @@ instance (MonadFix1T t m, MonadAtomicRef m) => MonadAtomicRef (Fix1T t m) where
 instance (MonadFix1T t m, MonadFail (Fix1T t m), MonadFile m) => MonadFile (Fix1T t m)
 
 instance (MonadFix1T t m, MonadStore m) => MonadStore (Fix1T t m) where
-  addPath' = lift . addPath'
-  toFile_' n = lift . toFile_' n
+  addToStore a b c d = lift $ addToStore a b c d
+  addTextToStore' a b c d = lift $ addTextToStore' a b c d
 
 ---------------------------------------------------------------------------------
 

From 801e32b366056383756c448d566544e967099e6c Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Mon, 26 Oct 2020 17:19:06 +0100
Subject: [PATCH 5/9] Cache hashDerivationModulo results ourselves

Ideally, we would have this cache inside the (h)nix-store, and persist
the store connection for the whole session.  Consider this a proof of
concept that may last.
---
 src/Nix/Effects/Basic.hs      |  6 +++---
 src/Nix/Effects/Derivation.hs | 29 ++++++++++++++++++-----------
 src/Nix/Reduce.hs             | 17 +++++++++--------
 src/Nix/Standard.hs           | 12 +++++++-----
 4 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/src/Nix/Effects/Basic.hs b/src/Nix/Effects/Basic.hs
index d9916cd4b..44535e85b 100644
--- a/src/Nix/Effects/Basic.hs
+++ b/src/Nix/Effects/Basic.hs
@@ -225,13 +225,13 @@ findPathM = findPathBy existingPath
     pure $ if exists then Just apath else Nothing
 
 defaultImportPath
-  :: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc) m)
+  :: (MonadNix e t f m, MonadState (HashMap FilePath NExprLoc, b) m)
   => FilePath
   -> m (NValue t f m)
 defaultImportPath path = do
   traceM $ "Importing file " ++ path
   withFrame Info (ErrorCall $ "While importing file " ++ show path) $ do
-    imports <- get
+    imports <- gets fst
     evalExprLoc =<< case M.lookup path imports of
       Just expr -> pure expr
       Nothing   -> do
@@ -242,7 +242,7 @@ defaultImportPath path = do
               $ ErrorCall
               . show $ fillSep ["Parse during import failed:", err]
           Success expr -> do
-            modify (M.insert path expr)
+            modify (\(a, b) -> (M.insert path expr a, b))
             pure expr
 
 defaultPathToDefaultNix :: MonadNix e t f m => FilePath -> m FilePath
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index b16486ab4..a9499f046 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -16,9 +16,11 @@ import           Prelude                 hiding ( readFile )
 import           Control.Arrow                  ( first, second )
 import           Control.Monad                  ( (>=>), forM, when )
 import           Control.Monad.Writer           ( join, lift )
+import           Control.Monad.State            ( MonadState, gets, modify )
 
 import           Data.Char                      ( isAscii, isAlphaNum )
 import qualified Data.HashMap.Lazy             as M
+import qualified Data.HashMap.Strict           as MS
 import qualified Data.HashSet                  as S
 import           Data.List
 import qualified Data.Map.Strict               as Map
@@ -100,7 +102,7 @@ writeDerivation (drv@Derivation {inputs, name}) = do
 
 -- | Traverse the graph of inputDrvs to replace fixed output derivations with their fixed output hash.
 -- this avoids propagating changes to their .drv when the output hash stays the same.
-hashDerivationModulo :: (Framed e m, MonadFile m) => Derivation -> m (Store.Digest 'Store.SHA256)
+hashDerivationModulo :: (MonadNix e t f m, MonadState (b, MS.HashMap Text Text) m) => Derivation -> m (Store.Digest 'Store.SHA256)
 hashDerivationModulo (Derivation {
     mFixed = Just (Store.SomeDigest (digest :: Store.Digest hashType)),
     outputs,
@@ -114,10 +116,14 @@ hashDerivationModulo (Derivation {
       <> ":" <> path
     outputsList -> throwError $ ErrorCall $ "This is weird. A fixed output drv should only have one output named 'out'. Got " ++ show outputsList
 hashDerivationModulo drv@(Derivation {inputs = (inputSrcs, inputDrvs)}) = do
-  inputsModulo <- Map.fromList <$> forM (Map.toList inputDrvs) (\(path, outs) -> do
-    drv' <- readDerivation $ Text.unpack path
-    hash <- Store.encodeBase16 <$> hashDerivationModulo drv'
-    return (hash, outs)
+  cache <- gets snd
+  inputsModulo <- Map.fromList <$> forM (Map.toList inputDrvs) (\(path, outs) ->
+    case MS.lookup path cache of
+      Just hash -> return (hash, outs)
+      Nothing -> do
+        drv' <- readDerivation $ Text.unpack path
+        hash <- Store.encodeBase16 <$> hashDerivationModulo drv'
+        return (hash, outs)
     )
   return $ Store.hash @'Store.SHA256 $ Text.encodeUtf8 $ unparseDrv (drv {inputs = (inputSrcs, inputsModulo)})
 
@@ -220,7 +226,7 @@ derivationParser = do
     _ -> (Nothing, Flat)
 
 
-defaultDerivationStrict :: forall e t f m . MonadNix e t f m => NValue t f m -> m (NValue t f m)
+defaultDerivationStrict :: forall e t f m b. (MonadNix e t f m, MonadState (b, MS.HashMap Text Text) m) => NValue t f m -> m (NValue t f m)
 defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
     (drv, ctx) <- runWithStringContextT' $ buildDerivationWithContext s
     drvName <- makeStorePathName $ name drv
@@ -248,13 +254,14 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
           , env = if useJson drv then env drv else Map.union outputs' (env drv)
           }
 
-    drvPath <- writeDerivation drv'
+    drvPath <- pathToText <$> writeDerivation drv'
 
-    -- TODO: memoize this result here.
-    -- _ <- hashDerivationModulo drv'
+    -- Memoize here, as it may be our last chance in case of readonly stores.
+    drvHash <- Store.encodeBase16 <$> hashDerivationModulo drv'
+    modify (\(a, b) -> (a, MS.insert drvPath drvHash b))
 
-    let outputsWithContext = Map.mapWithKey (\out path -> principledMakeNixStringWithSingletonContext path (StringContext (pathToText drvPath) (DerivationOutput out))) (outputs drv')
-        drvPathWithContext = principledMakeNixStringWithSingletonContext (pathToText drvPath) (StringContext (pathToText drvPath) AllOutputs)
+    let outputsWithContext = Map.mapWithKey (\out path -> principledMakeNixStringWithSingletonContext path (StringContext drvPath (DerivationOutput out))) (outputs drv')
+        drvPathWithContext = principledMakeNixStringWithSingletonContext drvPath (StringContext drvPath AllOutputs)
         attrSet = M.map nvStr $ M.fromList $ ("drvPath", drvPathWithContext): Map.toList outputsWithContext
     -- TODO: Add location information for all the entries.
     --              here --v
diff --git a/src/Nix/Reduce.hs b/src/Nix/Reduce.hs
index c035c8593..633a484c9 100644
--- a/src/Nix/Reduce.hs
+++ b/src/Nix/Reduce.hs
@@ -42,6 +42,7 @@ import           Control.Monad.State.Strict
 import           Data.Fix                       ( Fix(..), foldFix, foldFixM )
 import           Data.HashMap.Lazy              ( HashMap )
 import qualified Data.HashMap.Lazy             as M
+import qualified Data.HashMap.Strict           as MS
 import           Data.IORef
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 import qualified Data.List.NonEmpty            as NE
@@ -66,11 +67,11 @@ import           System.FilePath
 
 newtype Reducer m a = Reducer
     { runReducer :: ReaderT (Maybe FilePath, Scopes (Reducer m) NExprLoc)
-                           (StateT (HashMap FilePath NExprLoc) m) a }
+                           (StateT (HashMap FilePath NExprLoc, MS.HashMap Text Text) m) a }
     deriving (Functor, Applicative, Alternative, Monad, MonadPlus,
               MonadFix, MonadIO, MonadFail,
               MonadReader (Maybe FilePath, Scopes (Reducer m) NExprLoc),
-              MonadState (HashMap FilePath NExprLoc))
+              MonadState (HashMap FilePath NExprLoc, MS.HashMap Text Text))
 
 staticImport
   :: forall m
@@ -78,7 +79,7 @@ staticImport
      , Scoped NExprLoc m
      , MonadFail m
      , MonadReader (Maybe FilePath, Scopes m NExprLoc) m
-     , MonadState (HashMap FilePath NExprLoc) m
+     , MonadState (HashMap FilePath NExprLoc, HashMap Text Text) m
      )
   => SrcSpan
   -> FilePath
@@ -89,7 +90,7 @@ staticImport pann path = do
   path' <- liftIO $ pathToDefaultNixFile =<< canonicalizePath
     (maybe path (\p -> takeDirectory p </> path) mfile)
 
-  imports <- get
+  imports <- gets fst
   case M.lookup path' imports of
     Just expr -> pure expr
     Nothing   -> go path'
@@ -108,10 +109,10 @@ staticImport pann path = do
                           (Fix (NLiteralPath_ pann path))
                           pos
           x' = Fix (NLet_ span [cur] x)
-        modify (M.insert path x')
+        modify (\(a, b) -> (M.insert path x' a, b))
         local (const (Just path, emptyScopes @m @NExprLoc)) $ do
           x'' <- foldFix reduce x'
-          modify (M.insert path x'')
+          modify (\(a, b) -> (M.insert path x'' a, b))
           return x''
 
 -- gatherNames :: NExprLoc -> HashSet VarName
@@ -122,7 +123,7 @@ staticImport pann path = do
 reduceExpr
   :: (MonadIO m, MonadFail m) => Maybe FilePath -> NExprLoc -> m NExprLoc
 reduceExpr mpath expr =
-  (`evalStateT` M.empty)
+  (`evalStateT` (M.empty, MS.empty))
     . (`runReaderT` (mpath, emptyScopes))
     . runReducer
     $ foldFix reduce expr
@@ -133,7 +134,7 @@ reduce
      , Scoped NExprLoc m
      , MonadFail m
      , MonadReader (Maybe FilePath, Scopes m NExprLoc) m
-     , MonadState (HashMap FilePath NExprLoc) m
+     , MonadState (HashMap FilePath NExprLoc, MS.HashMap Text Text) m
      )
   => NExprLocF (m NExprLoc)
   -> m NExprLoc
diff --git a/src/Nix/Standard.hs b/src/Nix/Standard.hs
index ad483e66d..ac601d6c6 100644
--- a/src/Nix/Standard.hs
+++ b/src/Nix/Standard.hs
@@ -30,6 +30,8 @@ import           Control.Monad.Reader
 import           Control.Monad.Ref
 import           Control.Monad.State
 import           Data.HashMap.Lazy              ( HashMap )
+import qualified Data.HashMap.Strict
+import           Data.Text                      ( Text )
 import           Data.Typeable
 import           GHC.Generics
 import           Nix.Cited
@@ -139,7 +141,7 @@ instance ( MonadFix m
          , Typeable m
          , Scoped (StdValue m) m
          , MonadReader (Context m (StdValue m)) m
-         , MonadState (HashMap FilePath NExprLoc) m
+         , MonadState (HashMap FilePath NExprLoc, Data.HashMap.Strict.HashMap Text Text) m
          , MonadDataErrorContext (StdThunk m) (StdCited m) m
          , MonadThunk (StdThunk m) m (StdValue m)
          , MonadValue (StdValue m) m
@@ -192,7 +194,7 @@ instance ( MonadAtomicRef m
 
 newtype StandardTF r m a
   = StandardTF (ReaderT (Context r (StdValue r))
-                        (StateT (HashMap FilePath NExprLoc) m) a)
+                        (StateT (HashMap FilePath NExprLoc, HashMap Text Text) m) a)
   deriving
     ( Functor
     , Applicative
@@ -206,7 +208,7 @@ newtype StandardTF r m a
     , MonadThrow
     , MonadMask
     , MonadReader (Context r (StdValue r))
-    , MonadState (HashMap FilePath NExprLoc)
+    , MonadState (HashMap FilePath NExprLoc, HashMap Text Text)
     )
 
 instance MonadTrans (StandardTF r) where
@@ -233,7 +235,7 @@ instance MonadThunkId m => MonadThunkId (Fix1T StandardTF m) where
 mkStandardT
   :: ReaderT
        (Context (StandardT m) (StdValue (StandardT m)))
-       (StateT (HashMap FilePath NExprLoc) m)
+       (StateT (HashMap FilePath NExprLoc, Data.HashMap.Strict.HashMap Text Text) m)
        a
   -> StandardT m a
 mkStandardT = Fix1T . StandardTF
@@ -242,7 +244,7 @@ runStandardT
   :: StandardT m a
   -> ReaderT
        (Context (StandardT m) (StdValue (StandardT m)))
-       (StateT (HashMap FilePath NExprLoc) m)
+       (StateT (HashMap FilePath NExprLoc, Data.HashMap.Strict.HashMap Text Text) m)
        a
 runStandardT (Fix1T (StandardTF m)) = m
 

From 1927b424e68560bd07f2c9bedf78590756a2459a Mon Sep 17 00:00:00 2001
From: Anton-Latukha <anton.latukha@gmail.com>
Date: Thu, 31 Dec 2020 04:13:49 +0200
Subject: [PATCH 6/9] use & support recent hnix-store `master` == 0.4

M  default.nix
M  hnix.cabal
M  src/Nix/Effects/Derivation.hs

default.nix: fx overlay call
---
 default.nix                   | 29 ++++++++++++++++++++---------
 hnix.cabal                    |  4 ++--
 src/Nix/Effects/Derivation.hs |  8 ++++----
 3 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/default.nix b/default.nix
index 94213b189..12494fc84 100644
--- a/default.nix
+++ b/default.nix
@@ -91,7 +91,7 @@
 #   , nixos-20.03  # Last stable release, gets almost no updates to recipes, gets only required backports
 #   ...
 #   }
-, rev ? "24eb3f87fc610f18de7076aee7c5a84ac5591e3e"
+, rev ? "8ba15f6383c74e981d8038fa19cc77ed0c53ba22"
 
 , pkgs ?
     if builtins.compareVersions builtins.nixVersion "2.0" < 0
@@ -125,16 +125,16 @@ let
      then getDefaultGHC
      else compiler;
 
-  #  2020-05-23: NOTE: Currently HNix-store needs no overlay
-  # hnix-store-src = pkgs.fetchFromGitHub {
-  #   owner = "haskell-nix";
-  #   repo = "hnix-store";
-  #   rev = "0.2.0.0";
-  #   sha256 = "1qf5rn43d46vgqqgmwqdkjh78rfg6bcp4kypq3z7mx46sdpzvb78";
-  # };
+  #  2020-12-31: NOTE: Remove after `hnix-store 0.4` arrives into Nixpkgs
+  hnix-store-src = pkgs.fetchFromGitHub {
+    owner = "haskell-nix";
+    repo = "hnix-store";
+    rev = "fd09d29b8bef4904058f033d693e7d928a4a92dc";
+    sha256 = "0fxig1ckzknm5g19jzg7rrcpz7ssn4iiv9bs9hff9gfy3ciq4zrs";
+  };
 
   overlay = pkgs.lib.foldr pkgs.lib.composeExtensions (_: _: {}) [
-    # (import "${hnix-store-src}/overlay.nix")
+    (import "${hnix-store-src}/overlay.nix" pkgs pkgs.haskell.lib)
     (self: super:
       pkgs.lib.optionalAttrs withHoogle {
       ghc = super.ghc // { withPackages = super.ghc.withHoogle; };
@@ -223,6 +223,17 @@ let
     root = packageRoot;
 
     overrides = self: super: {
+      # 2020-12-07 We really want cryptohash-sha512, but it conflicts with
+      # recent versions of base, for seemingly no valid reason.
+      # As the update is slow to happen, just jailbreak here
+      # See https://github.com/haskell-hvr/cryptohash-sha512/pull/3
+      # and https://github.com/haskell-hvr/cryptohash-sha512/pull/5
+      cryptohash-sha512 = pkgs.haskell.lib.unmarkBroken ( pkgs.haskell.lib.doJailbreak super.cryptohash-sha512 );
+
+      # 2020-12-07 hnix-store-remote fails when trying to connect to a real hnix daemon.
+      # probably due to nix sandbox restrictions.
+      hnix-store-remote = pkgs.haskell.lib.dontCheck super.hnix-store-remote;
+
       # 2020-08-04 hnix uses custom LayoutOptions and therefore is
       # likely to be affected by the change in the ribbon width
       # calculation in prettyprinter-1.7.0.
diff --git a/hnix.cabal b/hnix.cabal
index 716ae1705..76612108f 100644
--- a/hnix.cabal
+++ b/hnix.cabal
@@ -402,8 +402,8 @@ library
     , gitrev >= 1.1.0 && < 1.4
     , hashable >= 1.2.5 && < 1.4
     , hashing >= 0.1.0 && < 0.2
-    , hnix-store-core >= 0.3.0 && < 0.4
-    , hnix-store-remote >= 0.2.0 && < 0.3
+    , hnix-store-core >= 0.4.0 && < 0.5
+    , hnix-store-remote >= 0.4.0 && < 0.5
     , http-client >= 0.5.14 && < 0.6 || >= 0.6.4 && < 0.7
     , http-client-tls >= 0.3.5 && < 0.4
     , http-types >= 0.12.2 && < 0.13
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index a9499f046..47e32bffc 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -112,7 +112,7 @@ hashDerivationModulo (Derivation {
       $  "fixed:out"
       <> (if hashMode == Recursive then ":r" else "")
       <> ":" <> (Store.algoName @hashType)
-      <> ":" <> (Store.encodeBase16 digest)
+      <> ":" <> (Store.encodeInBase Store.Base16 digest)
       <> ":" <> path
     outputsList -> throwError $ ErrorCall $ "This is weird. A fixed output drv should only have one output named 'out'. Got " ++ show outputsList
 hashDerivationModulo drv@(Derivation {inputs = (inputSrcs, inputDrvs)}) = do
@@ -122,7 +122,7 @@ hashDerivationModulo drv@(Derivation {inputs = (inputSrcs, inputDrvs)}) = do
       Just hash -> return (hash, outs)
       Nothing -> do
         drv' <- readDerivation $ Text.unpack path
-        hash <- Store.encodeBase16 <$> hashDerivationModulo drv'
+        hash <- Store.encodeInBase Store.Base16 <$> hashDerivationModulo drv'
         return (hash, outs)
     )
   return $ Store.hash @'Store.SHA256 $ Text.encodeUtf8 $ unparseDrv (drv {inputs = (inputSrcs, inputsModulo)})
@@ -135,7 +135,7 @@ unparseDrv (Derivation {..}) = Text.append "Derive" $ parens
         case mFixed of
           Nothing -> parens [s outputName, s outputPath, s "", s ""]
           Just (Store.SomeDigest (digest :: Store.Digest hashType)) ->
-            parens [s outputName, s outputPath, s $ prefix <> Store.algoName @hashType, s $ Store.encodeBase16 digest]
+            parens [s outputName, s outputPath, s $ prefix <> Store.algoName @hashType, s $ Store.encodeInBase Store.Base16 digest]
         )
     , -- inputDrvs
       list $ flip map (Map.toList $ snd inputs) (\(path, outs) ->
@@ -257,7 +257,7 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
     drvPath <- pathToText <$> writeDerivation drv'
 
     -- Memoize here, as it may be our last chance in case of readonly stores.
-    drvHash <- Store.encodeBase16 <$> hashDerivationModulo drv'
+    drvHash <- Store.encodeInBase Store.Base16 <$> hashDerivationModulo drv'
     modify (\(a, b) -> (a, MS.insert drvPath drvHash b))
 
     let outputsWithContext = Map.mapWithKey (\out path -> principledMakeNixStringWithSingletonContext path (StringContext drvPath (DerivationOutput out))) (outputs drv')

From 9b478f5a73403be868cf67eaf6ab1d8d9d9dd94b Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Tue, 8 Dec 2020 10:57:59 +0100
Subject: [PATCH 7/9] Add references, docs and minor improvements

default.nix: cosmetic: fx align
---
 default.nix                   | 33 +++++++++++++++++----------------
 src/Nix/Effects.hs            |  9 +++++----
 src/Nix/Effects/Derivation.hs |  6 +++---
 3 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/default.nix b/default.nix
index 12494fc84..c8ceffa79 100644
--- a/default.nix
+++ b/default.nix
@@ -111,19 +111,19 @@
 
 let
 
- getDefaultGHC = "ghc${
-    (
-      # Remove '.' from the string 8.8.4 -> 884
-      pkgs.lib.stringAsChars (c: if c == "." then "" else c)
-        # Get default GHC version,
-        (pkgs.lib.getVersion pkgs.haskellPackages.ghc)
-    )
-  }";
-
- compilerPackage =
-   if ((compiler == "") || (compiler == "default"))
-     then getDefaultGHC
-     else compiler;
+  getDefaultGHC = "ghc${
+      (
+        # Remove '.' from the string 8.8.4 -> 884
+        pkgs.lib.stringAsChars (c: if c == "." then "" else c)
+          # Get default GHC version,
+          (pkgs.lib.getVersion pkgs.haskellPackages.ghc)
+      )
+    }";
+
+  compilerPackage =
+    if ((compiler == "") || (compiler == "default"))
+      then getDefaultGHC
+      else compiler;
 
   #  2020-12-31: NOTE: Remove after `hnix-store 0.4` arrives into Nixpkgs
   hnix-store-src = pkgs.fetchFromGitHub {
@@ -226,13 +226,14 @@ let
       # 2020-12-07 We really want cryptohash-sha512, but it conflicts with
       # recent versions of base, for seemingly no valid reason.
       # As the update is slow to happen, just jailbreak here
-      # See https://github.com/haskell-hvr/cryptohash-sha512/pull/3
-      # and https://github.com/haskell-hvr/cryptohash-sha512/pull/5
+      # See https://github.com/haskell-hvr/cryptohash-sha512 PRs 3, 5 and issue 4
+      # See also https://github.com/NixOS/nixpkgs/pull/106333 for a temporary fix.
       cryptohash-sha512 = pkgs.haskell.lib.unmarkBroken ( pkgs.haskell.lib.doJailbreak super.cryptohash-sha512 );
 
       # 2020-12-07 hnix-store-remote fails when trying to connect to a real hnix daemon.
       # probably due to nix sandbox restrictions.
-      hnix-store-remote = pkgs.haskell.lib.dontCheck super.hnix-store-remote;
+      # Upstream issue @ https://github.com/haskell-nix/hnix-store/issues/80
+      hnix-store-remote = pkgs.haskell.lib.removeConfigureFlag super.hnix-store-remote "-fio-testsuite";
 
       # 2020-08-04 hnix uses custom LayoutOptions and therefore is
       # likely to be affected by the change in the ribbon width
diff --git a/src/Nix/Effects.hs b/src/Nix/Effects.hs
index c1df93300..0ce82e677 100644
--- a/src/Nix/Effects.hs
+++ b/src/Nix/Effects.hs
@@ -244,14 +244,15 @@ type StorePathSet = HS.HashSet StorePath
 
 class Monad m => MonadStore m where
 
-    -- | Add a path to the store, with bells and whistles
+    -- | Copy the contents of a local path to the store.  The resulting store
+    -- path is returned.  Note: This does not support yet support the expected
+    -- `filter` function that allows excluding some files.
     addToStore :: StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
     default addToStore :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> FilePath -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
     addToStore a b c d = lift $ addToStore a b c d
 
-    -- | Add a nar (action) to the store
-    -- addToStore' :: StorePathName -> IO Nar -> RecursiveFlag -> RepairFlag -> m (Either ErrorCall StorePath)
-
+    -- | Like addToStore, but the contents written to the output path is a
+    -- regular file containing the given string.
     addTextToStore' :: StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
     default addTextToStore' :: (MonadTrans t, MonadStore m', m ~ t m') => StorePathName -> Text -> Store.StorePathSet -> RepairFlag -> m (Either ErrorCall StorePath)
     addTextToStore' a b c d = lift $ addTextToStore' a b c d
diff --git a/src/Nix/Effects/Derivation.hs b/src/Nix/Effects/Derivation.hs
index 47e32bffc..51a0f3b16 100644
--- a/src/Nix/Effects/Derivation.hs
+++ b/src/Nix/Effects/Derivation.hs
@@ -219,10 +219,10 @@ derivationParser = do
       let (hashType, hashMode) = case Text.splitOn ":" rht of
             ["r", ht] -> (ht, Recursive)
             [ht] ->      (ht, Flat)
-            _ -> undefined -- What ?! -- TODO: Throw a proper error
+            _ -> error $ "Unsupported hash type for output of fixed-output derivation in .drv file: " ++ show fullOutputs
       in case Store.mkNamedDigest hashType hash of
         Right digest -> (Just digest, hashMode)
-        Left _err -> undefined -- TODO: Raise a proper parse error.
+        Left err -> error $ "Unsupported hash " ++ show (hashType <> ":" <> hash) ++ "in .drv file: " ++ err
     _ -> (Nothing, Flat)
 
 
@@ -282,7 +282,7 @@ defaultDerivationStrict = fromValue @(AttrSet (NValue t f m)) >=> \s -> do
       AllOutputs ->
         -- TODO: recursive lookup. See prim_derivationStrict
         -- XXX: When is this really used ?
-        undefined
+        error "Not implemented: derivations depending on a .drv file are not yet supported."
 
 
 -- | Build a derivation in a context collecting string contexts.

From 1a81b65bde97ee92432912bd7265c2cd2b96a7b3 Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Thu, 31 Dec 2020 22:08:06 +0100
Subject: [PATCH 8/9] Update chroot store syntax to new nix standards

---
 tests/Main.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/Main.hs b/tests/Main.hs
index 2e8978090..285db09eb 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -95,7 +95,7 @@ main = do
   prettyTestsEnv      <- lookupEnv "PRETTY_TESTS"
 
   pwd <- getCurrentDirectory
-  setEnv "NIX_REMOTE" ("local?root=" ++ pwd ++ "/")
+  setEnv "NIX_REMOTE" (pwd ++ "/real-store")
   setEnv "NIX_DATA_DIR" (pwd ++ "/data")
 
   defaultMain $ testGroup "hnix" $

From 43be29e4b4e38d77af65b5aaefe11b498dc166e8 Mon Sep 17 00:00:00 2001
From: Guillaume Maudoux <layus.on@gmail.com>
Date: Thu, 31 Dec 2020 22:50:04 +0100
Subject: [PATCH 9/9] install required data files with the binary

---
 hnix.cabal | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/hnix.cabal b/hnix.cabal
index 76612108f..3c744ad24 100644
--- a/hnix.cabal
+++ b/hnix.cabal
@@ -11,9 +11,19 @@ license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
 cabal-version:  >= 1.10
+data-dir:       data/
+data-files:
+    nix/corepkgs/buildenv.nix
+    nix/corepkgs/unpack-channel.nix
+    nix/corepkgs/derivation.nix
+    nix/corepkgs/fetchurl.nix
+    nix/corepkgs/imported-drv-to-derivation.nix
 extra-source-files:
     data/nix/corepkgs/buildenv.nix
+    data/nix/corepkgs/unpack-channel.nix
     data/nix/corepkgs/derivation.nix
+    data/nix/corepkgs/fetchurl.nix
+    data/nix/corepkgs/imported-drv-to-derivation.nix
     data/nix/tests/lang/binary-data
     data/nix/tests/lang/data
     data/nix/tests/lang/dir1/a.nix