{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables, ViewPatterns, RecordWildCards, NoImplicitPrelude, LambdaCase, NamedFieldPuns, GeneralizedNewtypeDeriving, DeriveFunctor #-}
module Distribution.Nixpkgs.Nodejs.ResolveLockfile
( resolveLockfileStatus
, Resolved(..), ResolvedLockfile
) where
import Protolude
import qualified Control.Monad.Trans.Except as E
import qualified Data.List.NonEmpty as NE
import qualified Data.MultiKeyedMap as MKM
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as AesonT
import qualified System.Process as Process
import qualified Control.Concurrent.Async.Pool as Async
import qualified Control.Monad.STM as STM
import qualified Yarn.Lock.Types as YLT
nixPrefetchGitPath :: FilePath
nixPrefetchGitPath = "nix-prefetch-git"
maxFetchers :: Int
maxFetchers = 5
data Resolved a = Resolved
{ hashSum :: Text
, resolved :: a
} deriving (Show, Eq, Functor)
type ResolvedLockfile = MKM.MKMap YLT.PackageKey (Resolved YLT.Package)
resolveLockfileStatus :: (Chan YLT.Remote) -> YLT.Lockfile
-> IO (Either (NE.NonEmpty Text) ResolvedLockfile)
resolveLockfileStatus msgChan lf = Async.withTaskGroup maxFetchers $ \taskGroup -> do
job <- STM.atomically $ Async.mapReduce taskGroup
$ fmap (\(ks, pkg) -> (:[]) <$> (E.runExceptT $ do
liftIO $ writeChan msgChan (YLT.remote pkg)
res <- resolve pkg
pure (ks, res)))
$ MKM.toList lf
resolved <- Async.wait job
case partitionEithers resolved of
(x:xs, _ ) -> pure $ Left $ x NE.:| xs
(_ , ys) -> pure $ Right $ MKM.fromList YLT.lockfileIkProxy ys
where
resolve :: YLT.Package -> E.ExceptT Text IO (Resolved YLT.Package)
resolve pkg = case YLT.remote pkg of
YLT.FileRemote{..} -> pure $ r fileSha1
YLT.GitRemote{..} -> r <$> fetchFromGit gitRepoUrl gitRev
where
r sha = Resolved { hashSum = sha, resolved = pkg }
fetchFromGit :: Text -> Text -> E.ExceptT Text IO Text
fetchFromGit repo rev = do
res <- liftIO $ Process.readProcessWithExitCode nixPrefetchGitPath
["--url", toS repo, "--rev", toS rev, "--hash", "sha256"] ""
case res of
((ExitFailure _), _, err) -> E.throwE $ toS err
(ExitSuccess, out, _) -> E.ExceptT . pure
$ first (\decErr -> "parsing json output failed:\n"
<> toS decErr <> "\nThe output was:\n" <> toS out)
$ do val <- Aeson.eitherDecode' (toS out)
AesonT.parseEither
(Aeson.withObject "PrefetchOutput" (Aeson..: "sha256")) val