-- 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 #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

{-|

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

  -- * 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(..)

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

  -- * Signing and verification
  , sign
  , verify

  , module Crypto.Random
  ) where

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

import Control.Lens hiding ((.=), elements)
import Control.Monad.Error.Lens (throwing, throwing_)
import Crypto.Error (onCryptoFailure)
import Crypto.Hash
import Crypto.MAC.HMAC
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Generate as ECC
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as PKCS15
import qualified Crypto.PubKey.RSA.PSS as PSS
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Curve25519 as Curve25519
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 Test.QuickCheck (Arbitrary(..), arbitrarySizedNatural, elements, oneof, vectorOf)

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
import Crypto.JOSE.Types.Orphans ()


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

instance Arbitrary Crv where
  arbitrary :: Gen Crv
arbitrary = [Crv] -> Gen Crv
forall a. [a] -> Gen a
elements [Crv
P_256, Crv
P_384, Crv
P_521]


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

instance FromJSON RSAPrivateKeyOthElem where
  parseJSON :: Value -> Parser RSAPrivateKeyOthElem
parseJSON = String
-> (Object -> Parser RSAPrivateKeyOthElem)
-> Value
-> Parser RSAPrivateKeyOthElem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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 (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
.= Base64Integer
r, Key
"d" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
d, Key
"t" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
t]

instance Arbitrary RSAPrivateKeyOthElem where
  arbitrary :: Gen RSAPrivateKeyOthElem
