{-# LANGUAGE TypeApplications #-}
module Test.S3.Interface where

import Data.Generics.Labels ()
import Control.Monad.Trans.Cont
import Test.Hspec
import Test.Hspec.Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import S3.Interface
import qualified Data.Conduit.Combinators as C
import Conduit ((.|), runConduit, runResourceT, liftIO)
import qualified Data.Text as T
import System.FilePath (takeBaseName, (</>), (<.>))
import qualified Data.ByteString.Char8 as BC
import Data.Map (Map)
import Data.HashMap.Strict (HashMap)
import qualified Data.Map.Strict as M
import qualified Data.HashMap.Strict as HM
import Data.Hashable (Hashable)
import Data.Text (Text)
import qualified Crypto.Random as Random
import MyLib (hash)
import System.IO.Temp (withSystemTempDirectory)
import Crypto.Hash.Algorithms (SHA256)
import Config.S3 (ConfigS3)
import Crypto.Hash (Digest)

withTempDir :: FilePath -> ContT r IO FilePath
withTempDir path = ContT (withSystemTempDirectory path)

-- XXX: Temporarily have the model just here
buildModel :: FilePath -> IO S3Interface
buildModel root =
  pure S3Interface
  { putFile = \path mt -> do
      let key = T.pack . takeBaseName $ path
      runResourceT $ do
        runConduit $ C.sourceFileBS path .| C.sinkFileBS (root </> T.unpack key)
        liftIO $ BC.writeFile (root </> T.unpack key <.> "metadata") (BC.pack $ show mt)
      pure key
  , getFile = \key outroot -> do
      let outpath = outroot </> T.unpack key
          inpath = root </> T.unpack key
      runResourceT $ runConduit $ C.sourceFileBS inpath .| C.sinkFileBS outpath
      pure outpath
  , getMetadata = \key -> do
      let path = root </> T.unpack key <.> "metadata"
      read . BC.unpack <$> BC.readFile path
  }

genMetadata :: Gen Metadata
genMetadata = convert <$> Gen.map (Range.linear 0 5) ((,) <$> text <*> text)
  where
    convert :: Hashable a => Map a b -> HashMap a b
    convert = HM.fromList . M.toList
    text = Gen.text (Range.linear 1 32) Gen.alpha

data File = File { name :: Text, chunks :: Int, metadata :: Metadata }
  deriving Show

genFile :: Gen File
genFile = File
  <$> Gen.text (Range.linear 1 32) Gen.alphaNum
  <*> Gen.integral (Range.linear 0 8192)
  <*> genMetadata

data FileCommand
  = PutFile File
  | ReadFile Int
  | ReadMetadata Int
  deriving Show

genCommand :: Gen FileCommand
genCommand = Gen.choice
  [ PutFile <$> genFile
  , ReadFile <$> Gen.integral (Range.linear 0 1000)
  , ReadMetadata <$> Gen.integral (Range.linear 0 1000)
  ]


write :: FilePath -> File -> IO FilePath
write root f = do
  let path = root </> T.unpack (name f)
  runResourceT $ runConduit $ C.replicateM (chunks f) (liftIO $ Random.getRandomBytes 256) .| C.sinkFileBS path
  pure path

specGetPut :: PropertyT IO ()
specGetPut = do
  file <- forAll genFile
  (wanted, got) <- liftIO $ flip runContT pure $ do
    root <- withTempDir "test-getput-in"
    modelroot <- withTempDir "test-getput-model"
    downloadroot <- withTempDir "test-getput-download"
    liftIO $ do
      interface <- buildModel modelroot
      inpath <- write root file
      key <- putFile interface inpath (metadata file)
      outpath <- getFile interface key downloadroot
      (,) <$> hash @SHA256 inpath <*> hash @SHA256 outpath
  wanted === got

data Result = Result
  { resultKey :: Text
  , resultHash :: Digest SHA256
  , resultOriginHash :: Digest SHA256
  }
  deriving (Show, Eq)

specGetPutS3 :: ConfigS3 -> PropertyT IO ()
specGetPutS3 config = do
  file <- forAll genFile
  annotateShow file
  (wanted, got) <- liftIO $ flip runContT pure $ do
    root <- withTempDir "test-getput-in"
    modelroot <- withTempDir "test-getput-model"
    downloadroot <- withTempDir "test-getput-download"
    liftIO $ do
      inpath <- write root file
      let mt = metadata file
      modelInt <- buildModel modelroot
      s3Int <- buildInterface config
      (,) <$> create modelInt downloadroot inpath mt <*> create s3Int downloadroot inpath mt
  wanted === got
  where
    create interface downloadroot inpath mt = do
      key <- putFile interface inpath mt
      s3path <- getFile interface key downloadroot
      Result <$> pure key <*> hash s3path <*> hash inpath

-- Contract test for the interface

spec :: Maybe ConfigS3 -> Spec
spec mConfig =
  describe "Contract test between S3 and the model" $ do
    context "Model" $ do
      it "satisfies the get-put property for content" $ hedgehog specGetPut
    flip (maybe (pure ())) mConfig $ \config -> do
      context "S3" $ do
        it "satisfies the get-put property for content" $ hedgehog (specGetPutS3 config)