{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.Sign.Ed25519
(
PublicKey(..)
, SecretKey(..)
, createKeypair
, createKeypairFromSeed_
, createKeypairFromSeed
, toPublicKey
, sign
, verify
, Signature(..)
, dsign
, dverify
, sign'
, verify'
) where
import safe Prelude (Eq,Show, Ord, IO, Either(Right,Left), Maybe, Bool, return, undefined, error, (==))
import safe GHC.Generics (Generic)
import safe qualified Crypto.ECC.Ed25519.Sign as S
import safe qualified Crypto.ECC.Ed25519.Internal.Ed25519 as I
import safe qualified Data.ByteString as BS
newtype PublicKey = PublicKey { PublicKey -> ByteString
unPublicKey :: BS.ByteString
}
deriving (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> [Char]
(Int -> PublicKey -> ShowS)
-> (PublicKey -> [Char])
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> [Char]
show :: PublicKey -> [Char]
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show, Eq PublicKey
Eq PublicKey =>
(PublicKey -> PublicKey -> Ordering)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> PublicKey)
-> (PublicKey -> PublicKey -> PublicKey)
-> Ord PublicKey
PublicKey -> PublicKey -> Bool
PublicKey -> PublicKey -> Ordering
PublicKey -> PublicKey -> PublicKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PublicKey -> PublicKey -> Ordering
compare :: PublicKey -> PublicKey -> Ordering
$c< :: PublicKey -> PublicKey -> Bool
< :: PublicKey -> PublicKey -> Bool
$c<= :: PublicKey -> PublicKey -> Bool
<= :: PublicKey -> PublicKey -> Bool
$c> :: PublicKey -> PublicKey -> Bool
> :: PublicKey -> PublicKey -> Bool
$c>= :: PublicKey -> PublicKey -> Bool
>= :: PublicKey -> PublicKey -> Bool
$cmax :: PublicKey -> PublicKey -> PublicKey
max :: PublicKey -> PublicKey -> PublicKey
$cmin :: PublicKey -> PublicKey -> PublicKey
min :: PublicKey -> PublicKey -> PublicKey
Ord, (forall x. PublicKey -> Rep PublicKey x)
-> (forall x. Rep PublicKey x -> PublicKey) -> Generic PublicKey
forall x. Rep PublicKey x -> PublicKey
forall x. PublicKey -> Rep PublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PublicKey -> Rep PublicKey x
from :: forall x. PublicKey -> Rep PublicKey x
$cto :: forall x. Rep PublicKey x -> PublicKey
to :: forall x. Rep PublicKey x -> PublicKey
Generic)
newtype SecretKey = SecretKey { SecretKey -> ByteString
unSecretKey :: BS.ByteString
}
deriving (SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> [Char]
(Int -> SecretKey -> ShowS)
-> (SecretKey -> [Char])
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> [Char]
show :: SecretKey -> [Char]
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show, Eq SecretKey
Eq SecretKey =>
(SecretKey -> SecretKey -> Ordering)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> SecretKey)
-> (SecretKey -> SecretKey -> SecretKey)
-> Ord SecretKey
SecretKey -> SecretKey -> Bool
SecretKey -> SecretKey -> Ordering
SecretKey -> SecretKey -> SecretKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SecretKey -> SecretKey -> Ordering
compare :: SecretKey -> SecretKey -> Ordering
$c< :: SecretKey -> SecretKey -> Bool
< :: SecretKey -> SecretKey -> Bool
$c<= :: SecretKey -> SecretKey -> Bool
<= :: SecretKey -> SecretKey -> Bool
$c> :: SecretKey -> SecretKey -> Bool
> :: SecretKey -> SecretKey -> Bool
$c>= :: SecretKey -> SecretKey -> Bool
>= :: SecretKey -> SecretKey -> Bool
$cmax :: SecretKey -> SecretKey -> SecretKey
max :: SecretKey -> SecretKey -> SecretKey
$cmin :: SecretKey -> SecretKey -> SecretKey
min :: SecretKey -> SecretKey -> SecretKey
Ord, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecretKey -> Rep SecretKey x
from :: forall x. SecretKey -> Rep SecretKey x
$cto :: forall x. Rep SecretKey x -> SecretKey
to :: forall x. Rep SecretKey x -> SecretKey
Generic)
createKeypair :: IO (PublicKey, SecretKey)
createKeypair :: IO (PublicKey, SecretKey)
createKeypair = do
Either [Char] (SecKey, ByteString)
a <- IO (Either [Char] (SecKey, ByteString))
S.genkeys
case Either [Char] (SecKey, ByteString)
a of
Right (I.SecKeyBytes ByteString
sk, ByteString
pk) -> (PublicKey, SecretKey) -> IO (PublicKey, SecretKey)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> PublicKey
PublicKey ByteString
pk, ByteString -> SecretKey
SecretKey ByteString
sk)
Left [Char]
e -> [Char] -> IO (PublicKey, SecretKey)
forall a. HasCallStack => [Char] -> a
error [Char]
e
createKeypairFromSeed_ :: BS.ByteString -> Maybe (PublicKey, SecretKey)
createKeypairFromSeed_ :: ByteString -> Maybe (PublicKey, SecretKey)
createKeypairFromSeed_ = ByteString -> Maybe (PublicKey, SecretKey)
forall a. HasCallStack => a
undefined
createKeypairFromSeed :: BS.ByteString -> (PublicKey, SecretKey)
createKeypairFromSeed :: ByteString -> (PublicKey, SecretKey)
createKeypairFromSeed = ByteString -> (PublicKey, SecretKey)
forall a. HasCallStack => a
undefined
toPublicKey :: SecretKey -> PublicKey
toPublicKey :: SecretKey -> PublicKey
toPublicKey SecretKey
sk = let (SecretKey ByteString
sk') = SecretKey
sk
sk'' :: SecKey
sk'' = ByteString -> SecKey
I.SecKeyBytes ByteString
sk'
a :: Either [Char] ByteString
a = SecKey -> Either [Char] ByteString
S.publickey SecKey
sk''
in case Either [Char] ByteString
a of
Right ByteString
pk -> ByteString -> PublicKey
PublicKey ByteString
pk
Left [Char]
e -> [Char] -> PublicKey
forall a. HasCallStack => [Char] -> a
error [Char]
e
sign :: SecretKey -> BS.ByteString -> BS.ByteString
sign :: SecretKey -> ByteString -> ByteString
sign SecretKey
sk ByteString
m = let SecretKey ByteString
sk' = SecretKey
sk
a :: Either [Char] ByteString
a = SecKey -> ByteString -> Either [Char] ByteString
S.sign (ByteString -> SecKey
I.SecKeyBytes ByteString
sk') ByteString
m
in case Either [Char] ByteString
a of
Right ByteString
sigm -> ByteString
sigm
Left [Char]
e -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
e
verify :: PublicKey -> BS.ByteString -> Bool
verify :: PublicKey -> ByteString -> Bool
verify PublicKey
pk ByteString
m = let PublicKey ByteString
pk' = PublicKey
pk
in ByteString -> ByteString -> VerifyResult
S.verify ByteString
pk' ByteString
m VerifyResult -> VerifyResult -> Bool
forall a. Eq a => a -> a -> Bool
== SigOK -> VerifyResult
forall a b. b -> Either a b
Right SigOK
I.SigOK
newtype Signature = Signature { Signature -> ByteString
unSignature :: BS.ByteString
}
deriving (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> [Char]
(Int -> Signature -> ShowS)
-> (Signature -> [Char])
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> [Char]
show :: Signature -> [Char]
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, Eq Signature
Eq Signature =>
(Signature -> Signature -> Ordering)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool)
-> (Signature -> Signature -> Signature)
-> (Signature -> Signature -> Signature)
-> Ord Signature
Signature -> Signature -> Bool
Signature -> Signature -> Ordering
Signature -> Signature -> Signature
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Signature -> Signature -> Ordering
compare :: Signature -> Signature -> Ordering
$c< :: Signature -> Signature -> Bool
< :: Signature -> Signature -> Bool
$c<= :: Signature -> Signature -> Bool
<= :: Signature -> Signature -> Bool
$c> :: Signature -> Signature -> Bool
> :: Signature -> Signature -> Bool
$c>= :: Signature -> Signature -> Bool
>= :: Signature -> Signature -> Bool
$cmax :: Signature -> Signature -> Signature
max :: Signature -> Signature -> Signature
$cmin :: Signature -> Signature -> Signature
min :: Signature -> Signature -> Signature
Ord)
dsign :: SecretKey -> BS.ByteString -> Signature
dsign :: SecretKey -> ByteString -> Signature
dsign SecretKey
sk ByteString
m = let SecretKey ByteString
sk' = SecretKey
sk
a :: Either [Char] ByteString
a = SecKey -> ByteString -> Either [Char] ByteString
S.dsign (ByteString -> SecKey
I.SecKeyBytes ByteString
sk') ByteString
m
in case Either [Char] ByteString
a of
Right ByteString
sig -> ByteString -> Signature
Signature ByteString
sig
Left [Char]
e -> [Char] -> Signature
forall a. HasCallStack => [Char] -> a
error [Char]
e
dverify :: PublicKey -> BS.ByteString -> Signature -> Bool
dverify :: PublicKey -> ByteString -> Signature -> Bool
dverify PublicKey
pk ByteString
m Signature
sig = let PublicKey ByteString
pk' = PublicKey
pk
Signature ByteString
sig' = Signature
sig
in ByteString -> ByteString -> ByteString -> VerifyResult
S.dverify ByteString
pk' ByteString
sig' ByteString
m VerifyResult -> VerifyResult -> Bool
forall a. Eq a => a -> a -> Bool
== SigOK -> VerifyResult
forall a b. b -> Either a b
Right SigOK
I.SigOK
sign' :: SecretKey -> BS.ByteString -> Signature
sign' :: SecretKey -> ByteString -> Signature
sign' SecretKey
sk ByteString
m = SecretKey -> ByteString -> Signature
dsign SecretKey
sk ByteString
m
verify' :: PublicKey -> BS.ByteString -> Signature -> Bool
verify' :: PublicKey -> ByteString -> Signature -> Bool
verify' PublicKey
pk ByteString
m Signature
sig = PublicKey -> ByteString -> Signature -> Bool
dverify PublicKey
pk ByteString
m Signature
sig