{-|
Description : Wrapper for the @nix-prefetch@ CLI utilities
Copyright   : Profpatsch, 2018
License     : GPL-3
Stability   : experimental
Portability : nix-prefetch-scripts 2018 (no version number)

Calls to the @nix-prefetch-X@ utilities, to parse their output
into nice reusable data types.
-}
{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Foreign.Nix.Shellout.Prefetch
( -- * nix-prefetch-url
  url, UrlOptions(..), defaultUrlOptions
  -- * nix-prefetch-git
, git, GitOptions(..), defaultGitOptions, GitOutput(..)
  -- * Types
, PrefetchError(..)
, Url(..), Sha256(..)
, module Foreign.Nix.Shellout.Types
) where

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
import Data.Text (Text)
import Data.String (IsString)
import GHC.IO.Exception (ExitCode(ExitFailure, ExitSuccess))
import qualified Data.Text as Text
import Data.Bool (bool)
import Data.Bifunctor (first)
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Text.Lazy.Encoding
import qualified Data.List as List
import Control.Monad.IO.Class (MonadIO)
import Foreign.Nix.Shellout.Helpers (getExecOr)

data PrefetchError
  = PrefetchOutputMalformed Text
    -- ^ the tool’s output could not be parsed as expected
  | ExpectedHashError
    -- ^ an expected hash was given and not valid
  | UnknownPrefetchError
    -- ^ catch-all error
  deriving (PrefetchError -> PrefetchError -> Bool
(PrefetchError -> PrefetchError -> Bool)
-> (PrefetchError -> PrefetchError -> Bool) -> Eq PrefetchError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrefetchError -> PrefetchError -> Bool
$c/= :: PrefetchError -> PrefetchError -> Bool
== :: PrefetchError -> PrefetchError -> Bool
$c== :: PrefetchError -> PrefetchError -> Bool
Eq, Int -> PrefetchError -> ShowS
[PrefetchError] -> ShowS
PrefetchError -> String
(Int -> PrefetchError -> ShowS)
-> (PrefetchError -> String)
-> ([PrefetchError] -> ShowS)
-> Show PrefetchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrefetchError] -> ShowS
$cshowList :: [PrefetchError] -> ShowS
show :: PrefetchError -> String
$cshow :: PrefetchError -> String
showsPrec :: Int -> PrefetchError -> ShowS
$cshowsPrec :: Int -> PrefetchError -> ShowS
Show)

-- | A descriptive type for URLs.
newtype Url = Url { Url -> Text
unUrl :: Text } deriving (Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url] -> ShowS
$cshowList :: [Url] -> ShowS
show :: Url -> String
$cshow :: Url -> String
showsPrec :: Int -> Url -> ShowS
$cshowsPrec :: Int -> Url -> ShowS
Show, Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c== :: Url -> Url -> Bool
Eq, String -> Url
(String -> Url) -> IsString Url
forall a. (String -> a) -> IsString a
fromString :: String -> Url
$cfromString :: String -> Url
IsString)
-- | A @sha-256@ hash.
newtype Sha256 = Sha256 { Sha256 -> Text
unSha256 :: Text } deriving (Int -> Sha256 -> ShowS
[Sha256] -> ShowS
Sha256 -> String
(Int -> Sha256 -> ShowS)
-> (Sha256 -> String) -> ([Sha256] -> ShowS) -> Show Sha256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sha256] -> ShowS
$cshowList :: [Sha256] -> ShowS
show :: Sha256 -> String
$cshow :: Sha256 -> String
showsPrec :: Int -> Sha256 -> ShowS
$cshowsPrec :: Int -> Sha256 -> ShowS
Show, Sha256 -> Sha256 -> Bool
(Sha256 -> Sha256 -> Bool)
-> (Sha256 -> Sha256 -> Bool) -> Eq Sha256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sha256 -> Sha256 -> Bool
$c/= :: Sha256 -> Sha256 -> Bool
== :: Sha256 -> Sha256 -> Bool
$c== :: Sha256 -> Sha256 -> Bool
Eq, String -> Sha256
(String -> Sha256) -> IsString Sha256
forall a. (String -> a) -> IsString a
fromString :: String -> Sha256
$cfromString :: String -> Sha256
IsString)

