-- 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 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
(RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool)
-> (RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool)
-> Eq RSAPrivateKeyOthElem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
== :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
$c/= :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
/= :: RSAPrivateKeyOthElem -> RSAPrivateKeyOthElem -> Bool
Eq, Int -> RSAPrivateKeyOthElem -> ShowS
[RSAPrivateKeyOthElem] -> ShowS
RSAPrivateKeyOthElem -> [Char]
(Int -> RSAPrivateKeyOthElem -> ShowS)
-> (RSAPrivateKeyOthElem -> [Char])
-> ([RSAPrivateKeyOthElem] -> ShowS)
-> Show RSAPrivateKeyOthElem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSAPrivateKeyOthElem -> ShowS
showsPrec :: Int -> RSAPrivateKeyOthElem -> ShowS
$cshow :: RSAPrivateKeyOthElem -> [Char]
show :: RSAPrivateKeyOthElem -> [Char]
$cshowList :: [RSAPrivateKeyOthElem] -> ShowS
showList :: [RSAPrivateKeyOthElem] -> ShowS
Show)

instance FromJSON RSAPrivateKeyOthElem where
  parseJSON :: Value -> Parser RSAPrivateKeyOthElem
parseJSON = [Char]
-> (Object -> Parser RSAPrivateKeyOthElem)
-> Value
-> Parser RSAPrivateKeyOthElem
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"oth" (\Object
o -> Base64Integer
-> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem
RSAPrivateKeyOthElem (Base64Integer
 -> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
-> Parser Base64Integer
-> Parser (Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
o Object -> Key -> Parser Base64Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"r" Parser (Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
-> Parser Base64Integer
-> Parser (Base64Integer -> RSAPrivateKeyOthElem)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser Base64Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"d" Parser (Base64Integer -> RSAPrivateKeyOthElem)
-> Parser Base64Integer -> Parser RSAPrivateKeyOthElem
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
o Object -> Key -> Parser Base64Integer
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" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
r, Key
"d" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
d, Key
"t" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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
(RSAPrivateKeyOptionalParameters
 -> RSAPrivateKeyOptionalParameters -> Bool)
-> (RSAPrivateKeyOptionalParameters
    -> RSAPrivateKeyOptionalParameters -> Bool)
-> Eq RSAPrivateKeyOptionalParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
== :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
$c/= :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
/= :: RSAPrivateKeyOptionalParameters
-> RSAPrivateKeyOptionalParameters -> Bool
Eq, Int -> RSAPrivateKeyOptionalParameters -> ShowS
[RSAPrivateKeyOptionalParameters] -> ShowS
RSAPrivateKeyOptionalParameters -> [Char]
(Int -> RSAPrivateKeyOptionalParameters -> ShowS)
-> (RSAPrivateKeyOptionalParameters -> [Char])
-> ([RSAPrivateKeyOptionalParameters] -> ShowS)
-> Show RSAPrivateKeyOptionalParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSAPrivateKeyOptionalParameters -> ShowS
showsPrec :: Int -> RSAPrivateKeyOptionalParameters -> ShowS
$cshow :: RSAPrivateKeyOptionalParameters -> [Char]
show :: RSAPrivateKeyOptionalParameters -> [Char]
$cshowList :: [RSAPrivateKeyOptionalParameters] -> ShowS
showList :: [RSAPrivateKeyOptionalParameters] -> ShowS
Show)

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

instance ToJSON RSAPrivateKeyOptionalParameters where
  toJSON :: RSAPrivateKeyOptionalParameters -> Value
toJSON RSAPrivateKeyOptionalParameters{Maybe (NonEmpty RSAPrivateKeyOthElem)
Base64Integer
rsaP :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQ :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDp :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDq :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQi :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaOth :: RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaP :: Base64Integer
rsaQ :: Base64Integer
rsaDp :: Base64Integer
rsaDq :: Base64Integer
rsaQi :: Base64Integer
rsaOth :: Maybe (NonEmpty RSAPrivateKeyOthElem)
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [
    Key
"p" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
rsaP
    , Key
"q" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
rsaQ
    , Key
"dp" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
rsaDp
    , Key
"dq" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
rsaDq
    , Key
"qi" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
rsaQi
    ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
-> (NonEmpty RSAPrivateKeyOthElem -> [Pair])
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:[]) (Pair -> [Pair])
-> (NonEmpty RSAPrivateKeyOthElem -> Pair)
-> NonEmpty RSAPrivateKeyOthElem
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"oth" Key -> NonEmpty RSAPrivateKeyOthElem -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=)) 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
(RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool)
-> (RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool)
-> Eq RSAPrivateKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
== :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
$c/= :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
/= :: RSAPrivateKeyParameters -> RSAPrivateKeyParameters -> Bool
Eq, Int -> RSAPrivateKeyParameters -> ShowS
[RSAPrivateKeyParameters] -> ShowS
RSAPrivateKeyParameters -> [Char]
(Int -> RSAPrivateKeyParameters -> ShowS)
-> (RSAPrivateKeyParameters -> [Char])
-> ([RSAPrivateKeyParameters] -> ShowS)
-> Show RSAPrivateKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSAPrivateKeyParameters -> ShowS
showsPrec :: Int -> RSAPrivateKeyParameters -> ShowS
$cshow :: RSAPrivateKeyParameters -> [Char]
show :: RSAPrivateKeyParameters -> [Char]
$cshowList :: [RSAPrivateKeyParameters] -> ShowS
showList :: [RSAPrivateKeyParameters] -> ShowS
Show)

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

instance ToJSON RSAPrivateKeyParameters where
  toJSON :: RSAPrivateKeyParameters -> Value
toJSON RSAPrivateKeyParameters {Maybe RSAPrivateKeyOptionalParameters
Base64Integer
rsaD :: RSAPrivateKeyParameters -> Base64Integer
rsaOptionalParameters :: RSAPrivateKeyParameters -> Maybe RSAPrivateKeyOptionalParameters
rsaD :: Base64Integer
rsaOptionalParameters :: Maybe RSAPrivateKeyOptionalParameters
..} =
    Key -> Base64Integer -> Value -> Value
forall v. ToJSON v => Key -> v -> Value -> Value
Types.insertToObject Key
"d" Base64Integer
rsaD
      (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Value
-> (RSAPrivateKeyOptionalParameters -> Value)
-> Maybe RSAPrivateKeyOptionalParameters
-> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object Object
forall a. Monoid a => a
mempty) RSAPrivateKeyOptionalParameters -> Value
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
(ECKeyParameters -> ECKeyParameters -> Bool)
-> (ECKeyParameters -> ECKeyParameters -> Bool)
-> Eq ECKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ECKeyParameters -> ECKeyParameters -> Bool
== :: ECKeyParameters -> ECKeyParameters -> Bool
$c/= :: ECKeyParameters -> ECKeyParameters -> Bool
/= :: ECKeyParameters -> ECKeyParameters -> Bool
Eq, Int -> ECKeyParameters -> ShowS
[ECKeyParameters] -> ShowS
ECKeyParameters -> [Char]
(Int -> ECKeyParameters -> ShowS)
-> (ECKeyParameters -> [Char])
-> ([ECKeyParameters] -> ShowS)
-> Show ECKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ECKeyParameters -> ShowS
showsPrec :: Int -> ECKeyParameters -> ShowS
$cshow :: ECKeyParameters -> [Char]
show :: ECKeyParameters -> [Char]
$cshowList :: [ECKeyParameters] -> ShowS
showList :: [ECKeyParameters] -> ShowS
Show)

