{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

module Distribution.Nixpkgs.Fetch
  ( Source(..)
  , Hash(..)
  , DerivationSource(..), fromDerivationSource, urlDerivationSource
  , DerivKind(..)
  , derivKindFunction
  , FetchSubmodules(..)
  , UnpackArchive(..)
  , fetch
  , fetchWith
  ) where

import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.List as L
import Data.Maybe
import GHC.Generics ( Generic )
import Language.Nix.PrettyPrinting as PP
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.Process

-- | A source is a location from which we can fetch, such as a HTTP URL, a GIT URL, ....
data Source = Source
  { Source -> String
sourceUrl       :: String       -- ^ URL to fetch from.
  , Source -> String
sourceRevision  :: String       -- ^ Revision to use. For protocols where this doesn't make sense (such as HTTP), this
                                    --   should be the empty string.
  , Source -> Hash
sourceHash      :: Hash         -- ^ The expected hash of the source, if available.
  , Source -> String
sourceCabalDir  :: String       -- ^ Directory where Cabal file is found.
  } deriving (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, Eq Source
Eq Source
-> (Source -> Source -> Ordering)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Bool)
-> (Source -> Source -> Source)
-> (Source -> Source -> Source)
-> Ord Source
Source -> Source -> Bool
Source -> Source -> Ordering
Source -> Source -> Source
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Source -> Source -> Source
$cmin :: Source -> Source -> Source
max :: Source -> Source -> Source
$cmax :: Source -> Source -> Source
>= :: Source -> Source -> Bool
$c>= :: Source -> Source -> Bool
> :: Source -> Source -> Bool
$c> :: Source -> Source -> Bool
<= :: Source -> Source -> Bool
$c<= :: Source -> Source -> Bool
< :: Source -> Source -> Bool
$c< :: Source -> Source -> Bool
compare :: Source -> Source -> Ordering
$ccompare :: Source -> Source -> Ordering
$cp1Ord :: Eq Source
Ord, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic)

instance NFData Source

data Hash = Certain String | Guess String | UnknownHash
  deriving (Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show, Hash -> Hash -> Bool
(Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hash -> Hash -> Bool
$c/= :: Hash -> Hash -> Bool
== :: Hash -> Hash -> Bool
$c== :: Hash -> Hash -> Bool
Eq, Eq Hash
Eq Hash
-> (Hash -> Hash -> Ordering)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Bool)
-> (Hash -> Hash -> Hash)
-> (Hash -> Hash -> Hash)
-> Ord Hash
Hash -> Hash -> Bool
Hash -> Hash -> Ordering
Hash -> Hash -> Hash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hash -> Hash -> Hash
$cmin :: Hash -> Hash -> Hash
max :: Hash -> Hash -> Hash
$cmax :: Hash -> Hash -> Hash
>= :: Hash -> Hash -> Bool
$c>= :: Hash -> Hash -> Bool
> :: Hash -> Hash -> Bool
$c> :: Hash -> Hash -> Bool
<= :: Hash -> Hash -> Bool
$c<= :: Hash -> Hash -> Bool
< :: Hash -> Hash -> Bool
$c< :: Hash -> Hash -> Bool
compare :: Hash -> Hash -> Ordering
$ccompare :: Hash -> Hash -> Ordering
$cp1Ord :: Eq Hash
Ord, (forall x. Hash -> Rep Hash x)
-> (forall x. Rep Hash x -> Hash) -> Generic Hash
forall x. Rep Hash x -> Hash
forall x. Hash -> Rep Hash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hash x -> Hash
$cfrom :: forall x. Hash -> Rep Hash x
Generic)

instance NFData Hash

isUnknown :: Hash -> Bool
isUnknown :: Hash -> Bool
isUnknown Hash
UnknownHash = Bool
True
isUnknown Hash
_           = Bool
False

hashToList :: Hash -> [String]
hashToList :: Hash -> [String]
hashToList (Certain String
s) = [String
s]
hashToList Hash
_           = []