data UrlOptions = UrlOptions
  { UrlOptions -> Url
urlUrl :: Url
    -- ^ the URL
  , UrlOptions -> Bool
urlUnpack :: Bool
    -- ^ whether to unpack before hashing (useful for prefetching @fetchTarball@)
  , UrlOptions -> Maybe Text
urlName :: Maybe Text
    -- ^ name of the store path
  , UrlOptions -> Maybe Sha256
urlExpectedHash :: Maybe Sha256
    -- ^ the hash we are expecting
  }

-- | Takes the URL, doesn’t unpack and uses the default name.
defaultUrlOptions :: Url -> UrlOptions
defaultUrlOptions :: Url -> UrlOptions
defaultUrlOptions Url
u = UrlOptions :: Url -> Bool -> Maybe Text -> Maybe Sha256 -> UrlOptions
UrlOptions
  { urlUrl :: Url
urlUrl = Url
u
  , urlUnpack :: Bool
urlUnpack = Bool
False
  , urlName :: Maybe Text
urlName = Maybe Text
forall a. Maybe a
Nothing
  , urlExpectedHash :: Maybe Sha256
urlExpectedHash = Maybe Sha256
forall a. Maybe a
Nothing }

-- | Runs @nix-prefetch-url@.
url :: (MonadIO m) => UrlOptions -> NixAction PrefetchError m (Sha256, StorePath Realized)
url :: UrlOptions
-> NixAction PrefetchError m (Sha256, StorePath Realized)
url UrlOptions{Bool
Maybe Text
Maybe Sha256
Url
urlExpectedHash :: Maybe Sha256
urlName :: Maybe Text
urlUnpack :: Bool
urlUrl :: Url
urlExpectedHash :: UrlOptions -> Maybe Sha256
urlName :: UrlOptions -> Maybe Text
urlUnpack :: UrlOptions -> Bool
urlUrl :: UrlOptions -> Url
..} = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction PrefetchError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
Helpers.getExecOr Executables -> Maybe String
exeNixPrefetchUrl Text
"nix-prefetch-url"
  ((Text, Text)
 -> ExitCode
 -> ExceptT PrefetchError m (Sha256, StorePath Realized))
-> Executable
-> [Text]
-> NixAction PrefetchError m (Sha256, StorePath Realized)
forall (m :: * -> *) e a.
MonadIO m =>
((Text, Text) -> ExitCode -> ExceptT e m a)
-> Executable -> [Text] -> NixAction e m a
Helpers.readProcess (Text, Text)
-> ExitCode -> ExceptT PrefetchError m (Sha256, StorePath Realized)
forall (m :: * -> *) a.
Monad m =>
(Text, Text)
-> ExitCode -> ExceptT PrefetchError m (Sha256, StorePath a)
handler Executable
exec [Text]
args
  where
    args :: [Text]
args =  [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [] [Text
"--unpack"] Bool
urlUnpack
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
n -> [Text
"--name", Text
n]) Maybe Text
urlName
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"--type", Text
"sha256"
            , Text
"--print-path"
            , Url -> Text
unUrl Url
urlUrl ]
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (Sha256 -> [Text]) -> Maybe Sha256 -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Text -> [Text]) -> (Sha256 -> Text) -> Sha256 -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Sha256 -> Text
unSha256) Maybe Sha256
urlExpectedHash

    handler :: (Text, Text)
-> ExitCode -> ExceptT PrefetchError m (Sha256, StorePath a)
handler (Text
out, Text
err) = \case
      ExitCode
ExitSuccess -> (Text -> PrefetchError)
-> ExceptT Text m (Sha256, StorePath a)
-> ExceptT PrefetchError m (Sha256, StorePath a)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT Text -> PrefetchError
PrefetchOutputMalformed (ExceptT Text m (Sha256, StorePath a)
 -> ExceptT PrefetchError m (Sha256, StorePath a))
-> ExceptT Text m (Sha256, StorePath a)
-> ExceptT PrefetchError m (Sha256, StorePath a)
forall a b. (a -> b) -> a -> b
$ do
        let ls :: [Text]
