module Pulsar.Protocol.CheckSum where import qualified Data.Binary as B import Data.Bool ( bool ) import qualified Data.ByteString.Lazy.Char8 as CL import Data.Digest.CRC32C ( crc32c ) data CheckSumValidation = Valid | Invalid deriving Int -> CheckSumValidation -> ShowS [CheckSumValidation] -> ShowS CheckSumValidation -> String (Int -> CheckSumValidation -> ShowS) -> (CheckSumValidation -> String) -> ([CheckSumValidation] -> ShowS) -> Show CheckSumValidation forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckSumValidation] -> ShowS $cshowList :: [CheckSumValidation] -> ShowS show :: CheckSumValidation -> String $cshow :: CheckSumValidation -> String showsPrec :: Int -> CheckSumValidation -> ShowS $cshowsPrec :: Int -> CheckSumValidation -> ShowS Show newtype CheckSum = CheckSum B.Word32 deriving (CheckSum -> CheckSum -> Bool (CheckSum -> CheckSum -> Bool) -> (CheckSum -> CheckSum -> Bool) -> Eq CheckSum forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: CheckSum -> CheckSum -> Bool $c/= :: CheckSum -> CheckSum -> Bool == :: CheckSum -> CheckSum -> Bool $c== :: CheckSum -> CheckSum -> Bool Eq, Int -> CheckSum -> ShowS [CheckSum] -> ShowS CheckSum -> String (Int -> CheckSum -> ShowS) -> (CheckSum -> String) -> ([CheckSum] -> ShowS) -> Show CheckSum forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [CheckSum] -> ShowS $cshowList :: [CheckSum] -> ShowS show :: CheckSum -> String $cshow :: CheckSum -> String showsPrec :: Int -> CheckSum -> ShowS $cshowsPrec :: Int -> CheckSum -> ShowS Show) runCheckSum :: CL.ByteString -> CheckSum -> CheckSumValidation runCheckSum :: ByteString -> CheckSum -> CheckSumValidation runCheckSum t :: ByteString t cs :: CheckSum cs = CheckSumValidation -> CheckSumValidation -> Bool -> CheckSumValidation forall a. a -> a -> Bool -> a bool CheckSumValidation Invalid CheckSumValidation Valid (Bool -> CheckSumValidation) -> Bool -> CheckSumValidation forall a b. (a -> b) -> a -> b $ ByteString -> CheckSum computeCheckSum ByteString t CheckSum -> CheckSum -> Bool forall a. Eq a => a -> a -> Bool == CheckSum cs computeCheckSum :: CL.ByteString -> CheckSum computeCheckSum :: ByteString -> CheckSum computeCheckSum t :: ByteString t = Word32 -> CheckSum CheckSum (Word32 -> CheckSum) -> Word32 -> CheckSum forall a b. (a -> b) -> a -> b $ ByteString -> Word32 crc32c (ByteString -> ByteString CL.toStrict ByteString t)