-- Copyright (C) 2013-2018  Fraser Tweedale
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

{-|

Cryptographic Algorithms for Keys.

-}
module Crypto.JOSE.JWA.JWK (
  -- * Type classes
    AsPublicKey(..)

  -- * Parameters for Elliptic Curve Keys
  , Crv(..)
  , ECKeyParameters
  , ecCrv, ecX, ecY, ecD
  , curve
  , point
  , ecPrivateKey
  , ecParametersFromX509
  , genEC

  -- * Parameters for RSA Keys
  , RSAPrivateKeyOthElem(..)
  , RSAPrivateKeyOptionalParameters(..)
  , RSAPrivateKeyParameters(..)
  , RSAKeyParameters(RSAKeyParameters)
  , toRSAKeyParameters
  , toRSAPublicKeyParameters
  , rsaE
  , rsaN
  , rsaPrivateKeyParameters
  , rsaPublicKey
  , genRSA

  -- * Parameters for Symmetric Keys
  , OctKeyParameters(..)
  , octK

  -- * Parameters for CFRG EC keys (RFC 8037)
  , OKPKeyParameters(..)
  , OKPCrv(..)
  , genOKP

  -- * Key generation
  , KeyMaterialGenParam(..)
  , KeyMaterial(..)
  , genKeyMaterial

  -- * Signing and verification
  , sign
  , verify

  , module Crypto.Random
  ) where

import Control.Monad (guard)
import Control.Monad.Except (MonadError)
import Data.Bifunctor
import Data.Foldable (toList)
import Data.Maybe (isJust)
import Data.Monoid ((<>))

import Control.Lens hiding ((.=), elements)
import Control.Monad.Error.Lens (throwing, throwing_)
import Crypto.Error (onCryptoFailure)
import Crypto.Hash
import Crypto.MAC.HMAC
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECC
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15
import qualified Crypto.PubKey.RSA.PSS as PSS
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.Curve25519 as Curve25519
import qualified Crypto.PubKey.Curve448 as Curve448
import Crypto.Random
import Data.Aeson
import qualified Data.Aeson.KeyMap as M
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Text as T
import Data.X509 as X509
import Data.X509.EC as X509.EC

import Crypto.JOSE.Error
import qualified Crypto.JOSE.JWA.JWS as JWA.JWS
import qualified Crypto.JOSE.TH
import qualified Crypto.JOSE.Types as Types
import qualified Crypto.JOSE.Types.Internal as Types


-- | \"crv\" (Curve) Parameter
--
$(Crypto.JOSE.TH.deriveJOSEType "Crv" ["P-256", "P-384", "P-521", "secp256k1"])


-- | \"oth\" (Other Primes Info) Parameter
--
data RSAPrivateKeyOthElem = RSAPrivateKeyOthElem {
  RSAPrivateKeyOthElem -> Base64Integer
rOth :: Types.Base64Integer,
  RSAPrivateKeyOthElem -> Base64Integer
dOth :: Types.Base64Integer,
  RSAPrivateKeyOthElem -> Base64Integer
tOth :: Types.Base64Integer
  }
  deriving (RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
$c/= :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
== :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
$c== :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
Eq, Int -> RSAPrivateKeyOthElem -> ShowS
[RSAPrivateKeyOthElem] -> ShowS
RSAPrivateKeyOthElem -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RSAPrivateKeyOthElem] -> ShowS
$cshowList :: [RSAPrivateKeyOthElem] -> ShowS
show :: RSAPrivateKeyOthElem -> [Char]
$cshow :: RSAPrivateKeyOthElem -> [Char]
showsPrec :: Int -> RSAPrivateKeyOthElem -> ShowS
$cshowsPrec :: Int -> RSAPrivateKeyOthElem -> ShowS
Show)

instance FromJSON RSAPrivateKeyOthElem where
  parseJSON :: Value -> Parser RSAPrivateKeyOthElem
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"oth" (\Object
o -> Base64Integer
-> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem
RSAPrivateKeyOthElem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"r" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"t")

instance ToJSON RSAPrivateKeyOthElem where
  toJSON :: RSAPrivateKeyOthElem -> Value
toJSON (RSAPrivateKeyOthElem Base64Integer
r Base64Integer
d Base64Integer
t) = [Pair] -> Value
object [Key
"r" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
r, Key
"d" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
d, Key
"t" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
t]


-- | Optional parameters for RSA private keys
--
data RSAPrivateKeyOptionalParameters = RSAPrivateKeyOptionalParameters {
  RSAPrivateKeyOptionalParameters -> Base64Integer
rsaP :: Types.Base64Integer
  , RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQ :: Types.Base64Integer
  , RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDp :: Types.Base64Integer
  , RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDq :: Types.Base64Integer
  , RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQi :: Types.Base64Integer
  , RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaOth :: Maybe (NonEmpty RSAPrivateKeyOthElem)
  }
  deriving (RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
$c/= :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
== :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
$c== :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
Eq, Int -> RSAPrivateKeyOptionalParameters -> ShowS
[RSAPrivateKeyOptionalParameters] -> ShowS
RSAPrivateKeyOptionalParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RSAPrivateKeyOptionalParameters] -> ShowS
$cshowList :: [RSAPrivateKeyOptionalParameters] -> ShowS
show :: RSAPrivateKeyOptionalParameters -> [Char]
$cshow :: RSAPrivateKeyOptionalParameters -> [Char]
showsPrec :: Int -> RSAPrivateKeyOptionalParameters -> ShowS
$cshowsPrec :: Int -> RSAPrivateKeyOptionalParameters -> ShowS
Show)

instance FromJSON RSAPrivateKeyOptionalParameters where
  parseJSON :: Value -> Parser RSAPrivateKeyOptionalParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RSA" (\Object
o -> Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
-> RSAPrivateKeyOptionalParameters
RSAPrivateKeyOptionalParameters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"p" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"q" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dp" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"dq" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qi" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"oth")

instance ToJSON RSAPrivateKeyOptionalParameters where
  toJSON :: RSAPrivateKeyOptionalParameters -> Value
toJSON RSAPrivateKeyOptionalParameters{Maybe (NonEmpty RSAPrivateKeyOthElem)
Base64Integer
rsaOth :: Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaQi :: Base64Integer
rsaDq :: Base64Integer
rsaDp :: Base64Integer
rsaQ :: Base64Integer
rsaP :: Base64Integer
rsaOth :: RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaQi :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDq :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDp :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQ :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaP :: RSAPrivateKeyOptionalParameters -> Base64Integer
..} = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ [
    Key
"p" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaP
    , Key
"q" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaQ
    , Key
"dp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaDp
    , Key
"dq" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaDq
    , Key
"qi" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaQi
    ] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"oth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaOth


