Safe Haskell | None |
---|---|
Language | Haskell2010 |
Desription: Core method of the authentication Copyright: (C) Qinka 2017 License: GPL-3 Maintainer: me@qinka.pro Stability: experimental Portability: unknown
The collection of core method for authentication.
- generateHash :: HashAlgorithm a => a -> ByteString -> ByteString
- verifyHash :: HashAlgorithm a => a -> ByteString -> ByteString -> Bool
- hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a
- data SHA512 :: * = SHA512
- data SHA384 :: * = SHA384
- data SHA3_512 :: * = SHA3_512
- data SHA3_384 :: * = SHA3_384
- data SHA3_256 :: * = SHA3_256
- data SHA3_224 :: * = SHA3_224
- data SHA256 :: * = SHA256
- data SHA224 :: * = SHA224
- data SHA1 :: * = SHA1
- data SHA512t_256 :: * = SHA512t_256
- data SHA512t_224 :: * = SHA512t_224
- class HashAlgorithm a where
- class ByteArrayAccess ba where
method for hash
These methods are used to generate the token to the hash and verify the token and hash.
If you want the generate the hash for "12345qwert", you should: > let hashStr = generateHash SHA512 "12345qwert" When you verify the hash, you need to > let isOk = verifyHash SHA512 "xxxxx" "12345qwert"
:: HashAlgorithm a | |
=> a | Hash algorithm |
-> ByteString | The hash of key |
-> ByteString | Hash string |
generate hash for the key
:: HashAlgorithm a | |
=> a | Hash algorithm |
-> ByteString | Hash for key |
-> ByteString | Hash string |
-> Bool |
verify the hash and key
hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a #
Hash a strict bytestring into a digest.
hash algorithm
SHA512 cryptographic hash algorithm
Data SHA512 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA512 -> c SHA512 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA512 # toConstr :: SHA512 -> Constr # dataTypeOf :: SHA512 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA512) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA512) # gmapT :: (forall b. Data b => b -> b) -> SHA512 -> SHA512 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA512 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA512 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA512 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA512 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA512 -> m SHA512 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA512 -> m SHA512 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA512 -> m SHA512 # | |
Show SHA512 | |
HashAlgorithm SHA512 | |
type HashBlockSize SHA512 :: Nat # type HashDigestSize SHA512 :: Nat # type HashInternalContextSize SHA512 :: Nat # hashBlockSize :: SHA512 -> Int # hashDigestSize :: SHA512 -> Int # hashInternalContextSize :: SHA512 -> Int # hashInternalInit :: Ptr (Context SHA512) -> IO () # hashInternalUpdate :: Ptr (Context SHA512) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA512) -> Ptr (Digest SHA512) -> IO () # | |
type HashInternalContextSize SHA512 | |
type HashDigestSize SHA512 | |
type HashBlockSize SHA512 | |
SHA384 cryptographic hash algorithm
Data SHA384 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA384 -> c SHA384 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA384 # toConstr :: SHA384 -> Constr # dataTypeOf :: SHA384 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA384) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA384) # gmapT :: (forall b. Data b => b -> b) -> SHA384 -> SHA384 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA384 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA384 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA384 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA384 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA384 -> m SHA384 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA384 -> m SHA384 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA384 -> m SHA384 # | |
Show SHA384 | |
HashAlgorithm SHA384 | |
type HashBlockSize SHA384 :: Nat # type HashDigestSize SHA384 :: Nat # type HashInternalContextSize SHA384 :: Nat # hashBlockSize :: SHA384 -> Int # hashDigestSize :: SHA384 -> Int # hashInternalContextSize :: SHA384 -> Int # hashInternalInit :: Ptr (Context SHA384) -> IO () # hashInternalUpdate :: Ptr (Context SHA384) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA384) -> Ptr (Digest SHA384) -> IO () # | |
type HashInternalContextSize SHA384 | |
type HashDigestSize SHA384 | |
type HashBlockSize SHA384 | |
SHA3 (512 bits) cryptographic hash algorithm
Data SHA3_512 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA3_512 -> c SHA3_512 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA3_512 # toConstr :: SHA3_512 -> Constr # dataTypeOf :: SHA3_512 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA3_512) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA3_512) # gmapT :: (forall b. Data b => b -> b) -> SHA3_512 -> SHA3_512 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_512 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_512 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA3_512 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA3_512 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA3_512 -> m SHA3_512 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_512 -> m SHA3_512 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_512 -> m SHA3_512 # | |
Show SHA3_512 | |
HashAlgorithm SHA3_512 | |
type HashBlockSize SHA3_512 :: Nat # type HashDigestSize SHA3_512 :: Nat # type HashInternalContextSize SHA3_512 :: Nat # hashBlockSize :: SHA3_512 -> Int # hashDigestSize :: SHA3_512 -> Int # hashInternalContextSize :: SHA3_512 -> Int # hashInternalInit :: Ptr (Context SHA3_512) -> IO () # hashInternalUpdate :: Ptr (Context SHA3_512) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA3_512) -> Ptr (Digest SHA3_512) -> IO () # | |
type HashInternalContextSize SHA3_512 | |
type HashDigestSize SHA3_512 | |
type HashBlockSize SHA3_512 | |
SHA3 (384 bits) cryptographic hash algorithm
Data SHA3_384 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA3_384 -> c SHA3_384 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA3_384 # toConstr :: SHA3_384 -> Constr # dataTypeOf :: SHA3_384 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA3_384) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA3_384) # gmapT :: (forall b. Data b => b -> b) -> SHA3_384 -> SHA3_384 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_384 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_384 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA3_384 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA3_384 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA3_384 -> m SHA3_384 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_384 -> m SHA3_384 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_384 -> m SHA3_384 # | |
Show SHA3_384 | |
HashAlgorithm SHA3_384 | |
type HashBlockSize SHA3_384 :: Nat # type HashDigestSize SHA3_384 :: Nat # type HashInternalContextSize SHA3_384 :: Nat # hashBlockSize :: SHA3_384 -> Int # hashDigestSize :: SHA3_384 -> Int # hashInternalContextSize :: SHA3_384 -> Int # hashInternalInit :: Ptr (Context SHA3_384) -> IO () # hashInternalUpdate :: Ptr (Context SHA3_384) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA3_384) -> Ptr (Digest SHA3_384) -> IO () # | |
type HashInternalContextSize SHA3_384 | |
type HashDigestSize SHA3_384 | |
type HashBlockSize SHA3_384 | |
SHA3 (256 bits) cryptographic hash algorithm
Data SHA3_256 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA3_256 -> c SHA3_256 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA3_256 # toConstr :: SHA3_256 -> Constr # dataTypeOf :: SHA3_256 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA3_256) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA3_256) # gmapT :: (forall b. Data b => b -> b) -> SHA3_256 -> SHA3_256 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_256 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_256 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA3_256 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA3_256 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA3_256 -> m SHA3_256 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_256 -> m SHA3_256 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_256 -> m SHA3_256 # | |
Show SHA3_256 | |
HashAlgorithm SHA3_256 | |
type HashBlockSize SHA3_256 :: Nat # type HashDigestSize SHA3_256 :: Nat # type HashInternalContextSize SHA3_256 :: Nat # hashBlockSize :: SHA3_256 -> Int # hashDigestSize :: SHA3_256 -> Int # hashInternalContextSize :: SHA3_256 -> Int # hashInternalInit :: Ptr (Context SHA3_256) -> IO () # hashInternalUpdate :: Ptr (Context SHA3_256) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA3_256) -> Ptr (Digest SHA3_256) -> IO () # | |
type HashInternalContextSize SHA3_256 | |
type HashDigestSize SHA3_256 | |
type HashBlockSize SHA3_256 | |
SHA3 (224 bits) cryptographic hash algorithm
Data SHA3_224 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA3_224 -> c SHA3_224 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA3_224 # toConstr :: SHA3_224 -> Constr # dataTypeOf :: SHA3_224 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA3_224) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA3_224) # gmapT :: (forall b. Data b => b -> b) -> SHA3_224 -> SHA3_224 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_224 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA3_224 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA3_224 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA3_224 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA3_224 -> m SHA3_224 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_224 -> m SHA3_224 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA3_224 -> m SHA3_224 # | |
Show SHA3_224 | |
HashAlgorithm SHA3_224 | |
type HashBlockSize SHA3_224 :: Nat # type HashDigestSize SHA3_224 :: Nat # type HashInternalContextSize SHA3_224 :: Nat # hashBlockSize :: SHA3_224 -> Int # hashDigestSize :: SHA3_224 -> Int # hashInternalContextSize :: SHA3_224 -> Int # hashInternalInit :: Ptr (Context SHA3_224) -> IO () # hashInternalUpdate :: Ptr (Context SHA3_224) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA3_224) -> Ptr (Digest SHA3_224) -> IO () # | |
type HashInternalContextSize SHA3_224 | |
type HashDigestSize SHA3_224 | |
type HashBlockSize SHA3_224 | |
SHA256 cryptographic hash algorithm
Data SHA256 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA256 -> c SHA256 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA256 # toConstr :: SHA256 -> Constr # dataTypeOf :: SHA256 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA256) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA256) # gmapT :: (forall b. Data b => b -> b) -> SHA256 -> SHA256 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA256 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA256 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA256 -> m SHA256 # | |
Show SHA256 | |
HashAlgorithm SHA256 | |
type HashBlockSize SHA256 :: Nat # type HashDigestSize SHA256 :: Nat # type HashInternalContextSize SHA256 :: Nat # hashBlockSize :: SHA256 -> Int # hashDigestSize :: SHA256 -> Int # hashInternalContextSize :: SHA256 -> Int # hashInternalInit :: Ptr (Context SHA256) -> IO () # hashInternalUpdate :: Ptr (Context SHA256) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA256) -> Ptr (Digest SHA256) -> IO () # | |
type HashInternalContextSize SHA256 | |
type HashDigestSize SHA256 | |
type HashBlockSize SHA256 | |
SHA224 cryptographic hash algorithm
Data SHA224 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA224 -> c SHA224 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA224 # toConstr :: SHA224 -> Constr # dataTypeOf :: SHA224 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA224) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA224) # gmapT :: (forall b. Data b => b -> b) -> SHA224 -> SHA224 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA224 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA224 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA224 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA224 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA224 -> m SHA224 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA224 -> m SHA224 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA224 -> m SHA224 # | |
Show SHA224 | |
HashAlgorithm SHA224 | |
type HashBlockSize SHA224 :: Nat # type HashDigestSize SHA224 :: Nat # type HashInternalContextSize SHA224 :: Nat # hashBlockSize :: SHA224 -> Int # hashDigestSize :: SHA224 -> Int # hashInternalContextSize :: SHA224 -> Int # hashInternalInit :: Ptr (Context SHA224) -> IO () # hashInternalUpdate :: Ptr (Context SHA224) -> Ptr Word8 -> Word32 -> IO () # hashInternalFinalize :: Ptr (Context SHA224) -> Ptr (Digest SHA224) -> IO () # | |
type HashInternalContextSize SHA224 | |
type HashDigestSize SHA224 | |
type HashBlockSize SHA224 | |
SHA1 cryptographic hash algorithm
Data SHA1 | |
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SHA1 -> c SHA1 # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c SHA1 # dataTypeOf :: SHA1 -> DataType # dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c SHA1) # dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA1) # gmapT :: (forall b. Data b => b -> b) -> SHA1 -> SHA1 # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA1 -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA1 -> r # gmapQ :: (forall d. Data d => d -> u) -> SHA1 -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> SHA1 -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> SHA1 -> m SHA1 # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA1 -> m SHA1 # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SHA1 -> m SHA1 # | |
Show SHA1 | |
HashAlgorithm SHA1 | |
type HashBlockSize SHA1 :: Nat # type HashDigestSize SHA1 :: Nat # type HashInternalContextSize SHA1 :: Nat # | |
type HashInternalContextSize SHA1 | |
type HashDigestSize SHA1 | |
type HashBlockSize SHA1 | |
data SHA512t_256 :: * #
SHA512t (256 bits) cryptographic hash algorithm
data SHA512t_224 :: * #
SHA512t (224 bits) cryptographic hash algorithm
class HashAlgorithm a where #
Class representing hashing algorithms.
The interface presented here is update in place and lowlevel. the Hash module takes care of hidding the mutable interface properly.
hashBlockSize, hashDigestSize, hashInternalContextSize, hashInternalInit, hashInternalUpdate, hashInternalFinalize
hashBlockSize :: a -> Int #
Get the block size of a hash algorithm
hashDigestSize :: a -> Int #
Get the digest size of a hash algorithm
class ByteArrayAccess ba where #
Class to Access size properties and data of a ByteArray
Return the length in bytes of a bytearray
withByteArray :: ba -> (Ptr p -> IO a) -> IO a #
Allow to use using a pointer
ByteArrayAccess ByteString | |
length :: ByteString -> Int # withByteArray :: ByteString -> (Ptr p -> IO a) -> IO a # | |
ByteArrayAccess String | |
PrimType ty => ByteArrayAccess (UArray ty) | |
ByteArrayAccess (Context a) | |
ByteArrayAccess (Digest a) | |