78 lines
2.5 KiB
Haskell
78 lines
2.5 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
|
|
module Fedi.Crypto where
|
|
|
|
import Control.Logger.Simple qualified as Log
|
|
import Control.Monad.IO.Class
|
|
import Crypto.Hash qualified as Crypto
|
|
import Crypto.PubKey.RSA.PKCS15 qualified as Crypto
|
|
import Crypto.Store.PKCS8 qualified as Crypto
|
|
import Crypto.Store.X509 qualified as Crypto
|
|
import Data.Base64.Types qualified as Base64
|
|
import Data.ByteArray qualified as BA
|
|
import Data.ByteString.Base64 qualified as Base64
|
|
import Data.Text qualified as T
|
|
import Data.Text.Encoding qualified as T
|
|
import Data.X509 qualified as Crypto
|
|
import Fedi.Helpers
|
|
|
|
verifyPub :: (MonadIO m) => (MonadThrow m) => ByteString -> ByteString -> ByteString -> m Bool
|
|
verifyPub pubkeypem sig message = do
|
|
Log.logDebug $
|
|
"Verifying signature: "
|
|
<> pShow
|
|
[ ("pubkeypem", pubkeypem)
|
|
, ("sig", sig)
|
|
, ("message", message)
|
|
]
|
|
|
|
pubkey <-
|
|
case Crypto.readPubKeyFileFromMemory pubkeypem of
|
|
[Crypto.PubKeyRSA pubkey'] -> pure pubkey'
|
|
_ -> throw "failed to read pubkey pem"
|
|
pure $ Crypto.verify (Just Crypto.SHA256) pubkey message (decodeBase64 sig)
|
|
|
|
sign :: FilePath -> ByteString -> IO SignedMessage
|
|
sign privatePemFile message = do
|
|
-- get private key
|
|
privkeypem <- Crypto.readKeyFile privatePemFile
|
|
privateKey <- case privkeypem of
|
|
[Crypto.Unprotected (Crypto.PrivKeyRSA privkey)] -> pure privkey
|
|
_ -> throw $ "error reading local private key from '" <> privatePemFile <> "'."
|
|
|
|
-- sign message
|
|
signedMessage <-
|
|
Crypto.sign Nothing (Just Crypto.SHA256) privateKey message
|
|
& either (throw . show) pure
|
|
|
|
-- return
|
|
pure (makeSignedMessage signedMessage)
|
|
|
|
-- | A Base64 encoded string.
|
|
newtype SignedMessage
|
|
= SignedMessage (Base64.Base64 'Base64.StdPadded ByteString)
|
|
deriving (Show)
|
|
|
|
makeSignedMessage :: ByteString -> SignedMessage
|
|
makeSignedMessage = SignedMessage . Base64.encodeBase64'
|
|
|
|
ppSignedMessage :: SignedMessage -> String
|
|
ppSignedMessage (SignedMessage message) =
|
|
T.unpack $ T.decodeUtf8 $ Base64.extractBase64 message
|
|
|
|
bsSignedMessage :: SignedMessage -> ByteString
|
|
bsSignedMessage (SignedMessage message) =
|
|
Base64.extractBase64 message
|
|
|
|
encodeBase64 :: ByteString -> ByteString
|
|
encodeBase64 = Base64.extractBase64 . Base64.encodeBase64'
|
|
|
|
encodeBase64String :: ByteString -> String
|
|
encodeBase64String = T.unpack . Base64.extractBase64 . Base64.encodeBase64
|
|
|
|
decodeBase64 :: ByteString -> ByteString
|
|
decodeBase64 = Base64.decodeBase64Lenient
|
|
|
|
makeDigest :: ByteString -> ByteString
|
|
makeDigest message =
|
|
BA.convert (Crypto.hash message :: Crypto.Digest Crypto.SHA256)
|