-- | RSA private key parameters
--
data RSAPrivateKeyParameters = RSAPrivateKeyParameters
  { RSAPrivateKeyParameters -> Base64Integer
rsaD :: Types.Base64Integer
  , RSAPrivateKeyParameters -> Maybe RSAPrivateKeyOptionalParameters
rsaOptionalParameters :: Maybe RSAPrivateKeyOptionalParameters
  }
  deriving (RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
$c/= :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
== :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
$c== :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
Eq, Int -> RSAPrivateKeyParameters -> ShowS
[RSAPrivateKeyParameters] -> ShowS
RSAPrivateKeyParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RSAPrivateKeyParameters] -> ShowS
$cshowList :: [RSAPrivateKeyParameters] -> ShowS
show :: RSAPrivateKeyParameters -> [Char]
$cshow :: RSAPrivateKeyParameters -> [Char]
showsPrec :: Int -> RSAPrivateKeyParameters -> ShowS
$cshowsPrec :: Int -> RSAPrivateKeyParameters -> ShowS
Show)

instance FromJSON RSAPrivateKeyParameters where
  parseJSON :: Value -> Parser RSAPrivateKeyParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RSA private key parameters" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Base64Integer
-> Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters
RSAPrivateKeyParameters
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Key -> KeyMap a -> Bool
`M.member` Object
o) [Key
"p", Key
"q", Key
"dp", Key
"dq", Key
"qi", Key
"oth"]
      then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)

instance ToJSON RSAPrivateKeyParameters where
  toJSON :: RSAPrivateKeyParameters -> Value
toJSON RSAPrivateKeyParameters {Maybe RSAPrivateKeyOptionalParameters
Base64Integer
rsaOptionalParameters :: Maybe RSAPrivateKeyOptionalParameters
rsaD :: Base64Integer
rsaOptionalParameters :: RSAPrivateKeyParameters -> Maybe RSAPrivateKeyOptionalParameters
rsaD :: RSAPrivateKeyParameters -> Base64Integer
..} =
    forall v. ToJSON v => Key -> v -> Value -> Value
Types.insertToObject Key
"d" Base64Integer
rsaD
      forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object forall a. Monoid a => a
mempty) forall a. ToJSON a => a -> Value
toJSON Maybe RSAPrivateKeyOptionalParameters
rsaOptionalParameters


-- | Parameters for Elliptic Curve Keys
--
data ECKeyParameters = ECKeyParameters
  { ECKeyParameters -> Crv
_ecCrv :: Crv
  , ECKeyParameters -> SizedBase64Integer
_ecX :: Types.SizedBase64Integer
  , ECKeyParameters -> SizedBase64Integer
_ecY :: Types.SizedBase64Integer
  , ECKeyParameters -> Maybe SizedBase64Integer
_ecD :: Maybe Types.SizedBase64Integer
  }
  deriving (ECKeyParameters -> ECKeyParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECKeyParameters -> ECKeyParameters -> Bool
$c/= :: ECKeyParameters -> ECKeyParameters -> Bool
== :: ECKeyParameters -> ECKeyParameters -> Bool
$c== :: ECKeyParameters -> ECKeyParameters -> Bool
Eq, Int -> ECKeyParameters -> ShowS
[ECKeyParameters] -> ShowS
ECKeyParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ECKeyParameters] -> ShowS
$cshowList :: [ECKeyParameters] -> ShowS
show :: ECKeyParameters -> [Char]
$cshow :: ECKeyParameters -> [Char]
showsPrec :: Int -> ECKeyParameters -> ShowS
$cshowsPrec :: Int -> ECKeyParameters -> ShowS
Show)

ecCrv :: Getter ECKeyParameters Crv
ecCrv :: Getter ECKeyParameters Crv
ecCrv = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(ECKeyParameters Crv
crv SizedBase64Integer
_ SizedBase64Integer
_ Maybe SizedBase64Integer
_) -> Crv
crv)

ecX, ecY :: Getter ECKeyParameters Types.SizedBase64Integer
ecX :: Getter ECKeyParameters SizedBase64Integer
ecX = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(ECKeyParameters Crv
_ SizedBase64Integer
x SizedBase64Integer
_ Maybe SizedBase64Integer
_) -> SizedBase64Integer
x)
ecY :: Getter ECKeyParameters SizedBase64Integer
ecY = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(ECKeyParameters Crv
_ SizedBase64Integer
_ SizedBase64Integer
y Maybe SizedBase64Integer
_) -> SizedBase64Integer
y)

ecD :: Getter ECKeyParameters (Maybe Types.SizedBase64Integer)
ecD :: Getter ECKeyParameters (Maybe SizedBase64Integer)
ecD = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(ECKeyParameters Crv
_ SizedBase64Integer
_ SizedBase64Integer
_ Maybe SizedBase64Integer
d) -> Maybe SizedBase64Integer
d)

instance FromJSON ECKeyParameters where
  parseJSON :: Value -> Parser ECKeyParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"EC" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== (Text
"EC" :: T.Text))
    Crv
crv <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"crv"
    let w :: a
w = forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv
    SizedBase64Integer
x <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize forall {a}. Integral a => a
w
    SizedBase64Integer
y <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize forall {a}. Integral a => a
w
    let int :: SizedBase64Integer -> Integer
int (Types.SizedBase64Integer Int
_ Integer
n) = Integer
n
    if Curve -> Point -> Bool
ECC.isPointValid (Crv -> Curve
curve Crv
crv) (Integer -> Integer -> Point
ECC.Point (SizedBase64Integer -> Integer
int SizedBase64Integer
x) (SizedBase64Integer -> Integer
int SizedBase64Integer
y))
      then Crv
-> SizedBase64Integer
-> SizedBase64Integer
-> Maybe SizedBase64Integer
-> ECKeyParameters
ECKeyParameters Crv
crv SizedBase64Integer
x SizedBase64Integer
y
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize forall {a}. Integral a => a
w))
      else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"point is not on specified curve"

instance ToJSON ECKeyParameters where
  toJSON :: ECKeyParameters -> Value
toJSON ECKeyParameters
k = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
    [ Key
"kty" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"EC" :: T.Text)
    , Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k
    , Key
"x" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters SizedBase64Integer
ecX ECKeyParameters
k
    , Key
"y" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters SizedBase64Integer
ecY ECKeyParameters
k
    ] forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"d" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters (Maybe SizedBase64Integer)
ecD ECKeyParameters
k))

genEC :: MonadRandom m => Crv -> m ECKeyParameters
genEC :: forall (m :: * -> *). MonadRandom m => Crv -> m ECKeyParameters
genEC Crv
crv = do
  let i :: Integer -> SizedBase64Integer
i = Int -> Integer -> SizedBase64Integer
Types.SizedBase64Integer (forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv)
  (ECDSA.PublicKey Curve
_ Point
p, ECDSA.PrivateKey Curve
_ Integer
d) <- forall (m :: * -> *).
MonadRandom m =>
Curve -> m (PublicKey, PrivateKey)
ECC.generate (Crv -> Curve
curve Crv
crv)
  case Point
p of
    ECC.Point Integer
x Integer
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Crv
-> SizedBase64Integer
-> SizedBase64Integer
-> Maybe SizedBase64Integer
-> ECKeyParameters
ECKeyParameters Crv
crv (Integer -> SizedBase64Integer
i Integer
x) (Integer -> SizedBase64Integer
i Integer
y) (forall a. a -> Maybe a
Just (Integer -> SizedBase64Integer
i Integer
d))
    Point
ECC.PointO -> forall (m :: * -> *). MonadRandom m => Crv -> m ECKeyParameters
genEC Crv
crv  -- JWK cannot represent point at infinity; recurse