ecCrv :: Getter ECKeyParameters Crv
ecCrv :: Getter ECKeyParameters Crv
ecCrv = (ECKeyParameters -> Crv)
-> (Crv -> f Crv) -> ECKeyParameters -> f ECKeyParameters
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 = (ECKeyParameters -> SizedBase64Integer)
-> (SizedBase64Integer -> f SizedBase64Integer)
-> ECKeyParameters
-> f ECKeyParameters
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 = (ECKeyParameters -> SizedBase64Integer)
-> (SizedBase64Integer -> f SizedBase64Integer)
-> ECKeyParameters
-> f ECKeyParameters
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 = (ECKeyParameters -> Maybe SizedBase64Integer)
-> (Maybe SizedBase64Integer -> f (Maybe SizedBase64Integer))
-> ECKeyParameters
-> f ECKeyParameters
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 = [Char]
-> (Object -> Parser ECKeyParameters)
-> Value
-> Parser ECKeyParameters
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"EC" ((Object -> Parser ECKeyParameters)
 -> Value -> Parser ECKeyParameters)
-> (Object -> Parser ECKeyParameters)
-> Value
-> Parser ECKeyParameters
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" Parser Text -> (Text -> Parser ()) -> Parser ()
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Text -> Bool) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"EC" :: T.Text))
    Crv
crv <- Object
o Object -> Key -> Parser Crv
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"crv"
    let w :: a
w = Crv -> a
forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv
    SizedBase64Integer
x <- Object
o Object -> Key -> Parser SizedBase64Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x" Parser SizedBase64Integer
-> (SizedBase64Integer -> Parser SizedBase64Integer)
-> Parser SizedBase64Integer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
forall {a}. Integral a => a
w
    SizedBase64Integer
y <- Object
o Object -> Key -> Parser SizedBase64Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y" Parser SizedBase64Integer
-> (SizedBase64Integer -> Parser SizedBase64Integer)
-> Parser SizedBase64Integer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
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
        (Maybe SizedBase64Integer -> ECKeyParameters)
-> Parser (Maybe SizedBase64Integer) -> Parser ECKeyParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe SizedBase64Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d" Parser (Maybe SizedBase64Integer)
-> (Maybe SizedBase64Integer -> Parser (Maybe SizedBase64Integer))
-> Parser (Maybe SizedBase64Integer)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SizedBase64Integer -> Parser SizedBase64Integer)
-> Maybe SizedBase64Integer -> Parser (Maybe SizedBase64Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
forall {a}. Integral a => a
w))
      else [Char] -> Parser ECKeyParameters
forall a. [Char] -> Parser a
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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"kty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"EC" :: T.Text)
    , Key
"crv" Key -> Crv -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Getting Crv ECKeyParameters Crv -> ECKeyParameters -> Crv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Crv ECKeyParameters Crv
Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k
    , Key
"x" Key -> SizedBase64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> ECKeyParameters -> SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecX ECKeyParameters
k
    , Key
"y" Key -> SizedBase64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> ECKeyParameters -> SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecY ECKeyParameters
k
    ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (SizedBase64Integer -> Pair) -> [SizedBase64Integer] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"d" Key -> SizedBase64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=) (Maybe SizedBase64Integer -> [SizedBase64Integer]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Getting
  (Maybe SizedBase64Integer)
  ECKeyParameters
  (Maybe SizedBase64Integer)
-> ECKeyParameters -> Maybe SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe SizedBase64Integer)
  ECKeyParameters
  (Maybe SizedBase64Integer)
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 (Crv -> Int
forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv)
  (ECDSA.PublicKey Curve
_ Point
p, ECDSA.PrivateKey Curve
_ Integer
d) <- Curve -> m (PublicKey, PrivateKey)
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 -> ECKeyParameters -> m ECKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECKeyParameters -> m ECKeyParameters)
-> ECKeyParameters -> m ECKeyParameters
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) (SizedBase64Integer -> Maybe SizedBase64Integer
forall a. a -> Maybe a
Just (Integer -> SizedBase64Integer
i Integer
d))
    Point
ECC.PointO -> Crv -> m ECKeyParameters
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 Getting
  (Maybe SizedBase64Integer)
  ECKeyParameters
  (Maybe SizedBase64Integer)
