Split host tests by component ownership

test/Nuthatch/Test/Streaming.hs

@@ -0,0 +1,76 @@
+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)