ls = Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd Text
out
        Text
path <- Text -> [Text] -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> [a] -> ExceptT e m a
tryLast Text
"nix-prefetch-url didn’t output a store path" [Text]
ls
        Text
sha  <- let errS :: Text
errS = Text
"nix-prefetch-url didn’t output a hash"
                in Text -> [Text] -> ExceptT Text m [Text]
forall (m :: * -> *) e a. Monad m => e -> [a] -> ExceptT e m [a]
tryInit Text
errS [Text]
ls ExceptT Text m [Text]
-> ([Text] -> ExceptT Text m Text) -> ExceptT Text m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Text] -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> [a] -> ExceptT e m a
tryLast Text
errS
        pure (Text -> Sha256
Sha256 Text
sha, String -> StorePath a
forall a. String -> StorePath a
StorePath (String -> StorePath a) -> String -> StorePath a
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
path)
      ExitFailure Int
_ -> PrefetchError -> ExceptT PrefetchError m (Sha256, StorePath a)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (PrefetchError -> ExceptT PrefetchError m (Sha256, StorePath a))
-> PrefetchError -> ExceptT PrefetchError m (Sha256, StorePath a)
forall a b. (a -> b) -> a -> b
$
        if Text
"error: hash mismatch" Text -> Text -> Bool
`T.isPrefixOf` Text
err
        then PrefetchError
ExpectedHashError
        else PrefetchError
UnknownPrefetchError


data GitOptions = GitOptions
  { GitOptions -> Url
gitUrl :: Url
    -- ^ the URL
  , GitOptions -> Maybe Text
gitRev :: Maybe Text
    -- ^ a git revision (hash, branch name, tag, ref, …)
  , GitOptions -> Maybe Sha256
gitExpectedHash :: Maybe Sha256
    -- ^ the hash we are expecting
  , GitOptions -> Bool
gitDeepClone :: Bool
    -- ^ whether to do a deep instead of a shallow (@--depth=1@) git clone
  , GitOptions -> Bool
gitLeaveDotGit :: Bool
    -- ^ whether to keep @.git@ directories
  , GitOptions -> Bool
gitFetchSubmodules :: Bool
    -- ^ whether to fetch submodules
  }

-- | Takes the url, mirrors the default `fetchgit` options in nixpkgs:
-- no deep clone, no @.git@, fetches submodules by default.
-- By default, the latest default @rev@ is used.
defaultGitOptions :: Url -> GitOptions
defaultGitOptions :: Url -> GitOptions
defaultGitOptions Url
u = GitOptions :: Url
-> Maybe Text -> Maybe Sha256 -> Bool -> Bool -> Bool -> GitOptions
GitOptions
  { gitUrl :: Url
gitUrl = Url
u
  , gitRev :: Maybe Text
gitRev = Maybe Text
forall a. Maybe a
Nothing
  , gitExpectedHash :: Maybe Sha256
gitExpectedHash = Maybe Sha256
forall a. Maybe a
Nothing
  , gitDeepClone :: Bool
gitDeepClone = Bool
False
  , gitLeaveDotGit :: Bool
gitLeaveDotGit = Bool
False
  , gitFetchSubmodules :: Bool
gitFetchSubmodules = Bool
True }

data GitOutput = GitOutput
  { GitOutput -> Text
gitOutputRev :: Text
    -- ^ The actual revision that is used (useful if no 'gitRev' was given)
  , GitOutput -> Sha256
gitOutputSha256 :: Sha256
    -- ^ the hash
  , GitOutput -> StorePath Realized
gitOuputPath :: StorePath Realized
    -- ^ the store path of the result
  } deriving (Int -> GitOutput -> ShowS
[GitOutput] -> ShowS
GitOutput -> String
(Int -> GitOutput -> ShowS)
-> (GitOutput -> String)
-> ([GitOutput] -> ShowS)
-> Show GitOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitOutput] -> ShowS
$cshowList :: [GitOutput] -> ShowS
show :: GitOutput -> String
$cshow :: GitOutput -> String
showsPrec :: Int -> GitOutput -> ShowS
$cshowsPrec :: Int -> GitOutput -> ShowS
Show, GitOutput -> GitOutput -> Bool
(GitOutput -> GitOutput -> Bool)
-> (GitOutput -> GitOutput -> Bool) -> Eq GitOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitOutput -> GitOutput -> Bool
$c/= :: GitOutput -> GitOutput -> Bool
== :: GitOutput -> GitOutput -> Bool
$c== :: GitOutput -> GitOutput -> Bool
Eq)

