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 Crypto.Error
import Data.SMTP.Crypto.Types.CP

data State = Sha3_512Ed25519s (Hash.Context Hashs.SHA512)

initCp :: Algo -> State
initCp Sha3_512Ed25519 = Sha3_512Ed25519s Hash.hashInit

update ::  State -> ByteString -> State
update (Sha3_512Ed25519s s) dt = Sha3_512Ed25519s $ Hash.hashUpdate s dt

update' :: State -> LBS.ByteString -> State
update' (Sha3_512Ed25519s s) dt = Sha3_512Ed25519s $ Hash.hashUpdates s $ LBS.toChunks dt

checkSeal :: State -> Seal.Seal -> PCP -> Bool
checkSeal _ _ PAll = True
checkSeal (Sha3_512Ed25519s s) (Seal.Seal _ seal _) (PCPSha3_512Ed25519 _ 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 -> PCP -> Maybe Seal.Seal
-- toSeal (Sha3_512Ed25519s s) (PCPSha3_512Ed25519 cpid pk (Just sk)) = let
--   dg = Hash.hashFinalize s
--   sig = ba2bs $ Ed25519.sign sk pk dg
--   in Just $ Seal.Seal cpid sig Nothing
-- toSeal (Sha3_512Ed25519s _) _ = Nothing


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