module Nuthatch.Test.Streaming
  ( tests
  ) where

import           Control.Exception (try)
import           Crypto.Hash (Digest, SHA256, hash)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import           Data.IORef (modifyIORef', newIORef, readIORef)
import qualified Data.Text.Encoding as TE
import           Nuthatch.Streaming
  ( UploadStreamError (..)
  , consumeUploadParts
  , maximumMultipartBytes
  , multipartPartBytes
  )
import           Nuthatch.Types (ContentSha256 (..))
import           Servant.Types.SourceT
  ( SourceT
  , StepT (..)
  , fromStepT
  , source
  )
import           Test.Tasty (TestTree, testGroup)
import           Test.Tasty.HUnit ((@?=), testCase)

tests :: TestTree
tests = testGroup "streaming"
  [ testCase "upload bodies are inspected and emitted in bounded parts" $ do
      inspected <- newIORef []
      emitted <- newIORef []
      consumeUploadParts
        6
        (strictSha256 "abcdef")
        2
        4
        (\piece -> modifyIORef' inspected (<> [piece]))
        (source ["abcdef"])
        (\part -> modifyIORef' emitted (<> [part]))
      readIORef inspected >>= (@?= ["ab", "cd", "ef"])
      readIORef emitted >>= (@?= ["abcd", "ef"])
  , testCase "multipart buffering has a fixed part-count bound" $
      maximumMultipartBytes @?= toInteger multipartPartBytes * 10000
  , testCase "upload rejects early end, surplus bytes, and identity mismatch" $ do
      short <- uploadFailure 4 (strictSha256 "body") (source ["bod"])
      short @?= UploadStreamSizeMismatch
      long <- uploadFailure 4 (strictSha256 "body") (source ["body!"])
      long @?= UploadStreamSizeMismatch
      identity <- uploadFailure 4 (strictSha256 "else") (source ["body"])
      identity @?= UploadStreamIdentityMismatch
  , testCase "upload preserves source errors" $ do
      failure <- uploadFailure
        4
        (strictSha256 "body")
        (fromStepT (Error "request failed"))
      failure @?= UploadStreamInvalid "request failed"
  ]

uploadFailure
  :: Integer
  -> ContentSha256
  -> SourceT IO BS.ByteString
  -> IO UploadStreamError
uploadFailure size identity body = do
  result <- try $
    consumeUploadParts
      size identity 2 4 (const (pure ())) body (const (pure ()))
  case result of
    Left failure -> pure failure
    Right _ -> fail "expected upload stream rejection"

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