signEC
  :: (BA.ByteArrayAccess msg, HashAlgorithm h,
      MonadRandom m, MonadError e m, AsError e)
  => h
  -> ECKeyParameters
  -> msg
  -> m B.ByteString
signEC :: forall msg h (m :: * -> *) e.
(ByteArrayAccess msg, HashAlgorithm h, MonadRandom m,
 MonadError e m, AsError e) =>
h -> ECKeyParameters -> msg -> m ByteString
signEC h
h ECKeyParameters
k msg
m = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters (Maybe SizedBase64Integer)
ecD ECKeyParameters
k of
  Just SizedBase64Integer
ecD' -> Signature -> ByteString
sigToBS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}. MonadRandom m => m Signature
sig where
    crv :: Crv
crv = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k
    w :: a
w = forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv
    sig :: m Signature
sig = forall msg hash (m :: * -> *).
(ByteArrayAccess msg, HashAlgorithm hash, MonadRandom m) =>
PrivateKey -> hash -> msg -> m Signature
ECDSA.sign PrivateKey
privateKey h
h msg
m
    sigToBS :: Signature -> ByteString
sigToBS (ECDSA.Signature Integer
r Integer
s) =
      forall a. Integral a => Int -> a -> ByteString
Types.sizedIntegerToBS forall {a}. Integral a => a
w Integer
r forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => Int -> a -> ByteString
Types.sizedIntegerToBS forall {a}. Integral a => a
w Integer
s
    privateKey :: PrivateKey
privateKey = Curve -> Integer -> PrivateKey
ECDSA.PrivateKey (Crv -> Curve
curve Crv
crv) (SizedBase64Integer -> Integer
d SizedBase64Integer
ecD')
    d :: SizedBase64Integer -> Integer
d (Types.SizedBase64Integer Int
_ Integer
n) = Integer
n
  Maybe SizedBase64Integer
Nothing -> forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not an EC private key"

verifyEC
  :: (BA.ByteArrayAccess msg, HashAlgorithm h)
  => h
  -> ECKeyParameters
  -> msg
  -> B.ByteString
  -> Bool
verifyEC :: forall msg h.
(ByteArrayAccess msg, HashAlgorithm h) =>
h -> ECKeyParameters -> msg -> ByteString -> Bool
verifyEC h
h ECKeyParameters
k msg
m ByteString
s = forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify h
h PublicKey
pubkey Signature
sig msg
m
  where
  pubkey :: PublicKey
pubkey = Curve -> Point -> PublicKey
ECDSA.PublicKey (Crv -> Curve
curve forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k) (ECKeyParameters -> Point
point ECKeyParameters
k)
  sig :: Signature
sig = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Signature
ECDSA.Signature
    forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> Integer
Types.bsToInteger ByteString -> Integer
Types.bsToInteger
    forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
s forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
s

curve :: Crv -> ECC.Curve
curve :: Crv -> Curve
curve = CurveName -> Curve
ECC.getCurveByName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Prism' CurveName Crv
fromCurveName

-- | Conversion from known curves and back again.
fromCurveName :: Prism' ECC.CurveName Crv
fromCurveName :: Prism' CurveName Crv
fromCurveName = forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism'
  (\case
    Crv
P_256 -> CurveName
ECC.SEC_p256r1
    Crv
P_384 -> CurveName
ECC.SEC_p384r1
    Crv
P_521 -> CurveName
ECC.SEC_p521r1
    Crv
Secp256k1 -> CurveName
ECC.SEC_p256k1)
  (\case
    CurveName
ECC.SEC_p256r1 -> forall a. a -> Maybe a
Just Crv
P_256
    CurveName
ECC.SEC_p384r1 -> forall a. a -> Maybe a
Just Crv
P_384
    CurveName
ECC.SEC_p521r1 -> forall a. a -> Maybe a
Just Crv
P_521
    CurveName
ECC.SEC_p256k1 -> forall a. a -> Maybe a
Just Crv
Secp256k1
    CurveName
_              -> forall a. Maybe a
Nothing)

point :: ECKeyParameters -> ECC.Point
point :: ECKeyParameters -> Point
point ECKeyParameters
k = Integer -> Integer -> Point
ECC.Point (Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> Integer
f Getter ECKeyParameters SizedBase64Integer
ecX) (Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> Integer
f Getter ECKeyParameters SizedBase64Integer
ecY) where
  f :: Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> Integer
f Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
l = case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
l ECKeyParameters
k of
    Types.SizedBase64Integer Int
_ Integer
n -> Integer
n

ecCoordBytes :: Integral a => Crv -> a
ecCoordBytes :: forall a. Integral a => Crv -> a
ecCoordBytes Crv
P_256 = a
32
ecCoordBytes Crv
P_384 = a
48
ecCoordBytes Crv
P_521 = a
66
ecCoordBytes Crv
Secp256k1 = a
32

ecPrivateKey :: (MonadError e m, AsError e) => ECKeyParameters -> m Integer
ecPrivateKey :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
ECKeyParameters -> m Integer
ecPrivateKey (ECKeyParameters Crv
_ SizedBase64Integer
_ SizedBase64Integer
_ (Just (Types.SizedBase64Integer Int
_ Integer
d))) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
d
ecPrivateKey ECKeyParameters
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Not an EC private key"

ecParametersFromX509 :: (MonadError e m, AsError e) => X509.PubKeyEC -> m ECKeyParameters
ecParametersFromX509 :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
PubKeyEC -> m ECKeyParameters
ecParametersFromX509 PubKeyEC
pubKeyEC = do
  Curve
ecCurve <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Invalid EC point") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PubKeyEC -> Maybe Curve
X509.EC.ecPubKeyCurve PubKeyEC
pubKeyEC
  CurveName
curveName <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Unknown curve") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PubKeyEC -> Maybe CurveName
X509.EC.ecPubKeyCurveName PubKeyEC
pubKeyEC
  Crv
crv <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Unsupported curve TODO ") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Prism' CurveName Crv
fromCurveName CurveName
curveName
  Point
pt <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Invalid EC point") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Curve -> SerializedPoint -> Maybe Point
X509.EC.unserializePoint Curve
ecCurve (PubKeyEC -> SerializedPoint
X509.pubkeyEC_pub PubKeyEC
pubKeyEC)
  (SizedBase64Integer
x, SizedBase64Integer
y) <- case Point
pt of
    Point
ECC.PointO    -> forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"Cannot use point at infinity"
    ECC.Point Integer
x Integer
y ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
x, Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
y)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Crv
-> SizedBase64Integer
-> SizedBase64Integer
-> Maybe SizedBase64Integer
-> ECKeyParameters
ECKeyParameters Crv
crv SizedBase64Integer
x SizedBase64Integer
y forall a. Maybe a
Nothing