-> ECKeyParameters -> Maybe SizedBase64Integer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe SizedBase64Integer)
  ECKeyParameters
  (Maybe SizedBase64Integer)
Getter ECKeyParameters (Maybe SizedBase64Integer)
ecD ECKeyParameters
k of
  Just SizedBase64Integer
ecD' -> Signature -> ByteString
sigToBS (Signature -> ByteString) -> m Signature -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Signature
forall {m :: * -> *}. MonadRandom m => m Signature
sig where
    crv :: Crv
crv = Getting Crv ECKeyParameters Crv -> ECKeyParameters -> Crv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Crv ECKeyParameters Crv
Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k
    w :: a
w = Crv -> a
forall a. Integral a => Crv -> a
ecCoordBytes Crv
crv
    sig :: m Signature
sig = PrivateKey -> h -> msg -> m Signature
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) =
      Int -> Integer -> ByteString
forall a. Integral a => Int -> a -> ByteString
Types.sizedIntegerToBS Int
forall {a}. Integral a => a
w Integer
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Integer -> ByteString
forall a. Integral a => Int -> a -> ByteString
Types.sizedIntegerToBS Int
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 -> AReview e Text -> Text -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e 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 = h -> PublicKey -> Signature -> msg -> Bool
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 (Crv -> Curve) -> Crv -> Curve
forall a b. (a -> b) -> a -> b
$ Getting Crv ECKeyParameters Crv -> ECKeyParameters -> Crv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Crv ECKeyParameters Crv
Getter ECKeyParameters Crv
ecCrv ECKeyParameters
k) (ECKeyParameters -> Point
point ECKeyParameters
k)
  sig :: Signature
sig = (Integer -> Integer -> Signature)
-> (Integer, Integer) -> Signature
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Signature
ECDSA.Signature
    ((Integer, Integer) -> Signature)
-> (Integer, Integer) -> Signature
forall a b. (a -> b) -> a -> b
$ (ByteString -> Integer)
-> (ByteString -> Integer)
-> (ByteString, ByteString)
-> (Integer, Integer)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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
    ((ByteString, ByteString) -> (Integer, Integer))
-> (ByteString, ByteString) -> (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
s

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

-- | Conversion from known curves and back again.
fromCurveName :: Prism' ECC.CurveName Crv
fromCurveName :: Prism' CurveName Crv
fromCurveName = (Crv -> CurveName)
-> (CurveName -> Maybe Crv) -> Prism' CurveName Crv
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 -> Crv -> Maybe Crv
forall a. a -> Maybe a
Just Crv
P_256
    CurveName
ECC.SEC_p384r1 -> Crv -> Maybe Crv
forall a. a -> Maybe a
Just Crv
P_384
    CurveName
ECC.SEC_p521r1 -> Crv -> Maybe Crv
forall a. a -> Maybe a
Just Crv
P_521
    CurveName
ECC.SEC_p256k1 -> Crv -> Maybe Crv
forall a. a -> Maybe a
Just Crv
Secp256k1
    CurveName
_              -> Maybe Crv
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 Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecX) (Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> Integer
f Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
Getter ECKeyParameters SizedBase64Integer
ecY) where
  f :: Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> Integer
f Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
l = case Getting SizedBase64Integer ECKeyParameters SizedBase64Integer
-> ECKeyParameters -> SizedBase64Integer
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))) = Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
d
ecPrivateKey ECKeyParameters
_ = AReview e Text -> Text -> m Integer
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e 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 <- m Curve -> (Curve -> m Curve) -> Maybe Curve -> m Curve
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AReview e Text -> Text -> m Curve
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Invalid EC point") Curve -> m Curve
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Curve -> m Curve) -> Maybe Curve -> m Curve
forall a b. (a -> b) -> a -> b
$ PubKeyEC -> Maybe Curve
X509.EC.ecPubKeyCurve PubKeyEC
pubKeyEC
  CurveName
curveName <- m CurveName
-> (CurveName -> m CurveName) -> Maybe CurveName -> m CurveName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AReview e Text -> Text -> m CurveName
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Unknown curve") CurveName -> m CurveName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe CurveName -> m CurveName) -> Maybe CurveName -> m CurveName
forall a b. (a -> b) -> a -> b
$ PubKeyEC -> Maybe CurveName
X509.EC.ecPubKeyCurveName PubKeyEC
pubKeyEC
  Crv
crv <- m Crv -> (Crv -> m Crv) -> Maybe Crv -> m Crv
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AReview e Text -> Text -> m Crv
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Unsupported curve TODO ") Crv -> m Crv
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Crv -> m Crv) -> Maybe Crv -> m Crv
forall a b. (a -> b) -> a -> b
$ Getting (First Crv) CurveName Crv -> CurveName -> Maybe Crv
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Crv) CurveName Crv
Prism' CurveName Crv
fromCurveName CurveName
curveName
  Point
pt <- m Point -> (Point -> m Point) -> Maybe Point -> m Point
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AReview e Text -> Text -> m Point
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Invalid EC point") Point -> m Point
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Point -> m Point) -> Maybe Point -> m Point
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    -> AReview e Text
-> Text -> m (SizedBase64Integer, SizedBase64Integer)
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"Cannot use point at infinity"
    ECC.Point Integer
x Integer
y ->
      (SizedBase64Integer, SizedBase64Integer)
-> m (SizedBase64Integer, SizedBase64Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
x, Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
y)
  ECKeyParameters -> m ECKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECKeyParameters -> m ECKeyParameters)
