125 lines
4 KiB
Haskell
125 lines
4 KiB
Haskell
module Network.Stellar.Keypair
|
|
( KeyPair(..)
|
|
, PublicKey(..)
|
|
, EncodingVersion(..)
|
|
, fromPrivateKey
|
|
, fromPrivateKey'
|
|
, signatureHint
|
|
, encodePublic
|
|
, encodePublicKey
|
|
, decodePublic
|
|
, decodePublicKey
|
|
, decodePublic'
|
|
, decodePublicKey'
|
|
, encodePrivate
|
|
, decodePrivate
|
|
, decodePrivate'
|
|
, encodeKey
|
|
)where
|
|
|
|
import Control.Monad (guard)
|
|
import Crypto.Random (getSystemDRG, randomBytesGenerate)
|
|
import Crypto.Sign.Ed25519
|
|
import Data.Bits
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as BS
|
|
import Data.ByteString.Base32 (decodeBase32, encodeBase32)
|
|
import Data.Maybe (fromJust, fromMaybe)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
import Data.Word (Word16, Word8)
|
|
import GHC.Stack (HasCallStack)
|
|
|
|
data KeyPair = KeyPair
|
|
{ kpPublicKey :: PublicKey
|
|
, kpPrivateKey :: SecretKey
|
|
, kpSeed :: ByteString
|
|
}
|
|
|
|
instance Show KeyPair where
|
|
show (KeyPair public _ seed) =
|
|
"KeyPair {" ++ Text.unpack (encodePublic $ unPublicKey public) ++ ", "
|
|
++ Text.unpack (encodePrivate seed) ++ "}"
|
|
|
|
fromSeed :: ByteString -> KeyPair
|
|
fromSeed seed = KeyPair public private seed
|
|
where (public, private) = fromJust $ createKeypairFromSeed_ seed
|
|
|
|
fromPrivateKey :: Text -> Maybe KeyPair
|
|
fromPrivateKey = fmap fromSeed . decodePrivate
|
|
|
|
fromPrivateKey' :: HasCallStack => Text -> KeyPair
|
|
fromPrivateKey' = fromSeed . decodePrivate'
|
|
|
|
signatureHint :: KeyPair -> ByteString
|
|
signatureHint = BS.drop 28 . unPublicKey . kpPublicKey
|
|
|
|
|
|
encodePublic :: ByteString -> Text
|
|
encodePublic = encodeKey EncodingAccount
|
|
|
|
encodePublicKey :: PublicKey -> Text
|
|
encodePublicKey = encodePublic . unPublicKey
|
|
|
|
encodePrivate :: ByteString -> Text
|
|
encodePrivate = encodeKey EncodingSeed
|
|
|
|
decodePublic :: Text -> Maybe ByteString
|
|
decodePublic = decodeKey EncodingAccount
|
|
|
|
decodePublicKey :: Text -> Maybe PublicKey
|
|
decodePublicKey = fmap PublicKey . decodeKey EncodingAccount
|
|
|
|
decodePublic' :: Text -> ByteString
|
|
decodePublic' = decodeKey' EncodingAccount
|
|
|
|
decodePublicKey' :: Text -> PublicKey
|
|
decodePublicKey' = PublicKey . decodePublic'
|
|
|
|
decodePrivate :: Text -> Maybe ByteString
|
|
decodePrivate = decodeKey EncodingSeed
|
|
|
|
decodePrivate' :: HasCallStack => Text -> ByteString
|
|
decodePrivate' = decodeKey' EncodingSeed
|
|
|
|
decodeKey :: EncodingVersion -> Text -> Maybe ByteString
|
|
decodeKey version key = do
|
|
keyBlob <- either (const Nothing) Just $ decodeBase32 $ encodeUtf8 key
|
|
let (payload, checksum) = BS.splitAt (BS.length keyBlob - 2) keyBlob
|
|
(versionByte, keyData) <- BS.uncons payload
|
|
let versionCheck = versionByte == versionByteName version
|
|
checksumCheck = crc16XmodemLE payload == checksum
|
|
guard (versionCheck && checksumCheck)
|
|
pure keyData
|
|
|
|
decodeKey' :: HasCallStack => EncodingVersion -> Text -> ByteString
|
|
decodeKey' version key =
|
|
fromMaybe (error $ "Decoding key failed " ++ Text.unpack key) $
|
|
decodeKey version key
|
|
|
|
data EncodingVersion = EncodingAccount | EncodingSeed | EncodingPreAuthTx | EncodingSha256Hash
|
|
|
|
versionByteName :: EncodingVersion -> Word8
|
|
versionByteName EncodingAccount = 48
|
|
versionByteName EncodingSeed = 144
|
|
versionByteName EncodingPreAuthTx = 152
|
|
versionByteName EncodingSha256Hash = 184
|
|
|
|
encodeKey :: EncodingVersion -> ByteString -> Text
|
|
encodeKey version key = encodeBase32 $ payload <> checksum
|
|
where
|
|
versionByte = versionByteName version
|
|
payload = versionByte `BS.cons` key
|
|
checksum = crc16XmodemLE payload
|
|
|
|
crc16XmodemLE :: ByteString -> ByteString
|
|
crc16XmodemLE bs = BS.pack [fromIntegral $ checksum .&. 0xFF, fromIntegral $ checksum `shiftR` 8]
|
|
where checksum = BS.foldl crcRound 0 bs
|
|
|
|
crcRound :: Word16 -> Word8 -> Word16
|
|
crcRound crc byte = crc2
|
|
where
|
|
code = (crc `shiftR` 8) `xor` fromIntegral byte
|
|
code2 = code `xor` (code `shiftR` 4)
|
|
crc2 = (crc `shiftL` 8) `xor` code2 `xor` (code2 `shiftL` 5) `xor` (code2 `shiftL` 12)
|