{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | Provides a data type ('SHA256') for efficient memory representation of a

-- sha-256 hash value, together with helper functions for converting to and from

-- that value. This module is intended to be imported qualified as @SHA256@.

--

-- Some nomenclature:

--

-- * Hashing calculates a new hash value from some input. @from@ takes a value

--   that represents an existing hash.

--

-- * Raw means a raw binary representation of the hash value, without any hex

--   encoding.

--

-- * Text always uses lower case hex encoding

--

-- @since 0.1.0.0

module Pantry.SHA256
  ( -- * Types

    SHA256
  , SHA256Exception (..)
    -- * Hashing

  , hashFile
  , hashBytes
  , hashLazyBytes
  , sinkHash
    -- * Convert from a hash representation

  , fromHexText
  , fromHexBytes
  , fromDigest
  , fromRaw
    -- * Convert to a hash representation

  , toHexText
  , toHexBytes
  , toRaw
  ) where

import           Conduit
import qualified Crypto.Hash as Hash ( Digest, SHA256, hash, hashlazy )
import qualified Crypto.Hash.Conduit as Hash ( hashFile, sinkHash )
import           Data.Aeson
import qualified Data.ByteArray
import qualified Data.ByteArray.Encoding as Mem
import           Data.StaticBytes
                   ( Bytes32, StaticBytesException, toStaticExact )
import           Database.Persist.Sql
import           RIO
import qualified RIO.Text as T

-- | A SHA256 hash, stored in a static size for more efficient

-- memory representation.

--

-- @since 0.1.0.0

newtype SHA256 = SHA256 Bytes32
  deriving (forall x. Rep SHA256 x -> SHA256
forall x. SHA256 -> Rep SHA256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SHA256 x -> SHA256
$cfrom :: forall x. SHA256 -> Rep SHA256 x
Generic, SHA256 -> SHA256 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SHA256 -> SHA256 -> Bool
$c/= :: SHA256 -> SHA256 -> Bool
== :: SHA256 -> SHA256 -> Bool
$c== :: SHA256 -> SHA256 -> Bool
Eq, SHA256 -> ()
forall a. (a -> ()) -> NFData a
rnf :: SHA256 -> ()
$crnf :: SHA256 -> ()
NFData, Typeable SHA256
SHA256 -> DataType
SHA256 -> Constr
(forall b. Data b => b -> b) -> SHA256 -> SHA256
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SHA256 -> u
forall u. (forall d. Data d => d -> u) -> SHA256 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SHA256
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SHA256 -> c SHA256
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SHA256)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA256)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SHA256 -> m SHA256
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SHA256 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SHA256 -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SHA256 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SHA256 -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SHA256 -> r
gmapT :: (forall b. Data b => b -> b) -> SHA256 -> SHA256
$cgmapT :: (forall b. Data b => b -> b) -> SHA256 -> SHA256
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA256)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SHA256)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SHA256)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SHA256)
dataTypeOf :: SHA256 -> DataType
$cdataTypeOf :: SHA256 -> DataType
toConstr :: SHA256 -> Constr
$ctoConstr :: SHA256 -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SHA256
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SHA256
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SHA256 -> c SHA256
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SHA256 -> c SHA256
Data, Typeable, Eq SHA256
SHA256 -> SHA256 -> Bool
SHA256 -> SHA256 -> Ordering
SHA256 -> SHA256 -> SHA256
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SHA256 -> SHA256 -> SHA256
$cmin :: SHA256 -> SHA256 -> SHA256
max :: SHA256 -> SHA256 -> SHA256
$cmax :: SHA256 -> SHA256 -> SHA256
>= :: SHA256 -> SHA256 -> Bool
$c>= :: SHA256 -> SHA256 -> Bool
> :: SHA256 -> SHA256 -> Bool
$c> :: SHA256 -> SHA256 -> Bool
<= :: SHA256 -> SHA256 -> Bool
$c<= :: SHA256 -> SHA256 -> Bool
< :: SHA256 -> SHA256 -> Bool
$c< :: SHA256 -> SHA256 -> Bool
compare :: SHA256 -> SHA256 -> Ordering
$ccompare :: SHA256 -> SHA256 -> Ordering
Ord, Eq SHA256
Int -> SHA256 -> Int
SHA256 -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SHA256 -> Int
$chash :: SHA256 -> Int
hashWithSalt :: Int -> SHA256 -> Int
$chashWithSalt :: Int -> SHA256 -> Int
Hashable)

