{-# OPTIONS_GHC -fno-warn-orphans #-}

module Crypto.Hash.Instances
  () where

import ClassyPrelude

import Crypto.Hash hiding (hash)

import Database.Persist
import Database.Persist.Sql

import Data.ByteArray (convert)

import Web.PathPieces
import Web.HttpApiData
import Data.Aeson as Aeson

import Control.Monad.Fail

import Language.Haskell.TH.Syntax (Lift(liftTyped))
import Instances.TH.Lift ()

import Data.Binary
import qualified Data.Binary.Put as Binary
import qualified Data.Binary.Get as Binary

import qualified Data.ByteString.Base64.URL as Base64

import Type.Reflection (typeRep)
  

instance HashAlgorithm hash => PersistField (Digest hash) where
  toPersistValue = PersistByteString . convert
  fromPersistValue (PersistByteString bs) = maybe (Left "Could not convert Digest from ByteString") Right $ digestFromByteString bs
  fromPersistValue (PersistText t) = maybe (Left "Cours not convert Digest from String") Right $ readMay t
  fromPersistValue _ = Left "Digest values must be converted from PersistByteString or PersistText"

instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
  sqlType _ = SqlBlob

instance HashAlgorithm hash => PathPiece (Digest hash) where
  toPathPiece = decodeUtf8 . Base64.encodeUnpadded . convert
  fromPathPiece = digestFromByteString <=< either (const Nothing) Just . Base64.decodeUnpadded . encodeUtf8

instance HashAlgorithm hash => ToHttpApiData (Digest hash) where
  toUrlPiece = toPathPiece

instance HashAlgorithm hash => FromHttpApiData (Digest hash) where
  parseUrlPiece = maybe (Left "Could not read Digest") Right . fromPathPiece

instance HashAlgorithm hash => ToJSON (Digest hash) where
  toJSON = Aeson.String . toUrlPiece

instance HashAlgorithm hash => FromJSON (Digest hash) where
  parseJSON = withText "Digest" $ either (fail . unpack) return . parseUrlPiece

instance Typeable hash => Hashable (Digest hash) where
  hashWithSalt s h = s `hashWithSalt` hash (typeRep @hash) `hashWithSalt` hash @ByteString (convert h)

instance HashAlgorithm hash => Lift (Digest hash) where
  liftTyped dgst = [||fromMaybe (error "Lifted digest has wrong length") $ digestFromByteString $$(liftTyped (convert dgst :: ByteString))||]

instance HashAlgorithm hash => Binary (Digest hash) where
  put = Binary.putByteString . convert
  get = Binary.getByteString (hashDigestSize (error "hashDigestSize inspected value of type hash" :: hash)) >>= maybe (fail "Could not parse Digest") return . digestFromByteString