-> ECKeyParameters -> m ECKeyParameters
forall a b. (a -> b) -> a -> b
$ Crv
-> SizedBase64Integer
-> SizedBase64Integer
-> Maybe SizedBase64Integer
-> ECKeyParameters
ECKeyParameters Crv
crv SizedBase64Integer
x SizedBase64Integer
y Maybe SizedBase64Integer
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
(RSAKeyParameters -> RSAKeyParameters -> Bool)
-> (RSAKeyParameters -> RSAKeyParameters -> Bool)
-> Eq RSAKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RSAKeyParameters -> RSAKeyParameters -> Bool
== :: RSAKeyParameters -> RSAKeyParameters -> Bool
$c/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
Eq, Int -> RSAKeyParameters -> ShowS
[RSAKeyParameters] -> ShowS
RSAKeyParameters -> [Char]
(Int -> RSAKeyParameters -> ShowS)
-> (RSAKeyParameters -> [Char])
-> ([RSAKeyParameters] -> ShowS)
-> Show RSAKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RSAKeyParameters -> ShowS
showsPrec :: Int -> RSAKeyParameters -> ShowS
$cshow :: RSAKeyParameters -> [Char]
show :: RSAKeyParameters -> [Char]
$cshowList :: [RSAKeyParameters] -> ShowS
showList :: [RSAKeyParameters] -> ShowS
Show)
makeLenses ''RSAKeyParameters

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

instance ToJSON RSAKeyParameters where
  toJSON :: RSAKeyParameters -> Value
toJSON RSAKeyParameters {Maybe RSAPrivateKeyParameters
Base64Integer
_rsaN :: RSAKeyParameters -> Base64Integer
_rsaE :: RSAKeyParameters -> Base64Integer
_rsaPrivateKeyParameters :: RSAKeyParameters -> Maybe RSAPrivateKeyParameters
_rsaN :: Base64Integer
_rsaE :: Base64Integer
_rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters
..} =
    [Pair] -> Value -> Value
Types.insertManyToObject
      [ Key
"kty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"RSA" :: T.Text)
      , Key
"n" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
_rsaN
      , Key
"e" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Base64Integer
_rsaE
      ]
      (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Value
-> (RSAPrivateKeyParameters -> Value)
-> Maybe RSAPrivateKeyParameters
-> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object Object
forall a. Monoid a => a
mempty) RSAPrivateKeyParameters -> Value
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 (PrivateKey -> RSAKeyParameters)
-> ((PublicKey, PrivateKey) -> PrivateKey)
-> (PublicKey, PrivateKey)
-> RSAKeyParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PublicKey, PrivateKey) -> PrivateKey
forall a b. (a, b) -> b
snd ((PublicKey, PrivateKey) -> RSAKeyParameters)
-> m (PublicKey, PrivateKey) -> m RSAKeyParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Integer -> m (PublicKey, PrivateKey)
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
  RSAKeyParameters
-> (RSAKeyParameters -> RSAKeyParameters) -> RSAKeyParameters
forall a b. a -> (a -> b) -> b
& ASetter
  RSAKeyParameters
  RSAKeyParameters
  (Maybe RSAPrivateKeyParameters)
  (Maybe RSAPrivateKeyParameters)
-> Maybe RSAPrivateKeyParameters
-> RSAKeyParameters
-> RSAKeyParameters
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  RSAKeyParameters
  RSAKeyParameters
  (Maybe RSAPrivateKeyParameters)
  (Maybe RSAPrivateKeyParameters)
Lens' RSAKeyParameters (Maybe RSAPrivateKeyParameters)
rsaPrivateKeyParameters (RSAPrivateKeyParameters -> Maybe RSAPrivateKeyParameters
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RSAPrivateKeyParameters -> Maybe RSAPrivateKeyParameters)
-> RSAPrivateKeyParameters -> Maybe RSAPrivateKeyParameters
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) Maybe RSAPrivateKeyParameters
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)
      (RSAPrivateKeyOptionalParameters
-> Maybe RSAPrivateKeyOptionalParameters
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) Maybe (NonEmpty RSAPrivateKeyOthElem)
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' <- RSAKeyParameters -> m PrivateKey
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
RSAKeyParameters -> m PrivateKey
rsaPrivateKey RSAKeyParameters
k
  Maybe h -> PrivateKey -> ByteString -> m (Either Error ByteString)
forall hashAlg (m :: * -> *).
(HashAlgorithmASN1 hashAlg, MonadRandom m) =>
Maybe hashAlg
-> PrivateKey -> ByteString -> m (Either Error ByteString)
PKCS15.signSafer (h -> Maybe h
forall a. a -> Maybe a
Just h
h) PrivateKey
k' ByteString
m
    m (Either Error ByteString)
-> (Either Error ByteString -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Error -> m ByteString)
-> (ByteString -> m ByteString)
-> Either Error ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AReview e Error -> Error -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Error
forall r. AsError r => Prism' r Error
Prism' e Error
_RSAError) ByteString -> m ByteString
forall a. a -> m a
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 = Maybe h -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
PKCS15.verify (h -> Maybe h
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' <- RSAKeyParameters -> m PrivateKey
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
RSAKeyParameters -> m PrivateKey
rsaPrivateKey RSAKeyParameters
k
  PSSParams h ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
PSSParams hash ByteString ByteString
-> PrivateKey -> ByteString -> m (Either Error ByteString)
PSS.signSafer (h -> PSSParams h ByteString ByteString
forall seed output hash.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hash) =>
hash -> PSSParams hash seed output
PSS.defaultPSSParams h
h) PrivateKey
k' ByteString
m
    m (Either Error ByteString)
-> (Either Error ByteString -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Error -> m ByteString)
-> (ByteString -> m ByteString)
-> Either Error ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AReview e Error -> Error -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Error
forall r. AsError r => Prism' r Error
Prism' e Error
_RSAError) ByteString -> m ByteString
forall a. a -> m a
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 = PSSParams h ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
forall hash.
HashAlgorithm hash =>
PSSParams hash ByteString ByteString
-> PublicKey -> ByteString -> ByteString -> Bool
PSS.verify (h -> PSSParams h ByteString ByteString
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)))
  | Maybe (NonEmpty RSAPrivateKeyOthElem) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe RSAPrivateKeyOptionalParameters
