76 lines
2.5 KiB
Haskell
76 lines
2.5 KiB
Haskell
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)
|