-- | Runs @nix-prefetch-git@.
git :: (MonadIO m) => GitOptions -> NixAction PrefetchError m GitOutput
git :: GitOptions -> NixAction PrefetchError m GitOutput
git GitOptions{Bool
Maybe Text
Maybe Sha256
Url
gitFetchSubmodules :: Bool
gitLeaveDotGit :: Bool
gitDeepClone :: Bool
gitExpectedHash :: Maybe Sha256
gitRev :: Maybe Text
gitUrl :: Url
gitFetchSubmodules :: GitOptions -> Bool
gitLeaveDotGit :: GitOptions -> Bool
gitDeepClone :: GitOptions -> Bool
gitExpectedHash :: GitOptions -> Maybe Sha256
gitRev :: GitOptions -> Maybe Text
gitUrl :: GitOptions -> Url
..} = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction PrefetchError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
getExecOr Executables -> Maybe String
exeNixPrefetchGit Text
"nix-prefetch-git"
  ((Text, Text) -> ExitCode -> ExceptT PrefetchError m GitOutput)
-> Executable -> [Text] -> NixAction PrefetchError m GitOutput
forall (m :: * -> *) e a.
MonadIO m =>
((Text, Text) -> ExitCode -> ExceptT e m a)
-> Executable -> [Text] -> NixAction e m a
Helpers.readProcess (Text, Text) -> ExitCode -> ExceptT PrefetchError m GitOutput
forall (m :: * -> *).
Monad m =>
(Text, Text) -> ExitCode -> ExceptT PrefetchError m GitOutput
handler Executable
exec [Text]
args
  where
    args :: [Text]
args =  [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [Text
"--no-deepClone"] [Text
"--deepClone"] Bool
gitDeepClone
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [] [Text
"--leave-dotGit"] Bool
gitLeaveDotGit
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [] [Text
"--fetch-submodules"] Bool
gitFetchSubmodules
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ Text
"--hash", Text
"sha256" -- --hash is the type, not the thing
            -- we need @url [rev [hash]]@,
            -- otherwise we can’t expect a hash
            , Url -> Text
unUrl Url
gitUrl
            , Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
gitRev ]
            -- hash comes last
         [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> (Sha256 -> [Text]) -> Maybe Sha256 -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Sha256 Text
h) -> [Text
h]) Maybe Sha256
gitExpectedHash

    handler :: (Text, Text) -> ExitCode -> ExceptT PrefetchError m GitOutput
handler (Text
out, Text
err) = \case
      ExitCode
ExitSuccess -> (Text -> PrefetchError)
-> ExceptT Text m GitOutput -> ExceptT PrefetchError m GitOutput
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT Text -> PrefetchError
PrefetchOutputMalformed (ExceptT Text m GitOutput -> ExceptT PrefetchError m GitOutput)
-> ExceptT Text m GitOutput -> ExceptT PrefetchError m GitOutput
forall a b. (a -> b) -> a -> b
$ do
        let error' :: a -> a
error' a
msg = a
"nix-prefetch-git " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
msg
            jsonError :: [Char] -> Text
            jsonError :: String -> Text
jsonError = \String
msg -> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
error' (Text -> [Text] -> Text
T.intercalate Text
"\n"
                      [ Text
"parsing json output failed:"
                      , String -> Text
Text.pack String
msg
                      , Text
"The output was:"
                      , Text
out ])

        (Text
gitOutputRev, Sha256
gitOutputSha256)
          <- m (Either Text (Text, Sha256)) -> ExceptT Text m (Text, Sha256)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text (Text, Sha256)) -> ExceptT Text m (Text, Sha256))