-- | Parameters for RSA Keys
--
data RSAKeyParameters = RSAKeyParameters
  { RSAKeyParameters -> Base64Integer
_rsaN :: Types.Base64Integer
  , RSAKeyParameters -> Base64Integer
_rsaE :: Types.Base64Integer
  , RSAKeyParameters -> Maybe RSAPrivateKeyParameters
_rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters
  }
  deriving (RSAKeyParameters -> RSAKeyParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
$c/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
== :: RSAKeyParameters -> RSAKeyParameters -> Bool
$c== :: RSAKeyParameters -> RSAKeyParameters -> Bool
Eq, Int -> RSAKeyParameters -> ShowS
[RSAKeyParameters] -> ShowS
RSAKeyParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RSAKeyParameters] -> ShowS
$cshowList :: [RSAKeyParameters] -> ShowS
show :: RSAKeyParameters -> [Char]
$cshow :: RSAKeyParameters -> [Char]
showsPrec :: Int -> RSAKeyParameters -> ShowS
$cshowsPrec :: Int -> RSAKeyParameters -> ShowS
Show)
makeLenses ''RSAKeyParameters

instance FromJSON RSAKeyParameters where
  parseJSON :: Value -> Parser RSAKeyParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"RSA" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== (Text
"RSA" :: T.Text))
    Base64Integer
-> Base64Integer
-> Maybe RSAPrivateKeyParameters
-> RSAKeyParameters
RSAKeyParameters
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"e"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if forall a. Key -> KeyMap a -> Bool
M.member Key
"d" Object
o
        then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

instance ToJSON RSAKeyParameters where
  toJSON :: RSAKeyParameters -> Value
toJSON RSAKeyParameters {Maybe RSAPrivateKeyParameters
Base64Integer
_rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters
_rsaE :: Base64Integer
_rsaN :: Base64Integer
_rsaPrivateKeyParameters :: RSAKeyParameters -> Maybe RSAPrivateKeyParameters
_rsaE :: RSAKeyParameters -> Base64Integer
_rsaN :: RSAKeyParameters -> Base64Integer
..} =
    [Pair] -> Value -> Value
Types.insertManyToObject
      [ Key
"kty" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"RSA" :: T.Text)
      , Key
"n" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
_rsaN
      , Key
"e" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
_rsaE
      ]
      forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object forall a. Monoid a => a
mempty) forall a. ToJSON a => a -> Value
toJSON Maybe RSAPrivateKeyParameters
_rsaPrivateKeyParameters

genRSA :: MonadRandom m => Int -> m RSAKeyParameters
genRSA :: forall (m :: * -> *). MonadRandom m => Int -> m RSAKeyParameters
genRSA Int
size = PrivateKey -> RSAKeyParameters
toRSAKeyParameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadRandom m =>
Int -> Integer -> m (PublicKey, PrivateKey)
RSA.generate Int
size Integer
65537

toRSAKeyParameters :: RSA.PrivateKey -> RSAKeyParameters
toRSAKeyParameters :: PrivateKey -> RSAKeyParameters
toRSAKeyParameters priv :: PrivateKey
priv@(RSA.PrivateKey PublicKey
pub Integer
_ Integer
_ Integer
_ Integer
_ Integer
_ Integer
_) =
  PublicKey -> RSAKeyParameters
toRSAPublicKeyParameters PublicKey
pub
  forall a b. a -> (a -> b) -> b
& forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' RSAKeyParameters (Maybe RSAPrivateKeyParameters)
rsaPrivateKeyParameters (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PrivateKey -> RSAPrivateKeyParameters
toRSAPrivateKeyParameters PrivateKey
priv)

toRSAPublicKeyParameters :: RSA.PublicKey -> RSAKeyParameters
toRSAPublicKeyParameters :: PublicKey -> RSAKeyParameters
toRSAPublicKeyParameters (RSA.PublicKey Int
_ Integer
n Integer
e) =
  Base64Integer
-> Base64Integer
-> Maybe RSAPrivateKeyParameters
-> RSAKeyParameters
RSAKeyParameters (Integer -> Base64Integer
Types.Base64Integer Integer
n) (Integer -> Base64Integer
Types.Base64Integer Integer
e) forall a. Maybe a
Nothing

toRSAPrivateKeyParameters :: RSA.PrivateKey -> RSAPrivateKeyParameters
toRSAPrivateKeyParameters :: PrivateKey -> RSAPrivateKeyParameters
toRSAPrivateKeyParameters (RSA.PrivateKey PublicKey
_ Integer
d Integer
p Integer
q Integer
dp Integer
dq Integer
qi) =
  let i :: Integer -> Base64Integer
i = Integer -> Base64Integer
Types.Base64Integer
  in Base64Integer
-> Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters
RSAPrivateKeyParameters (Integer -> Base64Integer
i Integer
d)
      (forall a. a -> Maybe a
Just (Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
-> RSAPrivateKeyOptionalParameters
RSAPrivateKeyOptionalParameters (Integer -> Base64Integer
i Integer
p) (Integer -> Base64Integer
i Integer
q) (Integer -> Base64Integer
i Integer
dp) (Integer -> Base64Integer
i Integer
dq) (Integer -> Base64Integer
i Integer
qi) forall a. Maybe a
Nothing))

signPKCS15
  :: (PKCS15.HashAlgorithmASN1 h, MonadRandom m, MonadError e m, AsError e)
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> m B.ByteString
signPKCS15 :: forall h (m :: * -> *) e.
(HashAlgorithmASN1 h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPKCS15 h
h RSAKeyParameters
k ByteString
m = do
  PrivateKey
k' <- forall e (m :: * -> *).
(MonadError e m, AsError e) =>
RSAKeyParameters -> m PrivateKey
rsaPrivateKey RSAKeyParameters
k
  forall hashAlg (m :: * -> *).
(HashAlgorithmASN1 hashAlg, MonadRandom m) =>
Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
PKCS15.signSafer (forall a. a -> Maybe a
Just h
h) PrivateKey
k' ByteString
m
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Error
_RSAError) forall (f :: * -> *) a. Applicative f => a -> f a
pure

verifyPKCS15
  :: PKCS15.HashAlgorithmASN1 h
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> B.ByteString
  -> Bool
verifyPKCS15 :: forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 h
h RSAKeyParameters
k = forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
PKCS15.verify (forall a. a -> Maybe a
Just h
h) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k)

signPSS
  :: (HashAlgorithm h, MonadRandom m, MonadError e m, AsError e)
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> m B.ByteString
signPSS :: forall h (m :: * -> *) e.
(HashAlgorithm h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPSS h
h RSAKeyParameters
k ByteString
m = do
  PrivateKey
k' <- forall e (m :: * -> *).
(MonadError e m, AsError e) =>
RSAKeyParameters -> m PrivateKey
rsaPrivateKey RSAKeyParameters
k
  forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
PSS.signSafer (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
PSS.defaultPSSParams h
h) PrivateKey
k' ByteString
m
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Error
_RSAError) forall (f :: * -> *) a. Applicative f => a -> f a
pure

verifyPSS
  :: (HashAlgorithm h)
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> B.ByteString
  -> Bool
verifyPSS :: forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS h
h RSAKeyParameters
k = forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
PSS.verify (forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
PSS.defaultPSSParams h
h) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k)

rsaPrivateKey
  :: (MonadError e m, AsError e)
  => RSAKeyParameters -> m RSA.PrivateKey
rsaPrivateKey :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
RSAKeyParameters -> m PrivateKey
rsaPrivateKey (RSAKeyParameters
  (Types.Base64Integer Integer
n)
  (Types.Base64Integer Integer
e)
  (Just (RSAPrivateKeyParameters (Types.Base64Integer Integer
d) Maybe RSAPrivateKeyOptionalParameters
opt)))
  | forall a. Maybe a -> Bool
