77 lines
2.2 KiB
Haskell
77 lines
2.2 KiB
Haskell
|
{-# 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))
|