{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Nuthatch.Test.UploadIdentityFixture
  ( tests
  ) where

import           Crypto.Hash (Digest, SHA256, hash)
import           Data.Aeson
  ( FromJSON (..)
  , eitherDecodeFileStrict
  , withObject
  , (.:)
  )
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           GHC.Generics (Generic)
import           Test.Tasty (TestTree)
import           Test.Tasty.HUnit (assertEqual, testCase)

data Fixture = Fixture
  { name    :: String
  , source  :: FixtureSource
  , sha256  :: T.Text
  }
  deriving stock (Generic)
  deriving anyclass (FromJSON)

data FixtureSource
  = Utf8 T.Text
  | Hex T.Text
  | RepeatHex T.Text Int

instance FromJSON FixtureSource where
  parseJSON = withObject "FixtureSource" $ \object -> do
    kind <- object .: "kind"
    case (kind :: T.Text) of
      "utf8" -> Utf8 <$> object .: "value"
      "hex" -> Hex <$> object .: "value"
      "repeat-hex" -> RepeatHex
        <$> object .: "pattern"
        <*> object .: "bytes"
      _ -> fail ("unknown fixture source kind: " <> T.unpack kind)

tests :: TestTree
tests = testCase "Haskell SHA-256 matches browser upload identity fixtures" $ do
  decoded <-
    eitherDecodeFileStrict "web/test/fixtures/upload-content-sha256.json"
      :: IO (Either String [Fixture])
  fixtures <- either fail pure decoded
  mapM_ verify fixtures

verify :: Fixture -> IO ()
verify Fixture {name, source, sha256} =
  assertEqual name sha256 (digestHex (fixtureBytes source))

digestHex :: BS.ByteString -> T.Text
digestHex bytes =
  TE.decodeUtf8 . B16.encode . BA.convert $
    (hash bytes :: Digest SHA256)

fixtureBytes :: FixtureSource -> BS.ByteString
fixtureBytes = \case
  Utf8 text -> TE.encodeUtf8 text
  Hex text -> decodeHex text
  RepeatHex patternText byteCount ->
    let patternBytes = decodeHex patternText
        repeats =
          (byteCount + BS.length patternBytes - 1) `div` BS.length patternBytes
    in BS.take byteCount (BS.concat (replicate repeats patternBytes))

decodeHex :: T.Text -> BS.ByteString
decodeHex text =
  either error id (B16.decode (TE.encodeUtf8 text))