{-# 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           Database.Persist.Sql
import           Pantry.Internal.StaticBytes
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 (Generic, Eq, NFData, Data, Typeable, Ord, 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 fp = fromDigest <$> Hash.hashFile fp

-- | Generate a 'SHA256' value by hashing a @ByteString@.
--
-- @since 0.1.0.0
hashBytes :: ByteString -> SHA256
hashBytes = fromDigest . Hash.hash

-- | Generate a 'SHA256' value by hashing a lazy @ByteString@.
--
-- @since 0.1.0.0
hashLazyBytes :: LByteString -> SHA256
hashLazyBytes = fromDigest . 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 = fromDigest <$> 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 = fromHexBytes . encodeUtf8

-- | Convert a base16-encoded 'ByteString' value containing a hash into a
-- 'SHA256'.
--
-- @since 0.1.0.0
fromHexBytes :: ByteString -> Either SHA256Exception SHA256
fromHexBytes hexBS = do
  mapLeft (InvalidHexBytes hexBS . T.pack) (Mem.convertFromBase Mem.Base16 hexBS) >>= fromRaw

-- | Convert a 'Hash.Digest' into a 'SHA256'
--
-- @since 0.1.0.0
fromDigest :: Hash.Digest Hash.SHA256 -> SHA256
fromDigest digest =
  case toStaticExact (Data.ByteArray.convert digest :: ByteString) of
    Left e -> error $ "Impossible failure in fromDigest: " ++ show (digest, e)
    Right x -> SHA256 x

-- | Convert a raw representation of a hash into a 'SHA256'.
--
-- @since 0.1.0.0
fromRaw :: ByteString -> Either SHA256Exception SHA256
fromRaw bs =
  either (Left . InvalidByteCount bs) (Right . SHA256) (toStaticExact bs)

-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
--
-- @since 0.1.0.0
toHexText :: SHA256 -> Text
toHexText ss =
  case decodeUtf8' $ toHexBytes ss of
    Left e ->
      error $ "Impossible failure in staticSHA256ToText: " ++ show (ss, e)
    Right t -> t

-- | Convert a 'SHA256' into a base16-encoded SHA256 hash.
--
-- @since 0.1.0.0
toHexBytes :: SHA256 -> ByteString
toHexBytes (SHA256 x) = Mem.convertToBase Mem.Base16 x

-- | Convert a 'SHA256' into a raw binary representation.
--
-- @since 0.1.0.0
toRaw :: SHA256 -> ByteString
toRaw (SHA256 x) = Data.ByteArray.convert x

-- Instances

instance Show SHA256 where
  show s = "SHA256 " ++ show (toHexText s)

instance PersistField SHA256 where
  toPersistValue = PersistByteString . toRaw
  fromPersistValue (PersistByteString bs) =
    case toStaticExact bs of
      Left e -> Left $ tshow e
      Right ss -> pure $ SHA256 ss
  fromPersistValue x = Left $ "Unexpected value: " <> tshow x

instance PersistFieldSql SHA256 where
  sqlType _ = SqlBlob

instance Display SHA256 where
  display = displayBytesUtf8 . toHexBytes

instance ToJSON SHA256 where
  toJSON = toJSON . toHexText
instance FromJSON SHA256 where
  parseJSON = withText "SHA256" $ \t ->
    case fromHexText t of
      Right x -> pure x
      Left e -> fail $ concat
        [ "Invalid SHA256 "
        , show t
        , ": "
        , show e
        ]

instance Exception SHA256Exception
instance Show SHA256Exception where
  show = T.unpack . utf8BuilderToText . 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 (InvalidByteCount bs sbe) =
    "Error: [S-161]\n"
    <> "Invalid byte count creating a SHA256 from "
    <> displayShow bs
    <> ": "
    <> displayShow sbe
  display (InvalidHexBytes bs t) =
    "Error: [S-165]\n"
    <> "Invalid hex bytes creating a SHA256: "
    <> displayShow bs
    <> ": "
    <> display t
