{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module App.Commands.SyncFromArchive
  ( cmdSyncFromArchive
  ) where

import Antiope.Core                     (Region (..), runResAws, toText)
import Antiope.Env                      (mkEnv)
import Antiope.Options.Applicative
import App.Commands.Options.Parser      (text)
import App.Commands.Options.Types       (SyncFromArchiveOptions (SyncFromArchiveOptions))
import Control.Applicative
import Control.Lens                     hiding ((<.>))
import Control.Monad.Catch              (MonadCatch)
import Control.Monad.Except
import Data.ByteString.Lazy.Search      (replace)
import Data.Generics.Product.Any        (the)
import Data.Maybe
import Foreign.C.Error                  (eXDEV)
import HaskellWorks.CabalCache.AppError
import HaskellWorks.CabalCache.IO.Error (catchErrno, exceptWarn, maybeToExcept)
import HaskellWorks.CabalCache.Location (toLocation, (<.>), (</>))
import HaskellWorks.CabalCache.Metadata (loadMetadata)
import HaskellWorks.CabalCache.Show
import HaskellWorks.CabalCache.Version  (archiveVersion)
import Options.Applicative              hiding (columns)
import System.Directory                 (createDirectoryIfMissing, doesDirectoryExist)

import qualified App.Commands.Options.Types                       as Z
import qualified App.Static                                       as AS
import qualified Control.Concurrent.STM                           as STM
import qualified Data.ByteString.Char8                            as C8
import qualified Data.ByteString.Lazy                             as LBS
import qualified Data.List                                        as L
import qualified Data.Map                                         as M
import qualified Data.Map.Strict                                  as Map
import qualified Data.Text                                        as T
import qualified HaskellWorks.CabalCache.AWS.Env                  as AWS
import qualified HaskellWorks.CabalCache.Concurrent.DownloadQueue as DQ
import qualified HaskellWorks.CabalCache.Concurrent.Fork          as IO
import qualified HaskellWorks.CabalCache.Core                     as Z
import qualified HaskellWorks.CabalCache.Data.List                as L
import qualified HaskellWorks.CabalCache.GhcPkg                   as GhcPkg
import qualified HaskellWorks.CabalCache.Hash                     as H
import qualified HaskellWorks.CabalCache.IO.Console               as CIO
import qualified HaskellWorks.CabalCache.IO.Lazy                  as IO
import qualified HaskellWorks.CabalCache.IO.Tar                   as IO
import qualified HaskellWorks.CabalCache.Types                    as Z
import qualified System.Directory                                 as IO
import qualified System.IO                                        as IO
import qualified System.IO.Temp                                   as IO
import qualified System.IO.Unsafe                                 as IO

{- HLINT ignore "Monoid law, left identity" -}
{- HLINT ignore "Reduce duplication"        -}
{- HLINT ignore "Redundant do"              -}

skippable :: Z.Package -> Bool
skippable :: Package -> Bool
skippable Package
package = Package
package Package -> Getting Text Package Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "packageType" s t a b => Lens s t a b
the @"packageType" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"pre-existing"

runSyncFromArchive :: Z.SyncFromArchiveOptions -> IO ()
runSyncFromArchive :: SyncFromArchiveOptions -> IO ()
runSyncFromArchive SyncFromArchiveOptions
opts = do
  let storePath :: [Char]
storePath             = SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting [Char] SyncFromArchiveOptions [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "storePath" s t a b => Lens s t a b
the @"storePath"
  let archiveUris :: [Location]
archiveUris           = SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting [Location] SyncFromArchiveOptions [Location]
-> [Location]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "archiveUris" s t a b => Lens s t a b
the @"archiveUris"
  let threads :: Int
threads               = SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting Int SyncFromArchiveOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "threads" s t a b => Lens s t a b
the @"threads"
  let awsLogLevel :: Maybe LogLevel
awsLogLevel           = SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting (Maybe LogLevel) SyncFromArchiveOptions (Maybe LogLevel)
-> Maybe LogLevel
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "awsLogLevel" s t a b => Lens s t a b
the @"awsLogLevel"
  let versionedArchiveUris :: [Location]
versionedArchiveUris  = [Location]
archiveUris [Location] -> ([Location] -> [Location]) -> [Location]
forall a b. a -> (a -> b) -> b
& (Location -> Identity Location)
-> [Location] -> Identity [Location]
forall s t a b. Each s t a b => Traversal s t a b
each ((Location -> Identity Location)
 -> [Location] -> Identity [Location])
-> (Location -> Location) -> [Location] -> [Location]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> Text -> Location
forall a s. IsPath a s => a -> s -> a
</> Text
forall s. IsString s => s
archiveVersion)
  let storePathHash :: [Char]
storePathHash         = SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting (Maybe [Char]) SyncFromArchiveOptions (Maybe [Char])
-> Maybe [Char]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "storePathHash" s t a b => Lens s t a b
the @"storePathHash" Maybe [Char] -> (Maybe [Char] -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [Char]
H.hashStorePath [Char]
storePath)
  let scopedArchiveUris :: [Location]
scopedArchiveUris     = [Location]
versionedArchiveUris [Location] -> ([Location] -> [Location]) -> [Location]
forall a b. a -> (a -> b) -> b
& (Location -> Identity Location)
-> [Location] -> Identity [Location]
forall s t a b. Each s t a b => Traversal s t a b
each ((Location -> Identity Location)
 -> [Location] -> Identity [Location])
-> (Location -> Location) -> [Location] -> [Location]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> Text -> Location
forall a s. IsPath a s => a -> s -> a
</> [Char] -> Text
T.pack [Char]
storePathHash)

  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Store path: "       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. ToText a => a -> Text