arbitrary = Base64Integer
-> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem
RSAPrivateKeyOthElem (Base64Integer
 -> Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
-> Gen Base64Integer
-> Gen (Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Base64Integer -> Base64Integer -> RSAPrivateKeyOthElem)
-> Gen Base64Integer -> Gen (Base64Integer -> RSAPrivateKeyOthElem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Base64Integer -> RSAPrivateKeyOthElem)
-> Gen Base64Integer -> Gen RSAPrivateKeyOthElem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary


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

instance FromJSON RSAPrivateKeyOptionalParameters where
  parseJSON :: Value -> Parser RSAPrivateKeyOptionalParameters
parseJSON = String
-> (Object -> Parser RSAPrivateKeyOptionalParameters)
-> Value
-> Parser RSAPrivateKeyOptionalParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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 (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 (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 (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 (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
rsaOth :: Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaQi :: Base64Integer
rsaDq :: Base64Integer
rsaDp :: Base64Integer
rsaQ :: Base64Integer
rsaP :: Base64Integer
rsaOth :: RSAPrivateKeyOptionalParameters
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaQi :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDq :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaDp :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaQ :: RSAPrivateKeyOptionalParameters -> Base64Integer
rsaP :: RSAPrivateKeyOptionalParameters -> Base64Integer
..} = [Pair] -> Value
object ([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
.= Base64Integer
rsaP
    , Key
"q" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaQ
    , Key
"dp" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaDp
    , Key
"dq" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
rsaDq
    , Key
"qi" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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
.=)) Maybe (NonEmpty RSAPrivateKeyOthElem)
rsaOth

instance Arbitrary RSAPrivateKeyOptionalParameters where
  arbitrary :: Gen RSAPrivateKeyOptionalParameters
arbitrary = Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Base64Integer
-> Maybe (NonEmpty RSAPrivateKeyOthElem)
-> RSAPrivateKeyOptionalParameters
RSAPrivateKeyOptionalParameters
    (Base64Integer
 -> Base64Integer
 -> Base64Integer
 -> Base64Integer
 -> Base64Integer
 -> Maybe (NonEmpty RSAPrivateKeyOthElem)
 -> RSAPrivateKeyOptionalParameters)
-> Gen Base64Integer
-> Gen
     (Base64Integer
      -> Base64Integer
      -> Base64Integer
      -> Base64Integer
      -> Maybe (NonEmpty RSAPrivateKeyOthElem)
      -> RSAPrivateKeyOptionalParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Base64Integer
   -> Base64Integer
   -> Base64Integer
   -> Base64Integer
   -> Maybe (NonEmpty RSAPrivateKeyOthElem)
   -> RSAPrivateKeyOptionalParameters)
-> Gen Base64Integer
-> Gen
     (Base64Integer
      -> Base64Integer
      -> Base64Integer
      -> Maybe (NonEmpty RSAPrivateKeyOthElem)
      -> RSAPrivateKeyOptionalParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Base64Integer
   -> Base64Integer
   -> Base64Integer
   -> Maybe (NonEmpty RSAPrivateKeyOthElem)
   -> RSAPrivateKeyOptionalParameters)
-> Gen Base64Integer
-> Gen
     (Base64Integer
      -> Base64Integer
      -> Maybe (NonEmpty RSAPrivateKeyOthElem)
      -> RSAPrivateKeyOptionalParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Base64Integer
   -> Base64Integer
   -> Maybe (NonEmpty RSAPrivateKeyOthElem)
   -> RSAPrivateKeyOptionalParameters)
-> Gen Base64Integer
-> Gen
     (Base64Integer
      -> Maybe (NonEmpty RSAPrivateKeyOthElem)
      -> RSAPrivateKeyOptionalParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Base64Integer
   -> Maybe (NonEmpty RSAPrivateKeyOthElem)
   -> RSAPrivateKeyOptionalParameters)
-> Gen Base64Integer
-> Gen
     (Maybe (NonEmpty RSAPrivateKeyOthElem)
      -> RSAPrivateKeyOptionalParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe (NonEmpty RSAPrivateKeyOthElem)
   -> RSAPrivateKeyOptionalParameters)
-> Gen (Maybe (NonEmpty RSAPrivateKeyOthElem))
-> Gen RSAPrivateKeyOptionalParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (NonEmpty RSAPrivateKeyOthElem))
forall a. Arbitrary a => Gen a
arbitrary


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

instance FromJSON RSAPrivateKeyParameters where
  parseJSON :: Value -> Parser RSAPrivateKeyParameters
parseJSON = String
-> (Object -> Parser RSAPrivateKeyParameters)
-> Value
-> Parser RSAPrivateKeyParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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 (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
rsaOptionalParameters :: Maybe RSAPrivateKeyOptionalParameters
rsaD :: Base64Integer
rsaOptionalParameters :: RSAPrivateKeyParameters -> Maybe RSAPrivateKeyOptionalParameters
rsaD :: RSAPrivateKeyParameters -> Base64Integer
..} =
    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

instance Arbitrary RSAPrivateKeyParameters where
  arbitrary :: Gen RSAPrivateKeyParameters
arbitrary = Base64Integer
-> Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters
RSAPrivateKeyParameters (Base64Integer
 -> Maybe RSAPrivateKeyOptionalParameters
 -> RSAPrivateKeyParameters)
-> Gen Base64Integer
-> Gen
     (Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Maybe RSAPrivateKeyOptionalParameters -> RSAPrivateKeyParameters)
-> Gen (Maybe RSAPrivateKeyOptionalParameters)
-> Gen RSAPrivateKeyParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe RSAPrivateKeyOptionalParameters)
forall a. Arbitrary a => Gen a
arbitrary


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

ecCrv :: Getter ECKeyParameters Crv
ecCrv :: (Crv -> f Crv) -> ECKeyParameters -> f ECKeyParameters
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 :: (SizedBase64Integer -> f SizedBase64Integer)
-> ECKeyParameters -> f ECKeyParameters
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 :: (SizedBase64Integer -> f SizedBase64Integer)
-> ECKeyParameters -> f ECKeyParameters
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 :: (Maybe SizedBase64Integer -> f (Maybe SizedBase64Integer))
-> ECKeyParameters -> f ECKeyParameters
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 = String
-> (Object -> Parser ECKeyParameters)
-> Value
-> Parser ECKeyParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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 :: Int
w = Crv -> Int
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
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 (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)
traverse (Int -> SizedBase64Integer -> Parser SizedBase64Integer
Types.checkSize Int
w))
      else String -> Parser ECKeyParameters
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
.= (Text
"EC" :: T.Text)
    , Key
"crv" Key -> Crv -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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
.= 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
.= 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 (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
.=) (Maybe SizedBase64Integer -> [SizedBase64Integer]
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))

instance Arbitrary ECKeyParameters where
  arbitrary :: Gen ECKeyParameters
arbitrary = do
    ChaChaDRG
drg <- (Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG
drgNewTest ((Word64, Word64, Word64, Word64, Word64) -> ChaChaDRG)
-> Gen (Word64, Word64, Word64, Word64, Word64) -> Gen ChaChaDRG
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Word64, Word64, Word64, Word64, Word64)
forall a. Arbitrary a => Gen a
arbitrary
    Crv