-- | Exceptions which can occur in this module

--

-- @since 0.1.0.0

data SHA256Exception
  = InvalidByteCount !ByteString !StaticBytesException
  | InvalidHexBytes !ByteString !Text
  deriving (Typeable)

-- | Generate a 'SHA256' value by hashing the contents of a file.

--

-- @since 0.1.0.0

hashFile :: MonadIO m => FilePath -> m SHA256
hashFile :: forall (m :: * -> *). MonadIO m => [Char] -> m SHA256
hashFile [Char]
fp = Digest SHA256 -> SHA256
fromDigest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
[Char] -> m (Digest hash)
Hash.hashFile [Char]
fp

-- | Generate a 'SHA256' value by hashing a @ByteString@.

--

-- @since 0.1.0.0

hashBytes :: ByteString -> SHA256
hashBytes :: ByteString -> SHA256
hashBytes = Digest SHA256 -> SHA256
fromDigest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash

-- | Generate a 'SHA256' value by hashing a lazy @ByteString@.

--

-- @since 0.1.0.0

hashLazyBytes :: LByteString -> SHA256
hashLazyBytes :: LByteString -> SHA256
hashLazyBytes = Digest SHA256 -> SHA256
fromDigest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashAlgorithm a => LByteString -> Digest a
Hash.hashlazy

-- | Generate a 'SHA256' value by hashing the contents of a stream.

--

-- @since 0.1.0.0

sinkHash :: Monad m => ConduitT ByteString o m SHA256
sinkHash :: forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
sinkHash = Digest SHA256 -> SHA256
fromDigest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) hash o.
(Monad m, HashAlgorithm hash) =>
ConduitT ByteString o m (Digest hash)
Hash.sinkHash

-- | Convert a base16-encoded 'Text' value containing a hash into a 'SHA256'.

--

-- @since 0.1.0.0

fromHexText :: Text -> Either SHA256Exception SHA256
fromHexText :: Text -> Either SHA256Exception SHA256
fromHexText = ByteString -> Either SHA256Exception SHA256
fromHexBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | Convert a base16-encoded 'ByteString' value containing a hash into a

-- 'SHA256'.

--

-- @since 0.1.0.0

fromHexBytes :: ByteString -> Either SHA256Exception SHA256
fromHexBytes :: ByteString -> Either SHA256Exception SHA256
fromHexBytes ByteString
hexBS = do
  forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft (ByteString -> Text -> SHA256Exception
InvalidHexBytes ByteString
hexBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either [Char] bout
Mem.convertFromBase Base
Mem.Base16 ByteString
hexBS) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either SHA256Exception SHA256
fromRaw

-- | Convert a 'Hash.Digest' into a 'SHA256'

--

-- @since 0.1.0.0

fromDigest :: Hash.Digest Hash.SHA256 -> SHA256
fromDigest :: Digest SHA256 -> SHA256
fromDigest Digest SHA256
digest =
  case forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticExact (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Digest SHA256
digest :: ByteString) of
    Left StaticBytesException
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible failure in fromDigest: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Digest SHA256
digest, StaticBytesException
e)
    Right Bytes32
x -> Bytes32 -> SHA256
SHA256 Bytes32
x

-- | Convert a raw representation of a hash into a 'SHA256'.

--

-- @since 0.1.0.0

