module Tezos.Crypto
(
PublicKey
, SecretKey
, Signature
, KeyHash (..)
, toPublic
, CryptoParseError (..)
, formatPublicKey
, parsePublicKey
, formatSecretKey
, parseSecretKey
, formatSignature
, parseSignature
, formatKeyHash
, parseKeyHash
, sign
, checkSignature
, hashKey
, blake2b
, blake2b160
, sha256
, sha512
, encodeBase58Check
, decodeBase58Check
, B58CheckWithPrefixError (..)
, decodeBase58CheckWithPrefix
) where
import Crypto.Error (CryptoError, CryptoFailable, eitherCryptoError)
import Crypto.Hash (Blake2b_160, Blake2b_256, Digest, SHA256, SHA512, hash)
import Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Crypto.Random (drgNewSeed, seedFromInteger, withDRG)
import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base58 as Base58
import Data.Coerce (coerce)
import Fmt (fmt, hexF, pretty)
import qualified Formatting.Buildable as Buildable
import Test.QuickCheck (Arbitrary(..), vector)
newtype PublicKey = PublicKey
{ unPublicKey :: Ed25519.PublicKey
} deriving (Show, Eq)
instance Arbitrary PublicKey where
arbitrary = toPublic <$> arbitrary
newtype SecretKey = SecretKey
{ unSecretKey :: Ed25519.SecretKey
} deriving (Show, Eq)
instance Arbitrary SecretKey where
arbitrary = do
seed <- BS.pack <$> vector 32
let chachaSeed = drgNewSeed . seedFromInteger . os2ip $ seed
(sk, _) = withDRG chachaSeed Ed25519.generateSecretKey
return (SecretKey sk)
toPublic :: SecretKey -> PublicKey
toPublic = PublicKey . Ed25519.toPublic . unSecretKey
newtype Signature = Signature
{ unSignature :: Ed25519.Signature
} deriving (Show, Eq)
instance Arbitrary Signature where
arbitrary = sign <$> arbitrary <*> (encodeUtf8 @String <$> arbitrary)
newtype KeyHash = KeyHash
{ unKeyHash :: ByteString
} deriving (Show, Eq, Ord)
instance Arbitrary KeyHash where
arbitrary = hashKey <$> arbitrary
publicKeyTag :: ByteString
publicKeyTag = "\13\15\37\217"
secretKeyTag :: ByteString
secretKeyTag = "\13\15\58\7"
signatureTag :: ByteString
signatureTag = "\9\245\205\134\18"
keyHashTag :: ByteString
keyHashTag = "\6\161\159"
data CryptoParseError
= CryptoParseWrongBase58Check
| CryptoParseWrongTag !ByteString
| CryptoParseCryptoError CryptoError
deriving (Show, Eq)
instance Buildable.Buildable CryptoParseError where
build =
\case
CryptoParseWrongBase58Check -> "Wrong base58check encoding of bytes"
CryptoParseWrongTag tag -> "Prefix is wrong tag: " <> fmt (hexF tag)
CryptoParseCryptoError err ->
"Cryptographic library reported an error: " <>
Buildable.build (displayException err)
formatPublicKey :: PublicKey -> Text
formatPublicKey = formatImpl publicKeyTag . unPublicKey
instance Buildable.Buildable PublicKey where
build = Buildable.build . formatPublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey = parseImpl publicKeyTag Ed25519.publicKey
formatSecretKey :: SecretKey -> Text
formatSecretKey = formatImpl secretKeyTag . unSecretKey
instance Buildable.Buildable SecretKey where
build = Buildable.build . formatSecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey = parseImpl secretKeyTag Ed25519.secretKey
formatSignature :: Signature -> Text
formatSignature = formatImpl signatureTag . unSignature
instance Buildable.Buildable Signature where
build = Buildable.build . formatSignature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature = parseImpl signatureTag Ed25519.signature
formatKeyHash :: KeyHash -> Text
formatKeyHash = formatImpl keyHashTag . unKeyHash
instance Buildable.Buildable KeyHash where
build = Buildable.build . formatKeyHash
parseKeyHash :: Text -> Either CryptoParseError KeyHash
parseKeyHash = parseImpl keyHashTag pure
formatImpl :: ByteArray.ByteArrayAccess x => ByteString -> x -> Text
formatImpl tag = encodeBase58Check . mappend tag . ByteArray.convert
parseImpl
:: Coercible x res
=> ByteString
-> (ByteString -> CryptoFailable x)
-> Text
-> Either CryptoParseError res
parseImpl expectedTag constructor text = do
let convertErr :: B58CheckWithPrefixError -> CryptoParseError
convertErr =
\case B58CheckWithPrefixWrongPrefix prefix -> CryptoParseWrongTag prefix
B58CheckWithPrefixWrongEncoding -> CryptoParseWrongBase58Check
payload <- first convertErr $ decodeBase58CheckWithPrefix expectedTag text
bimap CryptoParseCryptoError coerce $
eitherCryptoError $ constructor payload
instance ToJSON PublicKey where
toJSON = Aeson.String . formatPublicKey
toEncoding = Aeson.text . formatPublicKey
instance FromJSON PublicKey where
parseJSON =
Aeson.withText "PublicKey" $
either (fail . pretty) pure . parsePublicKey
instance ToJSON Signature where
toJSON = Aeson.String . formatSignature
toEncoding = Aeson.text . formatSignature
instance FromJSON Signature where
parseJSON =
Aeson.withText "Signature" $
either (fail . pretty) pure . parseSignature
instance ToJSON KeyHash where
toJSON = Aeson.String . formatKeyHash
toEncoding = Aeson.text . formatKeyHash
instance FromJSON KeyHash where
parseJSON =
Aeson.withText "KeyHash" $
either (fail . pretty) pure . parseKeyHash
sign :: SecretKey -> ByteString -> Signature
sign sk =
Signature .
Ed25519.sign (unSecretKey sk) (unPublicKey (toPublic sk)) . blake2b
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature (PublicKey pk) (Signature sig) bytes =
Ed25519.verify pk (blake2b bytes) sig
hashKey :: PublicKey -> KeyHash
hashKey (PublicKey pk) =
KeyHash (fromDigest @Blake2b_160 $ hash @ByteString $ ByteArray.convert pk)
blake2b :: ByteString -> ByteString
blake2b = fromDigest @Blake2b_256 . hash
blake2b160 :: ByteString -> ByteString
blake2b160 = fromDigest @Blake2b_160 . hash
sha256 :: ByteString -> ByteString
sha256 = fromDigest @SHA256 . hash
sha512 :: ByteString -> ByteString
sha512 = fromDigest @SHA512 . hash
fromDigest :: forall a. Digest a -> ByteString
fromDigest = ByteArray.convert
encodeBase58Check :: ByteString -> Text
encodeBase58Check =
decodeUtf8 . Base58.encodeBase58 Base58.bitcoinAlphabet . withCheckSum
where
withCheckSum :: ByteString -> ByteString
withCheckSum bs = bs <> checkSum bs
decodeBase58Check :: Text -> Maybe ByteString
decodeBase58Check text = do
bytes <- Base58.decodeBase58 Base58.bitcoinAlphabet (encodeUtf8 text)
let (payload, chk) = BS.splitAt (length bytes - 4) bytes
guard $ chk == checkSum payload
return payload
checkSum :: ByteString -> ByteString
checkSum = BS.take 4 . (sha256 . sha256)
data B58CheckWithPrefixError
= B58CheckWithPrefixWrongPrefix ByteString
| B58CheckWithPrefixWrongEncoding
deriving (Show)
decodeBase58CheckWithPrefix ::
ByteString -> Text -> Either B58CheckWithPrefixError ByteString
decodeBase58CheckWithPrefix prefix text =
case decodeBase58Check text of
Nothing -> Left B58CheckWithPrefixWrongEncoding
Just bs ->
let (actualPrefix, payload) = BS.splitAt (length prefix) bs
in if actualPrefix == prefix
then Right payload
else Left (B58CheckWithPrefixWrongPrefix actualPrefix)