opt Maybe RSAPrivateKeyOptionalParameters
-> (RSAPrivateKeyOptionalParameters
    -> Maybe (NonEmpty RSAPrivateKeyOthElem))
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaOth) = AReview e () -> m PrivateKey
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_OtherPrimesNotSupported
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2040 :: Integer) = AReview e () -> m PrivateKey
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall
  | Bool
otherwise = PrivateKey -> m PrivateKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrivateKey -> m PrivateKey) -> PrivateKey -> m PrivateKey
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 = Integer
-> (RSAPrivateKeyOptionalParameters -> Integer)
-> Maybe RSAPrivateKeyOptionalParameters
-> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Base64Integer -> Integer
unB64I (Base64Integer -> Integer)
-> (RSAPrivateKeyOptionalParameters -> Base64Integer)
-> RSAPrivateKeyOptionalParameters
-> Integer
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
_ = AReview e Text -> Text -> m PrivateKey
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e 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
(OctKeyParameters -> OctKeyParameters -> Bool)
-> (OctKeyParameters -> OctKeyParameters -> Bool)
-> Eq OctKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OctKeyParameters -> OctKeyParameters -> Bool
== :: OctKeyParameters -> OctKeyParameters -> Bool
$c/= :: OctKeyParameters -> OctKeyParameters -> Bool
/= :: OctKeyParameters -> OctKeyParameters -> Bool
Eq, Int -> OctKeyParameters -> ShowS
[OctKeyParameters] -> ShowS
OctKeyParameters -> [Char]
(Int -> OctKeyParameters -> ShowS)
-> (OctKeyParameters -> [Char])
-> ([OctKeyParameters] -> ShowS)
-> Show OctKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OctKeyParameters -> ShowS
showsPrec :: Int -> OctKeyParameters -> ShowS
$cshow :: OctKeyParameters -> [Char]
show :: OctKeyParameters -> [Char]
$cshowList :: [OctKeyParameters] -> ShowS
showList :: [OctKeyParameters] -> ShowS
Show)

octK :: Iso' OctKeyParameters Types.Base64Octets
octK :: Iso' OctKeyParameters Base64Octets
octK = (OctKeyParameters -> Base64Octets)
-> (Base64Octets -> OctKeyParameters)
-> Iso' OctKeyParameters Base64Octets
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 = [Char]
-> (Object -> Parser OctKeyParameters)
-> Value
-> Parser OctKeyParameters
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"symmetric key" ((Object -> Parser OctKeyParameters)
 -> Value -> Parser OctKeyParameters)
-> (Object -> Parser OctKeyParameters)
-> Value
-> Parser OctKeyParameters
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" Parser Text -> (Text -> Parser ()) -> Parser ()
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Text -> Bool) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"oct" :: T.Text))
    Base64Octets -> OctKeyParameters
OctKeyParameters (Base64Octets -> OctKeyParameters)
-> Parser Base64Octets -> Parser OctKeyParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Base64Octets
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"oct" :: T.Text)
    , Key
"k" Key -> Base64Octets -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Getting Base64Octets OctKeyParameters Base64Octets
-> OctKeyParameters -> Base64Octets
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64Octets OctKeyParameters Base64Octets
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< h -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize h
h
  then AReview e () -> m ByteString
forall e (m :: * -> *) x. MonadError e m => AReview e () -> m x
throwing_ AReview e ()
forall r. AsError r => Prism' r ()
Prism' e ()
_KeySizeTooSmall
  else ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ HMAC h -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (ByteString -> ByteString -> HMAC h
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
(OKPKeyParameters -> OKPKeyParameters -> Bool)
-> (OKPKeyParameters -> OKPKeyParameters -> Bool)
-> Eq OKPKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OKPKeyParameters -> OKPKeyParameters -> Bool
== :: OKPKeyParameters -> OKPKeyParameters -> Bool
$c/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
Eq)

instance Show OKPKeyParameters where
  show :: OKPKeyParameters -> [Char]
show = \case
      Ed25519Key PublicKey
pk Maybe SecretKey
sk  -> [Char]
"Ed25519 " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> [Char]
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 " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> [Char]
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 " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> [Char]
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 " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> [Char]
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 = a -> [Char]
forall a. Show a => a -> [Char]
show a
pk [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> f [Char] -> [Char]
forall a. Show a => a -> [Char]
show (([Char]
"SECRET" :: String) [Char] -> f b -> f [Char]
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
sk)

instance FromJSON OKPKeyParameters where
  parseJSON :: Value -> Parser OKPKeyParameters
parseJSON = [Char]
-> (Object -> Parser OKPKeyParameters)
-> Value
-> Parser OKPKeyParameters
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"OKP" ((Object -> Parser OKPKeyParameters)
 -> Value -> Parser OKPKeyParameters)
-> (Object -> Parser OKPKeyParameters)
-> Value
-> Parser OKPKeyParameters
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kty" Parser Text -> (Text -> Parser ()) -> Parser ()
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Text -> Bool) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"OKP" :: T.Text))
    Text
crv <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"crv"
    case (Text
crv :: T.Text) of
      Text
"Ed25519" -> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable PublicKey)
-> (ByteString -> CryptoFailable SecretKey)
-> Object
-> Parser OKPKeyParameters
forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey Object
o
      Text
"X25519"  -> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable PublicKey)
-> (ByteString -> CryptoFailable SecretKey)
-> Object
-> Parser OKPKeyParameters
forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve25519.publicKey ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve25519.secretKey Object
o
      Text
"Ed448"   -> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable PublicKey)
-> (ByteString -> CryptoFailable SecretKey)
-> Object
-> Parser OKPKeyParameters
forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed448.publicKey ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey Object
o
      Text
"X448"    -> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable PublicKey)
-> (ByteString -> CryptoFailable SecretKey)
-> Object
-> Parser OKPKeyParameters
forall {a} {b} {b}.
(a -> Maybe b -> b)
-> (ByteString -> CryptoFailable a)
-> (ByteString -> CryptoFailable b)
-> Object
-> Parser b
parseOKPKey PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve448.publicKey ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve448.secretKey Object
o
      Text