crv <- Gen Crv
forall a. Arbitrary a => Gen a
arbitrary
    let (ECKeyParameters
params, ChaChaDRG
_) = ChaChaDRG
-> MonadPseudoRandom ChaChaDRG ECKeyParameters
-> (ECKeyParameters, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
drg (Crv -> MonadPseudoRandom ChaChaDRG ECKeyParameters
forall (m :: * -> *). MonadRandom m => Crv -> m ECKeyParameters
genEC Crv
crv)
    Bool
includePrivate <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    if Bool
includePrivate
      then ECKeyParameters -> Gen ECKeyParameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure ECKeyParameters
params
      else ECKeyParameters -> Gen ECKeyParameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure ECKeyParameters
params { _ecD :: Maybe SizedBase64Integer
_ecD = Maybe SizedBase64Integer
forall a. Maybe a
Nothing }

genEC :: MonadRandom m => Crv -> m ECKeyParameters
genEC :: 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 (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 :: 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
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 :: Int
w = Crv -> Int
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
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
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
_KeyMismatch Text
"not an EC private key"

verifyEC
  :: (BA.ByteArrayAccess msg, HashAlgorithm h)
  => h
  -> ECKeyParameters
  -> msg
  -> B.ByteString
  -> Bool
verifyEC :: 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 (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 :: p Crv (f Crv) -> p CurveName (f CurveName)
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)
  (\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
_              -> 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 :: Crv -> a
ecCoordBytes Crv
P_256 = a
32
ecCoordBytes Crv
P_384 = a
48
ecCoordBytes Crv
P_521 = a
66

ecPrivateKey :: (MonadError e m, AsError e) => ECKeyParameters -> m Integer
ecPrivateKey :: ECKeyParameters -> m Integer
ecPrivateKey (ECKeyParameters Crv
_ SizedBase64Integer
_ SizedBase64Integer
_ (Just (Types.SizedBase64Integer Int
_ Integer
d))) = Integer -> m Integer
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
_KeyMismatch Text
"Not an EC private key"

ecParametersFromX509 :: X509.PubKeyEC -> Maybe ECKeyParameters
ecParametersFromX509 :: PubKeyEC -> Maybe ECKeyParameters
ecParametersFromX509 PubKeyEC
pubKeyEC = do
  Curve
ecCurve <- PubKeyEC -> Maybe Curve
X509.EC.ecPubKeyCurve PubKeyEC
pubKeyEC
  CurveName
curveName <- PubKeyEC -> Maybe CurveName
X509.EC.ecPubKeyCurveName PubKeyEC
pubKeyEC
  Crv
crv <- 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 <- 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    -> Maybe (SizedBase64Integer, SizedBase64Integer)
forall a. Maybe a
Nothing
    ECC.Point Integer
x Integer
y ->
      (SizedBase64Integer, SizedBase64Integer)
-> Maybe (SizedBase64Integer, SizedBase64Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
x, Integer -> SizedBase64Integer
Types.makeSizedBase64Integer Integer
y)
  ECKeyParameters -> Maybe ECKeyParameters
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECKeyParameters -> Maybe ECKeyParameters)
-> ECKeyParameters -> Maybe 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
/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
$c/= :: RSAKeyParameters -> RSAKeyParameters -> Bool
== :: RSAKeyParameters -> RSAKeyParameters -> Bool
$c== :: RSAKeyParameters -> RSAKeyParameters -> Bool
Eq, Int -> RSAKeyParameters -> ShowS
[RSAKeyParameters] -> ShowS
RSAKeyParameters -> String
(Int -> RSAKeyParameters -> ShowS)
-> (RSAKeyParameters -> String)
-> ([RSAKeyParameters] -> ShowS)
-> Show RSAKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSAKeyParameters] -> ShowS
$cshowList :: [RSAKeyParameters] -> ShowS
show :: RSAKeyParameters -> String
$cshow :: RSAKeyParameters -> String
showsPrec :: Int -> RSAKeyParameters -> ShowS
$cshowsPrec :: Int -> RSAKeyParameters -> ShowS
Show)
makeLenses ''RSAKeyParameters

instance FromJSON RSAKeyParameters where
  parseJSON :: Value -> Parser RSAKeyParameters
