{-# LANGUAGE QuasiQuotes      #-}
{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE TypeApplications #-}

module Main
  ( main
  ) where

import           Universum

import qualified Codec.Archive.Tar as Tar
import           Crypto.Hash (Digest, SHA512, hashlazy)
import qualified Data.ByteString.Lazy as BSL
import           Data.List ((\\))
import qualified Data.Text.Lazy.IO as TL
import           Data.Version (showVersion)
import           Formatting (Format, format, mapf, text, (%))
import qualified NeatInterpolation as NI (text)
import           Options.Applicative (Parser, execParser, footerDoc, fullDesc,
                     header, help, helper, info, infoOption, long, metavar,
                     option, progDesc, short)
import           Options.Applicative.Types (readerAsk)
import           System.Exit (ExitCode (ExitFailure))
import           System.FilePath (normalise, takeFileName, (<.>), (</>))
import qualified System.PosixCompat as PosixCompat
import           System.Process (readProcess)
import           Text.PrettyPrint.ANSI.Leijen (Doc)

import           Paths_cardano_sl (version)
import           Pos.Util (directory, ls, withTempDir)

data UpdateGenOptions = UpdateGenOptions
    { oldDir    :: !Text
    , newDir    :: !Text
    , outputTar :: !Text
    } deriving (Show)

optionsParser :: Parser UpdateGenOptions
optionsParser = do
    oldDir <- textOption $
           long    "old"
        <> metavar "PATH"
        <> help    "Path to directory with old program."
    newDir <- textOption $
           long    "new"
        <> metavar "PATH"
        <> help    "Path to directory with new program."
    outputTar <- textOption $
           short   'o'
        <> long    "output"
        <> metavar "PATH"
        <> help    "Path to output .tar-file with diff."
    pure UpdateGenOptions{..}
    where
      textOption = option (toText <$> readerAsk)

getUpdateGenOptions :: IO UpdateGenOptions
getUpdateGenOptions = execParser programInfo
  where
    programInfo = info (helper <*> versionOption <*> optionsParser) $
        fullDesc <> progDesc ("")
                 <> header "Cardano SL updates generator."
                 <> footerDoc usageExample

    versionOption = infoOption
        ("cardano-genupdate-" <> showVersion version)
        (long "version" <> help "Show version.")

usageExample :: Maybe Doc
usageExample = (Just . fromString @Doc . toString @Text) [NI.text|
Command example:

  stack exec -- cardano-genupdate --old /tmp/app-v000 --new /tmp/app-v001 -o /tmp/app-update.tar

Both directories must have equal file structure (e.g. they must contain the same
files in the same subdirectories correspondingly), otherwise 'cardano-genupdate' will fail.

Please note that 'cardano-genupdate' uses 'bsdiff' program, so make sure 'bsdiff' is available in the PATH.|]

main :: IO ()
main = do
    UpdateGenOptions{..} <- getUpdateGenOptions
    createUpdate (toString oldDir)
                 (toString newDir)
                 (toString outputTar)

-- | Outputs a `FilePath` as a `LText`.
fp :: Format LText (String -> LText)
fp = mapf toLText text

createUpdate :: FilePath -> FilePath -> FilePath -> IO ()
createUpdate oldDir newDir updPath = do
    oldFiles <- ls oldDir
    newFiles <- ls newDir
    -- find directories and fail if there are any (we can't handle
    -- directories)
    do oldNotFiles <- filterM (fmap (not . PosixCompat.isRegularFile) . PosixCompat.getFileStatus . normalise) oldFiles
       newNotFiles <- filterM (fmap (not . PosixCompat.isRegularFile) . PosixCompat.getFileStatus . normalise) newFiles
       unless (null oldNotFiles && null newNotFiles) $ do
           unless (null oldNotFiles) $ do
               TL.putStrLn $ format (fp%" contains not-files:") oldDir
               for_ oldNotFiles $ TL.putStrLn . format ("  * "%fp)
           unless (null newNotFiles) $ do
               TL.putStrLn $ format (fp%" contains not-files:") newDir
               for_ newNotFiles $ TL.putStrLn . format ("  * "%fp)
           putText "Generation aborted."
           exitWith (ExitFailure 2)
    -- fail if lists of files are unequal
    do let notInOld = map takeFileName newFiles \\ map takeFileName oldFiles
       let notInNew = map takeFileName oldFiles \\ map takeFileName newFiles
       unless (null notInOld && null notInNew) $ do
           unless (null notInOld) $ do
               putText "these files are in the NEW dir but not in the OLD dir:"
               for_ notInOld $ TL.putStrLn . format ("  * "%fp)
           unless (null notInNew) $ do
               TL.putStr "these files are in the OLD dir but not in the NEW dir:"
               for_ notInNew $ TL.putStrLn . format ("  * "%fp)
           putText "Generation aborted."
           exitWith (ExitFailure 3)
    -- otherwise, for all files, generate hashes and a diff
    withTempDir (directory updPath) "temp" $ \tempDir -> do
      (manifest, bsdiffs) <-
          fmap (unzip . catMaybes) $
          forM oldFiles $ \f -> do
              let fname = takeFileName f
                  oldFile = oldDir </> fname
                  newFile = newDir </> fname
                  diffFile = tempDir </> (fname <.> "bsdiff")
              oldHash <- hashFile oldFile
              newHash <- hashFile newFile
              if oldHash == newHash
                  then return Nothing
                  else do
                      _ <- readProcess "bsdiff" [oldFile, newFile, diffFile] mempty
                      diffHash <- hashFile diffFile
                      return (Just (unwords [oldHash, newHash, diffHash],
                                    takeFileName diffFile))
      -- write the MANIFEST file
      writeFile (tempDir </> "MANIFEST") (unlines manifest)
      -- put diffs and a manifesto into a tar file
      Tar.create updPath tempDir ("MANIFEST" : bsdiffs)

hashLBS :: LByteString -> Text
hashLBS lbs = show $ hashSHA512 lbs
  where
    hashSHA512 :: LByteString -> Digest SHA512
    hashSHA512 = hashlazy

hashFile :: FilePath -> IO Text
hashFile f = hashLBS <$> BSL.readFile f