_         -> [Char] -> Parser OKPKeyParameters
forall a. [Char] -> Parser a
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 = (CryptoError -> m a) -> (a -> m a) -> CryptoFailable a -> m a
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure ([Char] -> m a
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m a) -> (CryptoError -> [Char]) -> CryptoError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> [Char]
forall a. Show a => a -> [Char]
show) a -> m a
forall a. a -> m a
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
        (a -> Maybe b -> b) -> Parser a -> Parser (Maybe b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Base64Octets
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x" Parser Base64Octets -> (Base64Octets -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CryptoFailable a -> Parser a
forall {m :: * -> *} {a}. MonadFail m => CryptoFailable a -> m a
handleError (CryptoFailable a -> Parser a)
-> (Base64Octets -> CryptoFailable a) -> Base64Octets -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable a
mkPub (ByteString -> CryptoFailable a)
-> (Base64Octets -> ByteString) -> Base64Octets -> CryptoFailable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> ByteString
bs)
        Parser (Maybe b -> b) -> Parser (Maybe b) -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Base64Octets)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"d" Parser (Maybe Base64Octets)
-> (Maybe Base64Octets -> Parser (Maybe b)) -> Parser (Maybe b)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Base64Octets -> Parser b)
-> Maybe Base64Octets -> Parser (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (CryptoFailable b -> Parser b
forall {m :: * -> *} {a}. MonadFail m => CryptoFailable a -> m a
handleError (CryptoFailable b -> Parser b)
-> (Base64Octets -> CryptoFailable b) -> Base64Octets -> Parser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable b
mkSec (ByteString -> CryptoFailable b)
-> (Base64Octets -> ByteString) -> Base64Octets -> CryptoFailable b
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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    Key
"kty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"OKP" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: case OKPKeyParameters
x of
      Ed25519Key PublicKey
pk Maybe SecretKey
sk -> Key
"crv" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"Ed25519" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"Ed448" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"X25519" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"X448" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
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 (ByteString -> Base64Octets)
-> (a -> ByteString) -> a -> Base64Octets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
      params :: a -> t a -> [a]
params a
pk t a
sk = Key
"x" Key -> Base64Octets -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> a
.= a -> Base64Octets
forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 a
pk a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((Key
"d" Key -> Base64Octets -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> a
.=) (Base64Octets -> a) -> (a -> Base64Octets) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Base64Octets
forall {a}. ByteArrayAccess a => a -> Base64Octets
b64 (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
sk)

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

genOKP :: MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP :: forall (m :: * -> *). MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP = \case
  OKPCrv
Ed25519 -> m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey m SecretKey
-> (SecretKey -> m OKPKeyParameters) -> m OKPKeyParameters
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> OKPKeyParameters -> m OKPKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key (SecretKey -> PublicKey
Ed25519.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
Ed448 -> m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed448.generateSecretKey m SecretKey
-> (SecretKey -> m OKPKeyParameters) -> m OKPKeyParameters
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> OKPKeyParameters -> m OKPKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed448Key (SecretKey -> PublicKey
Ed448.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
X25519 -> m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Curve25519.generateSecretKey m SecretKey
-> (SecretKey -> m OKPKeyParameters) -> m OKPKeyParameters
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> OKPKeyParameters -> m OKPKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key (SecretKey -> PublicKey
Curve25519.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just SecretKey
k))
  OKPCrv
X448 -> m SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Curve448.generateSecretKey m SecretKey
-> (SecretKey -> m OKPKeyParameters) -> m OKPKeyParameters
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SecretKey
k -> OKPKeyParameters -> m OKPKeyParameters
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKey -> Maybe SecretKey -> OKPKeyParameters
X448Key (SecretKey -> PublicKey
Curve448.toPublic SecretKey
k) (SecretKey -> Maybe SecretKey
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 = ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Signature -> ByteString) -> Signature -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Signature -> m ByteString) -> Signature -> m ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
sk PublicKey
pk ByteString
m
signEdDSA (Ed25519Key PublicKey
_   Maybe SecretKey
Nothing)  ByteString
_ = AReview e Text -> Text -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"not a private key"
signEdDSA (Ed448Key PublicKey
pk (Just SecretKey
sk))   ByteString
m = ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString)
-> (Signature -> ByteString) -> Signature -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Signature -> m ByteString) -> Signature -> m ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed448.sign SecretKey
sk PublicKey
pk ByteString
m
signEdDSA (Ed448Key PublicKey
_   Maybe SecretKey
Nothing)    ByteString
_ = AReview e Text -> Text -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"not a private key"
signEdDSA (X25519Key PublicKey
_ Maybe SecretKey
_) ByteString
_ = AReview e Text -> Text -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e Text
_KeyMismatch Text
"not an EdDSA key"
signEdDSA (X448Key PublicKey
_ Maybe SecretKey
_)   ByteString
_ = AReview e Text -> Text -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e Text
forall r. AsError r => Prism' r Text
Prism' e 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 =
  (CryptoError -> m Bool)
-> (Signature -> m Bool) -> CryptoFailable Signature -> m Bool
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure
    (AReview e CryptoError -> CryptoError -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e CryptoError
forall r. AsError r => Prism' r CryptoError
Prism' e CryptoError
_CryptoError)
    (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Signature -> Bool) -> Signature -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> msg -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pk msg
m)
    (sig -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature sig
s)
verifyEdDSA (Ed448Key PublicKey
pk Maybe SecretKey
_) msg
m sig
s =
  (CryptoError -> m Bool)