parseJSON = String
-> (Object -> Parser RSAKeyParameters)
-> Value
-> Parser RSAKeyParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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 (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 (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 (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
_rsaPrivateKeyParameters :: Maybe RSAPrivateKeyParameters
_rsaE :: Base64Integer
_rsaN :: Base64Integer
_rsaPrivateKeyParameters :: RSAKeyParameters -> Maybe RSAPrivateKeyParameters
_rsaE :: RSAKeyParameters -> Base64Integer
_rsaN :: RSAKeyParameters -> Base64Integer
..} =
    [Pair] -> Value -> Value
Types.insertManyToObject
      [ Key
"kty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"RSA" :: T.Text)
      , Key
"n" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Integer
_rsaN
      , Key
"e" Key -> Base64Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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

instance Arbitrary RSAKeyParameters where
  arbitrary :: Gen RSAKeyParameters
arbitrary = Base64Integer
-> Base64Integer
-> Maybe RSAPrivateKeyParameters
-> RSAKeyParameters
RSAKeyParameters
    (Base64Integer
 -> Base64Integer
 -> Maybe RSAPrivateKeyParameters
 -> RSAKeyParameters)
-> Gen Base64Integer
-> Gen
     (Base64Integer
      -> Maybe RSAPrivateKeyParameters -> RSAKeyParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Base64Integer
   -> Maybe RSAPrivateKeyParameters -> RSAKeyParameters)
-> Gen Base64Integer
-> Gen (Maybe RSAPrivateKeyParameters -> RSAKeyParameters)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Base64Integer
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe RSAPrivateKeyParameters -> RSAKeyParameters)
-> Gen (Maybe RSAPrivateKeyParameters) -> Gen RSAKeyParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe RSAPrivateKeyParameters)
forall a. Arbitrary a => Gen a
arbitrary

genRSA :: MonadRandom m => Int -> m RSAKeyParameters
genRSA :: 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 (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 :: 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 (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
_RSAError) ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure

verifyPKCS15
  :: PKCS15.HashAlgorithmASN1 h
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> B.ByteString
  -> Bool
verifyPKCS15 :: 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 :: 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 (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
_RSAError) ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure

verifyPSS
  :: (HashAlgorithm h)
  => h
  -> RSAKeyParameters
  -> B.ByteString
  -> B.ByteString
  -> Bool
verifyPSS :: 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 :: 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 (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 ()
_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 ()
_KeySizeTooSmall
  | Bool
otherwise = PrivateKey -> m PrivateKey
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
_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
/= :: OctKeyParameters -> OctKeyParameters -> Bool
$c/= :: OctKeyParameters -> OctKeyParameters -> Bool
== :: OctKeyParameters -> OctKeyParameters -> Bool
$c== :: OctKeyParameters -> OctKeyParameters -> Bool
Eq, Int -> OctKeyParameters -> ShowS
[OctKeyParameters] -> ShowS
OctKeyParameters -> String
(Int -> OctKeyParameters -> ShowS)
-> (OctKeyParameters -> String)
-> ([OctKeyParameters] -> ShowS)
-> Show OctKeyParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OctKeyParameters] -> ShowS
$cshowList :: [OctKeyParameters] -> ShowS
show :: OctKeyParameters -> String
$cshow :: OctKeyParameters -> String
showsPrec :: Int -> OctKeyParameters -> ShowS
$cshowsPrec :: Int -> OctKeyParameters -> ShowS
Show)

octK :: Iso' OctKeyParameters Types.Base64Octets
octK :: p Base64Octets (f Base64Octets)
-> p OctKeyParameters (f OctKeyParameters)
octK = (OctKeyParameters -> Base64Octets)
-> (Base64Octets -> OctKeyParameters)
-> Iso OctKeyParameters OctKeyParameters Base64Octets 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 = String
-> (Object -> Parser OctKeyParameters)
-> Value
-> Parser OctKeyParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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
.= (Text
"oct" :: T.Text)
    , Key
"k" Key -> Base64Octets -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (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 OctKeyParameters Base64Octets Base64Octets
octK OctKeyParameters
k :: Types.Base64Octets)
    ]

instance Arbitrary OctKeyParameters where
  arbitrary :: Gen OctKeyParameters
arbitrary = Base64Octets -> OctKeyParameters
OctKeyParameters (Base64Octets -> OctKeyParameters)
-> Gen Base64Octets -> Gen OctKeyParameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Base64Octets
forall a. Arbitrary a => Gen a
arbitrary

signOct
  :: forall h e m. (HashAlgorithm h, MonadError e m, AsError e)
  => h
  -> OctKeyParameters
  -> B.ByteString
  -> m B.ByteString
signOct :: 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 ()
_KeySizeTooSmall
  else ByteString -> m ByteString
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)
  | X25519Key Curve25519.PublicKey (Maybe Curve25519.SecretKey)
  deriving (OKPKeyParameters -> OKPKeyParameters -> Bool
(OKPKeyParameters -> OKPKeyParameters -> Bool)
-> (OKPKeyParameters -> OKPKeyParameters -> Bool)
-> Eq OKPKeyParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
$c/= :: OKPKeyParameters -> OKPKeyParameters -> Bool
== :: OKPKeyParameters -> OKPKeyParameters -> Bool
$c== :: OKPKeyParameters -> OKPKeyParameters -> Bool
Eq)