toText [Char]
storePath
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Store path hash: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
storePathHash
  [Location] -> (Location -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Location]
archiveUris ((Location -> IO ()) -> IO ()) -> (Location -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Location
archiveUri -> do
    Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Archive URI: "      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Location -> Text
forall a. ToText a => a -> Text
toText Location
archiveUri
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Archive version: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
forall s. IsString s => s
archiveVersion
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Threads: "          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
threads
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"AWS Log level: "    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe LogLevel -> Text
forall a. Show a => a -> Text
tshow Maybe LogLevel
awsLogLevel

  Either AppError PlanJson
mbPlan <- [Char] -> IO (Either AppError PlanJson)
Z.loadPlan ([Char] -> IO (Either AppError PlanJson))
-> [Char] -> IO (Either AppError PlanJson)
forall a b. (a -> b) -> a -> b
$ SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting [Char] SyncFromArchiveOptions [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "buildPath" s t a b => Lens s t a b
the @"buildPath"

  case Either AppError PlanJson
mbPlan of
    Right PlanJson
planJson -> do
      Either Text CompilerContext
compilerContextResult <- ExceptT Text IO CompilerContext -> IO (Either Text CompilerContext)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO CompilerContext
 -> IO (Either Text CompilerContext))
-> ExceptT Text IO CompilerContext
-> IO (Either Text CompilerContext)
forall a b. (a -> b) -> a -> b
$ PlanJson -> ExceptT Text IO CompilerContext
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
PlanJson -> ExceptT Text m CompilerContext
Z.mkCompilerContext PlanJson
planJson

      case Either Text CompilerContext
compilerContextResult of
        Right CompilerContext
compilerContext -> do
          CompilerContext -> IO ()
GhcPkg.testAvailability CompilerContext
compilerContext

          Env
envAws <- IO Env -> IO Env
forall a. IO a -> IO a
IO.unsafeInterleaveIO (IO Env -> IO Env) -> IO Env -> IO Env
forall a b. (a -> b) -> a -> b
$ Region -> (LogLevel -> ByteString -> IO ()) -> IO Env
mkEnv (SyncFromArchiveOptions
opts SyncFromArchiveOptions
-> Getting Region SyncFromArchiveOptions Region -> Region
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "region" s t a b => Lens s t a b
the @"region") (Maybe LogLevel -> LogLevel -> ByteString -> IO ()
AWS.awsLogger Maybe LogLevel
awsLogLevel)
          let compilerId :: Text
compilerId                  = PlanJson
planJson PlanJson -> Getting Text PlanJson Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "compilerId" s t a b => Lens s t a b
the @"compilerId"
          let storeCompilerPath :: [Char]
storeCompilerPath           = [Char]
storePath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> Text -> [Char]
T.unpack Text
compilerId
          let storeCompilerPackageDbPath :: [Char]
storeCompilerPackageDbPath  = [Char]
storeCompilerPath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
"package.db"
          let storeCompilerLibPath :: [Char]
storeCompilerLibPath        = [Char]
storeCompilerPath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
"lib"

          Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn Text
"Creating store directories"
          Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
storePath
          Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
storeCompilerPath
          Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
storeCompilerLibPath

          Bool
storeCompilerPackageDbPathExists <- [Char] -> IO Bool
doesDirectoryExist [Char]
storeCompilerPackageDbPath

          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
storeCompilerPackageDbPathExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn Text
"Package DB missing. Creating Package DB"
            CompilerContext -> [Char] -> IO ()
GhcPkg.init CompilerContext
compilerContext [Char]
storeCompilerPackageDbPath

          [PackageInfo]
packages <- [Char] -> PlanJson -> IO [PackageInfo]
Z.getPackages [Char]
storePath PlanJson
planJson

          let installPlan :: [Package]
installPlan = PlanJson
planJson PlanJson -> Getting [Package] PlanJson [Package] -> [Package]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "installPlan" s t a b => Lens s t a b
the @"installPlan"
          let planPackages :: Map Text Package
planPackages = [(Text, Package)] -> Map Text Package
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Package)] -> Map Text Package)
-> [(Text, Package)] -> Map Text Package
forall a b. (a -> b) -> a -> b
$ (Package -> (Text, Package)) -> [Package] -> [(Text, Package)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Package
p -> (Package
p Package -> Getting Text Package Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "id" s t a b => Lens s t a b
the @"id", Package
p)) [Package]
installPlan

          let planDeps0 :: [(Text, Text)]