isJust (Maybe RSAPrivateKeyOptionalParameters
opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaOth) = forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ forall r. AsError r => Prism' r ()
_OtherPrimesNotSupported
  | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2040 :: Integer) = forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ forall r. AsError r => Prism' r ()
_KeySizeTooSmall
  | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    PublicKey
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> Integer
-> PrivateKey
RSA.PrivateKey (Int -> Integer -> Integer -> PublicKey
RSA.PublicKey (Integer -> Int
Types.intBytes Integer
n) Integer
n Integer
e) Integer
d
      ((RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
rsaP) ((RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQ) ((RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDp) ((RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDq) ((RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQi)
    where
      opt' :: (RSAPrivateKeyOptionalParameters -> Base64Integer) -> Integer
opt' RSAPrivateKeyOptionalParameters -> Base64Integer
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Base64Integer -> Integer
unB64I forall b c a. (b -> c) -> (a -> b) -> a -> c
. RSAPrivateKeyOptionalParameters -> Base64Integer
f) Maybe RSAPrivateKeyOptionalParameters
opt
      unB64I :: Base64Integer -> Integer
unB64I (Types.Base64Integer Integer
x) = Integer
x
rsaPrivateKey RSAKeyParameters
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not an RSA private key"

rsaPublicKey :: RSAKeyParameters -> RSA.PublicKey
rsaPublicKey :: RSAKeyParameters -> PublicKey
rsaPublicKey (RSAKeyParameters (Types.Base64Integer Integer
n) (Types.Base64Integer Integer
e) Maybe RSAPrivateKeyParameters
_)
  = Int -> Integer -> Integer -> PublicKey
RSA.PublicKey (Integer -> Int
Types.intBytes Integer
n) Integer
n Integer
e


-- | Symmetric key parameters data.
--
newtype OctKeyParameters = OctKeyParameters Types.Base64Octets
  deriving (OctKeyParameters -> OctKeyParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OctKeyParameters -> OctKeyParameters -> Bool
$c/= :: OctKeyParameters -> OctKeyParameters -> Bool
== :: OctKeyParameters -> OctKeyParameters -> Bool
$c== :: OctKeyParameters -> OctKeyParameters -> Bool
Eq, Int -> OctKeyParameters -> ShowS
[OctKeyParameters] -> ShowS
OctKeyParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OctKeyParameters] -> ShowS
$cshowList :: [OctKeyParameters] -> ShowS
show :: OctKeyParameters -> [Char]
$cshow :: OctKeyParameters -> [Char]
showsPrec :: Int -> OctKeyParameters -> ShowS
$cshowsPrec :: Int -> OctKeyParameters -> ShowS
Show)

octK :: Iso' OctKeyParameters Types.Base64Octets
octK :: Iso' OctKeyParameters Base64Octets
octK = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(OctKeyParameters Base64Octets
k) -> Base64Octets
k) Base64Octets -> OctKeyParameters
OctKeyParameters

instance FromJSON OctKeyParameters where
  parseJSON :: Value -> Parser OctKeyParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"symmetric key" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== (Text
"oct" :: T.Text))
    Base64Octets -> OctKeyParameters
OctKeyParameters forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"k"

instance ToJSON OctKeyParameters where
  toJSON :: OctKeyParameters -> Value
toJSON OctKeyParameters
k = [Pair] -> Value
object
    [ Key
"kty" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"oct" :: T.Text)
    , Key
"k" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Iso' OctKeyParameters Base64Octets
octK OctKeyParameters
k :: Types.Base64Octets)
    ]

signOct
  :: forall h e m. (HashAlgorithm h, MonadError e m, AsError e)
  => h
  -> OctKeyParameters
  -> B.ByteString
  -> m B.ByteString
signOct :: forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct h
h (OctKeyParameters (Types.Base64Octets ByteString
k)) ByteString
m =
  if ByteString -> Int
B.length ByteString
k forall a. Ord a => a -> a -> Bool
< forall a. HashAlgorithm a => a -> Int
hashDigestSize h
h
  then forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ forall r. AsError r => Prism' r ()
_KeySizeTooSmall
  else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
k ByteString
m :: HMAC h)


-- "OKP" (CFRG Octet Key Pair) keys (RFC 8037)
--
data OKPKeyParameters
  = Ed25519Key Ed25519.PublicKey (Maybe Ed25519.SecretKey)
  | Ed448Key Ed448.PublicKey (Maybe Ed448.SecretKey)
  | X25519Key Curve25519.PublicKey (Maybe Curve25519.SecretKey)
  | X448Key Curve448.PublicKey (Maybe Curve448.SecretKey)
  deriving (OKPKeyParameters -> OKPKeyParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
$c/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
== :: OKPKeyParameters -> OKPKeyParameters -> Bool
$c== :: OKPKeyParameters -> OKPKeyParameters -> Bool
Eq)

instance Show OKPKeyParameters where
  show :: OKPKeyParameters -> [Char]
show = \case
      Ed25519Key PublicKey
pk Maybe SecretKey
sk  -> [Char]
"Ed25519 " forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *} {b}.
(Show a, Show (f [Char]), Functor f) =>
a -> f b -> [Char]
showKeys PublicKey
pk Maybe SecretKey
sk
      Ed448Key PublicKey
pk Maybe SecretKey
sk  -> [Char]
"Ed448 " forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *} {b}.
(Show a, Show (f [Char]), Functor f) =>
a -> f b -> [Char]
showKeys PublicKey
pk Maybe SecretKey
sk
      X25519Key PublicKey
pk Maybe SecretKey
sk   -> [Char]
"X25519 " forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *} {b}.
(Show a, Show (f [Char]), Functor f) =>
a -> f b -> [Char]
showKeys PublicKey
pk Maybe SecretKey
sk
      X448Key PublicKey
pk Maybe SecretKey
sk   -> [Char]
"X448 " forall a. Semigroup a => a -> a -> a
<> forall {a} {f :: * -> *} {b}.
(Show a, Show (f [Char]), Functor f) =>
a -> f b -> [Char]
showKeys PublicKey
pk Maybe SecretKey
sk
    where
      showKeys :: a -> f b -> [Char]
showKeys a
pk f b
sk = forall a. Show a => a -> [Char]
show a
pk forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (([Char]
"SECRET" :: String) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
sk)

instance FromJSON OKPKeyParameters where
  parseJSON :: Value -> Parser OKPKeyParameters
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"OKP" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== (Text
"OKP" :: T.Text))
    Text
crv <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"crv"
    case (Text
crv :: T.Text) of
      Text
"Ed25519" -> forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey Object
o
      Text
"X25519"  -> forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve25519.publicKey forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve25519.secretKey Object
o
      Text
"Ed448"   -> forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed448.publicKey forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey Object
o
      Text
"X448"    -> forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve448.publicKey forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve448.secretKey Object
o
      Text
_         -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"unrecognised OKP key subtype"
    where
      bs :: Base64Octets -> ByteString
bs (Types.Base64Octets ByteString
k) = ByteString
k
      handleError :: CryptoFailable a -> m a