-> (Either String (Text, Sha256) -> m (Either Text (Text, Sha256)))
-> Either String (Text, Sha256)
-> ExceptT Text m (Text, Sha256)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text (Text, Sha256) -> m (Either Text (Text, Sha256))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Text, Sha256) -> m (Either Text (Text, Sha256)))
-> (Either String (Text, Sha256) -> Either Text (Text, Sha256))
-> Either String (Text, Sha256)
-> m (Either Text (Text, Sha256))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text)
-> Either String (Text, Sha256) -> Either Text (Text, Sha256)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
jsonError (Either String (Text, Sha256) -> ExceptT Text m (Text, Sha256))
-> Either String (Text, Sha256) -> ExceptT Text m (Text, Sha256)
forall a b. (a -> b) -> a -> b
$ do
            Value
val <- ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' (Text -> ByteString
Text.Lazy.Encoding.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.Lazy.fromStrict Text
out)
            ((Value -> Parser (Text, Sha256))
 -> Value -> Either String (Text, Sha256))
-> Value
-> (Value -> Parser (Text, Sha256))
-> Either String (Text, Sha256)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Value -> Parser (Text, Sha256))
-> Value -> Either String (Text, Sha256)
forall a b. (a -> Parser b) -> a -> Either String b
AesonT.parseEither Value
val
              ((Value -> Parser (Text, Sha256)) -> Either String (Text, Sha256))
-> (Value -> Parser (Text, Sha256)) -> Either String (Text, Sha256)
forall a b. (a -> b) -> a -> b
$ String
-> (Object -> Parser (Text, Sha256))
-> Value
-> Parser (Text, Sha256)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GitPrefetchOutput" ((Object -> Parser (Text, Sha256))
 -> Value -> Parser (Text, Sha256))
-> (Object -> Parser (Text, Sha256))
-> Value
-> Parser (Text, Sha256)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
                    (,) (Text -> Sha256 -> (Text, Sha256))
-> Parser Text -> Parser (Sha256 -> (Text, Sha256))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"rev"
                        Parser (Sha256 -> (Text, Sha256))
-> Parser Sha256 -> Parser (Text, Sha256)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Sha256) -> Parser Text -> Parser Sha256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Sha256
Sha256 (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"sha256")

        -- The path isn’t output in the json, but on stderr. :(
        -- So this is a bit more hacky than necessary.
        StorePath Realized
gitOuputPath <- case
          (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Text
"path is /nix/store" Text -> Text -> Bool
`T.isPrefixOf`) (Text -> [Text]
T.lines Text
err)
          Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
T.stripPrefix Text
"path is " of
          Maybe Text
Nothing -> Text -> ExceptT Text m (StorePath Realized)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
            (Text -> ExceptT Text m (StorePath Realized))
-> Text -> ExceptT Text m (StorePath Realized)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. HasCallStack => String -> a
error String
"could not find nix store output path on stderr"
          Just Text
path -> StorePath Realized -> ExceptT Text m (StorePath Realized)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorePath Realized -> ExceptT Text m (StorePath Realized))
-> StorePath Realized -> ExceptT Text m (StorePath Realized)
forall a b. (a -> b) -> a -> b
$ String -> StorePath Realized
forall a. String -> StorePath a
StorePath (String -> StorePath Realized) -> String -> StorePath Realized
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
path

        pure GitOutput :: Text -> Sha256 -> StorePath Realized -> GitOutput
GitOutput{Text
StorePath Realized
Sha256
gitOuputPath :: StorePath Realized
gitOutputSha256 :: Sha256
gitOutputRev :: Text
gitOuputPath :: StorePath Realized
gitOutputSha256 :: Sha256
gitOutputRev :: Text
..}

      ExitFailure Int
_ -> PrefetchError -> ExceptT PrefetchError m GitOutput
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (PrefetchError -> ExceptT PrefetchError m GitOutput)
-> PrefetchError -> ExceptT PrefetchError m GitOutput
forall a b. (a -> b) -> a -> b
$
        if Text
"hash mismatch for URL" Text -> Text -> Bool
`T.isInfixOf` Text
err
        then PrefetchError
ExpectedHashError
        else PrefetchError
UnknownPrefetchError