-> (Signature -> m Bool) -> CryptoFailable Signature -> m Bool
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure
    (AReview e CryptoError -> CryptoError -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e CryptoError
forall r. AsError r => Prism' r CryptoError
Prism' e CryptoError
_CryptoError)
    (Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> (Signature -> Bool) -> Signature -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> msg -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed448.verify PublicKey
pk msg
m)
    (sig -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed448.signature sig
s)
verifyEdDSA (X25519Key PublicKey
_ Maybe SecretKey
_) msg
_ sig
_ = AReview e [Char] -> [Char] -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e [Char]
forall r. AsError r => Prism' r [Char]
Prism' e [Char]
_AlgorithmMismatch [Char]
"not an EdDSA key"
verifyEdDSA (X448Key PublicKey
_ Maybe SecretKey
_)   msg
_ sig
_ = AReview e [Char] -> [Char] -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e [Char]
forall r. AsError r => Prism' r [Char]
Prism' e [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
(KeyMaterial -> KeyMaterial -> Bool)
-> (KeyMaterial -> KeyMaterial -> Bool) -> Eq KeyMaterial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyMaterial -> KeyMaterial -> Bool
== :: KeyMaterial -> KeyMaterial -> Bool
$c/= :: KeyMaterial -> KeyMaterial -> Bool
/= :: KeyMaterial -> KeyMaterial -> Bool
Eq, Int -> KeyMaterial -> ShowS
[KeyMaterial] -> ShowS
KeyMaterial -> [Char]
(Int -> KeyMaterial -> ShowS)
-> (KeyMaterial -> [Char])
-> ([KeyMaterial] -> ShowS)
-> Show KeyMaterial
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyMaterial -> ShowS
showsPrec :: Int -> KeyMaterial -> ShowS
$cshow :: KeyMaterial -> [Char]
show :: KeyMaterial -> [Char]
$cshowList :: [KeyMaterial] -> ShowS
showList :: [KeyMaterial] -> ShowS
Show)

showKeyType :: KeyMaterial -> String
showKeyType :: KeyMaterial -> [Char]
showKeyType (ECKeyMaterial ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
crv }) = [Char]
"ECDSA (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Crv -> [Char]
forall a. Show a => a -> [Char]
show Crv
crv [Char] -> ShowS
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 = [Char]
-> (Object -> Parser KeyMaterial) -> Value -> Parser KeyMaterial
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"KeyMaterial" ((Object -> Parser KeyMaterial) -> Value -> Parser KeyMaterial)
-> (Object -> Parser KeyMaterial) -> Value -> Parser KeyMaterial
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
"kty" Object
o of
      Maybe Value
Nothing     -> [Char] -> Parser KeyMaterial
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"missing \"kty\" parameter"
      Just Value
"EC"   -> ECKeyParameters -> KeyMaterial
ECKeyMaterial  (ECKeyParameters -> KeyMaterial)
-> Parser ECKeyParameters -> Parser KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ECKeyParameters
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"RSA"  -> RSAKeyParameters -> KeyMaterial
RSAKeyMaterial (RSAKeyParameters -> KeyMaterial)
-> Parser RSAKeyParameters -> Parser KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser RSAKeyParameters
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"oct"  -> OctKeyParameters -> KeyMaterial
OctKeyMaterial (OctKeyParameters -> KeyMaterial)
-> Parser OctKeyParameters -> Parser KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OctKeyParameters
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"OKP"  -> OKPKeyParameters -> KeyMaterial
OKPKeyMaterial (OKPKeyParameters -> KeyMaterial)
-> Parser OKPKeyParameters -> Parser KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser OKPKeyParameters
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
s      -> [Char] -> Parser KeyMaterial
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser KeyMaterial) -> [Char] -> Parser KeyMaterial
forall a b. (a -> b) -> a -> b
$ [Char]
"unsupported \"kty\": " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> [Char]
forall a. Show a => a -> [Char]
show Value
s

instance ToJSON KeyMaterial where
  toJSON :: KeyMaterial -> Value
toJSON (ECKeyMaterial ECKeyParameters
p)  = ECKeyParameters -> Value
forall a. ToJSON a => a -> Value
toJSON ECKeyParameters
p
  toJSON (RSAKeyMaterial RSAKeyParameters
p) = RSAKeyParameters -> Value
forall a. ToJSON a => a -> Value
toJSON RSAKeyParameters
p
  toJSON (OctKeyMaterial OctKeyParameters
p) = OctKeyParameters -> Value
forall a. ToJSON a => a -> Value
toJSON OctKeyParameters
p
  toJSON (OKPKeyMaterial OKPKeyParameters
p) = OKPKeyParameters -> Value
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
(KeyMaterialGenParam -> KeyMaterialGenParam -> Bool)
-> (KeyMaterialGenParam -> KeyMaterialGenParam -> Bool)
-> Eq KeyMaterialGenParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
$c/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
Eq, Int -> KeyMaterialGenParam -> ShowS
[KeyMaterialGenParam] -> ShowS
KeyMaterialGenParam -> [Char]
(Int -> KeyMaterialGenParam -> ShowS)
-> (KeyMaterialGenParam -> [Char])
-> ([KeyMaterialGenParam] -> ShowS)
-> Show KeyMaterialGenParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyMaterialGenParam -> ShowS
showsPrec :: Int -> KeyMaterialGenParam -> ShowS
$cshow :: KeyMaterialGenParam -> [Char]
show :: KeyMaterialGenParam -> [Char]
$cshowList :: [KeyMaterialGenParam] -> ShowS
showList :: [KeyMaterialGenParam] -> ShowS
Show)

genKeyMaterial :: MonadRandom m => KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial :: forall (m :: * -> *).
MonadRandom m =>
KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial (ECGenParam Crv
crv) = ECKeyParameters -> KeyMaterial
ECKeyMaterial (ECKeyParameters -> KeyMaterial)
-> m ECKeyParameters -> m KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Crv -> m ECKeyParameters
forall (m :: * -> *). MonadRandom m => Crv -> m ECKeyParameters
genEC Crv
crv
genKeyMaterial (RSAGenParam Int
size) = RSAKeyParameters -> KeyMaterial
RSAKeyMaterial (RSAKeyParameters -> KeyMaterial)
-> m RSAKeyParameters -> m KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m RSAKeyParameters
forall (m :: * -> *). MonadRandom m => Int -> m RSAKeyParameters
genRSA Int
size
genKeyMaterial (OctGenParam Int
n) =
  OctKeyParameters -> KeyMaterial