fromRaw :: ByteString -> Either SHA256Exception SHA256
fromRaw :: ByteString -> Either SHA256Exception SHA256
fromRaw ByteString
bs =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StaticBytesException -> SHA256Exception
InvalidByteCount ByteString
bs) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes32 -> SHA256
SHA256) (forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticExact ByteString
bs)

-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.

--

-- @since 0.1.0.0

toHexText :: SHA256 -> Text
toHexText :: SHA256 -> Text
toHexText SHA256
ss =
  case ByteString -> Either UnicodeException Text
decodeUtf8' forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString
toHexBytes SHA256
ss of
    Left UnicodeException
e ->
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible failure in staticSHA256ToText: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SHA256
ss, UnicodeException
e)
    Right Text
t -> Text
t

-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.

--

-- @since 0.1.0.0

toHexBytes :: SHA256 -> ByteString
toHexBytes :: SHA256 -> ByteString
toHexBytes (SHA256 Bytes32
x) = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
Mem.convertToBase Base
Mem.Base16 Bytes32
x

-- | Convert a 'SHA256' into a raw binary representation.

--

-- @since 0.1.0.0

toRaw :: SHA256 -> ByteString
toRaw :: SHA256 -> ByteString
toRaw (SHA256 Bytes32
x) = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Bytes32
x

-- Instances


instance Show SHA256 where
  show :: SHA256 -> [Char]
show SHA256
s = [Char]
"SHA256 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (SHA256 -> Text
toHexText SHA256
s)

instance PersistField SHA256 where
  toPersistValue :: SHA256 -> PersistValue
toPersistValue = ByteString -> PersistValue
PersistByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> ByteString
toRaw
  fromPersistValue :: PersistValue -> Either Text SHA256
fromPersistValue (PersistByteString ByteString
bs) =
    case forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticExact ByteString
bs of
      Left StaticBytesException
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow StaticBytesException
e
      Right Bytes32
ss -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bytes32 -> SHA256
SHA256 Bytes32
ss
  fromPersistValue PersistValue
x = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unexpected value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow PersistValue
x

instance PersistFieldSql SHA256 where
  sqlType :: Proxy SHA256 -> SqlType
sqlType Proxy SHA256
_ = SqlType
SqlBlob

instance Display SHA256 where
  display :: SHA256 -> Utf8Builder
display = ByteString -> Utf8Builder
displayBytesUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> ByteString
toHexBytes

instance ToJSON SHA256 where
  toJSON :: SHA256 -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> Text
toHexText
instance FromJSON SHA256 where
  parseJSON :: Value -> Parser SHA256
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"SHA256" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text -> Either SHA256Exception SHA256
fromHexText Text
t of
      Right SHA256
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SHA256
x
      Left SHA256Exception
e -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Invalid SHA256 "
        , forall a. Show a => a -> [Char]
show Text
t
        , [Char]
": "
        , forall a. Show a => a -> [Char]
show SHA256Exception
e
        ]

instance Exception SHA256Exception
instance Show SHA256Exception where
  show :: SHA256Exception -> [Char]
show = Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
display

-- To support the Haskell Foundation's

-- [Haskell Error Index](https://errors.haskell.org/) initiative, all Pantry

-- error messages generated by Pantry itself begin with an unique code in the

-- form `[S-nnn]`, where `nnn` is a three-digit number in the range 100 to 999.

-- The numbers are selected at random, not in sequence.

instance Display SHA256Exception where
  display :: SHA256Exception -> Utf8Builder
display (InvalidByteCount ByteString
bs StaticBytesException
sbe) =
    Utf8Builder
"Error: [S-161]\n"
    forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid byte count creating a SHA256 from "
    forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow ByteString
bs
    forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
    forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow StaticBytesException
sbe
  display (InvalidHexBytes ByteString
bs Text
t) =
    Utf8Builder
"Error: [S-165]\n"
    forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Invalid hex bytes creating a SHA256: "
    forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow ByteString
bs
    forall a. Semigroup a => a -> a -> a
<> Utf8Builder
": "
    forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display Text
t