handleError = forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure
      parseOKPKey :: (a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey a -> Maybe b -> b
con ByteString -> CryptoFailable a
mkPub ByteString -> CryptoFailable b
mkSec Object
o = a -> Maybe b -> b
con
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {a}. MonadFail m => CryptoFailable a -> m a
handleError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable a
mkPub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> ByteString
bs)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {m :: * -> *} {a}. MonadFail m => CryptoFailable a -> m a
handleError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable b
mkSec forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> ByteString
bs))

instance ToJSON OKPKeyParameters where
  toJSON :: OKPKeyParameters -> Value
toJSON OKPKeyParameters
x = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
    Key
"kty" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"OKP" :: T.Text) forall a. a -> [a] -> [a]
: case OKPKeyParameters
x of
      Ed25519Key PublicKey
pk Maybe SecretKey
sk -> Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Ed25519" :: T.Text) forall a. a -> [a] -> [a]
: forall {a} {a} {a} {t :: * -> *}.
(KeyValue a, ByteArrayAccess a, ByteArrayAccess a, Foldable t) =>
a -> t a -> [a]
params PublicKey
pk Maybe SecretKey
sk
      Ed448Key PublicKey
pk Maybe SecretKey
sk -> Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Ed448" :: T.Text) forall a. a -> [a] -> [a]
: forall {a} {a} {a} {t :: * -> *}.
(KeyValue a, ByteArrayAccess a, ByteArrayAccess a, Foldable t) =>
a -> t a -> [a]
params PublicKey
pk Maybe SecretKey
sk
      X25519Key PublicKey
pk Maybe SecretKey
sk  -> Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"X25519" :: T.Text) forall a. a -> [a] -> [a]
: forall {a} {a} {a} {t :: * -> *}.
(KeyValue a, ByteArrayAccess a, ByteArrayAccess a, Foldable t) =>
a -> t a -> [a]
params PublicKey
pk Maybe SecretKey
sk
      X448Key PublicKey
pk Maybe SecretKey
sk  -> Key
"crv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"X448" :: T.Text) forall a. a -> [a] -> [a]
: forall {a} {a} {a} {t :: * -> *}.
(KeyValue a, ByteArrayAccess a, ByteArrayAccess a, Foldable t) =>
a -> t a -> [a]
params PublicKey
pk Maybe SecretKey
sk
    where
      b64 :: a -> Base64Octets
b64 = ByteString -> Base64Octets
Types.Base64Octets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
      params :: a -> t a -> [a]
params a
pk t a
sk = Key
"x" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 a
pk forall a. a -> [a] -> [a]
: ((Key
"d" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
sk)

data OKPCrv = Ed25519 | Ed448 | X25519 | X448
  deriving (OKPCrv -> OKPCrv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OKPCrv -> OKPCrv -> Bool
$c/= :: OKPCrv -> OKPCrv -> Bool
== :: OKPCrv -> OKPCrv -> Bool
$c== :: OKPCrv -> OKPCrv -> Bool
Eq, Int -> OKPCrv -> ShowS
[OKPCrv] -> ShowS
OKPCrv -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OKPCrv] -> ShowS
$cshowList :: [OKPCrv] -> ShowS
show :: OKPCrv -> [Char]
$cshow :: OKPCrv -> [Char]
showsPrec :: Int -> OKPCrv -> ShowS
$cshowsPrec :: Int -> OKPCrv -> ShowS
Show)

genOKP :: MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP :: forall (m :: * -> *). MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP = \case
  OKPCrv
Ed25519 -> forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
k) (forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
Ed448 -> forall (m :: * -> *). MonadRandom m => m SecretKey
Ed448.generateSecretKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key (SecretKey -> PublicKey
Ed448.toPublic SecretKey
k) (forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
X25519 -> forall (m :: * -> *). MonadRandom m => m SecretKey
Curve25519.generateSecretKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key (SecretKey -> PublicKey
Curve25519.toPublic SecretKey
k) (forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
X448 -> forall (m :: * -> *). MonadRandom m => m SecretKey
Curve448.generateSecretKey forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key (SecretKey -> PublicKey
Curve448.toPublic SecretKey
k) (forall a. a -> Maybe a
Just SecretKey
k))

signEdDSA
  :: (MonadError e m, AsError e)
  => OKPKeyParameters
  -> B.ByteString
  -> m B.ByteString
signEdDSA :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
OKPKeyParameters -> ByteString -> m ByteString
signEdDSA (Ed25519Key PublicKey
pk (Just SecretKey
sk)) ByteString
m = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall a b. (a -> b) -> a -> b
$ forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
sk PublicKey
pk ByteString
m
signEdDSA (Ed25519Key PublicKey
_   Maybe SecretKey
Nothing)  ByteString
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not a private key"
signEdDSA (Ed448Key PublicKey
pk (Just SecretKey
sk))   ByteString
m = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall a b. (a -> b) -> a -> b
$ forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
sk PublicKey
pk ByteString
m
signEdDSA (Ed448Key PublicKey
_   Maybe SecretKey
Nothing)    ByteString
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not a private key"
signEdDSA (X25519Key PublicKey
_ Maybe SecretKey
_) ByteString
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not an EdDSA key"
signEdDSA (X448Key PublicKey
_ Maybe SecretKey
_)   ByteString
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r Text
_KeyMismatch Text
"not an EdDSA key"

verifyEdDSA
  :: (BA.ByteArrayAccess msg, BA.ByteArrayAccess sig, MonadError e m, AsError e)
  => OKPKeyParameters -> msg -> sig -> m Bool
verifyEdDSA :: forall msg sig e (m :: * -> *).
(ByteArrayAccess msg, ByteArrayAccess sig, MonadError e m,
 AsError e) =>
OKPKeyParameters -> msg -> sig -> m Bool
verifyEdDSA (Ed25519Key PublicKey
pk Maybe SecretKey
_) msg
m sig
s =
  forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure
    (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r CryptoError
_CryptoError)
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pk msg
m)
    (forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature sig
s)
verifyEdDSA (Ed448Key PublicKey
pk Maybe SecretKey
_) msg
m sig
s =
  forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure
    (forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r CryptoError
_CryptoError)
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
pk msg
m)
    (forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature sig
s)
verifyEdDSA (X25519Key PublicKey
_ Maybe SecretKey
_) msg
_ sig
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r [Char]
_AlgorithmMismatch [Char]
"not an EdDSA key"
verifyEdDSA (X448Key PublicKey
_ Maybe SecretKey
_)   msg
_ sig
_ = forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r [Char]
_AlgorithmMismatch [Char]
"not an EdDSA key"


-- | Key material sum type.
--
data KeyMaterial
  = ECKeyMaterial ECKeyParameters
  | RSAKeyMaterial RSAKeyParameters
  | OctKeyMaterial OctKeyParameters
  | OKPKeyMaterial OKPKeyParameters
  deriving (KeyMaterial -> KeyMaterial -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMaterial -> KeyMaterial -> Bool
$c/= :: KeyMaterial -> KeyMaterial -> Bool
== :: KeyMaterial -> KeyMaterial -> Bool
$c== :: KeyMaterial -> KeyMaterial -> Bool
Eq, Int -> KeyMaterial -> ShowS
[KeyMaterial] -> ShowS
KeyMaterial -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [KeyMaterial] -> ShowS
$cshowList :: [KeyMaterial] -> ShowS
show :: KeyMaterial -> [Char]
$cshow :: KeyMaterial -> [Char]
showsPrec :: Int -> KeyMaterial -> ShowS
$cshowsPrec :: Int -> KeyMaterial -> ShowS
Show)