OctKeyMaterial (OctKeyParameters -> KeyMaterial)
-> (ByteString -> OctKeyParameters) -> ByteString -> KeyMaterial
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64Octets -> OctKeyParameters
OctKeyParameters (Base64Octets -> OctKeyParameters)
-> (ByteString -> Base64Octets) -> ByteString -> OctKeyParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64Octets
Types.Base64Octets (ByteString -> KeyMaterial) -> m ByteString -> m KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall byteArray. ByteArray byteArray => Int -> m byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
n
genKeyMaterial (OKPGenParam OKPCrv
crv) = OKPKeyParameters -> KeyMaterial
OKPKeyMaterial (OKPKeyParameters -> KeyMaterial)
-> m OKPKeyParameters -> m KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OKPCrv -> m OKPKeyParameters
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
_ -> ByteString -> m ByteString
forall a. a -> m a
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 }) = SHA256 -> ECKeyParameters -> ByteString -> m ByteString
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 }) = SHA384 -> ECKeyParameters -> ByteString -> m ByteString
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 }) = SHA512 -> ECKeyParameters -> ByteString -> m ByteString
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 }) = SHA256 -> ECKeyParameters -> ByteString -> m ByteString
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) = SHA256 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA384 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA512 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA256 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA384 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA512 -> RSAKeyParameters -> ByteString -> m ByteString
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) = SHA256 -> OctKeyParameters -> ByteString -> m ByteString
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) = SHA384 -> OctKeyParameters -> ByteString -> m ByteString
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) = SHA512 -> OctKeyParameters -> ByteString -> m ByteString
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) = OKPKeyParameters -> ByteString -> m ByteString
forall e (m :: * -> *).
(MonadError e m, AsError e) =>
OKPKeyParameters -> ByteString -> m ByteString
signEdDSA OKPKeyParameters
k
sign Alg
h KeyMaterial
k = \ByteString
_ -> AReview e [Char] -> [Char] -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e [Char]
forall r. AsError r => Prism' r [Char]
Prism' e [Char]
_AlgorithmMismatch
  (Alg -> [Char]
forall a. Show a => a -> [Char]
show Alg
h [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be used with " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> [Char]
showKeyType KeyMaterial
k [Char] -> ShowS
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 -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ ByteString
s ByteString -> ByteString -> Bool
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 }) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> ECKeyParameters -> ByteString -> ByteString -> Bool
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 }) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA384 -> ECKeyParameters -> ByteString -> ByteString -> Bool
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 }) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA512 -> ECKeyParameters -> ByteString -> ByteString -> Bool
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 }) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> ECKeyParameters -> ByteString -> ByteString -> Bool
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) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA256
SHA256 RSAKeyParameters
k
verify Alg
JWA.JWS.RS384 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA384 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA384
SHA384 RSAKeyParameters
k
verify Alg
JWA.JWS.RS512 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA512 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
forall h.
HashAlgorithmASN1 h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPKCS15 SHA512
SHA512 RSAKeyParameters
k
verify Alg
JWA.JWS.PS256 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS SHA256
SHA256 RSAKeyParameters
k
verify Alg
JWA.JWS.PS384 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA384 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
forall h.
HashAlgorithm h =>
h -> RSAKeyParameters -> ByteString -> ByteString -> Bool
verifyPSS SHA384
SHA384 RSAKeyParameters
k
verify Alg
JWA.JWS.PS512 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString -> Bool) -> ByteString -> m Bool)
-> (ByteString -> ByteString -> Bool)
-> ByteString
-> ByteString
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA512 -> RSAKeyParameters -> ByteString -> ByteString -> Bool
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 -> ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s (ByteString -> Bool) -> m ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SHA256 -> OctKeyParameters -> ByteString -> m ByteString
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 -> ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s (ByteString -> Bool) -> m ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SHA384 -> OctKeyParameters -> ByteString -> m ByteString
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 -> ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
BA.constEq ByteString
s (ByteString -> Bool) -> m ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SHA512 -> OctKeyParameters -> ByteString -> m ByteString
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) = OKPKeyParameters -> ByteString -> ByteString -> m Bool
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
_ -> AReview e [Char] -> [Char] -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e [Char]
forall r. AsError r => Prism' r [Char]
Prism' e [Char]
_AlgorithmMismatch
  (Alg -> [Char]
forall a. Show a => a -> [Char]
show Alg
h [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" cannot be used with " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> [Char]
showKeyType KeyMaterial
k [Char] -> ShowS
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 = (RSAKeyParameters -> Maybe RSAKeyParameters)
-> (Maybe RSAKeyParameters -> f (Maybe RSAKeyParameters))
-> RSAKeyParameters
-> f RSAKeyParameters
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (RSAKeyParameters -> Maybe RSAKeyParameters
forall a. a -> Maybe a
Just (RSAKeyParameters -> Maybe RSAKeyParameters)
-> (RSAKeyParameters -> RSAKeyParameters)
-> RSAKeyParameters
-> Maybe RSAKeyParameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  RSAKeyParameters
  RSAKeyParameters
  (Maybe RSAPrivateKeyParameters)
  (Maybe RSAPrivateKeyParameters)
-> Maybe RSAPrivateKeyParameters
-> RSAKeyParameters
-> RSAKeyParameters
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  RSAKeyParameters
  RSAKeyParameters
  (Maybe RSAPrivateKeyParameters)
  (Maybe RSAPrivateKeyParameters)
Lens' RSAKeyParameters (Maybe RSAPrivateKeyParameters)
rsaPrivateKeyParameters Maybe RSAPrivateKeyParameters
forall a. Maybe a
Nothing)

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

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

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