{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Crypto.WebAuthn.Cose.PublicKey
(
UncheckedPublicKey (..),
checkPublicKey,
PublicKey (PublicKey),
EdDSAKeyBytes (..),
CoseCurveEdDSA (..),
coordinateSizeEdDSA,
CoseCurveECDSA (..),
toCryptCurveECDSA,
fromCryptCurveECDSA,
coordinateSizeECDSA,
)
where
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Ed25519 as Ed25519
import Crypto.WebAuthn.Internal.ToJSONOrphans (PrettyHexByteString (PrettyHexByteString))
import Data.Aeson (ToJSON)
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
newtype EdDSAKeyBytes = EdDSAKeyBytes {EdDSAKeyBytes -> ByteString
unEdDSAKeyBytes :: BS.ByteString}
deriving newtype (EdDSAKeyBytes -> EdDSAKeyBytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EdDSAKeyBytes -> EdDSAKeyBytes -> Bool
$c/= :: EdDSAKeyBytes -> EdDSAKeyBytes -> Bool
== :: EdDSAKeyBytes -> EdDSAKeyBytes -> Bool
$c== :: EdDSAKeyBytes -> EdDSAKeyBytes -> Bool
Eq)
deriving (Int -> EdDSAKeyBytes -> ShowS
[EdDSAKeyBytes] -> ShowS
EdDSAKeyBytes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EdDSAKeyBytes] -> ShowS
$cshowList :: [EdDSAKeyBytes] -> ShowS
show :: EdDSAKeyBytes -> String
$cshow :: EdDSAKeyBytes -> String
showsPrec :: Int -> EdDSAKeyBytes -> ShowS
$cshowsPrec :: Int -> EdDSAKeyBytes -> ShowS
Show, [EdDSAKeyBytes] -> Encoding
[EdDSAKeyBytes] -> Value
EdDSAKeyBytes -> Encoding
EdDSAKeyBytes -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EdDSAKeyBytes] -> Encoding
$ctoEncodingList :: [EdDSAKeyBytes] -> Encoding
toJSONList :: [EdDSAKeyBytes] -> Value
$ctoJSONList :: [EdDSAKeyBytes] -> Value
toEncoding :: EdDSAKeyBytes -> Encoding
$ctoEncoding :: EdDSAKeyBytes -> Encoding
toJSON :: EdDSAKeyBytes -> Value
$ctoJSON :: EdDSAKeyBytes -> Value
ToJSON) via PrettyHexByteString
data UncheckedPublicKey
=
PublicKeyEdDSA
{
UncheckedPublicKey -> CoseCurveEdDSA
eddsaCurve :: CoseCurveEdDSA,
UncheckedPublicKey -> EdDSAKeyBytes
eddsaX :: EdDSAKeyBytes
}
|
PublicKeyECDSA
{
UncheckedPublicKey -> CoseCurveECDSA
ecdsaCurve :: CoseCurveECDSA,
UncheckedPublicKey -> Integer
ecdsaX :: Integer,
UncheckedPublicKey -> Integer
ecdsaY :: Integer
}
|
PublicKeyRSA
{
UncheckedPublicKey -> Integer
rsaN :: Integer,
UncheckedPublicKey -> Integer
rsaE :: Integer
}
deriving (UncheckedPublicKey -> UncheckedPublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UncheckedPublicKey -> UncheckedPublicKey -> Bool
$c/= :: UncheckedPublicKey -> UncheckedPublicKey -> Bool
== :: UncheckedPublicKey -> UncheckedPublicKey -> Bool
$c== :: UncheckedPublicKey -> UncheckedPublicKey -> Bool
Eq, Int -> UncheckedPublicKey -> ShowS
[UncheckedPublicKey] -> ShowS
UncheckedPublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UncheckedPublicKey] -> ShowS
$cshowList :: [UncheckedPublicKey] -> ShowS
show :: UncheckedPublicKey -> String
$cshow :: UncheckedPublicKey -> String
showsPrec :: Int -> UncheckedPublicKey -> ShowS
$cshowsPrec :: Int -> UncheckedPublicKey -> ShowS
Show, forall x. Rep UncheckedPublicKey x -> UncheckedPublicKey
forall x. UncheckedPublicKey -> Rep UncheckedPublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UncheckedPublicKey x -> UncheckedPublicKey
$cfrom :: forall x. UncheckedPublicKey -> Rep UncheckedPublicKey x
Generic)
deriving instance ToJSON UncheckedPublicKey
newtype PublicKey = CheckedPublicKey UncheckedPublicKey
deriving newtype (PublicKey -> PublicKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c== :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKey] -> ShowS
$cshowList :: [PublicKey] -> ShowS
show :: PublicKey -> String
$cshow :: PublicKey -> String
showsPrec :: Int -> PublicKey -> ShowS
$cshowsPrec :: Int -> PublicKey -> ShowS
Show)
deriving newtype instance ToJSON PublicKey
pattern PublicKey :: UncheckedPublicKey -> PublicKey
pattern $mPublicKey :: forall {r}.
PublicKey -> (UncheckedPublicKey -> r) -> ((# #) -> r) -> r
PublicKey k <- CheckedPublicKey k
{-# COMPLETE PublicKey #-}
checkPublicKey :: UncheckedPublicKey -> Either Text PublicKey
checkPublicKey :: UncheckedPublicKey -> Either Text PublicKey
checkPublicKey key :: UncheckedPublicKey
key@PublicKeyEdDSA {CoseCurveEdDSA
EdDSAKeyBytes
eddsaX :: EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
eddsaX :: UncheckedPublicKey -> EdDSAKeyBytes
eddsaCurve :: UncheckedPublicKey -> CoseCurveEdDSA
..}
| Int
actualSize forall a. Eq a => a -> a -> Bool
== Int
expectedSize = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ UncheckedPublicKey -> PublicKey
CheckedPublicKey UncheckedPublicKey
key
| Bool
otherwise =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
Text
"EdDSA public key for curve "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CoseCurveEdDSA
eddsaCurve)
forall a. Semigroup a => a -> a -> a
<> Text
" didn't have the expected size of "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Int
expectedSize)
forall a. Semigroup a => a -> a -> a
<> Text
" bytes, it has "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Int
actualSize)
forall a. Semigroup a => a -> a -> a
<> Text
" bytes instead: "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show EdDSAKeyBytes
eddsaX)
where
actualSize :: Int
actualSize = ByteString -> Int
BS.length forall a b. (a -> b) -> a -> b
$ EdDSAKeyBytes -> ByteString
unEdDSAKeyBytes EdDSAKeyBytes
eddsaX
expectedSize :: Int
expectedSize = CoseCurveEdDSA -> Int
coordinateSizeEdDSA CoseCurveEdDSA
eddsaCurve
checkPublicKey key :: UncheckedPublicKey
key@PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaY :: UncheckedPublicKey -> Integer
ecdsaX :: UncheckedPublicKey -> Integer
ecdsaCurve :: UncheckedPublicKey -> CoseCurveECDSA
..}
| Curve -> Point -> Bool
ECC.isPointValid Curve
curve Point
point = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ UncheckedPublicKey -> PublicKey
CheckedPublicKey UncheckedPublicKey
key
| Bool
otherwise =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
Text
"ECDSA public key point is not valid for curve "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CoseCurveECDSA
ecdsaCurve)
forall a. Semigroup a => a -> a -> a
<> Text
": "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Point
point)
where
curve :: Curve
curve = CurveName -> Curve
ECC.getCurveByName (CoseCurveECDSA -> CurveName
toCryptCurveECDSA CoseCurveECDSA
ecdsaCurve)
point :: Point
point = Integer -> Integer -> Point
ECC.Point Integer
ecdsaX Integer
ecdsaY
checkPublicKey UncheckedPublicKey
key = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ UncheckedPublicKey -> PublicKey
CheckedPublicKey UncheckedPublicKey
key
data CoseCurveEdDSA
=
CoseCurveEd25519
deriving (CoseCurveEdDSA -> CoseCurveEdDSA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseCurveEdDSA -> CoseCurveEdDSA -> Bool
$c/= :: CoseCurveEdDSA -> CoseCurveEdDSA -> Bool
== :: CoseCurveEdDSA -> CoseCurveEdDSA -> Bool
$c== :: CoseCurveEdDSA -> CoseCurveEdDSA -> Bool
Eq, Int -> CoseCurveEdDSA -> ShowS
[CoseCurveEdDSA] -> ShowS
CoseCurveEdDSA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseCurveEdDSA] -> ShowS
$cshowList :: [CoseCurveEdDSA] -> ShowS
show :: CoseCurveEdDSA -> String
$cshow :: CoseCurveEdDSA -> String
showsPrec :: Int -> CoseCurveEdDSA -> ShowS
$cshowsPrec :: Int -> CoseCurveEdDSA -> ShowS
Show, Int -> CoseCurveEdDSA
CoseCurveEdDSA -> Int
CoseCurveEdDSA -> [CoseCurveEdDSA]
CoseCurveEdDSA -> CoseCurveEdDSA
CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
CoseCurveEdDSA
-> CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseCurveEdDSA
-> CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
$cenumFromThenTo :: CoseCurveEdDSA
-> CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
enumFromTo :: CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
$cenumFromTo :: CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
enumFromThen :: CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
$cenumFromThen :: CoseCurveEdDSA -> CoseCurveEdDSA -> [CoseCurveEdDSA]
enumFrom :: CoseCurveEdDSA -> [CoseCurveEdDSA]
$cenumFrom :: CoseCurveEdDSA -> [CoseCurveEdDSA]
fromEnum :: CoseCurveEdDSA -> Int
$cfromEnum :: CoseCurveEdDSA -> Int
toEnum :: Int -> CoseCurveEdDSA
$ctoEnum :: Int -> CoseCurveEdDSA
pred :: CoseCurveEdDSA -> CoseCurveEdDSA
$cpred :: CoseCurveEdDSA -> CoseCurveEdDSA
succ :: CoseCurveEdDSA -> CoseCurveEdDSA
$csucc :: CoseCurveEdDSA -> CoseCurveEdDSA
Enum, CoseCurveEdDSA
forall a. a -> a -> Bounded a
maxBound :: CoseCurveEdDSA
$cmaxBound :: CoseCurveEdDSA
minBound :: CoseCurveEdDSA
$cminBound :: CoseCurveEdDSA
Bounded, forall x. Rep CoseCurveEdDSA x -> CoseCurveEdDSA
forall x. CoseCurveEdDSA -> Rep CoseCurveEdDSA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoseCurveEdDSA x -> CoseCurveEdDSA
$cfrom :: forall x. CoseCurveEdDSA -> Rep CoseCurveEdDSA x
Generic)
deriving instance ToJSON CoseCurveEdDSA
coordinateSizeEdDSA :: CoseCurveEdDSA -> Int
coordinateSizeEdDSA :: CoseCurveEdDSA -> Int
coordinateSizeEdDSA CoseCurveEdDSA
CoseCurveEd25519 = Int
Ed25519.publicKeySize
data CoseCurveECDSA
=
CoseCurveP256
|
CoseCurveP384
|
CoseCurveP521
deriving (CoseCurveECDSA -> CoseCurveECDSA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseCurveECDSA -> CoseCurveECDSA -> Bool
$c/= :: CoseCurveECDSA -> CoseCurveECDSA -> Bool
== :: CoseCurveECDSA -> CoseCurveECDSA -> Bool
$c== :: CoseCurveECDSA -> CoseCurveECDSA -> Bool
Eq, Int -> CoseCurveECDSA -> ShowS
[CoseCurveECDSA] -> ShowS
CoseCurveECDSA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseCurveECDSA] -> ShowS
$cshowList :: [CoseCurveECDSA] -> ShowS
show :: CoseCurveECDSA -> String
$cshow :: CoseCurveECDSA -> String
showsPrec :: Int -> CoseCurveECDSA -> ShowS
$cshowsPrec :: Int -> CoseCurveECDSA -> ShowS
Show, Int -> CoseCurveECDSA
CoseCurveECDSA -> Int
CoseCurveECDSA -> [CoseCurveECDSA]
CoseCurveECDSA -> CoseCurveECDSA
CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
CoseCurveECDSA
-> CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseCurveECDSA
-> CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
$cenumFromThenTo :: CoseCurveECDSA
-> CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
enumFromTo :: CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
$cenumFromTo :: CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
enumFromThen :: CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
$cenumFromThen :: CoseCurveECDSA -> CoseCurveECDSA -> [CoseCurveECDSA]
enumFrom :: CoseCurveECDSA -> [CoseCurveECDSA]
$cenumFrom :: CoseCurveECDSA -> [CoseCurveECDSA]
fromEnum :: CoseCurveECDSA -> Int
$cfromEnum :: CoseCurveECDSA -> Int
toEnum :: Int -> CoseCurveECDSA
$ctoEnum :: Int -> CoseCurveECDSA
pred :: CoseCurveECDSA -> CoseCurveECDSA
$cpred :: CoseCurveECDSA -> CoseCurveECDSA
succ :: CoseCurveECDSA -> CoseCurveECDSA
$csucc :: CoseCurveECDSA -> CoseCurveECDSA
Enum, CoseCurveECDSA
forall a. a -> a -> Bounded a
maxBound :: CoseCurveECDSA
$cmaxBound :: CoseCurveECDSA
minBound :: CoseCurveECDSA
$cminBound :: CoseCurveECDSA
Bounded, forall x. Rep CoseCurveECDSA x -> CoseCurveECDSA
forall x. CoseCurveECDSA -> Rep CoseCurveECDSA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoseCurveECDSA x -> CoseCurveECDSA
$cfrom :: forall x. CoseCurveECDSA -> Rep CoseCurveECDSA x
Generic)
deriving instance ToJSON CoseCurveECDSA
toCryptCurveECDSA :: CoseCurveECDSA -> ECC.CurveName
toCryptCurveECDSA :: CoseCurveECDSA -> CurveName
toCryptCurveECDSA CoseCurveECDSA
CoseCurveP256 = CurveName
ECC.SEC_p256r1
toCryptCurveECDSA CoseCurveECDSA
CoseCurveP384 = CurveName
ECC.SEC_p384r1
toCryptCurveECDSA CoseCurveECDSA
CoseCurveP521 = CurveName
ECC.SEC_p521r1
fromCryptCurveECDSA :: ECC.CurveName -> Either Text CoseCurveECDSA
fromCryptCurveECDSA :: CurveName -> Either Text CoseCurveECDSA
fromCryptCurveECDSA CurveName
ECC.SEC_p256r1 = forall a b. b -> Either a b
Right CoseCurveECDSA
CoseCurveP256
fromCryptCurveECDSA CurveName
ECC.SEC_p384r1 = forall a b. b -> Either a b
Right CoseCurveECDSA
CoseCurveP384
fromCryptCurveECDSA CurveName
ECC.SEC_p521r1 = forall a b. b -> Either a b
Right CoseCurveECDSA
CoseCurveP521
fromCryptCurveECDSA CurveName
curve =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
Text
"Curve "
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CurveName
curve)
forall a. Semigroup a => a -> a -> a
<> Text
" is not a supported COSE ECDSA public key curve"
coordinateSizeECDSA :: CoseCurveECDSA -> Int
coordinateSizeECDSA :: CoseCurveECDSA -> Int
coordinateSizeECDSA CoseCurveECDSA
curve = Int
byteSize
where
bitSize :: Int
bitSize = Curve -> Int
ECC.curveSizeBits (CurveName -> Curve
ECC.getCurveByName (CoseCurveECDSA -> CurveName
toCryptCurveECDSA CoseCurveECDSA
curve))
byteSize :: Int
byteSize = (Int
bitSize forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8