    {-# LANGUAGE NoImplicitPrelude #-}
    {-# LANGUAGE ViewPatterns      #-}

    module Pantry.Tree
      ( unpackTree
      , rawParseGPD
      ) where

    import           Distribution.PackageDescription ( GenericPackageDescription )
    import           Distribution.PackageDescription.Parsec
                       ( parseGenericPackageDescription, runParseResult )
    import           Distribution.Parsec ( PWarning (..) )
    import           Pantry.Storage ( loadBlob, withStorage )
    import           Pantry.Types
                       ( FileType (..), HasPantryConfig, PantryException (..)
                       , RawPackageLocationImmutable, Tree (..), TreeEntry (..)
                       , unSafeFilePath
                       )
    import           Path ( Abs, Dir, File, Path, toFilePath )
    import           RIO
    import qualified RIO.ByteString as B
    import           RIO.Directory
                       ( createDirectoryIfMissing, getPermissions
                       , setOwnerExecutable, setPermissions
                       )
    import           RIO.FilePath ((</>), takeDirectory)
    import qualified RIO.Map as Map
    import qualified RIO.Text as T

    unpackTree ::
         (HasPantryConfig env, HasLogFunc env)
      => RawPackageLocationImmutable -- for exceptions

      -> Path Abs Dir -- ^ dest dir, will be created if necessary

      -> Tree
      -> RIO env ()
    unpackTree :: forall env.
    (HasPantryConfig env, HasLogFunc env) =>
    RawPackageLocationImmutable -> Path Abs Dir -> Tree -> RIO env ()
    unpackTree RawPackageLocationImmutable
    rpli (Path Abs Dir -> FilePath
    forall b t. Path b t -> FilePath
    toFilePath -> FilePath
    dir) (TreeMap Map SafeFilePath TreeEntry
    m) = do
      ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall env a.
    (HasPantryConfig env, HasLogFunc env) =>
    ReaderT SqlBackend (RIO env) a -> RIO env a
    withStorage (ReaderT SqlBackend (RIO env) () -> RIO env ())
    -> ReaderT SqlBackend (RIO env) () -> RIO env ()
    forall a b. (a -> b) -> a -> b
    $ [(SafeFilePath, TreeEntry)]
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ (Map SafeFilePath TreeEntry -> [(SafeFilePath, TreeEntry)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map SafeFilePath TreeEntry
    m) (((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
     -> ReaderT SqlBackend (RIO env) ())
    -> ((SafeFilePath, TreeEntry) -> ReaderT SqlBackend (RIO env) ())
    -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ \(SafeFilePath
    sfp, TreeEntry BlobKey
    blobKey FileType
    ft) -> do
        let dest :: FilePath
    dest = FilePath
    dir FilePath -> FilePath -> FilePath
    </> Text -> FilePath
    T.unpack (SafeFilePath -> Text
    unSafeFilePath SafeFilePath
    sfp)
        Bool -> FilePath -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
    createDirectoryIfMissing Bool
    True (FilePath -> ReaderT SqlBackend (RIO env) ())
    -> FilePath -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    takeDirectory FilePath
    dest
        Maybe ByteString
    mbs <- BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    forall env.
    HasLogFunc env =>
    BlobKey -> ReaderT SqlBackend (RIO env) (Maybe ByteString)
    loadBlob BlobKey
    blobKey
        case Maybe ByteString
    mbs of
          Maybe ByteString
    Nothing -> do
            -- TODO when we have pantry wire stuff, try downloading

            PantryException -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
    throwIO (PantryException -> ReaderT SqlBackend (RIO env) ())
    -> PantryException -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ RawPackageLocationImmutable
    -> SafeFilePath -> BlobKey -> PantryException
    TreeReferencesMissingBlob RawPackageLocationImmutable
    rpli SafeFilePath
    sfp BlobKey
    blobKey
          Just ByteString
    bs -> do
            FilePath -> ByteString -> ReaderT SqlBackend (RIO env) ()
    forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
    B.writeFile FilePath
    dest ByteString
    bs
            case FileType
    ft of
              FileType
    FTNormal -> () -> ReaderT SqlBackend (RIO env) ()
    forall a. a -> ReaderT SqlBackend (RIO env) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
              FileType
    FTExecutable -> IO () -> ReaderT SqlBackend (RIO env) ()
    forall a. IO a -> ReaderT SqlBackend (RIO env) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ReaderT SqlBackend (RIO env) ())
    -> IO () -> ReaderT SqlBackend (RIO env) ()
    forall a b. (a -> b) -> a -> b
    $ do
                Permissions
    perms <- FilePath -> IO Permissions
    forall (m :: * -> *). MonadIO m => FilePath -> m Permissions
    getPermissions FilePath
    dest
                FilePath -> Permissions -> IO ()
    forall (m :: * -> *). MonadIO m => FilePath -> Permissions -> m ()
    setPermissions FilePath
    dest (Permissions -> IO ()) -> Permissions -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Permissions -> Permissions
    setOwnerExecutable Bool
    True Permissions
    perms

    -- | A helper function that performs the basic character encoding necessary.

    rawParseGPD ::
         MonadThrow m
      => Either RawPackageLocationImmutable (Path Abs File)
      -> ByteString
      -> m ([PWarning], GenericPackageDescription)
    rawParseGPD :: forall (m :: * -> *).
    MonadThrow m =>
    Either RawPackageLocationImmutable (Path Abs File)
    -> ByteString -> m ([PWarning], GenericPackageDescription)
    rawParseGPD Either RawPackageLocationImmutable (Path Abs File)
    loc ByteString
    bs =
      case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
    eres of
        Left (Maybe Version
    mversion, NonEmpty PError
    errs) ->
          PantryException -> m ([PWarning], GenericPackageDescription)
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (PantryException -> m ([PWarning], GenericPackageDescription))
    -> PantryException -> m ([PWarning], GenericPackageDescription)
    forall a b. (a -> b) -> a -> b
    $ Either RawPackageLocationImmutable (Path Abs File)
    -> Maybe Version -> [PError] -> [PWarning] -> PantryException
    InvalidCabalFile Either RawPackageLocationImmutable (Path Abs File)
    loc Maybe Version
    mversion (NonEmpty PError -> [PError]
    forall a. NonEmpty a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList NonEmpty PError
    errs) [PWarning]
    warnings
        Right GenericPackageDescription
    gpkg -> ([PWarning], GenericPackageDescription)
    -> m ([PWarning], GenericPackageDescription)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([PWarning]
    warnings, GenericPackageDescription
    gpkg)
     where
      ([PWarning]
    warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
    eres) = ParseResult GenericPackageDescription
    -> ([PWarning],
        Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
    forall a.
    ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    runParseResult (ParseResult GenericPackageDescription
     -> ([PWarning],
         Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
    -> ParseResult GenericPackageDescription
    -> ([PWarning],
        Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ParseResult GenericPackageDescription
    parseGenericPackageDescription ByteString
    bs