instance Show OKPKeyParameters where
  show :: OKPKeyParameters -> String
show = \case
      Ed25519Key PublicKey
pk Maybe SecretKey
sk  -> String
"Ed25519 " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> String
forall a (f :: * -> *) b.
(Show a, Show (f String), Functor f) =>
a -> f b -> String
showKeys PublicKey
pk Maybe SecretKey
sk
      X25519Key PublicKey
pk Maybe SecretKey
sk   -> String
"X25519 " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PublicKey -> Maybe SecretKey -> String
forall a (f :: * -> *) b.
(Show a, Show (f String), Functor f) =>
a -> f b -> String
showKeys PublicKey
pk Maybe SecretKey
sk
    where
      showKeys :: a -> f b -> String
showKeys a
pk f b
sk = a -> String
forall a. Show a => a -> String
show a
pk String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> f String -> String
forall a. Show a => a -> String
show ((String
"SECRET" :: String) String -> f b -> f String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
sk)

instance FromJSON OKPKeyParameters where
  parseJSON :: Value -> Parser OKPKeyParameters
parseJSON = String
-> (Object -> Parser OKPKeyParameters)
-> Value
-> Parser OKPKeyParameters
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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 (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"   -> String -> Parser OKPKeyParameters
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Ed448 keys not implemented"
      Text
"X448"    -> String -> Parser OKPKeyParameters
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"X448 not implemented"
      Text
_         -> String -> Parser OKPKeyParameters
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (CryptoError -> String) -> CryptoError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) 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 (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 (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 (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)
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
.= (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
.= (Text
"Ed25519" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
forall a bin bin (t :: * -> *).
(KeyValue a, ByteArrayAccess bin, ByteArrayAccess bin,
 Foldable t) =>
bin -> t bin -> [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
.= (Text
"X25519" :: T.Text) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: PublicKey -> Maybe SecretKey -> [Pair]
forall a bin bin (t :: * -> *).
(KeyValue a, ByteArrayAccess bin, ByteArrayAccess bin,
 Foldable t) =>
bin -> t bin -> [a]
params PublicKey
pk Maybe SecretKey
sk
    where
      b64 :: bin -> Base64Octets
b64 = ByteString -> Base64Octets
Types.Base64Octets (ByteString -> Base64Octets)
-> (bin -> ByteString) -> bin -> Base64Octets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bin -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
      params :: bin -> t bin -> [a]
params bin
pk t bin
sk = Key
"x" Key -> Base64Octets -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= bin -> Base64Octets
forall bin. ByteArrayAccess bin => bin -> Base64Octets
b64 bin
pk a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((Key
"d" Key -> Base64Octets -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (Base64Octets -> a) -> (bin -> Base64Octets) -> bin -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bin -> Base64Octets
forall bin. ByteArrayAccess bin => bin -> Base64Octets
b64 (bin -> a) -> [bin] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t bin -> [bin]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t bin
sk)

instance Arbitrary OKPKeyParameters where
  arbitrary :: Gen OKPKeyParameters
arbitrary = [Gen OKPKeyParameters] -> Gen OKPKeyParameters
forall a. [Gen a] -> Gen a
oneof
    [ PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key
        (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> Gen PublicKey -> Gen (Maybe SecretKey -> OKPKeyParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> CryptoFailable PublicKey) -> Gen PublicKey
forall b. Int -> (ByteString -> CryptoFailable b) -> Gen b
keyOfLen Int
32 ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey
        Gen (Maybe SecretKey -> OKPKeyParameters)
-> Gen (Maybe SecretKey) -> Gen OKPKeyParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe SecretKey)] -> Gen (Maybe SecretKey)
forall a. [Gen a] -> Gen a
oneof [Maybe SecretKey -> Gen (Maybe SecretKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SecretKey
forall a. Maybe a
Nothing, SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just (SecretKey -> Maybe SecretKey)
-> Gen SecretKey -> Gen (Maybe SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> CryptoFailable SecretKey) -> Gen SecretKey
forall b. Int -> (ByteString -> CryptoFailable b) -> Gen b
keyOfLen Int
32 ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey]
    , PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key
        (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> Gen PublicKey -> Gen (Maybe SecretKey -> OKPKeyParameters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> CryptoFailable PublicKey) -> Gen PublicKey
forall b. Int -> (ByteString -> CryptoFailable b) -> Gen b
keyOfLen Int
32 ByteString -> CryptoFailable PublicKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable PublicKey
Curve25519.publicKey
        Gen (Maybe SecretKey -> OKPKeyParameters)
-> Gen (Maybe SecretKey) -> Gen OKPKeyParameters
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen (Maybe SecretKey)] -> Gen (Maybe SecretKey)
forall a. [Gen a] -> Gen a
oneof [Maybe SecretKey -> Gen (Maybe SecretKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SecretKey
forall a. Maybe a
Nothing, SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just (SecretKey -> Maybe SecretKey)
-> Gen SecretKey -> Gen (Maybe SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (ByteString -> CryptoFailable SecretKey) -> Gen SecretKey
forall b. Int -> (ByteString -> CryptoFailable b) -> Gen b
keyOfLen Int
32 ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve25519.secretKey]
    ]
    where
      bsOfLen :: Int -> Gen ByteString
bsOfLen Int
n = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
      keyOfLen :: Int -> (ByteString -> CryptoFailable b) -> Gen b
keyOfLen Int
n ByteString -> CryptoFailable b
con = (CryptoError -> b) -> (b -> b) -> CryptoFailable b -> b
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> (CryptoError -> String) -> CryptoError -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) b -> b
forall a. a -> a
id (CryptoFailable b -> b)
-> (ByteString -> CryptoFailable b) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable b
con (ByteString -> b) -> Gen ByteString -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
bsOfLen Int
n

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

instance Arbitrary OKPCrv where
  arbitrary :: Gen OKPCrv
arbitrary = [OKPCrv] -> Gen OKPCrv
forall a. [a] -> Gen a
elements [OKPCrv
Ed25519, OKPCrv
X25519]

genOKP :: MonadRandom m => OKPCrv -> m OKPKeyParameters
genOKP :: OKPCrv -> m OKPKeyParameters
genOKP = \case
  OKPCrv
Ed25519 -> Int
-> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable SecretKey)
-> (SecretKey -> PublicKey)
-> m OKPKeyParameters
forall (m :: * -> *) t a b.
MonadRandom m =>
Int
-> (t -> Maybe a -> b)
-> (ByteString -> CryptoFailable a)
-> (a -> t)
-> m b
go Int
32 PublicKey -> Maybe SecretKey -> OKPKeyParameters
Ed25519Key ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey SecretKey -> PublicKey
Ed25519.toPublic
  OKPCrv
X25519 -> Int
-> (PublicKey -> Maybe SecretKey -> OKPKeyParameters)
-> (ByteString -> CryptoFailable SecretKey)
-> (SecretKey -> PublicKey)
-> m OKPKeyParameters
forall (m :: * -> *) t a b.
MonadRandom m =>
Int
-> (t -> Maybe a -> b)
-> (ByteString -> CryptoFailable a)
-> (a -> t)
-> m b
go Int
32 PublicKey -> Maybe SecretKey -> OKPKeyParameters
X25519Key ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
Curve25519.secretKey SecretKey -> PublicKey
Curve25519.toPublic
  where
    go :: Int
-> (t -> Maybe a -> b)
-> (ByteString -> CryptoFailable a)
-> (a -> t)
-> m b
go Int
len t -> Maybe a -> b
con ByteString -> CryptoFailable a
skCon a -> t
toPub = do
      (ByteString
bs :: B.ByteString) <- Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
len
      let sk :: a
sk = (CryptoError -> a) -> (a -> a) -> CryptoFailable a -> a
forall r a. (CryptoError -> r) -> (a -> r) -> CryptoFailable a -> r
onCryptoFailure (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (CryptoError -> String) -> CryptoError -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoError -> String
forall a. Show a => a -> String
show) a -> a
forall a. a -> a
id (ByteString -> CryptoFailable a
skCon ByteString
bs)
      b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ t -> Maybe a -> b
con (a -> t
toPub a
sk) (a -> Maybe a
forall a. a -> Maybe a
Just a
sk)

signEdDSA
  :: (MonadError e m, AsError e)
  => OKPKeyParameters
  -> B.ByteString
  -> m B.ByteString
signEdDSA :: OKPKeyParameters -> ByteString -> m ByteString
signEdDSA (Ed25519Key PublicKey
pk (Just SecretKey
sk)) ByteString
m = ByteString -> m ByteString
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
_KeyMismatch Text
"not a private key"
signEdDSA OKPKeyParameters
_ 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
_KeyMismatch Text
"not an EdDSA key"

verifyEdDSA
  :: (BA.ByteArrayAccess msg, BA.ByteArrayAccess sig, MonadError e m, AsError e)
  => OKPKeyParameters -> msg -> sig -> m Bool
verifyEdDSA :: 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
_CryptoError)
    (Bool -> m Bool
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 OKPKeyParameters
_ msg
_ sig
_ = AReview e String -> String -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e String
forall r. AsError r => Prism' r String
_AlgorithmMismatch String
"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
/= :: KeyMaterial -> KeyMaterial -> Bool
$c/= :: KeyMaterial -> KeyMaterial -> Bool
== :: KeyMaterial -> KeyMaterial -> Bool
$c== :: KeyMaterial -> KeyMaterial -> Bool
Eq, Int -> KeyMaterial -> ShowS
[KeyMaterial] -> ShowS
KeyMaterial -> String
(Int -> KeyMaterial -> ShowS)
-> (KeyMaterial -> String)
-> ([KeyMaterial] -> ShowS)
-> Show KeyMaterial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMaterial] -> ShowS
$cshowList :: [KeyMaterial] -> ShowS
show :: KeyMaterial -> String
$cshow :: KeyMaterial -> String
showsPrec :: Int -> KeyMaterial -> ShowS
$cshowsPrec :: Int -> KeyMaterial -> ShowS
Show)

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

instance FromJSON KeyMaterial where
  parseJSON :: Value -> Parser KeyMaterial
parseJSON = String
-> (Object -> Parser KeyMaterial) -> Value -> Parser KeyMaterial
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"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     -> String -> Parser KeyMaterial
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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      -> String -> Parser KeyMaterial
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser KeyMaterial) -> String -> Parser KeyMaterial
forall a b. (a -> b) -> a -> b
$ String
"unsupported \"kty\": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
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
/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
$c/= :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
$c== :: KeyMaterialGenParam -> KeyMaterialGenParam -> Bool
Eq, Int -> KeyMaterialGenParam -> ShowS
[KeyMaterialGenParam] -> ShowS
KeyMaterialGenParam -> String
(Int -> KeyMaterialGenParam -> ShowS)
-> (KeyMaterialGenParam -> String)
-> ([KeyMaterialGenParam] -> ShowS)
-> Show KeyMaterialGenParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMaterialGenParam] -> ShowS
$cshowList :: [KeyMaterialGenParam] -> ShowS
show :: KeyMaterialGenParam -> String
$cshow :: KeyMaterialGenParam -> String
showsPrec :: Int -> KeyMaterialGenParam -> ShowS
$cshowsPrec :: Int -> KeyMaterialGenParam -> ShowS
Show)

instance Arbitrary KeyMaterialGenParam where
  arbitrary :: Gen KeyMaterialGenParam
arbitrary = [Gen KeyMaterialGenParam] -> Gen KeyMaterialGenParam
forall a. [Gen a] -> Gen a
oneof
    [ Crv -> KeyMaterialGenParam
ECGenParam (Crv -> KeyMaterialGenParam) -> Gen Crv -> Gen KeyMaterialGenParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Crv
forall a. Arbitrary a => Gen a
arbitrary
    , Int -> KeyMaterialGenParam
RSAGenParam (Int -> KeyMaterialGenParam) -> Gen Int -> Gen KeyMaterialGenParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> Gen Int
forall a. [a] -> Gen a
elements ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
2048, Int
3072, Int
4096])
    , Int -> KeyMaterialGenParam
