{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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 representats 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 RIO
import Data.Aeson
import Database.Persist.Sql
import Pantry.Internal.StaticBytes
import Conduit
import qualified RIO.Text as T

import qualified Crypto.Hash.Conduit as Hash (hashFile, sinkHash)
import qualified Crypto.Hash as Hash (hash, hashlazy, Digest, SHA256)
import qualified Data.ByteArray
import qualified Data.ByteArray.Encoding as Mem

-- | 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. SHA256 -> Rep SHA256 x)
-> (forall x. Rep SHA256 x -> SHA256) -> Generic SHA256
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
(SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool) -> Eq SHA256
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 -> ()
(SHA256 -> ()) -> NFData SHA256
forall a. (a -> ()) -> NFData a
rnf :: SHA256 -> ()
$crnf :: SHA256 -> ()
NFData, Typeable SHA256
DataType
Constr
Typeable SHA256
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SHA256 -> c SHA256)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SHA256)
-> (SHA256 -> Constr)
-> (SHA256 -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SHA256 -> SHA256)
-> (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 u. (forall d. Data d => d -> u) -> SHA256 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SHA256 -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SHA256 -> m SHA256)
-> Data SHA256
SHA256 -> DataType
SHA256 -> Constr
(forall b. Data b => b -> b) -> SHA256 -> SHA256
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SHA256 -> c SHA256
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSHA256 :: Constr
$tSHA256 :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> SHA256 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SHA256 -> u
gmapQ :: (forall d. Data d => d -> u) -> SHA256 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SHA256 -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable SHA256
Data, Typeable, Eq SHA256
Eq SHA256
-> (SHA256 -> SHA256 -> Ordering)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> SHA256)
-> (SHA256 -> SHA256 -> SHA256)
-> Ord 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
$cp1Ord :: Eq SHA256
Ord, Int -> SHA256 -> Int
SHA256 -> Int
(Int -> SHA256 -> Int) -> (SHA256 -> Int) -> Hashable SHA256
forall 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 :: FilePath -> m SHA256
hashFile FilePath
fp = Digest SHA256 -> SHA256
fromDigest (Digest SHA256 -> SHA256) -> m (Digest SHA256) -> m SHA256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m (Digest SHA256)
forall (m :: * -> *) hash.
(MonadIO m, HashAlgorithm hash) =>
FilePath -> m (Digest hash)
Hash.hashFile FilePath
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 (Digest SHA256 -> SHA256)
-> (ByteString -> Digest SHA256) -> ByteString -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256
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 (Digest SHA256 -> SHA256)
-> (LByteString -> Digest SHA256) -> LByteString -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Digest SHA256
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 :: ConduitT ByteString o m SHA256
sinkHash = Digest SHA256 -> SHA256
fromDigest (Digest SHA256 -> SHA256)
-> ConduitT ByteString o m (Digest SHA256)
-> ConduitT ByteString o m SHA256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ByteString o m (Digest SHA256)
forall (m :: * -> *) hash.
(Monad m, HashAlgorithm hash) =>
Consumer ByteString 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 (ByteString -> Either SHA256Exception SHA256)
-> (Text -> ByteString) -> Text -> Either SHA256Exception SHA256
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
  (FilePath -> SHA256Exception)
-> Either FilePath ByteString -> Either SHA256Exception ByteString
forall a1 a2 b. (a1 -> a2) -> Either a1 b -> Either a2 b
mapLeft (ByteString -> Text -> SHA256Exception
InvalidHexBytes ByteString
hexBS (Text -> SHA256Exception)
-> (FilePath -> Text) -> FilePath -> SHA256Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (Base -> ByteString -> Either FilePath ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either FilePath bout
Mem.convertFromBase Base
Mem.Base16 ByteString
hexBS) Either SHA256Exception ByteString
-> (ByteString -> Either SHA256Exception SHA256)
-> Either SHA256Exception SHA256
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 ByteString -> Either StaticBytesException Bytes32
forall dbytes sbytes.
(DynamicBytes dbytes, StaticBytes sbytes) =>
dbytes -> Either StaticBytesException sbytes
toStaticExact (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Digest SHA256
digest :: ByteString) of
    Left StaticBytesException
e -> FilePath -> SHA256
forall a. HasCallStack => FilePath -> a
error (FilePath -> SHA256) -> FilePath -> SHA256
forall a b. (a -> b) -> a -> b
$ FilePath
"Impossible failure in fromDigest: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Digest SHA256, StaticBytesException) -> FilePath
forall a. Show a => a -> FilePath
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 = (StaticBytesException -> Either SHA256Exception SHA256)
-> (Bytes32 -> Either SHA256Exception SHA256)
-> Either StaticBytesException Bytes32
-> Either SHA256Exception SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SHA256Exception -> Either SHA256Exception SHA256
forall a b. a -> Either a b
Left (SHA256Exception -> Either SHA256Exception SHA256)
-> (StaticBytesException -> SHA256Exception)
-> StaticBytesException
-> Either SHA256Exception SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StaticBytesException -> SHA256Exception
InvalidByteCount ByteString
bs) (SHA256 -> Either SHA256Exception SHA256
forall a b. b -> Either a b
Right (SHA256 -> Either SHA256Exception SHA256)
-> (Bytes32 -> SHA256) -> Bytes32 -> Either SHA256Exception SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes32 -> SHA256
SHA256) (ByteString -> Either StaticBytesException Bytes32
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' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString
toHexBytes SHA256
ss of
    Left UnicodeException
e -> FilePath -> Text
forall a. HasCallStack => FilePath -> a
error (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Impossible failure in staticSHA256ToText: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (SHA256, UnicodeException) -> FilePath
forall a. Show a => a -> FilePath
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) = Base -> Bytes32 -> ByteString
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) = Bytes32 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Data.ByteArray.convert Bytes32
x

-- Instances

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

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

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

instance Exception SHA256Exception
instance Show SHA256Exception where
  show :: SHA256Exception -> FilePath
show = Text -> FilePath
T.unpack (Text -> FilePath)
-> (SHA256Exception -> Text) -> SHA256Exception -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text)
-> (SHA256Exception -> Utf8Builder) -> SHA256Exception -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256Exception -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display
instance Display SHA256Exception where
  display :: SHA256Exception -> Utf8Builder
display (InvalidByteCount ByteString
bs StaticBytesException
sbe) =
    Utf8Builder
"Invalid byte count creating a SHA256 from " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ByteString
bs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    StaticBytesException -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow StaticBytesException
sbe
  display (InvalidHexBytes ByteString
bs Text
t) =
    Utf8Builder
"Invalid hex bytes creating a SHA256: " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow ByteString
bs Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Utf8Builder
": " Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
<>
    Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display Text
t