ResolveLockfile.hs

{-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables, ViewPatterns, RecordWildCards, NoImplicitPrelude, LambdaCase, NamedFieldPuns, GeneralizedNewtypeDeriving, DeriveFunctor #-}
-- TODO: remove exts
{-|
Description: IO-based resolving of missing hashes

Resolving a 'YLT.Lockfile' and generating all necessary data (e.g. hashes), so that it can be converted to a nix expression. Might need IO & network access to succeed.
-}
module Distribution.Nixpkgs.Nodejs.ResolveLockfile
( resolveLockfileStatus
, Resolved(..), ResolvedLockfile
) where

import Protolude
import qualified Control.Monad.Trans.Either 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

maxFetchers :: Int
maxFetchers = 5

-- | A thing whose hash is already known (“resolved”).
--
-- Only packages with known hashes are truly “locked”.
data Resolved a = Resolved
  { hashSum :: Text
  , resolved :: a
  } deriving (Show, Eq, Functor)

-- | In order to write a nix file, all packages need to know their shasums first.
type ResolvedLockfile = MKM.MKMap YLT.PackageKey (Resolved YLT.Package)

-- | Resolve all packages by downloading their sources if necessary.
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.runEitherT $ 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.EitherT 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.EitherT Text IO Text
    fetchFromGit repo rev = do
      res <- liftIO $ Process.readProcessWithExitCode "nix-prefetch-git"
               ["--url", toS repo, "--rev", toS rev, "--hash", "sha256"] ""
      case res of
        ((ExitFailure _), _, err) -> E.left $ toS err
        (ExitSuccess, out, _) -> E.hoistEither
          $ 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