planDeps0 = [Package]
installPlan [Package] -> (Package -> [(Text, Text)]) -> [(Text, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Package
p -> (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Package
p Package -> Getting Text Package Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "id" s t a b => Lens s t a b
the @"id", ) ([Text] -> [(Text, Text)]) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ [Text]
forall a. Monoid a => a
mempty
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Package
p Package -> Getting [Text] Package [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "depends" s t a b => Lens s t a b
the @"depends")
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Package
p Package -> Getting [Text] Package [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "exeDepends" s t a b => Lens s t a b
the @"exeDepends")
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Package
p Package -> Getting (Endo [Text]) Package Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "components" s t a b => Lens s t a b
the @"components" ((Maybe Components -> Const (Endo [Text]) (Maybe Components))
 -> Package -> Const (Endo [Text]) Package)
-> ((Text -> Const (Endo [Text]) Text)
    -> Maybe Components -> Const (Endo [Text]) (Maybe Components))
-> Getting (Endo [Text]) Package Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Components -> Const (Endo [Text]) Components)
-> Maybe Components -> Const (Endo [Text]) (Maybe Components)
forall s t a b. Each s t a b => Traversal s t a b
each ((Components -> Const (Endo [Text]) Components)
 -> Maybe Components -> Const (Endo [Text]) (Maybe Components))
-> ((Text -> Const (Endo [Text]) Text)
    -> Components -> Const (Endo [Text]) Components)
-> (Text -> Const (Endo [Text]) Text)
-> Maybe Components
-> Const (Endo [Text]) (Maybe Components)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "lib" s t a b => Lens s t a b
the @"lib" ((Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
 -> Components -> Const (Endo [Text]) Components)
-> ((Text -> Const (Endo [Text]) Text)
    -> Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
-> (Text -> Const (Endo [Text]) Text)
-> Components
-> Const (Endo [Text]) Components
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lib -> Const (Endo [Text]) Lib)
-> Maybe Lib -> Const (Endo [Text]) (Maybe Lib)
forall s t a b. Each s t a b => Traversal s t a b
each ((Lib -> Const (Endo [Text]) Lib)
 -> Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
-> ((Text -> Const (Endo [Text]) Text)
    -> Lib -> Const (Endo [Text]) Lib)
-> (Text -> Const (Endo [Text]) Text)
-> Maybe Lib
-> Const (Endo [Text]) (Maybe Lib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "depends" s t a b => Lens s t a b
the @"depends"    (([Text] -> Const (Endo [Text]) [Text])
 -> Lib -> Const (Endo [Text]) Lib)
-> ((Text -> Const (Endo [Text]) Text)
    -> [Text] -> Const (Endo [Text]) [Text])
-> (Text -> Const (Endo [Text]) Text)
-> Lib
-> Const (Endo [Text]) Lib
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> [Text] -> Const (Endo [Text]) [Text]
forall s t a b. Each s t a b => Traversal s t a b
each)
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Package
p Package -> Getting (Endo [Text]) Package Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "components" s t a b => Lens s t a b
the @"components" ((Maybe Components -> Const (Endo [Text]) (Maybe Components))
 -> Package -> Const (Endo [Text]) Package)
-> ((Text -> Const (Endo [Text]) Text)
    -> Maybe Components -> Const (Endo [Text]) (Maybe Components))
-> Getting (Endo [Text]) Package Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Components -> Const (Endo [Text]) Components)
-> Maybe Components -> Const (Endo [Text]) (Maybe Components)
forall s t a b. Each s t a b => Traversal s t a b
each ((Components -> Const (Endo [Text]) Components)
 -> Maybe Components -> Const (Endo [Text]) (Maybe Components))
-> ((Text -> Const (Endo [Text]) Text)
    -> Components -> Const (Endo [Text]) Components)
-> (Text -> Const (Endo [Text]) Text)
-> Maybe Components
-> Const (Endo [Text]) (Maybe Components)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "lib" s t a b => Lens s t a b
the @"lib" ((Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
 -> Components -> Const (Endo [Text]) Components)
-> ((Text -> Const (Endo [Text]) Text)
    -> Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
-> (Text -> Const (Endo [Text]) Text)
-> Components
-> Const (Endo [Text]) Components
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lib -> Const (Endo [Text]) Lib)
-> Maybe Lib -> Const (Endo [Text]) (Maybe Lib)
forall s t a b. Each s t a b => Traversal s t a b
each ((Lib -> Const (Endo [Text]) Lib)
 -> Maybe Lib -> Const (Endo [Text]) (Maybe Lib))
-> ((Text -> Const (Endo [Text]) Text)
    -> Lib -> Const (Endo [Text]) Lib)
-> (Text -> Const (Endo [Text]) Text)
-> Maybe Lib
-> Const (Endo [Text]) (Maybe Lib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "exeDepends" s t a b => Lens s t a b
the @"exeDepends" (([Text] -> Const (Endo [Text]) [Text])
 -> Lib -> Const (Endo [Text]) Lib)
-> ((Text -> Const (Endo [Text]) Text)
    -> [Text] -> Const (Endo [Text]) [Text])
-> (Text -> Const (Endo [Text]) Text)
-> Lib
-> Const (Endo [Text]) Lib
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> [Text] -> Const (Endo [Text]) [Text]
forall s t a b. Each s t a b => Traversal s t a b
each)
          let planDeps :: [(Text, Text)]
planDeps  = [(Text, Text)]
planDeps0 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> (Package -> (Text, Text)) -> [Package] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Package
p -> (Text
"[universe]", Package
p Package -> Getting Text Package Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "id" s t a b => Lens s t a b
the @"id")) [Package]
installPlan

          DownloadQueue
downloadQueue <- STM DownloadQueue -> IO DownloadQueue
forall a. STM a -> IO a
STM.atomically (STM DownloadQueue -> IO DownloadQueue)
-> STM DownloadQueue -> IO DownloadQueue
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> STM DownloadQueue
DQ.createDownloadQueue [(Text, Text)]
planDeps

          let pInfos :: Map Text PackageInfo
pInfos = [(Text, PackageInfo)] -> Map Text PackageInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, PackageInfo)] -> Map Text PackageInfo)
-> [(Text, PackageInfo)] -> Map Text PackageInfo
forall a b. (a -> b) -> a -> b
$ (PackageInfo -> (Text, PackageInfo))
-> [PackageInfo] -> [(Text, PackageInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PackageInfo
p -> (PackageInfo
p PackageInfo -> Getting Text PackageInfo Text -> Text
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "packageId" s t a b => Lens s t a b
the @"packageId", PackageInfo
p)) [PackageInfo]
packages

          [Char] -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Char] -> ([Char] -> m a) -> m a
