fcmtp-data/src/Data/SMTP/Crypto/Algos/CP.hs

{- |
Crypto algorithms used on capabilities
-}
module Data.SMTP.Crypto.Algos.CP (
  Algo,
  initCp,
  update,
  update',
  checkSeal,
  toSeal
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.SMTP.Seal as Seal
import qualified Crypto.Hash as Hash
import qualified Crypto.Hash.Algorithms as Hashs
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import Crypto.Error
import Data.SMTP.Crypto.Types.CP

data Algo = Sha512Ed25519 deriving (Eq, Ord, Bounded, Enum)

instance Show Algo where
  show Sha512Ed25519 = "SHA512-ED25519"

data State = Sha512Ed25519s (Hash.Context Hashs.SHA512)
             
initCp :: Algo -> State
initCp Sha512Ed25519 = Sha512Ed25519s Hash.hashInit
update ::  State -> ByteString -> State
update (Sha512Ed25519s s) dt = Sha512Ed25519s $ Hash.hashUpdate s dt
update' :: State -> LBS.ByteString -> State
update' (Sha512Ed25519s s) dt = Sha512Ed25519s $ Hash.hashUpdates s $ LBS.toChunks dt
checkSeal :: State -> Seal.Seal -> CP -> Bool
checkSeal (Sha512Ed25519s s) (Seal.Seal _ seal _) (Sha512Ed25519Cp _ pk _) = let
  dg = Hash.hashFinalize s
  sig' = Ed25519.signature seal
  in case sig' of
    CryptoFailed _ -> False
    CryptoPassed sig -> Ed25519.verify pk dg sig
toSeal :: State -> CP -> Maybe Seal.Seal
toSeal (Sha512Ed25519s s) (Sha512Ed25519Cp cpid pk (Just sk)) = let
  dg = Hash.hashFinalize s
  sig = ba2bs $ Ed25519.sign sk pk dg
  in Just $ Seal.Seal cpid sig Nothing
toSeal (Sha512Ed25519s _) _ = Nothing


ba2bs :: BA.ByteArrayAccess a => a -> ByteString
ba2bs = BS.pack . BA.unpack