{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

module NixHash (mkFileAttrs, replaceLeadingDot) where

import           BuilderDirs (BuilderDirs, currentDir)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Reader
import           Crypto.Hash (Digest, SHA256, hash)
import qualified Data.ByteString as B
import           Data.Text (Text)
import qualified Data.Text as T
import           Nix
import           Path (Abs, File, Path, Rel, toFilePath, (</>))
import           Path.IO (withSystemTempFile)
import           System.IO
import           System.Nix.Hash (BaseEncoding (..), encodeDigestWith)
import           System.Nix.Nar (buildNarIO, narEffectsIO)

-- | Build a set of @filename -> derivation@ attributes.
mkFileAttrs :: [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)]
mkFileAttrs :: [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)]
mkFileAttrs = (Path Rel File -> ReaderT BuilderDirs IO (Text, NExpr))
-> [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Path Rel File -> ReaderT BuilderDirs IO (Text, NExpr))
 -> [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)])
-> (Path Rel File -> ReaderT BuilderDirs IO (Text, NExpr))
-> [Path Rel File]
-> ReaderT BuilderDirs IO [(Text, NExpr)]
forall a b. (a -> b) -> a -> b
$ \Path Rel File
f -> do
  NExpr
h <- Path Rel File -> ReaderT BuilderDirs IO NExpr
mkFileAttr Path Rel File
f
  (Text, NExpr) -> ReaderT BuilderDirs IO (Text, NExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack (Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
f), NExpr
h)

-- | Hash the file, using Nix's NAR hash (the default to
-- @builtins.path@ is NAR-style recursive hashing), and build a call
-- to Nix's @builtins.path@ function. If @"file1"@ is a regular file,
-- @mkHashEntry "file1"@ will generate:
--
-- @
-- builtins.path {
--   path = ./file1;
--   sha256 = "<<hash of file1>>";
-- }
-- @
--
-- If @".file2"@ starts with a dot, that's an illegal Nix derivation
-- name, so @mkHashEntry ".file2"@ will generate:
--
-- @
-- builtins.path {
--   path = ./.file2;
--   name = "_file2";
--   sha256 = "<<hash of .file2>>"
-- }
-- @
mkFileAttr :: Path Rel File -> ReaderT BuilderDirs IO NExpr
mkFileAttr :: Path Rel File -> ReaderT BuilderDirs IO NExpr
mkFileAttr Path Rel File
f = do
  Path Abs File
absF <- (Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f) (Path Abs Dir -> Path Abs File)
-> ReaderT BuilderDirs IO (Path Abs Dir)
-> ReaderT BuilderDirs IO (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT BuilderDirs IO (Path Abs Dir)
currentDir
  Text
h <- Path Abs File -> ReaderT BuilderDirs IO Text
forall (m :: * -> *). MonadIO m => Path Abs File -> m Text
recursiveHash Path Abs File
absF

  let bindings :: [Binding NExpr]
bindings =
        [ Text
"path" Text -> NExpr -> Binding NExpr
$= Bool -> String -> NExpr
mkPath Bool
False (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
absF)
        , Text
"sha256" Text -> NExpr -> Binding NExpr
$= Text -> NExpr
mkStr Text
h
        ] [Binding NExpr] -> [Binding NExpr] -> [Binding NExpr]
forall a. [a] -> [a] -> [a]
++ [ Text
"name" Text -> NExpr -> Binding NExpr
$= Text -> NExpr
mkStr (String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
replaceLeadingDot (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
f)
             | String -> Char
forall a. [a] -> a
head (Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
f) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
             ]
  NExpr -> ReaderT BuilderDirs IO NExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NExpr -> ReaderT BuilderDirs IO NExpr)
-> NExpr -> ReaderT BuilderDirs IO NExpr
forall a b. (a -> b) -> a -> b
$ NExpr
"builtins" NExpr -> Text -> NExpr
@. Text
"path" NExpr -> NExpr -> NExpr
@@ [Binding NExpr] -> NExpr
mkNonRecSet [Binding NExpr]
bindings


-- | Serialise as per
-- https://gist.github.com/jbeda/5c79d2b1434f0018d693 , which is an
-- extract from Figure 5.2 of http://nixos.org/~eelco/pubs/phd-thesis.pdf ,
-- which is the Nix thesis.
recursiveHash :: MonadIO m => Path Abs File -> m Text
recursiveHash :: Path Abs File -> m Text
recursiveHash Path Abs File
absF =
  IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text)
-> ((Path Abs File -> Handle -> IO Text) -> IO Text)
-> (Path Abs File -> Handle -> IO Text)
-> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Path Abs File -> Handle -> IO Text) -> IO Text
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (Path Abs File -> Handle -> m a) -> m a
withSystemTempFile String
"nix-freeze-tree.nar" ((Path Abs File -> Handle -> IO Text) -> m Text)
-> (Path Abs File -> Handle -> IO Text) -> m Text
forall a b. (a -> b) -> a -> b
$ \Path Abs File
_ Handle
h -> do
    NarEffects IO -> String -> Handle -> IO ()
buildNarIO NarEffects IO
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadBaseControl IO m) =>
NarEffects m
narEffectsIO (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
absF) Handle
h
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
0
    ByteString
contents <- Handle -> IO ByteString
B.hGetContents Handle
h
    Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ BaseEncoding -> Digest SHA256 -> Text
forall a. BaseEncoding -> Digest a -> Text
encodeDigestWith BaseEncoding
NixBase32 (ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
contents :: Digest SHA256)

-- | A leading dot is illegal in Nix derivation names. Replace it with '_'.
replaceLeadingDot :: FilePath -> FilePath
replaceLeadingDot :: String -> String
replaceLeadingDot (Char
'.':String
f) = Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
f
replaceLeadingDot String
f = String
f