-- | A source for a derivation. It always needs a hash and also has a protocol attached to it (url, git, svn, ...).
-- A @DerivationSource@ also always has it's revision fully resolved (not relative revisions like @master@, @HEAD@, etc).
data DerivationSource = DerivationSource
  { DerivationSource -> Maybe DerivKind
derivKind     :: Maybe DerivKind -- ^ The kind of the source. If Nothing, it is a local derivation.
  , DerivationSource -> String
derivUrl      :: String -- ^ URL to fetch from.
  , DerivationSource -> String
derivRevision :: String -- ^ Revision to use. Leave empty if the fetcher doesn't support revisions.
  , DerivationSource -> String
derivHash     :: String -- ^ The hash of the source.
  , DerivationSource -> Maybe Bool
derivSubmodule :: Maybe Bool -- ^ The fetchSubmodule setting (if any)
  }
  deriving (Int -> DerivationSource -> ShowS
[DerivationSource] -> ShowS
DerivationSource -> String
(Int -> DerivationSource -> ShowS)
-> (DerivationSource -> String)
-> ([DerivationSource] -> ShowS)
-> Show DerivationSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationSource] -> ShowS
$cshowList :: [DerivationSource] -> ShowS
show :: DerivationSource -> String
$cshow :: DerivationSource -> String
showsPrec :: Int -> DerivationSource -> ShowS
$cshowsPrec :: Int -> DerivationSource -> ShowS
Show, (forall x. DerivationSource -> Rep DerivationSource x)
-> (forall x. Rep DerivationSource x -> DerivationSource)
-> Generic DerivationSource
forall x. Rep DerivationSource x -> DerivationSource
forall x. DerivationSource -> Rep DerivationSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivationSource x -> DerivationSource
$cfrom :: forall x. DerivationSource -> Rep DerivationSource x
Generic)

instance NFData DerivationSource

instance FromJSON DerivationSource where
  parseJSON :: Value -> Parser DerivationSource
parseJSON (Object Object
o) = Maybe DerivKind
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource (String -> Maybe DerivKind
forall a. HasCallStack => String -> a
error String
"undefined DerivationSource.kind")
        (String -> String -> String -> Maybe Bool -> DerivationSource)
