{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Haskoin.Keys.Common (
PubKeyI (..),
SecKeyI (..),
exportPubKey,
importPubKey,
wrapPubKey,
derivePubKeyI,
wrapSecKey,
fromMiniKey,
tweakPubKey,
tweakSecKey,
getSecKey,
secKey,
fromWif,
toWif,
) where
import Control.DeepSeq
import Control.Monad (guard, mzero, (<=<))
import Crypto.Secp256k1
import Data.Aeson (
FromJSON,
ToJSON (..),
Value (String),
parseJSON,
withText,
)
import Data.Aeson.Encoding (unsafeToEncoding)
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (char7)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Hashable
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import GHC.Generics (Generic)
import Haskoin.Address.Base58
import Haskoin.Crypto.Hash
import Haskoin.Data
import Haskoin.Util
data PubKeyI = PubKeyI
{ PubKeyI -> PubKey
pubKeyPoint :: !PubKey
, PubKeyI -> Bool
pubKeyCompressed :: !Bool
}
deriving (forall x. Rep PubKeyI x -> PubKeyI
forall x. PubKeyI -> Rep PubKeyI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PubKeyI x -> PubKeyI
$cfrom :: forall x. PubKeyI -> Rep PubKeyI x
Generic, PubKeyI -> PubKeyI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubKeyI -> PubKeyI -> Bool
$c/= :: PubKeyI -> PubKeyI -> Bool
== :: PubKeyI -> PubKeyI -> Bool
$c== :: PubKeyI -> PubKeyI -> Bool
Eq, Int -> PubKeyI -> ShowS
[PubKeyI] -> ShowS
PubKeyI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubKeyI] -> ShowS
$cshowList :: [PubKeyI] -> ShowS
show :: PubKeyI -> String
$cshow :: PubKeyI -> String
showsPrec :: Int -> PubKeyI -> ShowS
$cshowsPrec :: Int -> PubKeyI -> ShowS
Show, ReadPrec [PubKeyI]
ReadPrec PubKeyI
Int -> ReadS PubKeyI
ReadS [PubKeyI]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PubKeyI]
$creadListPrec :: ReadPrec [PubKeyI]
readPrec :: ReadPrec PubKeyI
$creadPrec :: ReadPrec PubKeyI
readList :: ReadS [PubKeyI]
$creadList :: ReadS [PubKeyI]
readsPrec :: Int -> ReadS PubKeyI
$creadsPrec :: Int -> ReadS PubKeyI
Read, Eq PubKeyI
Int -> PubKeyI -> Int
PubKeyI -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PubKeyI -> Int
$chash :: PubKeyI -> Int
hashWithSalt :: Int -> PubKeyI -> Int
$chashWithSalt :: Int -> PubKeyI -> Int
Hashable, PubKeyI -> ()
forall a. (a -> ()) -> NFData a
rnf :: PubKeyI -> ()
$crnf :: PubKeyI -> ()
NFData)
instance IsString PubKeyI where
fromString :: String -> PubKeyI
fromString String
str =
forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs String
str
where
e :: a
e = forall a. HasCallStack => String -> a
error String
"Could not decode public key"
instance ToJSON PubKeyI where
toJSON :: PubKeyI -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
toEncoding :: PubKeyI -> Encoding
toEncoding PubKeyI
s =
forall a. Builder -> Encoding' a
unsafeToEncoding forall a b. (a -> b) -> a -> b
$
Char -> Builder
char7 Char
'"'
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
hexBuilder (Put -> ByteString
runPutL (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
s))
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
instance FromJSON PubKeyI where
parseJSON :: Value -> Parser PubKeyI
parseJSON =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PubKeyI" forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex)
instance Serial PubKeyI where
deserialize :: forall (m :: * -> *). MonadGet m => m PubKeyI
deserialize =
m Bool
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> m PubKeyI
c
Bool
False -> m PubKeyI
u
where
s :: m Bool
s =
forall (m :: * -> *) a. MonadGet m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). MonadGet m => m Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0x02 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Word8
0x03 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Word8
0x04 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a public key"
c :: m PubKeyI
c = do
ByteString
bs <- forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
33
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode public key") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
PubKey -> Bool -> PubKeyI
PubKeyI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe PubKey
importPubKey ByteString
bs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
u :: m PubKeyI
u = do
ByteString
bs <- forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
65
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode public key") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
PubKey -> Bool -> PubKeyI
PubKeyI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe PubKey
importPubKey ByteString
bs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
serialize :: forall (m :: * -> *). MonadPut m => PubKeyI -> m ()
serialize PubKeyI
pk = forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> ByteString
exportPubKey (PubKeyI -> Bool
pubKeyCompressed PubKeyI
pk) (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pk)
instance Serialize PubKeyI where
put :: Putter PubKeyI
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get PubKeyI
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance Binary PubKeyI where
put :: PubKeyI -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
get :: Get PubKeyI
get = forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
wrapPubKey :: Bool -> PubKey -> PubKeyI
wrapPubKey :: Bool -> PubKey -> PubKeyI
wrapPubKey Bool
c PubKey
p = PubKey -> Bool -> PubKeyI
PubKeyI PubKey
p Bool
c
derivePubKeyI :: SecKeyI -> PubKeyI
derivePubKeyI :: SecKeyI -> PubKeyI
derivePubKeyI (SecKeyI SecKey
d Bool
c) = PubKey -> Bool -> PubKeyI
PubKeyI (SecKey -> PubKey
derivePubKey SecKey
d) Bool
c
tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey
tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey
tweakPubKey PubKey
p Hash256
h = PubKey -> Tweak -> Maybe PubKey
tweakAddPubKey PubKey
p forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Maybe Tweak
tweak (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h))
data SecKeyI = SecKeyI
{ SecKeyI -> SecKey
secKeyData :: !SecKey
, SecKeyI -> Bool
secKeyCompressed :: !Bool
}
deriving (SecKeyI -> SecKeyI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecKeyI -> SecKeyI -> Bool
$c/= :: SecKeyI -> SecKeyI -> Bool
== :: SecKeyI -> SecKeyI -> Bool
$c== :: SecKeyI -> SecKeyI -> Bool
Eq, Int -> SecKeyI -> ShowS
[SecKeyI] -> ShowS
SecKeyI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecKeyI] -> ShowS
$cshowList :: [SecKeyI] -> ShowS
show :: SecKeyI -> String
$cshow :: SecKeyI -> String
showsPrec :: Int -> SecKeyI -> ShowS
$cshowsPrec :: Int -> SecKeyI -> ShowS
Show, ReadPrec [SecKeyI]
ReadPrec SecKeyI
Int -> ReadS SecKeyI
ReadS [SecKeyI]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SecKeyI]
$creadListPrec :: ReadPrec [SecKeyI]
readPrec :: ReadPrec SecKeyI
$creadPrec :: ReadPrec SecKeyI
readList :: ReadS [SecKeyI]
$creadList :: ReadS [SecKeyI]
readsPrec :: Int -> ReadS SecKeyI
$creadsPrec :: Int -> ReadS SecKeyI
Read, forall x. Rep SecKeyI x -> SecKeyI
forall x. SecKeyI -> Rep SecKeyI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SecKeyI x -> SecKeyI
$cfrom :: forall x. SecKeyI -> Rep SecKeyI x
Generic, SecKeyI -> ()
forall a. (a -> ()) -> NFData a
rnf :: SecKeyI -> ()
$crnf :: SecKeyI -> ()
NFData)
wrapSecKey :: Bool -> SecKey -> SecKeyI
wrapSecKey :: Bool -> SecKey -> SecKeyI
wrapSecKey Bool
c SecKey
d = SecKey -> Bool -> SecKeyI
SecKeyI SecKey
d Bool
c
tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey
tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey
tweakSecKey SecKey
key Hash256
h = SecKey -> Tweak -> Maybe SecKey
tweakAddSecKey SecKey
key forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Maybe Tweak
tweak (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h))
fromMiniKey :: ByteString -> Maybe SecKeyI
fromMiniKey :: ByteString -> Maybe SecKeyI
fromMiniKey ByteString
bs = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
checkShortKey
Bool -> SecKey -> SecKeyI
wrapSecKey Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe SecKey
secKey (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (forall b. ByteArrayAccess b => b -> Hash256
sha256 ByteString
bs)))
where
checkHash :: ByteString
checkHash = Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ forall b. ByteArrayAccess b => b -> Hash256
sha256 forall a b. (a -> b) -> a -> b
$ ByteString
bs ByteString -> ByteString -> ByteString
`BS.append` ByteString
"?"
checkShortKey :: Bool
checkShortKey = ByteString -> Int
BS.length ByteString
bs forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
22, Int
30] Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Word8
BS.head ByteString
checkHash forall a. Eq a => a -> a -> Bool
== Word8
0x00
fromWif :: Network -> Base58 -> Maybe SecKeyI
fromWif :: Network -> Text -> Maybe SecKeyI
fromWif Network
net Text
wif = do
ByteString
bs <- Text -> Maybe ByteString
decodeBase58Check Text
wif
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HasCallStack => ByteString -> Word8
BS.head ByteString
bs forall a. Eq a => a -> a -> Bool
== Network -> Word8
getSecretPrefix Network
net)
case ByteString -> Int
BS.length ByteString
bs of
Int
33 -> Bool -> SecKey -> SecKeyI
wrapSecKey Bool
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe SecKey
secKey (HasCallStack => ByteString -> ByteString
BS.tail ByteString
bs)
Int
34 -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
BS.last ByteString
bs forall a. Eq a => a -> a -> Bool
== Word8
0x01
Bool -> SecKey -> SecKeyI
wrapSecKey Bool
True forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe SecKey
secKey (HasCallStack => ByteString -> ByteString
BS.tail forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
BS.init ByteString
bs)
Int
_ -> forall a. Maybe a
Nothing
toWif :: Network -> SecKeyI -> Base58
toWif :: Network -> SecKeyI -> Text
toWif Network
net (SecKeyI SecKey
k Bool
c) =
ByteString -> Text
encodeBase58Check forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> ByteString
BS.cons (Network -> Word8
getSecretPrefix Network
net) forall a b. (a -> b) -> a -> b
$
if Bool
c
then SecKey -> ByteString
getSecKey SecKey
k ByteString -> Word8 -> ByteString
`BS.snoc` Word8
0x01
else SecKey -> ByteString
getSecKey SecKey
k