OctGenParam (Int -> KeyMaterialGenParam) -> Gen Int -> Gen KeyMaterialGenParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int -> Int) -> Gen Int -> Gen Int -> Gen Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Gen Int
forall a. Integral a => Gen a
arbitrarySizedNatural ([Int] -> Gen Int
forall a. [a] -> Gen a
elements [Int
32, Int
48, Int
64])
    , OKPCrv -> KeyMaterialGenParam
OKPGenParam (OKPCrv -> KeyMaterialGenParam)
-> Gen OKPCrv -> Gen KeyMaterialGenParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OKPCrv
forall a. Arbitrary a => Gen a
arbitrary
    ]

genKeyMaterial :: MonadRandom m => KeyMaterialGenParam -> m KeyMaterial
genKeyMaterial :: 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 (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 :: Alg -> KeyMaterial -> ByteString -> m ByteString
sign Alg
JWA.JWS.None KeyMaterial
_ = \ByteString
_ -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
sign Alg
JWA.JWS.ES256 (ECKeyMaterial k :: ECKeyParameters
k@ECKeyParameters{ _ecCrv :: ECKeyParameters -> Crv
_ecCrv = Crv
P_256 }) = 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.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 String -> String -> m ByteString
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e String
forall r. AsError r => Prism' r String
_AlgorithmMismatch
  (Alg -> String
forall a. Show a => a -> String
show Alg
h String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cannot be used with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> String
showKeyType KeyMaterial
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" key")

verify
  :: (MonadError e m, AsError e)
  => JWA.JWS.Alg
  -> KeyMaterial
  -> B.ByteString
  -> B.ByteString
  -> m Bool
verify :: Alg -> KeyMaterial -> ByteString -> ByteString -> m Bool
verify Alg
JWA.JWS.None KeyMaterial
_ = \ByteString
_ ByteString
s -> Bool -> m Bool
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 ECKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 ECKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 ECKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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.RS256 (RSAKeyMaterial RSAKeyParameters
k) = (Bool -> m Bool) -> (ByteString -> Bool) -> ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> m Bool
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 String -> String -> m Bool
forall e (m :: * -> *) t x.
MonadError e m =>
AReview e t -> t -> m x
throwing AReview e String
forall r. AsError r => Prism' r String
_AlgorithmMismatch
  (Alg -> String
forall a. Show a => a -> String
show Alg
h String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cannot be used with " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KeyMaterial -> String
showKeyType KeyMaterial
k String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" key")

instance Arbitrary KeyMaterial where
  arbitrary :: Gen KeyMaterial
arbitrary = [Gen KeyMaterial] -> Gen KeyMaterial
forall a. [Gen a] -> Gen a
oneof
    [ ECKeyParameters -> KeyMaterial
ECKeyMaterial (ECKeyParameters -> KeyMaterial)
-> Gen ECKeyParameters -> Gen KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ECKeyParameters
forall a. Arbitrary a => Gen a
arbitrary
    , RSAKeyParameters -> KeyMaterial
RSAKeyMaterial (RSAKeyParameters -> KeyMaterial)
-> Gen RSAKeyParameters -> Gen KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RSAKeyParameters
forall a. Arbitrary a => Gen a
arbitrary
    , OctKeyParameters -> KeyMaterial
OctKeyMaterial (OctKeyParameters -> KeyMaterial)
-> Gen OctKeyParameters -> Gen KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OctKeyParameters
forall a. Arbitrary a => Gen a
arbitrary
    , OKPKeyParameters -> KeyMaterial
OKPKeyMaterial (OKPKeyParameters -> KeyMaterial)
-> Gen OKPKeyParameters -> Gen KeyMaterial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OKPKeyParameters
forall a. Arbitrary a => Gen a
arbitrary
    ]


-- | 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 :: (Maybe RSAKeyParameters -> f (Maybe RSAKeyParameters))
-> RSAKeyParameters -> f 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 :: (Maybe ECKeyParameters -> f (Maybe ECKeyParameters))
-> ECKeyParameters -> f 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 :: Maybe SizedBase64Integer
_ecD = Maybe SizedBase64Integer
forall a. Maybe a
Nothing })