showKeyType :: KeyMaterial -> String
showKeyType :: KeyMaterial -> [Char]
showKeyType (ECKeyMaterial ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
crv }) = [Char]
"ECDSA (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Crv
crv forall a. [a] -> [a] -> [a]
++ [Char]
")"
showKeyType (RSAKeyMaterial RSAKeyParameters
_) = [Char]
"RSA"
showKeyType (OctKeyMaterial OctKeyParameters
_) = [Char]
"symmetric"
showKeyType (OKPKeyMaterial OKPKeyParameters
_) = [Char]
"OKP"

instance FromJSON KeyMaterial where
  parseJSON :: Value -> Parser KeyMaterial
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"KeyMaterial" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
"kty" Object
o of
      Maybe Value
Nothing     -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"missing \"kty\" parameter"
      Just Value
"EC"   -> ECKeyParameters -> KeyMaterial
ECKeyMaterial  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"RSA"  -> RSAKeyParameters -> KeyMaterial
RSAKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"oct"  -> OctKeyParameters -> KeyMaterial
OctKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"OKP"  -> OKPKeyParameters -> KeyMaterial
OKPKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
s      -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported \"kty\": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Value
s

instance ToJSON KeyMaterial where
  toJSON :: KeyMaterial -> Value
toJSON (ECKeyMaterial ECKeyParameters
p)  = forall a. ToJSON a => a -> Value
toJSON ECKeyParameters
p
  toJSON (RSAKeyMaterial RSAKeyParameters
p) = forall a. ToJSON a => a -> Value
toJSON RSAKeyParameters
p
  toJSON (OctKeyMaterial OctKeyParameters
p) = forall a. ToJSON a => a -> Value
toJSON OctKeyParameters
p
  toJSON (OKPKeyMaterial OKPKeyParameters
p) = forall a. ToJSON a => a -> Value
toJSON OKPKeyParameters
p

-- | Keygen parameters.
--
data KeyMaterialGenParam
  = ECGenParam Crv
  -- ^ Generate an EC key with specified curve.
  | RSAGenParam Int
  -- ^ Generate an RSA key with specified size in /bytes/.
  | OctGenParam Int
  -- ^ Generate a symmetric key with specified size in /bytes/.
  | OKPGenParam OKPCrv
  -- ^ Generate an EdDSA or Edwards ECDH key with specified curve.
  deriving (KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
$c/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
$c== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
Eq, Int -> KeyMaterialGenParam -> ShowS
[KeyMaterialGenParam] -> ShowS
KeyMaterialGenParam -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [KeyMaterialGenParam] -> ShowS
$cshowList :: [KeyMaterialGenParam] -> ShowS
show :: KeyMaterialGenParam -> [Char]
$cshow :: KeyMaterialGenParam -> [Char]
showsPrec :: Int -> KeyMaterialGenParam -> ShowS
$cshowsPrec :: Int -> KeyMaterialGenParam -> ShowS
Show)

genKeyMaterial :: MonadRandom m => KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial :: forall (m :: * -> *).
MonadRandom m =>
KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial (ECGenParam Crv
crv) = ECKeyParameters -> KeyMaterial
ECKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => Crv -> m ECKeyParameters
genEC Crv
crv
genKeyMaterial (RSAGenParam Int
size) = RSAKeyParameters -> KeyMaterial
RSAKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => Int -> m RSAKeyParameters
genRSA Int
size
genKeyMaterial (OctGenParam Int
n) =
  OctKeyParameters -> KeyMaterial
OctKeyMaterial forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> OctKeyParameters
OctKeyParameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64Octets
Types.Base64Octets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
n
genKeyMaterial (OKPGenParam OKPCrv
crv) = OKPKeyParameters -> KeyMaterial
OKPKeyMaterial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP OKPCrv
crv

sign
  :: (MonadRandom m, MonadError e m, AsError e)
  => JWA.JWS.Alg
  -> KeyMaterial
  -> B.ByteString
  -> m B.ByteString
sign :: forall (m :: * -> *) e.
(MonadRandom m, MonadError e m, AsError e) =>
Alg -> KeyMaterial -> ByteString -> m ByteString
sign Alg
JWA.JWS.None KeyMaterial
_ = \ByteString
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
sign Alg
JWA.JWS.ES256 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_256 }) = forall msg h (m :: * -> *) e.
(ByteArrayAccess msg, HashAlgorithm h, MonadRandom m,
 MonadError e m, AsError e) =>
h -> ECKeyParameters -> msg -> m ByteString
signEC SHA256
SHA256 ECKeyParameters
k
sign Alg
JWA.JWS.ES384 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_384 }) = forall msg h (m :: * -> *) e.
(ByteArrayAccess msg, HashAlgorithm h, MonadRandom m,
 MonadError e m, AsError e) =>
h -> ECKeyParameters -> msg -> m ByteString
signEC SHA384
SHA384 ECKeyParameters
k
sign Alg
JWA.JWS.ES512 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_521 }) = forall msg h (m :: * -> *) e.
(ByteArrayAccess msg, HashAlgorithm h, MonadRandom m,
 MonadError e m, AsError e) =>
h -> ECKeyParameters -> msg -> m ByteString
signEC SHA512
SHA512 ECKeyParameters
k
sign Alg
JWA.JWS.ES256K (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
Secp256k1 }) = forall msg h (m :: * -> *) e.
(ByteArrayAccess msg, HashAlgorithm h, MonadRandom m,
 MonadError e m, AsError e) =>
h -> ECKeyParameters -> msg -> m ByteString
signEC SHA256
SHA256 ECKeyParameters
k
sign Alg
JWA.JWS.RS256 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithmASN1 h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPKCS15 SHA256
SHA256 RSAKeyParameters
k
sign Alg
JWA.JWS.RS384 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithmASN1 h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPKCS15 SHA384
SHA384 RSAKeyParameters
k
sign Alg
JWA.JWS.RS512 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithmASN1 h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPKCS15 SHA512
SHA512 RSAKeyParameters
k
sign Alg
JWA.JWS.PS256 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithm h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPSS SHA256
SHA256 RSAKeyParameters
k
sign Alg
JWA.JWS.PS384 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithm h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPSS SHA384
SHA384 RSAKeyParameters
k
sign Alg
JWA.JWS.PS512 (RSAKeyMaterial RSAKeyParameters
k) = forall h (m :: * -> *) e.
(HashAlgorithm h, MonadRandom m, MonadError e m, AsError e) =>
h -> RSAKeyParameters -> ByteString -> m ByteString
signPSS SHA512
SHA512 RSAKeyParameters
k
sign Alg
JWA.JWS.HS256 (OctKeyMaterial OctKeyParameters
k) = forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA256
SHA256 OctKeyParameters
k
sign Alg
JWA.JWS.HS384 (OctKeyMaterial OctKeyParameters
k) = forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA384
SHA384 OctKeyParameters
k
sign Alg
JWA.JWS.HS512 (OctKeyMaterial OctKeyParameters
k) = forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA512
SHA512 OctKeyParameters
k
sign Alg
JWA.JWS.EdDSA (OKPKeyMaterial OKPKeyParameters
k) = forall e (m :: * -> *).
(MonadError e m, AsError e) =>
OKPKeyParameters -> ByteString -> m ByteString
signEdDSA OKPKeyParameters
k
sign Alg
h KeyMaterial
k = \ByteString
_ -> forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r [Char]
_AlgorithmMismatch
  (forall a. Show a => a -> [Char]
show Alg
h forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be used with " forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> [Char]
showKeyType KeyMaterial
k forall a. Semigroup a => a -> a -> a
<> [Char]
" key")

