From dc31e3c6e14d9a77183b552f1aa8e2eef00f5915 Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Fri, 22 Oct 2021 14:09:41 +0900 Subject: [PATCH] Add support for building remote imports as FOD to dhall-nixpkgs (#2318) --- dhall-nixpkgs/Main.hs | 169 +++++++++++++++++++++++++----- dhall-nixpkgs/dhall-nixpkgs.cabal | 2 + 2 files changed, 142 insertions(+), 29 deletions(-) diff --git a/dhall-nixpkgs/Main.hs b/dhall-nixpkgs/Main.hs index 0c3d8c7ac..ce53c10e4 100644 --- a/dhall-nixpkgs/Main.hs +++ b/dhall-nixpkgs/Main.hs @@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| @dhall-to-nixpkgs@ is essentially the Dhall analog of @cabal2nix@. @@ -75,9 +76,12 @@ import Control.Monad.Morph (hoist) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict (StateT) import Data.Aeson (FromJSON) +import Data.ByteArray.Encoding (Base (Base16, Base64), convertToBase) import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Void (Void) +import Dhall.Crypto (SHA256Digest (..)) import Dhall.Import (Status (..), stack) import Dhall.Parser (Src) import GHC.Generics (Generic) @@ -104,6 +108,7 @@ import Dhall.Core import qualified Control.Foldl as Foldl import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as ByteString.Char8 import qualified Data.Foldable as Foldable import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Text as Text @@ -149,6 +154,7 @@ data Directory = Directory , file :: FilePath , source :: Bool , document :: Bool + , fixedOutputDerivations :: Bool } data NixPrefetchGit = NixPrefetchGit @@ -206,6 +212,13 @@ parseDocument = <> Options.help "Generate documentation for the Nix package" ) +parseFixedOutputDerivations :: Parser Bool +parseFixedOutputDerivations = + Options.switch + ( Options.long "fixed-output-derivations" + <> Options.help "Translate Dhall remote imports to Nix fixed-output derivations" + ) + parseName :: Parser (Maybe Text) parseName = optional @@ -271,6 +284,8 @@ parseDirectory = do document <- parseDocument + fixedOutputDerivations <- parseFixedOutputDerivations + return Directory{..} parserInfoOptions :: ParserInfo Options @@ -306,11 +321,12 @@ nub = Foldl.fold Foldl.nub This function finds all remote imports that are transitive dependencies of the given expression, failing if any of them are missing integrity checks. -} -findExternalDependencies :: Expr Src Import -> StateT Status Shell URL +findExternalDependencies :: Expr Src Import -> StateT Status Shell (URL, SHA256Digest) findExternalDependencies expression = do -- This is a best-effort attempt to pick an import alternative if there is -- more than one - let pickAlt (ImportAlt e0 e1) + let pickAlt :: Expr Src Import -> Maybe (Expr Src Import) + pickAlt (ImportAlt e0 e1) -- If only the latter import has an integrity check, then select -- that | Embed Import{ importHashed = ImportHashed{ hash = Nothing } } <- Dhall.Core.shallowDenote e0 @@ -322,7 +338,8 @@ findExternalDependencies expression = do pickAlt _ = Nothing - let rewrittenExpression = + let rewrittenExpression :: Expr Src Import + rewrittenExpression = Dhall.Optics.rewriteOf Dhall.Core.subExpressions pickAlt expression import_ <- lift (Turtle.select (Foldable.toList rewrittenExpression)) @@ -349,8 +366,8 @@ findExternalDependencies expression = do Remote url -> case hash of - Just _ -> - return url + Just sha256 -> + return (url, sha256) Nothing -> die (MissingSemanticIntegrityCheck url) @@ -366,16 +383,69 @@ findExternalDependencies expression = do findExternalDependencies parsedExpression data Dependency = Dependency - { functionParameter :: (Text, Maybe NExpr) + { functionParameter :: Maybe (Text, Maybe NExpr) -- ^ Function parameter used to bring the dependency into scope for the - -- Nix package. The @`Maybe` `NExpr`@ is always `Nothing`, but we + -- Nix package. + -- + -- This is 'Nothing' when 'fixedOutputDerivations' is enabled, since these + -- dependencies don't need to passed in as arguments. This is 'Just' + -- when 'fixedOutputDerivations' is not enabled. + -- + -- The @'Maybe' 'NExpr'@ is always 'Nothing', but we -- include it here for convenience , dependencyExpression :: NExpr - -- ^ The dependency expression to include in the dependency list. This - -- will be an expression of the form: + -- ^ The dependency expression to include in the dependency list. + -- + -- 'dependencyToNix' will create an expression of the following form. + -- This is called when 'fixedOutputDerivations' is 'False': -- -- > someDependency.override { file = "./someFile.dhall" } + -- + -- 'dependencyToNixAsFOD' will create an expression of the following form. + -- This is called when 'fixedOutputDerivations' is 'True': + -- + -- > buildDhallUrl { + -- > url = "https://some.url.to/a/dhall/file.dhall"; + -- > hash = "sha256-ZTSiQUXpPbPfPvS8OeK6dDQE6j6NbP27ho1cg9YfENI="; + -- > dhall-hash = + -- > "sha256:6534a24145e93db3df3ef4bc39e2ba743404ea3e8d6cfdbb868d5c83d61f10d2"; + -- > } } + deriving stock Show + +-- | Convert a 'URL' and integrity check to a Nix 'Dependency' that uses the +-- Nix function @buildDhallUrl@ to build. +-- +-- This function will create a Nix dependency of the form: +-- +-- > buildDhallUrl { +-- > url = "https://some.url.to/a/dhall/file.dhall"; +-- > hash = "sha256-ZTSiQUXpPbPfPvS8OeK6dDQE6j6NbP27ho1cg9YfENI="; +-- > dhall-hash = +-- > "sha256:6534a24145e93db3df3ef4bc39e2ba743404ea3e8d6cfdbb868d5c83d61f10d2"; +-- > } +-- +-- The @hash@ argument is an SRI hash that Nix understands. The @dhall-hash@ +-- argument is a base-16-encoded hash that Dhall understands. +dependencyToNixAsFOD :: URL -> SHA256Digest -> IO Dependency +dependencyToNixAsFOD url (SHA256Digest shaBytes) = do + let functionParameter = Nothing + + let dhallHash = + "sha256:" <> ByteString.Char8.unpack (convertToBase Base16 shaBytes) + + let nixSRIHash = + "sha256-" <> ByteString.Char8.unpack (convertToBase Base64 shaBytes) + + let dependencyExpression = + "buildDhallUrl" + @@ Nix.attrsE + [ ("url", Nix.mkStr $ Dhall.Core.pretty url) + , ("hash", Nix.mkStr $ Text.pack nixSRIHash) + , ("dhall-hash", Nix.mkStr $ Text.pack dhallHash) + ] + + return Dependency{..} {-| The Nixpkgs support for Dhall implements two conventions that @dhall-to-nixpkgs@ depends on: @@ -409,7 +479,7 @@ dependencyToNix url@URL{ authority, path } = do "dhall-lang" : "dhall-lang" : _rev : "Prelude" : rest -> do let fileArgument = Text.intercalate "/" rest - let functionParameter = (prelude, Nothing) + let functionParameter = Just (prelude, Nothing) let dependencyExpression = (Nix.mkSym prelude @. "overridePackage") @@ -421,7 +491,7 @@ dependencyToNix url@URL{ authority, path } = do _owner : repo : _rev : rest -> do let fileArgument = Text.intercalate "/" rest - let functionParameter = (repo, Nothing) + let functionParameter = Just (repo, Nothing) let dependencyExpression = (Nix.mkSym repo @. "overridePackage") @@ -460,10 +530,10 @@ dependencyToNix url@URL{ authority, path } = do rest rest -> rest - + let fileArgument = Text.intercalate "/" pathComponents - let functionParameter = (prelude, Nothing) + let functionParameter = Just (prelude, Nothing) let dependencyExpression = (Nix.mkSym prelude @. "overridePackage") @@ -475,6 +545,45 @@ dependencyToNix url@URL{ authority, path } = do _ -> do die (UnsupportedDomainDependency url authority) +-- | Turn a list of 'Dependency's into an argument list for the generated Nix +-- function. +-- +-- The following 'makeNixFunctionParams' call: +-- +-- @@ +-- 'makeNixFunctionParams' +-- \"buildDhallDirectoryPackage\" +-- [ 'Dependency' ('Just' (\"Prelude\", 'Nothing')) ... +-- , 'Dependency' ('Just' (\"Prelude\", 'Nothing')) ... +-- , 'Dependency' 'Nothing' ... +-- , 'Dependency' ('Just' (\"example-repo\", 'Nothing')) ... +-- ] +-- @@ +-- +-- will generate an argument list like the following: +-- +-- > { buildDhallDirectoryPackage, buildDhallUrl, Prelude, example-repo }: +-- +-- Note that identical 'functionParameter's will be collapsed into a single +-- parameter (like @Prelude@ above). +-- +-- @buildDhallUrl@ will be added as an argument only if there is a 'Dependency' +-- with a 'Nothing' value for 'functionalParameter'. +makeNixFunctionParams :: Text -> [Dependency] -> [(Text, Maybe NExpr)] +makeNixFunctionParams buildDhallFuncName nixDependencies = + let containsBuildDhallUrlDependency = + any (\dep -> functionParameter dep == Nothing) nixDependencies + + buildDhallUrlParam = + if containsBuildDhallUrlDependency + then [ ("buildDhallUrl", Nothing) ] + else [ ] + + in ( [ (buildDhallFuncName, Nothing) ] + <> buildDhallUrlParam + <> nub (mapMaybe functionParameter nixDependencies) + ) + githubToNixpkgs :: GitHub -> IO () githubToNixpkgs GitHub{ name, uri, rev = maybeRev, hash, fetchSubmodules, directory, file, source, document } = do URI{ uriScheme, uriAuthority = Just URIAuth{ uriUserInfo, uriRegName, uriPort }, uriPath, uriQuery, uriFragment } <- do @@ -600,18 +709,16 @@ githubToNixpkgs GitHub{ name, uri, rev = maybeRev, hash, fetchSubmodules, direct dependencies <- Turtle.reduce Foldl.nub (State.evalStateT (findExternalDependencies expression) status) - nixDependencies <- traverse dependencyToNix dependencies + nixDependencies <- traverse (\(url, _sha256) -> dependencyToNix url) dependencies let buildDhallGitHubPackage = "buildDhallGitHubPackage" + let functionParams = + makeNixFunctionParams buildDhallGitHubPackage nixDependencies + let nixExpression = Nix.mkFunction - (Nix.mkParamset - ( [ (buildDhallGitHubPackage, Nothing) ] - <> nub (fmap functionParameter nixDependencies) - ) - False - ) + (Nix.mkParamset functionParams False) ( Nix.mkSym buildDhallGitHubPackage @@ Nix.attrsE [ ("name", Nix.mkStr finalName) @@ -633,7 +740,7 @@ githubToNixpkgs GitHub{ name, uri, rev = maybeRev, hash, fetchSubmodules, direct Prettyprint.Text.putDoc ((Nix.Pretty.prettyNix nixExpression) <> "\n") directoryToNixpkgs :: Directory -> IO () -directoryToNixpkgs Directory{ name, directory, file, source, document } = do +directoryToNixpkgs Directory{ name, directory, file, source, document, fixedOutputDerivations } = do let finalName = case name of Nothing -> Turtle.format fp (Turtle.dirname directory) @@ -661,7 +768,13 @@ directoryToNixpkgs Directory{ name, directory, file, source, document } = do dependencies <- Turtle.reduce Foldl.nub (State.evalStateT (findExternalDependencies expression) status) - nixDependencies <- traverse dependencyToNix dependencies + let depToNix :: (URL, SHA256Digest) -> IO Dependency + depToNix (url, sha256) = + if fixedOutputDerivations + then dependencyToNixAsFOD url sha256 + else dependencyToNix url + + nixDependencies <- traverse depToNix dependencies let buildDhallDirectoryPackage = "buildDhallDirectoryPackage" @@ -671,14 +784,12 @@ directoryToNixpkgs Directory{ name, directory, file, source, document } = do where directoryString = Turtle.encodeString directory + let functionParams = + makeNixFunctionParams buildDhallDirectoryPackage nixDependencies + let nixExpression = Nix.mkFunction - (Nix.mkParamset - ( [ (buildDhallDirectoryPackage, Nothing) ] - <> nub (fmap functionParameter nixDependencies) - ) - False - ) + (Nix.mkParamset functionParams False) ( Nix.mkSym buildDhallDirectoryPackage @@ Nix.attrsE [ ("name", Nix.mkStr finalName) @@ -942,7 +1053,7 @@ The following command: , rev : Text , path : Text , sha256 : Text - , fetchSubmodules : Bool + , fetchSubmodules : Bool } ... but JSON decoding failed with the following error: diff --git a/dhall-nixpkgs/dhall-nixpkgs.cabal b/dhall-nixpkgs/dhall-nixpkgs.cabal index 997dd1f1f..715d3b48a 100644 --- a/dhall-nixpkgs/dhall-nixpkgs.cabal +++ b/dhall-nixpkgs/dhall-nixpkgs.cabal @@ -18,6 +18,7 @@ Executable dhall-to-nixpkgs Main-Is: Main.hs Build-Depends: base >= 4.11 && < 5 , aeson >= 1.0.0.0 && < 1.6 + , bytestring < 0.12 , data-fix , dhall >= 1.32.0 && < 1.41 , foldl < 1.5 @@ -25,6 +26,7 @@ Executable dhall-to-nixpkgs , lens-family-core >= 1.0.0 && < 2.2 -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469 , megaparsec >= 7.0.0 && < 10 + , memory >= 0.14 && < 0.17 , mmorph < 1.3 , neat-interpolation < 0.6 , optparse-applicative >= 0.14.0.0 && < 0.17