IO.withSystemTempDirectory [Char]
"cabal-cache" (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
tempPath -> do
            Bool -> [Char] -> IO ()
IO.createDirectoryIfMissing Bool
True ([Char]
tempPath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> Text -> [Char]
T.unpack Text
compilerId [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
"package.db")

            Int -> IO () -> IO ()
IO.forkThreadsWait Int
threads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DownloadQueue -> (Text -> IO Bool) -> IO ()
forall (m :: * -> *).
MonadIO m =>
DownloadQueue -> (Text -> m Bool) -> m ()
DQ.runQueue DownloadQueue
downloadQueue ((Text -> IO Bool) -> IO ()) -> (Text -> IO Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
packageId -> case Text -> Map Text PackageInfo -> Maybe PackageInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
packageId Map Text PackageInfo
pInfos of
              Just PackageInfo
pInfo -> do
                let archiveBaseName :: [Char]
archiveBaseName     = PackageInfo -> [Char]
Z.packageDir PackageInfo
pInfo [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
<.> [Char]
".tar.gz"
                let archiveFiles :: [Location]
archiveFiles        = [Location]
versionedArchiveUris [Location] -> ([Location] -> [Location]) -> [Location]
forall a b. a -> (a -> b) -> b
& (Location -> Identity Location)
-> [Location] -> Identity [Location]
forall s t a b. Each s t a b => Traversal s t a b
each ((Location -> Identity Location)
 -> [Location] -> Identity [Location])
-> (Location -> Location) -> [Location] -> [Location]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> Text -> Location
forall a s. IsPath a s => a -> s -> a
</> [Char] -> Text
T.pack [Char]
archiveBaseName)
                let scopedArchiveFiles :: [Location]
scopedArchiveFiles  = [Location]
scopedArchiveUris [Location] -> ([Location] -> [Location]) -> [Location]
forall a b. a -> (a -> b) -> b
& (Location -> Identity Location)
-> [Location] -> Identity [Location]
forall s t a b. Each s t a b => Traversal s t a b
each ((Location -> Identity Location)
 -> [Location] -> Identity [Location])
-> (Location -> Location) -> [Location] -> [Location]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Location -> Text -> Location
forall a s. IsPath a s => a -> s -> a
</> [Char] -> Text
T.pack [Char]
archiveBaseName)
                let packageStorePath :: [Char]
packageStorePath    = [Char]
storePath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> PackageInfo -> [Char]
Z.packageDir PackageInfo
pInfo
                let maybePackage :: Maybe Package
maybePackage        = Text -> Map Text Package -> Maybe Package
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
packageId Map Text Package
planPackages

                Bool
storeDirectoryExists <- [Char] -> IO Bool
doesDirectoryExist [Char]
packageStorePath

                case Maybe Package
maybePackage of
                  Maybe Package
Nothing -> do
                    Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: package not found" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageId
                    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                  Just Package
package -> if Package -> Bool
skippable Package
package
                    then do
                      Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Skipping: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageId
                      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    else if Bool
storeDirectoryExists
                      then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                      else Env -> AWS Bool -> IO Bool
forall (m :: * -> *) r a.
(MonadUnliftIO m, HasEnv r) =>
r -> AWS a -> m a
runResAws Env
envAws (AWS Bool -> IO Bool) -> AWS Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (AppError -> AWST' Env (ResourceT IO) ())
-> Bool
-> ExceptT AppError (AWST' Env (ResourceT IO)) Bool
-> AWS Bool
forall (m :: * -> *) a.
MonadIO m =>
(AppError -> m ()) -> a -> ExceptT AppError m a -> m a
onError ([Char] -> Text -> AppError -> AWST' Env (ResourceT IO) ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
[Char] -> Text -> AppError -> m ()
cleanupStorePath [Char]
packageStorePath Text
packageId) Bool
False (ExceptT AppError (AWST' Env (ResourceT IO)) Bool -> AWS Bool)
-> ExceptT AppError (AWST' Env (ResourceT IO)) Bool -> AWS Bool
forall a b. (a -> b) -> a -> b
$ do
                        (ByteString
existingArchiveFileContents, Location
existingArchiveFile) <- AWST' Env (ResourceT IO) (Either AppError (ByteString, Location))
-> ExceptT
     AppError (AWST' Env (ResourceT IO)) (ByteString, Location)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (AWST' Env (ResourceT IO) (Either AppError (ByteString, Location))
 -> ExceptT
      AppError (AWST' Env (ResourceT IO)) (ByteString, Location))
-> AWST'
     Env (ResourceT IO) (Either AppError (ByteString, Location))
-> ExceptT
     AppError (AWST' Env (ResourceT IO)) (ByteString, Location)
forall a b. (a -> b) -> a -> b
$ Env
-> [Location]
-> AWST'
     Env (ResourceT IO) (Either AppError (ByteString, Location))
forall (m :: * -> *).
(MonadResource m, MonadCatch m) =>
Env -> [Location] -> m (Either AppError (ByteString, Location))
IO.readFirstAvailableResource Env
envAws (((Location, Location) -> [Location])
-> [(Location, Location)] -> [Location]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Location, Location) -> [Location]
forall a. (a, a) -> [a]
L.tuple2ToList ([Location] -> [Location] -> [(Location, Location)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Location]
archiveFiles [Location]
scopedArchiveFiles))
                        Text -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn (Text -> ExceptT AppError (AWST' Env (ResourceT IO)) ())
-> Text -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall a b. (a -> b) -> a -> b
$ Text
"Extracting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Location -> Text
forall a. ToText a => a -> Text
toText Location
existingArchiveFile

                        let tempArchiveFile :: [Char]
tempArchiveFile = [Char]
tempPath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
archiveBaseName
                        IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ())
-> IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
LBS.writeFile [Char]
tempArchiveFile ByteString
existingArchiveFileContents
                        [Char] -> [Char] -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> ExceptT AppError m ()
IO.extractTar [Char]
tempArchiveFile [Char]
storePath

                        Map Text ByteString
meta <- [Char]
-> ExceptT
     AppError (AWST' Env (ResourceT IO)) (Map Text ByteString)
forall (m :: * -> *).
MonadIO m =>
[Char] -> m (Map Text ByteString)
loadMetadata [Char]
packageStorePath
                        ByteString
oldStorePath <- AppError
-> Maybe ByteString
-> ExceptT AppError (AWST' Env (ResourceT IO)) ByteString
forall (m :: * -> *) a.
Monad m =>
AppError -> Maybe a -> ExceptT AppError m a
maybeToExcept AppError
"store-path is missing from Metadata" (Text -> Map Text ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"store-path" Map Text ByteString
meta)

                        case PackageInfo -> Tagged [Char] Presence
Z.confPath PackageInfo
pInfo of
                          Z.Tagged [Char]
conf Presence
_ -> do
                            let theConfPath :: [Char]
theConfPath = [Char]
storePath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
conf
                            let tempConfPath :: [Char]
tempConfPath = [Char]
tempPath [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
conf
                            Bool
confPathExists <- IO Bool -> ExceptT AppError (AWST' Env (ResourceT IO)) Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT AppError (AWST' Env (ResourceT IO)) Bool)
-> IO Bool -> ExceptT AppError (AWST' Env (ResourceT IO)) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
IO.doesFileExist [Char]
theConfPath
                            Bool
-> ExceptT AppError (AWST' Env (ResourceT IO)) ()
-> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
confPathExists (ExceptT AppError (AWST' Env (ResourceT IO)) ()
 -> ExceptT AppError (AWST' Env (ResourceT IO)) ())
-> ExceptT AppError (AWST' Env (ResourceT IO)) ()
-> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall a b. (a -> b) -> a -> b
$ do
                              ByteString
confContents <- IO ByteString
-> ExceptT AppError (AWST' Env (ResourceT IO)) ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString
 -> ExceptT AppError (AWST' Env (ResourceT IO)) ByteString)
-> IO ByteString
-> ExceptT AppError (AWST' Env (ResourceT IO)) ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
LBS.readFile [Char]
theConfPath
                              IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ())
-> IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
LBS.writeFile [Char]
tempConfPath (ByteString -> ByteString -> ByteString -> ByteString
forall rep.
Substitution rep =>
ByteString -> rep -> ByteString -> ByteString
replace (ByteString -> ByteString
LBS.toStrict ByteString
oldStorePath) ([Char] -> ByteString
C8.pack [Char]
storePath) ByteString
confContents)
                              IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ())
-> IO () -> ExceptT AppError (AWST' Env (ResourceT IO)) ()
forall a b. (a -> b) -> a -> b
$ [Errno] -> IO () -> IO () -> IO ()
forall a. [Errno] -> IO a -> IO a -> IO a
catchErrno [Errno
eXDEV] ([Char] -> [Char] -> IO ()
IO.renameFile [Char]
tempConfPath [Char]
theConfPath) ([Char] -> [Char] -> IO ()
IO.copyFile [Char]
tempConfPath [Char]
theConfPath IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> IO ()
IO.removeFile [Char]
tempConfPath)

                            Bool -> ExceptT AppError (AWST' Env (ResourceT IO)) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
              Maybe PackageInfo
Nothing -> do
                Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Invalid package id: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageId
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

          Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
CIO.putStrLn Text
"Recaching package database"
          CompilerContext -> [Char] -> IO ()
GhcPkg.recache CompilerContext
compilerContext [Char]
storeCompilerPackageDbPath

          Set Text
failures <- STM (Set Text) -> IO (Set Text)
forall a. STM a -> IO a
STM.atomically (STM (Set Text) -> IO (Set Text))
-> STM (Set Text) -> IO (Set Text)
forall a b. (a -> b) -> a -> b
$ TVar (Set Text) -> STM (Set Text)
forall a. TVar a -> STM a
STM.readTVar (TVar (Set Text) -> STM (Set Text))
-> TVar (Set Text) -> STM (Set Text)
forall a b. (a -> b) -> a -> b
$ DownloadQueue
downloadQueue DownloadQueue
-> Getting (TVar (Set Text)) DownloadQueue (TVar (Set Text))
-> TVar (Set Text)
forall s a. s -> Getting a s a -> a
^. forall k (sel :: k) s t a b. HasAny sel s t a b => Lens s t a b
forall s t a b. HasAny "tFailures" s t a b => Lens s t a b
the @"tFailures"

          Set Text -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set Text
failures ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
packageId -> Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to download: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageId
        Left Text
msg -> Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr Text
msg
    Left AppError
appError -> do
      Handle -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"ERROR: Unable to parse plan.json file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AppError -> Text
displayAppError AppError
appError

  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

cleanupStorePath :: (MonadIO m, MonadCatch m) => FilePath -> Z.PackageId -> AppError -> m ()
cleanupStorePath :: [Char] -> Text -> AppError -> m ()
cleanupStorePath [Char]
packageStorePath Text
packageId AppError
e = do
  Handle -> Text -> m ()
forall (m :: * -> *). MonadIO m => Handle -> Text -> m ()
CIO.hPutStrLn Handle
IO.stderr (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Warning: Sync failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
packageId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", reason: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AppError -> Text
displayAppError AppError
e
  Bool
pathExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
IO.doesPathExist [Char]
packageStorePath
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pathExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (Either AppError ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either AppError ()) -> m ()) -> m (Either AppError ()) -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m (Either AppError ())
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
[Char] -> m (Either AppError ())
IO.removePathRecursive [Char]
packageStorePath

onError :: MonadIO m => (AppError -> m ()) -> a -> ExceptT AppError m a -> m a
onError :: (AppError -> m ()) -> a -> ExceptT AppError m a -> m a
onError AppError -> m ()
h a
failureValue ExceptT AppError m a
f = do
  Either AppError a
result <- ExceptT AppError m a -> m (Either AppError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT AppError m a -> m (Either AppError a))
-> ExceptT AppError m a -> m (Either AppError a)
forall a b. (a -> b) -> a -> b
$ ExceptT AppError m a
-> (AppError -> ExceptT AppError m a) -> ExceptT AppError m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ExceptT AppError m a -> ExceptT AppError m a
forall (m :: * -> *) a.
MonadIO m =>
ExceptT AppError m a -> ExceptT AppError m a
exceptWarn ExceptT AppError m a
f) AppError -> ExceptT AppError m a
forall (t :: (* -> *) -> * -> *).
(MonadTrans t, Monad (t m)) =>
AppError -> t m a
handler
  case Either AppError a
result of
    Left AppError
_  -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
failureValue
    Right a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where handler :: AppError -> t m a
handler AppError
e = m () -> t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (AppError -> m ()
h AppError
e) t m () -> t m a -> t m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
failureValue

optsSyncFromArchive :: Parser SyncFromArchiveOptions
optsSyncFromArchive :: Parser SyncFromArchiveOptions
optsSyncFromArchive = Region
-> [Location]
-> [Char]
-> [Char]
-> Maybe [Char]
-> Int
-> Maybe LogLevel
-> SyncFromArchiveOptions
SyncFromArchiveOptions
  (Region
 -> [Location]
 -> [Char]
 -> [Char]
 -> Maybe [Char]
 -> Int
 -> Maybe LogLevel
 -> SyncFromArchiveOptions)
-> Parser Region
-> Parser
     ([Location]
      -> [Char]
      -> [Char]
      -> Maybe [Char]
      -> Int
      -> Maybe LogLevel
      -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Region -> Mod OptionFields Region -> Parser Region
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (ReadM Region
forall a. Read a => ReadM a
auto ReadM Region -> ReadM Region -> ReadM Region
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadM Region
forall a. FromText a => ReadM a
text)
      (  [Char] -> Mod OptionFields Region
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"region"
      Mod OptionFields Region
-> Mod OptionFields Region -> Mod OptionFields Region
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Region
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"AWS_REGION"
      Mod OptionFields Region
-> Mod OptionFields Region -> Mod OptionFields Region
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Region
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields Region
-> Mod OptionFields Region -> Mod OptionFields Region
forall a. Semigroup a => a -> a -> a
<> Region -> Mod OptionFields Region
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Region
Oregon
      Mod OptionFields Region
-> Mod OptionFields Region -> Mod OptionFields Region
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Region
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"The AWS region in which to operate"
      )
  Parser
  ([Location]
   -> [Char]
   -> [Char]
   -> Maybe [Char]
   -> Int
   -> Maybe LogLevel
   -> SyncFromArchiveOptions)
-> Parser [Location]
-> Parser
     ([Char]
      -> [Char]
      -> Maybe [Char]
      -> Int
      -> Maybe LogLevel
      -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Location -> Parser [Location]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
      (  ReadM Location -> Mod OptionFields Location -> Parser Location
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (([Char] -> Maybe Location) -> ReadM Location
forall a. ([Char] -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe Location
toLocation (Text -> Maybe Location)
-> ([Char] -> Text) -> [Char] -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack))
        (   [Char] -> Mod OptionFields Location
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"archive-uri"
        Mod OptionFields Location
-> Mod OptionFields Location -> Mod OptionFields Location
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields Location
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Archive URI to sync to"
        Mod OptionFields Location
-> Mod OptionFields Location -> Mod OptionFields Location
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields Location
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"S3_URI"
        )
      )
  Parser
  ([Char]
   -> [Char]
   -> Maybe [Char]
   -> Int
   -> Maybe LogLevel
   -> SyncFromArchiveOptions)
-> Parser [Char]
-> Parser
     ([Char]
      -> Maybe [Char] -> Int -> Maybe LogLevel -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      (   [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"build-path"
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help ([Char]
"Path to cabal build directory.  Defaults to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
AS.buildPath)
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIRECTORY"
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
AS.buildPath
      )
  Parser
  ([Char]
   -> Maybe [Char] -> Int -> Maybe LogLevel -> SyncFromArchiveOptions)
-> Parser [Char]
-> Parser
     (Maybe [Char] -> Int -> Maybe LogLevel -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      (   [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"store-path"
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help ([Char]
"Path to cabal store.  Defaults to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
AS.cabalDirectory)
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIRECTORY"
      Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ([Char]
AS.cabalDirectory [Char] -> [Char] -> [Char]
forall a s. IsPath a s => a -> s -> a
</> [Char]
"store")
      )
  Parser
  (Maybe [Char] -> Int -> Maybe LogLevel -> SyncFromArchiveOptions)
-> Parser (Maybe [Char])
-> Parser (Int -> Maybe LogLevel -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Char] -> Parser (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Mod OptionFields [Char] -> Parser [Char]
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (   [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"store-path-hash"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Store path hash (do not use)"
        Mod OptionFields [Char]
-> Mod OptionFields [Char] -> Mod OptionFields [Char]
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields [Char]
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HASH"
        )
      )
  Parser (Int -> Maybe LogLevel -> SyncFromArchiveOptions)
-> Parser Int -> Parser (Maybe LogLevel -> SyncFromArchiveOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
      (   [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"threads"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Number of concurrent threads"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NUM_THREADS"
      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>  Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
4
      )
  Parser (Maybe LogLevel -> SyncFromArchiveOptions)
-> Parser (Maybe LogLevel) -> Parser SyncFromArchiveOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser LogLevel -> Parser (Maybe LogLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM LogLevel
forall a. FromText a => ReadM a
autoText
        (   [Char] -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"aws-log-level"
        Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields LogLevel
forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"AWS Log Level.  One of (Error, Info, Debug, Trace)"
        Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<>  [Char] -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"AWS_LOG_LEVEL"
        )
      )

cmdSyncFromArchive :: Mod CommandFields (IO ())
cmdSyncFromArchive :: Mod CommandFields (IO ())
cmdSyncFromArchive = [Char] -> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"sync-from-archive"  (ParserInfo (IO ()) -> Mod CommandFields (IO ()))
-> ParserInfo (IO ()) -> Mod CommandFields (IO ())
forall a b. (a -> b) -> a -> b
$ (Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ()))
-> InfoMod (IO ()) -> Parser (IO ()) -> ParserInfo (IO ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser (IO ()) -> InfoMod (IO ()) -> ParserInfo (IO ())
forall a. Parser a -> InfoMod a -> ParserInfo a
info InfoMod (IO ())
forall a. Monoid a => a
idm (Parser (IO ()) -> ParserInfo (IO ()))
-> Parser (IO ()) -> ParserInfo (IO ())
forall a b. (a -> b) -> a -> b
$ SyncFromArchiveOptions -> IO ()
runSyncFromArchive (SyncFromArchiveOptions -> IO ())
-> Parser SyncFromArchiveOptions -> Parser (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SyncFromArchiveOptions
optsSyncFromArchive