instance AsPublicKey OKPKeyParameters where
  asPublicKey :: (Maybe OKPKeyParameters -> f (Maybe OKPKeyParameters))
-> OKPKeyParameters -> f OKPKeyParameters
asPublicKey = (OKPKeyParameters -> Maybe OKPKeyParameters)
-> (Maybe OKPKeyParameters -> f (Maybe OKPKeyParameters))
-> OKPKeyParameters
-> f OKPKeyParameters
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((OKPKeyParameters -> Maybe OKPKeyParameters)
 -> (Maybe OKPKeyParameters -> f (Maybe OKPKeyParameters))
 -> OKPKeyParameters
 -> f OKPKeyParameters)
-> (OKPKeyParameters -> Maybe OKPKeyParameters)
-> (Maybe OKPKeyParameters -> f (Maybe OKPKeyParameters))
-> OKPKeyParameters
-> f 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)
    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)

instance AsPublicKey KeyMaterial where
  asPublicKey :: (Maybe KeyMaterial -> f (Maybe KeyMaterial))
-> KeyMaterial -> f KeyMaterial
asPublicKey = (KeyMaterial -> Maybe KeyMaterial)
-> (Maybe KeyMaterial -> f (Maybe KeyMaterial))
-> KeyMaterial
-> f KeyMaterial
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((KeyMaterial -> Maybe KeyMaterial)
 -> (Maybe KeyMaterial -> f (Maybe KeyMaterial))
 -> KeyMaterial
 -> f KeyMaterial)
-> (KeyMaterial -> Maybe KeyMaterial)
-> (Maybe KeyMaterial -> f (Maybe KeyMaterial))
-> KeyMaterial
-> f 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)
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)
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)
asPublicKey OKPKeyParameters
k