{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, ApplicativeDo #-}
module Foreign.Nix.Shellout.Prefetch
(
url, UrlOptions(..), defaultUrlOptions
, git, GitOptions(..), defaultGitOptions, GitOutput(..)
, PrefetchError(..)
, Url(..), Sha256(..)
, runNixAction, NixAction(..)
) where
import Protolude
import Control.Error hiding (bool, err)
import qualified Data.Text as T
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as AesonT
import Foreign.Nix.Shellout.Types
import qualified Foreign.Nix.Shellout.Helpers as Helpers
data PrefetchError
= PrefetchOutputMalformed Text
| ExpectedHashError
| UnknownPrefetchError
deriving (Eq, Show)
newtype Url = Url { unUrl :: Text } deriving (Show, Eq, IsString)
newtype Sha256 = Sha256 { unSha256 :: Text } deriving (Show, Eq, IsString)
data UrlOptions = UrlOptions
{ urlUrl :: Url
, urlUnpack :: Bool
, urlName :: Maybe Text
, urlExpectedHash :: Maybe Sha256
}
defaultUrlOptions :: Url -> UrlOptions
defaultUrlOptions u = UrlOptions
{ urlUrl = u
, urlUnpack = False
, urlName = Nothing
, urlExpectedHash = Nothing }
url :: UrlOptions -> NixAction PrefetchError (Sha256, StorePath Realized)
url UrlOptions{..} = Helpers.readProcess handler exec args
where
exec = "nix-prefetch-url"
args = bool [] ["--unpack"] urlUnpack
<> maybe [] (\n -> ["--name", n]) urlName
<> [ "--type", "sha256"
, "--print-path"
, unUrl urlUrl ]
<> maybe [] (pure.unSha256) urlExpectedHash
handler (out, err) = \case
ExitSuccess -> withExceptT PrefetchOutputMalformed $ do
let ls = T.lines $ T.stripEnd out
path <- tryLast (exec <> " didn’t output a store path") ls
sha <- let errS = (exec <> " didn’t output a hash")
in tryInit errS ls >>= tryLast errS
pure (Sha256 sha, StorePath $ toS path)
ExitFailure _ -> throwE $
if "error: hash mismatch" `T.isPrefixOf` err
then ExpectedHashError
else UnknownPrefetchError
data GitOptions = GitOptions
{ gitUrl :: Url
, gitRev :: Maybe Text
, gitExpectedHash :: Maybe Sha256
, gitDeepClone :: Bool
, gitLeaveDotGit :: Bool
, gitFetchSubmodules :: Bool
}
defaultGitOptions :: Url -> GitOptions
defaultGitOptions u = GitOptions
{ gitUrl = u
, gitRev = Nothing
, gitExpectedHash = Nothing
, gitDeepClone = False
, gitLeaveDotGit = False
, gitFetchSubmodules = True }
data GitOutput = GitOutput
{ gitOutputRev :: Text
, gitOutputSha256 :: Sha256
, gitOuputPath :: StorePath Realized
} deriving (Show, Eq)
git :: GitOptions -> NixAction PrefetchError GitOutput
git GitOptions{..} = Helpers.readProcess handler exec args
where
exec = "nix-prefetch-git"
args = bool ["--no-deepClone"] ["--deepClone"] gitDeepClone
<> bool [] ["--leave-dotGit"] gitLeaveDotGit
<> bool [] ["--fetch-submodules"] gitFetchSubmodules
<> [ "--hash", "sha256"
, unUrl gitUrl
, maybe "" identity gitRev ]
<> maybe [] (\(Sha256 h) -> [h]) gitExpectedHash
handler (out, err) = \case
ExitSuccess -> withExceptT PrefetchOutputMalformed $ do
let error msg = exec <> " " <> msg
jsonError :: [Char] -> Text
jsonError = \msg -> error (T.intercalate "\n"
[ "parsing json output failed:"
, toS msg
, "The output was:"
, out ])
(gitOutputRev, gitOutputSha256)
<- ExceptT . pure . first jsonError $ do
val <- Aeson.eitherDecode' (toS out)
flip AesonT.parseEither val
$ Aeson.withObject "GitPrefetchOutput" $ \obj -> do
(,) <$> obj Aeson..: "rev"
<*> fmap Sha256 (obj Aeson..: "sha256")
gitOuputPath <- case
find ("path is /nix/store" `T.isPrefixOf`) (T.lines err)
>>= T.stripPrefix "path is " of
Nothing -> throwE
$ error "could not find nix store output path on stderr"
Just path -> pure $ StorePath $ toS path
pure GitOutput{..}
ExitFailure _ -> throwE $
if ("hash mismatch for URL" `T.isInfixOf` err)
then ExpectedHashError
else UnknownPrefetchError