-> Parser String
-> Parser (String -> String -> Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        Parser (String -> String -> Maybe Bool -> DerivationSource)
-> Parser String
-> Parser (String -> Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rev"
        Parser (String -> Maybe Bool -> DerivationSource)
-> Parser String -> Parser (Maybe Bool -> DerivationSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha256"
        Parser (Maybe Bool -> DerivationSource)
-> Parser (Maybe Bool) -> Parser DerivationSource
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetchSubmodules"
  parseJSON Value
_ = String -> Parser DerivationSource
forall a. HasCallStack => String -> a
error String
"invalid DerivationSource"

instance PP.Pretty DerivationSource where
  pPrint :: DerivationSource -> Doc
pPrint DerivationSource {String
Maybe Bool
Maybe DerivKind
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: Maybe DerivKind
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> Maybe DerivKind
..} =
    let isHackagePackage :: Bool
isHackagePackage = String
"mirror://hackage/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
derivUrl
    in if Bool
isHackagePackage then if String
derivHash String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then String -> Doc -> Doc
attr String
"sha256" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash else Doc
forall a. Monoid a => a
mempty
       else case Maybe DerivKind
derivKind of
          Maybe DerivKind
Nothing ->  String -> Doc -> Doc
attr String
"src" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
derivUrl
          Just DerivKind
derivKind' -> [Doc] -> Doc
vcat
                 [ String -> Doc
text String
"src" Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> String -> Doc
text (DerivKind -> String
derivKindFunction DerivKind
derivKind') Doc -> Doc -> Doc
<+> Doc
lbrace
                 , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
                   [ String -> Doc -> Doc
attr String
"url" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivUrl
                   , String -> Doc -> Doc
attr String
"sha256" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
string String
derivHash
                   , if String
derivRevision String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then String -> Doc -> Doc
attr String
"rev" (String -> Doc
string String
derivRevision) else Doc
PP.empty
                   , String -> Bool -> Bool -> Doc
boolattr String
"fetchSubmodules" (Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
derivSubmodule) (Maybe Bool -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Bool
derivSubmodule)
                   ]
                 , Doc
rbrace Doc -> Doc -> Doc
PP.<> Doc
semi
                 ]


urlDerivationSource :: String -> String -> DerivationSource
urlDerivationSource :: String -> String -> DerivationSource
urlDerivationSource String
url String
hash =
  DerivationSource :: Maybe DerivKind
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource {
    derivKind :: Maybe DerivKind
derivKind = DerivKind -> Maybe DerivKind
forall a. a -> Maybe a
Just (UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
DontUnpackArchive),
    derivUrl :: String
derivUrl = String
url,
    derivRevision :: String
derivRevision = String
"",
    derivHash :: String
derivHash = String
hash,
    derivSubmodule :: Maybe Bool
derivSubmodule = Maybe Bool
forall a. Maybe a
Nothing
  }

fromDerivationSource :: DerivationSource -> Source
fromDerivationSource :: DerivationSource -> Source
fromDerivationSource DerivationSource{String
Maybe Bool
Maybe DerivKind
derivSubmodule :: Maybe Bool
derivHash :: String
derivRevision :: String
derivUrl :: String
derivKind :: Maybe DerivKind
derivSubmodule :: DerivationSource -> Maybe Bool
derivHash :: DerivationSource -> String
derivRevision :: DerivationSource -> String
derivUrl :: DerivationSource -> String
derivKind :: DerivationSource -> Maybe DerivKind
..} =
  Source :: String -> String -> Hash -> String -> Source
Source {
    sourceUrl :: String
sourceUrl = String
derivUrl,
    sourceRevision :: String
sourceRevision = String
derivRevision,
    sourceHash :: Hash
sourceHash = String -> Hash
Certain String
derivHash,
    sourceCabalDir :: String
sourceCabalDir = String
"."
  }

-- | Fetch a source, trying any of the various nix-prefetch-* scripts.
fetch :: forall a.
         FetchSubmodules
      -- ^ whether to fetch submodules when the source is a git repository
      -> (String -> MaybeT IO a)
      -- ^ This function is passed the output path name as an argument.
      -- It should return 'Nothing' if the file doesn't match the expected format.
      -- This is required, because we cannot always check if a download succeeded otherwise.
      -> Source
      -- ^ The source to fetch from.
      -> IO (Maybe (DerivationSource, a))
      -- ^ The derivation source and the result of the processing function. Returns Nothing if the download failed.
fetch :: FetchSubmodules
-> (String -> MaybeT IO a)
-> Source
-> IO (Maybe (DerivationSource, a))
fetch FetchSubmodules
optSubModules String -> MaybeT IO a
f = MaybeT IO (DerivationSource, a) -> IO (Maybe (DerivationSource, a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (DerivationSource, a)
 -> IO (Maybe (DerivationSource, a)))
-> (Source -> MaybeT IO (DerivationSource, a))
-> Source
-> IO (Maybe (DerivationSource, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> MaybeT IO (DerivationSource, a)
fetchers where
  fetchers :: Source -> MaybeT IO (DerivationSource, a)
  fetchers :: Source -> MaybeT IO (DerivationSource, a)
fetchers Source
source = [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT IO (DerivationSource, a)]
 -> MaybeT IO (DerivationSource, a))
-> ([MaybeT IO (DerivationSource, a)]
    -> [MaybeT IO (DerivationSource, a)])
-> [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Source -> MaybeT IO (DerivationSource, a)
fetchLocal Source
source MaybeT IO (DerivationSource, a)
-> [MaybeT IO (DerivationSource, a)]
-> [MaybeT IO (DerivationSource, a)]
forall a. a -> [a] -> [a]
:) ([MaybeT IO (DerivationSource, a)]
 -> MaybeT IO (DerivationSource, a))
-> [MaybeT IO (DerivationSource, a)]
-> MaybeT IO (DerivationSource, a)
forall a b. (a -> b) -> a -> b
$ ((Bool, DerivKind) -> MaybeT IO (DerivationSource, a))
-> [(Bool, DerivKind)] -> [MaybeT IO (DerivationSource, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool, DerivKind)
fetcher -> (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool, DerivKind)
fetcher Source
source MaybeT IO (DerivationSource, String)
-> ((DerivationSource, String) -> MaybeT IO (DerivationSource, a))
-> MaybeT IO (DerivationSource, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process)
    [ (Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
DontUnpackArchive)
    , (Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
UnpackArchive)
    , (Bool
True, FetchSubmodules -> DerivKind
DerivKindGit FetchSubmodules
optSubModules)
    , (Bool
True, DerivKind
DerivKindHg)
    , (Bool
True, DerivKind
DerivKindSvn)
    , (Bool
True, DerivKind
DerivKindBzr)
    ]

  -- | Remove '/' from the end of the path. Nix doesn't accept paths that
  -- end in a slash.
  stripSlashSuffix :: String -> String
  stripSlashSuffix :: ShowS
stripSlashSuffix = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse

  fetchLocal :: Source -> MaybeT IO (DerivationSource, a)
  fetchLocal :: Source -> MaybeT IO (DerivationSource, a)
fetchLocal Source
src = do
    let path :: String
path = ShowS
stripSlashSuffix ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
stripPrefix String
"file://" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Source -> String
sourceUrl Source
src
    Bool
existsFile <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path
    Bool
existsDir  <- IO Bool -> MaybeT IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
path
    Bool -> MaybeT IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT IO ()) -> Bool -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Bool
existsDir Bool -> Bool -> Bool
|| Bool
existsFile
    let path' :: String
path' | Char
'/' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
path = String
path
              | Bool
otherwise       = String
"./" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
    (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (String -> DerivationSource
localDerivationSource String
path', String
path') MaybeT IO (DerivationSource, a)
-> MaybeT IO (DerivationSource, a)
-> MaybeT IO (DerivationSource, a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> MaybeT IO (DerivationSource, a)
localArchive String
path'

  localArchive :: FilePath -> MaybeT IO (DerivationSource, a)
  localArchive :: String -> MaybeT IO (DerivationSource, a)
localArchive String
path = do
    String
absolutePath <- IO String -> MaybeT IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
path
    String
unpacked <-
      (DerivationSource, String) -> String
forall a b. (a, b) -> b
snd ((DerivationSource, String) -> String)
-> MaybeT IO (DerivationSource, String) -> MaybeT IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith
          (Bool
False, UnpackArchive -> DerivKind
DerivKindUrl UnpackArchive
UnpackArchive)
          (Source :: String -> String -> Hash -> String -> Source
Source {
            sourceUrl :: String
sourceUrl = String
"file://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
absolutePath,
            sourceRevision :: String
sourceRevision = String
"",
            sourceHash :: Hash
sourceHash = Hash
UnknownHash,
            sourceCabalDir :: String
sourceCabalDir = String
"."
          })
    (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (String -> DerivationSource
localDerivationSource String
absolutePath, String
unpacked)

  process :: (DerivationSource, FilePath) -> MaybeT IO (DerivationSource, a)
  process :: (DerivationSource, String) -> MaybeT IO (DerivationSource, a)
process (DerivationSource
derivSource, String
file) = (,) DerivationSource
derivSource (a -> (DerivationSource, a))
-> MaybeT IO a -> MaybeT IO (DerivationSource, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> MaybeT IO a
f String
file

  localDerivationSource :: String -> DerivationSource
localDerivationSource String
p =
    DerivationSource :: Maybe DerivKind
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource {
      derivKind :: Maybe DerivKind
derivKind = Maybe DerivKind
forall a. Maybe a
Nothing,
      derivUrl :: String
derivUrl = String
p,
      derivRevision :: String
derivRevision = String
"",
      derivHash :: String
derivHash = String
"",
      derivSubmodule :: Maybe Bool
derivSubmodule = Maybe Bool
forall a. Maybe a
Nothing
    }

data DerivKind
  = DerivKindUrl UnpackArchive
  | DerivKindGit FetchSubmodules
  | DerivKindHg
  | DerivKindSvn
  | DerivKindBzr
  deriving (Int -> DerivKind -> ShowS
[DerivKind] -> ShowS
DerivKind -> String
(Int -> DerivKind -> ShowS)
-> (DerivKind -> String)
-> ([DerivKind] -> ShowS)
-> Show DerivKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivKind] -> ShowS
$cshowList :: [DerivKind] -> ShowS
show :: DerivKind -> String
$cshow :: DerivKind -> String
showsPrec :: Int -> DerivKind -> ShowS
$cshowsPrec :: Int -> DerivKind -> ShowS
Show, (forall x. DerivKind -> Rep DerivKind x)
-> (forall x. Rep DerivKind x -> DerivKind) -> Generic DerivKind
forall x. Rep DerivKind x -> DerivKind
forall x. DerivKind -> Rep DerivKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivKind x -> DerivKind
$cfrom :: forall x. DerivKind -> Rep DerivKind x
Generic)

instance NFData DerivKind

-- | Whether to fetch submodules (git).
data FetchSubmodules = FetchSubmodules | DontFetchSubmodules
  deriving (Int -> FetchSubmodules -> ShowS
[FetchSubmodules] -> ShowS
FetchSubmodules -> String
(Int -> FetchSubmodules -> ShowS)
-> (FetchSubmodules -> String)
-> ([FetchSubmodules] -> ShowS)
-> Show FetchSubmodules
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FetchSubmodules] -> ShowS
$cshowList :: [FetchSubmodules] -> ShowS
show :: FetchSubmodules -> String
$cshow :: FetchSubmodules -> String
showsPrec :: Int -> FetchSubmodules -> ShowS
$cshowsPrec :: Int -> FetchSubmodules -> ShowS
Show, (forall x. FetchSubmodules -> Rep FetchSubmodules x)
-> (forall x. Rep FetchSubmodules x -> FetchSubmodules)
-> Generic FetchSubmodules
forall x. Rep FetchSubmodules x -> FetchSubmodules
forall x. FetchSubmodules -> Rep FetchSubmodules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FetchSubmodules x -> FetchSubmodules
$cfrom :: forall x. FetchSubmodules -> Rep FetchSubmodules x
Generic)

instance NFData FetchSubmodules


-- | Whether to unpack an archive after fetching, before putting it into the nix store.
data UnpackArchive = UnpackArchive | DontUnpackArchive
  deriving (Int -> UnpackArchive -> ShowS
[UnpackArchive] -> ShowS
UnpackArchive -> String
(Int -> UnpackArchive -> ShowS)
-> (UnpackArchive -> String)
-> ([UnpackArchive] -> ShowS)
-> Show UnpackArchive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnpackArchive] -> ShowS
$cshowList :: [UnpackArchive] -> ShowS
show :: UnpackArchive -> String
$cshow :: UnpackArchive -> String
showsPrec :: Int -> UnpackArchive -> ShowS
$cshowsPrec :: Int -> UnpackArchive -> ShowS
Show, (forall x. UnpackArchive -> Rep UnpackArchive x)
-> (forall x. Rep UnpackArchive x -> UnpackArchive)
-> Generic UnpackArchive
forall x. Rep UnpackArchive x -> UnpackArchive
forall x. UnpackArchive -> Rep UnpackArchive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnpackArchive x -> UnpackArchive
$cfrom :: forall x. UnpackArchive -> Rep UnpackArchive x
Generic)

instance NFData UnpackArchive


-- | The nixpkgs function to use for fetching this kind of derivation
derivKindFunction :: DerivKind -> String
derivKindFunction :: DerivKind -> String
derivKindFunction = \case
  DerivKindUrl UnpackArchive
DontUnpackArchive -> String
"fetchurl"
  DerivKindUrl UnpackArchive
UnpackArchive -> String
"fetchzip"
  DerivKindGit FetchSubmodules
_ -> String
"fetchgit"
  DerivKind
DerivKindHg -> String
"fetchhg"
  DerivKind
DerivKindSvn -> String
"fetchsvn"
  DerivKind
DerivKindBzr -> String
"fetchbzr"


-- | Like 'fetch', but allows to specify which script to use.
fetchWith :: (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, FilePath)
fetchWith :: (Bool, DerivKind) -> Source -> MaybeT IO (DerivationSource, String)
fetchWith (Bool
supportsRev, DerivKind
kind) Source
source = do
  Bool -> MaybeT IO () -> MaybeT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Source -> String
sourceRevision Source
source String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") Bool -> Bool -> Bool
|| Hash -> Bool
isUnknown (Source -> Hash
sourceHash Source
source) Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
supportsRev) (MaybeT IO () -> MaybeT IO ()) -> MaybeT IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$
    IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"** need a revision for VCS when the hash is given. skipping.") MaybeT IO () -> MaybeT IO () -> MaybeT IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MaybeT IO ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero

  let (String
script, [String]
extraArgs) = case DerivKind
kind of
        DerivKindUrl UnpackArchive
UnpackArchive ->  (String
"nix-prefetch-url", [String
"--unpack"])
        DerivKindUrl UnpackArchive
DontUnpackArchive ->  (String
"nix-prefetch-url", [])
        DerivKindGit FetchSubmodules
FetchSubmodules -> (String
"nix-prefetch-git", [String
"--fetch-submodules"])
        DerivKindGit FetchSubmodules
DontFetchSubmodules -> (String
"nix-prefetch-git", [])
        DerivKind
DerivKindHg -> (String
"nix-prefetch-hg", [])
        DerivKind
DerivKindSvn -> (String
"nix-prefetch-svn", [])
        DerivKind
DerivKindBzr -> (String
"nix-prefetch-bzr", [])

  let [String]
args :: [String] =
            [String]
extraArgs
         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Source -> String
sourceUrl Source
source
         String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ Source -> String
sourceRevision Source
source | Bool
supportsRev ]
         [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Hash -> [String]
hashToList (Source -> Hash
sourceHash Source
source)

  IO (Maybe (DerivationSource, String))
-> MaybeT IO (DerivationSource, String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (DerivationSource, String))
 -> MaybeT IO (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
-> MaybeT IO (DerivationSource, String)
forall a b. (a -> b) -> a -> b
$ IO (Maybe (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (DerivationSource, String))
 -> IO (Maybe (DerivationSource, String)))
-> IO (Maybe (DerivationSource, String))
-> IO (Maybe (DerivationSource, String))
forall a b. (a -> b) -> a -> b
$ do
    [(String, String)]
envs <- IO [(String, String)]
getEnvironment
    (Maybe Handle
Nothing, Just Handle
stdoutH, Maybe Handle
_, ProcessHandle
processH) <-
      CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
        (String -> [String] -> CreateProcess
proc String
script [String]
args)
        { env :: Maybe [(String, String)]
env = [(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just ([(String, String)] -> Maybe [(String, String)])
-> [(String, String)] -> Maybe [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String
"PRINT_PATH", String
"1") (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
envs
        , std_in :: StdStream
std_in = StdStream
Inherit
        , std_err :: StdStream
std_err = StdStream
Inherit
        , std_out :: StdStream
std_out = StdStream
CreatePipe
        }

    ExitCode
exitCode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
processH
    case ExitCode
exitCode of
      ExitFailure Int
_ -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DerivationSource, String)
forall a. Maybe a
Nothing
      ExitCode
ExitSuccess   -> do
        ByteString
buf <- Handle -> IO ByteString
BS.hGetContents Handle
stdoutH
        let (ByteString
l,[ByteString]
ls) = case [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString -> [ByteString]
BS.lines ByteString
buf) of
                       []     -> String -> (ByteString, [ByteString])
forall a. HasCallStack => String -> a
error String
"This can't happen, but GHC doesn't know that."
                       (ByteString
x:[ByteString]
xs) -> (ByteString
x,[ByteString]
xs)
            buf' :: ByteString
buf'   = [ByteString] -> ByteString
BS.unlines ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
ls)
        case [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ls of
          Int
0 -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DerivationSource, String)
forall a. Maybe a
Nothing
          Int
1 -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((DerivationSource, String) -> Maybe (DerivationSource, String)
forall a. a -> Maybe a
Just (DerivationSource :: Maybe DerivKind
-> String -> String -> String -> Maybe Bool -> DerivationSource
DerivationSource { derivKind :: Maybe DerivKind
derivKind = DerivKind -> Maybe DerivKind
forall a. a -> Maybe a
Just DerivKind
kind
                                              , derivUrl :: String
derivUrl = Source -> String
sourceUrl Source
source
                                              , derivRevision :: String
derivRevision = String
""
                                              , derivHash :: String
derivHash = ByteString -> String
BS.unpack ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
ls)
                                              , derivSubmodule :: Maybe Bool
derivSubmodule = Maybe Bool
forall a. Maybe a
Nothing
                                              }
                            , ByteString -> String
BS.unpack ByteString
l))
          Int
_ -> case ByteString -> Either String DerivationSource
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
buf' of
                 Left String
err -> String -> IO (Maybe (DerivationSource, String))
forall a. HasCallStack => String -> a
error (String
"invalid JSON: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
buf')
                 Right DerivationSource
ds -> Maybe (DerivationSource, String)
-> IO (Maybe (DerivationSource, String))
forall (m :: * -> *) a. Monad m => a -> m a
return ((DerivationSource, String) -> Maybe (DerivationSource, String)
forall a. a -> Maybe a
Just (DerivationSource
ds { derivKind :: Maybe DerivKind
derivKind = DerivKind -> Maybe DerivKind
forall a. a -> Maybe a
Just DerivKind
kind }, ByteString -> String
BS.unpack ByteString
l))


stripPrefix :: Eq a => [a] -> [a] -> [a]
stripPrefix :: [a] -> [a] -> [a]
stripPrefix [a]
prefix [a]
as
  | [a]
prefix' [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
prefix = [a]
stripped
  | Bool
otherwise = [a]
as
 where
  ([a]
prefix', [a]
stripped) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
prefix) [a]
as