verify
  :: (MonadError e m, AsError e)
  => JWA.JWS.Alg
  -> KeyMaterial
  -> B.ByteString
  -> B.ByteString
  -> m Bool
verify :: forall e (m :: * -> *).
(MonadError e m, AsError e) =>
Alg -> KeyMaterial -> ByteString -> ByteString -> m Bool
verify Alg
JWA.JWS.None KeyMaterial
_ = \ByteString
_ ByteString
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
""
verify Alg
JWA.JWS.ES256 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_256 }) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg h.
(ByteArrayAccess msg, HashAlgorithm h) =>
h -> ECKeyParameters -> msg -> ByteString -> Bool
verifyEC SHA256
SHA256 ECKeyParameters
k
verify Alg
JWA.JWS.ES384 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_384 }) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg h.
(ByteArrayAccess msg, HashAlgorithm h) =>
h -> ECKeyParameters -> msg -> ByteString -> Bool
verifyEC SHA384
SHA384 ECKeyParameters
k
verify Alg
JWA.JWS.ES512 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_521 }) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg h.
(ByteArrayAccess msg, HashAlgorithm h) =>
h -> ECKeyParameters -> msg -> ByteString -> Bool
verifyEC SHA512
SHA512 ECKeyParameters
k
verify Alg
JWA.JWS.ES256K (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
Secp256k1 }) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall msg h.
(ByteArrayAccess msg, HashAlgorithm h) =>
h -> ECKeyParameters -> msg -> ByteString -> Bool
verifyEC SHA256
SHA256 ECKeyParameters
k
verify Alg
JWA.JWS.RS256 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA256
SHA256 RSAKeyParameters
k
verify Alg
JWA.JWS.RS384 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA384
SHA384 RSAKeyParameters
k
verify Alg
JWA.JWS.RS512 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA512
SHA512 RSAKeyParameters
k
verify Alg
JWA.JWS.PS256 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS SHA256
SHA256 RSAKeyParameters
k
verify Alg
JWA.JWS.PS384 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS SHA384
SHA384 RSAKeyParameters
k
verify Alg
JWA.JWS.PS512 (RSAKeyMaterial RSAKeyParameters
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS SHA512
SHA512 RSAKeyParameters
k
verify Alg
JWA.JWS.HS256 (OctKeyMaterial OctKeyParameters
k) = \ByteString
m ByteString
s -> forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA256
SHA256 OctKeyParameters
k ByteString
m
verify Alg
JWA.JWS.HS384 (OctKeyMaterial OctKeyParameters
k) = \ByteString
m ByteString
s -> forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA384
SHA384 OctKeyParameters
k ByteString
m
verify Alg
JWA.JWS.HS512 (OctKeyMaterial OctKeyParameters
k) = \ByteString
m ByteString
s -> forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall h e (m :: * -> *).
(HashAlgorithm h, MonadError e m, AsError e) =>
h -> OctKeyParameters -> ByteString -> m ByteString
signOct SHA512
SHA512 OctKeyParameters
k ByteString
m
verify Alg
JWA.JWS.EdDSA (OKPKeyMaterial OKPKeyParameters
k) = forall msg sig e (m :: * -> *).
(ByteArrayAccess msg, ByteArrayAccess sig, MonadError e m,
 AsError e) =>
OKPKeyParameters -> msg -> sig -> m Bool
verifyEdDSA OKPKeyParameters
k
verify Alg
h KeyMaterial
k = \ByteString
_ ByteString
_ -> forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing forall r. AsError r => Prism' r [Char]
_AlgorithmMismatch
  (forall a. Show a => a -> [Char]
show Alg
h forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be used with " forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> [Char]
showKeyType KeyMaterial
k forall a. Semigroup a => a -> a -> a
<> [Char]
" key")


-- | Keys that may have have public material
--
class AsPublicKey k where
  -- | Get the public key
  asPublicKey :: Getter k (Maybe k)


instance AsPublicKey RSAKeyParameters where
  asPublicKey :: Getter RSAKeyParameters (Maybe RSAKeyParameters)
asPublicKey = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' RSAKeyParameters (Maybe RSAPrivateKeyParameters)
rsaPrivateKeyParameters forall a. Maybe a
Nothing)

instance AsPublicKey ECKeyParameters where
  asPublicKey :: Getter ECKeyParameters (Maybe ECKeyParameters)
asPublicKey = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\ECKeyParameters
k -> forall a. a -> Maybe a
Just ECKeyParameters
k { _ecD :: Maybe SizedBase64Integer
_ecD = forall a. Maybe a
Nothing })

instance AsPublicKey OKPKeyParameters where
  asPublicKey :: Getter OKPKeyParameters (Maybe OKPKeyParameters)
asPublicKey = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \case
    Ed25519Key  PublicKey
pk Maybe SecretKey
_  -> forall a. a -> Maybe a
Just (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key PublicKey
pk forall a. Maybe a
Nothing)
    Ed448Key    PublicKey
pk Maybe SecretKey
_  -> forall a. a -> Maybe a
Just (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key PublicKey
pk forall a. Maybe a
Nothing)
    X25519Key   PublicKey
pk Maybe SecretKey
_  -> forall a. a -> Maybe a
Just (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key PublicKey
pk forall a. Maybe a
Nothing)
    X448Key     PublicKey
pk Maybe SecretKey
_  -> forall a. a -> Maybe a
Just (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key PublicKey
pk forall a. Maybe a
Nothing)

instance AsPublicKey KeyMaterial where
  asPublicKey :: Getter KeyMaterial (Maybe KeyMaterial)
asPublicKey = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a b. (a -> b) -> a -> b
$ \case
    OctKeyMaterial OctKeyParameters
_  -> forall a. Maybe a
Nothing
    RSAKeyMaterial RSAKeyParameters
k  -> RSAKeyParameters -> KeyMaterial
RSAKeyMaterial  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall k. AsPublicKey k => Getter k (Maybe k)
asPublicKey RSAKeyParameters
k
    ECKeyMaterial ECKeyParameters
k   -> ECKeyParameters -> KeyMaterial
ECKeyMaterial   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall k. AsPublicKey k => Getter k (Maybe k)
asPublicKey ECKeyParameters
k
    OKPKeyMaterial OKPKeyParameters
k  -> OKPKeyParameters -> KeyMaterial
OKPKeyMaterial  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall k. AsPublicKey k => Getter k (Maybe k)
asPublicKey OKPKeyParameters
k