-- Copyright (C) 2015, 2016  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 MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Crypto.JOSE.JWE
  (
    JWEHeader(..)

  , JWE(..)
  ) where

import Control.Applicative ((<|>))
import Data.Bifunctor (bimap)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))

import Control.Lens (view)
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Data.List.NonEmpty (NonEmpty)

import Crypto.Cipher.AES
import Crypto.Cipher.Types
import Crypto.Data.Padding
import Crypto.Error
import Crypto.Hash
import Crypto.MAC.HMAC
import Crypto.PubKey.MaskGenFunction
import qualified Crypto.PubKey.RSA.OAEP as OAEP

import Crypto.JOSE.AESKW
import Crypto.JOSE.Error
import Crypto.JOSE.Header
import Crypto.JOSE.JWA.JWE
import Crypto.JOSE.JWK
import qualified Crypto.JOSE.Types as Types
import qualified Crypto.JOSE.Types.Internal as Types


critInvalidNames :: [T.Text]
critInvalidNames :: [Text]
critInvalidNames =
  [ Text
"alg" , Text
"enc" , Text
"zip" , Text
"jku" , Text
"jwk" , Text
"kid"
  , Text
"x5u" , Text
"x5c" , Text
"x5t" , Text
"x5t#S256" , Text
"typ" , Text
"cty" , Text
"crit" ]

newtype CritParameters = CritParameters (NonEmpty (T.Text, Value))
  deriving (CritParameters -> CritParameters -> Bool
(CritParameters -> CritParameters -> Bool)
-> (CritParameters -> CritParameters -> Bool) -> Eq CritParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CritParameters -> CritParameters -> Bool
$c/= :: CritParameters -> CritParameters -> Bool
== :: CritParameters -> CritParameters -> Bool
$c== :: CritParameters -> CritParameters -> Bool
Eq, Int -> CritParameters -> ShowS
[CritParameters] -> ShowS
CritParameters -> String
(Int -> CritParameters -> ShowS)
-> (CritParameters -> String)
-> ([CritParameters] -> ShowS)
-> Show CritParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CritParameters] -> ShowS
$cshowList :: [CritParameters] -> ShowS
show :: CritParameters -> String
$cshow :: CritParameters -> String
showsPrec :: Int -> CritParameters -> ShowS
$cshowsPrec :: Int -> CritParameters -> ShowS
Show)


data JWEHeader p = JWEHeader
  { JWEHeader p -> Maybe AlgWithParams
_jweAlg :: Maybe AlgWithParams
  , JWEHeader p -> HeaderParam p Enc
_jweEnc :: HeaderParam p Enc
  , JWEHeader p -> Maybe Text
_jweZip :: Maybe T.Text  -- protected header only  "DEF" (DEFLATE) defined
  , JWEHeader p -> Maybe (HeaderParam p URI)
_jweJku :: Maybe (HeaderParam p Types.URI)
  , JWEHeader p -> Maybe (HeaderParam p JWK)
_jweJwk :: Maybe (HeaderParam p JWK)
  , JWEHeader p -> Maybe (HeaderParam p Text)
_jweKid :: Maybe (HeaderParam p T.Text)
  , JWEHeader p -> Maybe (HeaderParam p URI)
_jweX5u :: Maybe (HeaderParam p Types.URI)
  , JWEHeader p -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
_jweX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
  , JWEHeader p -> Maybe (HeaderParam p Base64SHA1)
_jweX5t :: Maybe (HeaderParam p Types.Base64SHA1)
  , JWEHeader p -> Maybe (HeaderParam p Base64SHA256)
_jweX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
  , JWEHeader p -> Maybe (HeaderParam p Text)
_jweTyp :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of object)
  , JWEHeader p -> Maybe (HeaderParam p Text)
_jweCty :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of payload)
  , JWEHeader p -> Maybe (NonEmpty Text)
_jweCrit :: Maybe (NonEmpty T.Text)
  }
  deriving (JWEHeader p -> JWEHeader p -> Bool
(JWEHeader p -> JWEHeader p -> Bool)
-> (JWEHeader p -> JWEHeader p -> Bool) -> Eq (JWEHeader p)
forall p. Eq p => JWEHeader p -> JWEHeader p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JWEHeader p -> JWEHeader p -> Bool
$c/= :: forall p. Eq p => JWEHeader p -> JWEHeader p -> Bool
== :: JWEHeader p -> JWEHeader p -> Bool
$c== :: forall p. Eq p => JWEHeader p -> JWEHeader p -> Bool
Eq, Int -> JWEHeader p -> ShowS
[JWEHeader p] -> ShowS
JWEHeader p -> String
(Int -> JWEHeader p -> ShowS)
-> (JWEHeader p -> String)
-> ([JWEHeader p] -> ShowS)
-> Show (JWEHeader p)
forall p. Show p => Int -> JWEHeader p -> ShowS
forall p. Show p => [JWEHeader p] -> ShowS
forall p. Show p => JWEHeader p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JWEHeader p] -> ShowS
$cshowList :: forall p. Show p => [JWEHeader p] -> ShowS
show :: JWEHeader p -> String
$cshow :: forall p. Show p => JWEHeader p -> String
showsPrec :: Int -> JWEHeader p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> JWEHeader p -> ShowS
Show)

newJWEHeader :: ProtectionIndicator p => AlgWithParams -> Enc -> JWEHeader p
newJWEHeader :: AlgWithParams -> Enc -> JWEHeader p
newJWEHeader AlgWithParams
alg Enc
enc =
  Maybe AlgWithParams
-> HeaderParam p Enc
-> Maybe Text
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWEHeader p
forall p.
Maybe AlgWithParams
-> HeaderParam p Enc
-> Maybe Text
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWEHeader p
JWEHeader (AlgWithParams -> Maybe AlgWithParams
forall a. a -> Maybe a
Just AlgWithParams
alg) (p -> Enc -> HeaderParam p Enc
forall p a. p -> a -> HeaderParam p a
HeaderParam p
forall a. ProtectionIndicator a => a
getProtected Enc
enc) Maybe Text
forall a. Maybe a
z Maybe (HeaderParam p URI)
forall a. Maybe a
z Maybe (HeaderParam p JWK)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (HeaderParam p URI)
forall a. Maybe a
z Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall a. Maybe a
z Maybe (HeaderParam p Base64SHA1)
forall a. Maybe a
z Maybe (HeaderParam p Base64SHA256)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (HeaderParam p Text)
forall a. Maybe a
z Maybe (NonEmpty Text)
forall a. Maybe a
z
  where z :: Maybe a
z = Maybe a
forall a. Maybe a
Nothing

instance HasParams JWEHeader where
  parseParamsFor :: Proxy b -> Maybe Object -> Maybe Object -> Parser (JWEHeader p)
parseParamsFor Proxy b
proxy Maybe Object
hp Maybe Object
hu = Maybe AlgWithParams
-> HeaderParam p Enc
-> Maybe Text
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWEHeader p
forall p.
Maybe AlgWithParams
-> HeaderParam p Enc
-> Maybe Text
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p JWK)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p URI)
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p Base64SHA1)
-> Maybe (HeaderParam p Base64SHA256)
-> Maybe (HeaderParam p Text)
-> Maybe (HeaderParam p Text)
-> Maybe (NonEmpty Text)
-> JWEHeader p
JWEHeader
    (Maybe AlgWithParams
 -> HeaderParam p Enc
 -> Maybe Text
 -> Maybe (HeaderParam p URI)
 -> Maybe (HeaderParam p JWK)
 -> Maybe (HeaderParam p Text)
 -> Maybe (HeaderParam p URI)
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
 -> Maybe (HeaderParam p Base64SHA1)
 -> Maybe (HeaderParam p Base64SHA256)
 -> Maybe (HeaderParam p Text)
 -> Maybe (HeaderParam p Text)
 -> Maybe (NonEmpty Text)
 -> JWEHeader p)
-> Parser (Maybe AlgWithParams)
-> Parser
     (HeaderParam p Enc
      -> Maybe Text
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Maybe AlgWithParams)
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object (Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hp Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hu))
    Parser
  (HeaderParam p Enc
   -> Maybe Text
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (HeaderParam p Enc)
-> Parser
     (Maybe Text
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p Enc)
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text -> Maybe Object -> Maybe Object -> Parser (HeaderParam p a)
headerRequired Text
"enc" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe Text
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe Text)
-> Parser
     (Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Object -> Maybe Object -> Parser (Maybe Text)
forall a.
FromJSON a =>
Text -> Maybe Object -> Maybe Object -> Parser (Maybe a)
headerOptionalProtected Text
"zip" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p URI))
-> Parser
     (Maybe (HeaderParam p JWK)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p URI))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"jku" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p JWK)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p JWK))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p JWK))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"jwk" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser
     (Maybe (HeaderParam p URI)
      -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"kid" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p URI)
   -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p URI))
-> Parser
     (Maybe (HeaderParam p (NonEmpty SignedCertificate))
      -> Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p URI))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5u" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p (NonEmpty SignedCertificate))
   -> Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> Parser
     (Maybe (HeaderParam p Base64SHA1)
      -> Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe (HeaderParam p (NonEmpty Base64X509))
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (HeaderParam p (NonEmpty Base64X509))
  -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
 -> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
 -> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate))))
-> ((Base64X509 -> SignedCertificate)
    -> Maybe (HeaderParam p (NonEmpty Base64X509))
    -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> (Base64X509 -> SignedCertificate)
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
-> Parser (Maybe (HeaderParam p (NonEmpty SignedCertificate)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderParam p (NonEmpty Base64X509)
 -> HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (HeaderParam p (NonEmpty Base64X509))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HeaderParam p (NonEmpty Base64X509)
  -> HeaderParam p (NonEmpty SignedCertificate))
 -> Maybe (HeaderParam p (NonEmpty Base64X509))
 -> Maybe (HeaderParam p (NonEmpty SignedCertificate)))
-> ((Base64X509 -> SignedCertificate)
    -> HeaderParam p (NonEmpty Base64X509)
    -> HeaderParam p (NonEmpty SignedCertificate))
-> (Base64X509 -> SignedCertificate)
-> Maybe (HeaderParam p (NonEmpty Base64X509))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> HeaderParam p (NonEmpty Base64X509)
-> HeaderParam p (NonEmpty SignedCertificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty Base64X509 -> NonEmpty SignedCertificate)
 -> HeaderParam p (NonEmpty Base64X509)
 -> HeaderParam p (NonEmpty SignedCertificate))
-> ((Base64X509 -> SignedCertificate)
    -> NonEmpty Base64X509 -> NonEmpty SignedCertificate)
-> (Base64X509 -> SignedCertificate)
-> HeaderParam p (NonEmpty Base64X509)
-> HeaderParam p (NonEmpty SignedCertificate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base64X509 -> SignedCertificate)
-> NonEmpty Base64X509 -> NonEmpty SignedCertificate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
          (\(Types.Base64X509 SignedCertificate
cert) -> SignedCertificate
cert) (Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p (NonEmpty Base64X509)))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5c" Maybe Object
hp Maybe Object
hu)
    Parser
  (Maybe (HeaderParam p Base64SHA1)
   -> Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p Base64SHA1))
-> Parser
     (Maybe (HeaderParam p Base64SHA256)
      -> Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Base64SHA1))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5t" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Base64SHA256)
   -> Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p Base64SHA256))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text)
      -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Base64SHA256))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"x5t#S256" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text)
   -> JWEHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser
     (Maybe (HeaderParam p Text)
      -> Maybe (NonEmpty Text) -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"typ" Maybe Object
hp Maybe Object
hu
    Parser
  (Maybe (HeaderParam p Text)
   -> Maybe (NonEmpty Text) -> JWEHeader p)
-> Parser (Maybe (HeaderParam p Text))
-> Parser (Maybe (NonEmpty Text) -> JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Maybe Object
-> Maybe Object
-> Parser (Maybe (HeaderParam p Text))
forall a p.
(FromJSON a, ProtectionIndicator p) =>
Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (HeaderParam p a))
headerOptional Text
"cty" Maybe Object
hp Maybe Object
hu
    Parser (Maybe (NonEmpty Text) -> JWEHeader p)
-> Parser (Maybe (NonEmpty Text)) -> Parser (JWEHeader p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text
-> Maybe Object -> Maybe Object -> Parser (Maybe (NonEmpty Text))
forall a.
FromJSON a =>
Text -> Maybe Object -> Maybe Object -> Parser (Maybe a)
headerOptionalProtected Text
"crit" Maybe Object
hp Maybe Object
hu
      Parser (Maybe (NonEmpty Text))
-> (Maybe (NonEmpty Text) -> Parser (Maybe (NonEmpty Text)))
-> Parser (Maybe (NonEmpty Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text]
-> [Text]
-> Object
-> Maybe (NonEmpty Text)
-> Parser (Maybe (NonEmpty Text))
forall (t0 :: * -> *) (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *)
       (m :: * -> *).
(Foldable t0, Foldable t1, Traversable t2, Traversable t3,
 MonadFail m) =>
t0 Text -> t1 Text -> Object -> t2 (t3 Text) -> m (t2 (t3 Text))
parseCrit [Text]
critInvalidNames (Proxy b -> [Text]
forall (a :: * -> *). HasParams a => Proxy a -> [Text]
extensions Proxy b
proxy)
        (Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hp Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty Maybe Object
hu))
  params :: JWEHeader p -> [(Bool, Pair)]
params (JWEHeader Maybe AlgWithParams
alg HeaderParam p Enc
enc Maybe Text
zip' Maybe (HeaderParam p URI)
jku Maybe (HeaderParam p JWK)
jwk Maybe (HeaderParam p Text)
kid Maybe (HeaderParam p URI)
x5u Maybe (HeaderParam p (NonEmpty SignedCertificate))
x5c Maybe (HeaderParam p Base64SHA1)
x5t Maybe (HeaderParam p Base64SHA256)
x5tS256 Maybe (HeaderParam p Text)
typ Maybe (HeaderParam p Text)
cty Maybe (NonEmpty Text)
crit) =
    [Maybe (Bool, Pair)] -> [(Bool, Pair)]
forall a. [Maybe a] -> [a]
catMaybes
      [ Maybe (Bool, Pair)
forall a. HasCallStack => a
undefined -- TODO
      , (Bool, Pair) -> Maybe (Bool, Pair)
forall a. a -> Maybe a
Just (Getting Bool (HeaderParam p Enc) Bool -> HeaderParam p Enc -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Enc) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Enc
enc,      Key
"enc" Key -> Enc -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Enc (HeaderParam p Enc) Enc -> HeaderParam p Enc -> Enc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Enc (HeaderParam p Enc) Enc
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Enc
enc)
      , (Text -> (Bool, Pair)) -> Maybe Text -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
p -> (Bool
True, Key
"zip" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
p)) Maybe Text
zip'
      , (HeaderParam p URI -> (Bool, Pair))
-> Maybe (HeaderParam p URI) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p URI
p -> (Getting Bool (HeaderParam p URI) Bool -> HeaderParam p URI -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p URI) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p URI
p, Key
"jku" Key -> URI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting URI (HeaderParam p URI) URI -> HeaderParam p URI -> URI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URI (HeaderParam p URI) URI
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p URI
p)) Maybe (HeaderParam p URI)
jku
      , (HeaderParam p JWK -> (Bool, Pair))
-> Maybe (HeaderParam p JWK) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p JWK
p -> (Getting Bool (HeaderParam p JWK) Bool -> HeaderParam p JWK -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p JWK) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p JWK
p, Key
"jwk" Key -> JWK -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting JWK (HeaderParam p JWK) JWK -> HeaderParam p JWK -> JWK
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting JWK (HeaderParam p JWK) JWK
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p JWK
p)) Maybe (HeaderParam p JWK)
jwk
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"kid" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) Maybe (HeaderParam p Text)
kid
      , (HeaderParam p URI -> (Bool, Pair))
-> Maybe (HeaderParam p URI) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p URI
p -> (Getting Bool (HeaderParam p URI) Bool -> HeaderParam p URI -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p URI) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p URI
p, Key
"x5u" Key -> URI -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting URI (HeaderParam p URI) URI -> HeaderParam p URI -> URI
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting URI (HeaderParam p URI) URI
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p URI
p)) Maybe (HeaderParam p URI)
x5u
      , (HeaderParam p (NonEmpty SignedCertificate) -> (Bool, Pair))
-> Maybe (HeaderParam p (NonEmpty SignedCertificate))
-> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p (NonEmpty SignedCertificate)
p -> (Getting Bool (HeaderParam p (NonEmpty SignedCertificate)) Bool
-> HeaderParam p (NonEmpty SignedCertificate) -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p (NonEmpty SignedCertificate)) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p (NonEmpty SignedCertificate)
p, Key
"x5c" Key -> NonEmpty Base64X509 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (SignedCertificate -> Base64X509)
-> NonEmpty SignedCertificate -> NonEmpty Base64X509
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SignedCertificate -> Base64X509
Types.Base64X509 (Getting
  (NonEmpty SignedCertificate)
  (HeaderParam p (NonEmpty SignedCertificate))
  (NonEmpty SignedCertificate)
-> HeaderParam p (NonEmpty SignedCertificate)
-> NonEmpty SignedCertificate
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (NonEmpty SignedCertificate)
  (HeaderParam p (NonEmpty SignedCertificate))
  (NonEmpty SignedCertificate)
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p (NonEmpty SignedCertificate)
p))) Maybe (HeaderParam p (NonEmpty SignedCertificate))
x5c
      , (HeaderParam p Base64SHA1 -> (Bool, Pair))
-> Maybe (HeaderParam p Base64SHA1) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Base64SHA1
p -> (Getting Bool (HeaderParam p Base64SHA1) Bool
-> HeaderParam p Base64SHA1 -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Base64SHA1) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Base64SHA1
p, Key
"x5t" Key -> Base64SHA1 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Base64SHA1 (HeaderParam p Base64SHA1) Base64SHA1
-> HeaderParam p Base64SHA1 -> Base64SHA1
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64SHA1 (HeaderParam p Base64SHA1) Base64SHA1
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Base64SHA1
p)) Maybe (HeaderParam p Base64SHA1)
x5t
      , (HeaderParam p Base64SHA256 -> (Bool, Pair))
-> Maybe (HeaderParam p Base64SHA256) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Base64SHA256
p -> (Getting Bool (HeaderParam p Base64SHA256) Bool
-> HeaderParam p Base64SHA256 -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Base64SHA256) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Base64SHA256
p, Key
"x5t#S256" Key -> Base64SHA256 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Base64SHA256 (HeaderParam p Base64SHA256) Base64SHA256
-> HeaderParam p Base64SHA256 -> Base64SHA256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Base64SHA256 (HeaderParam p Base64SHA256) Base64SHA256
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Base64SHA256
p)) Maybe (HeaderParam p Base64SHA256)
x5tS256
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"typ" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) Maybe (HeaderParam p Text)
typ
      , (HeaderParam p Text -> (Bool, Pair))
-> Maybe (HeaderParam p Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HeaderParam p Text
p -> (Getting Bool (HeaderParam p Text) Bool
-> HeaderParam p Text -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool (HeaderParam p Text) Bool
forall p a. ProtectionIndicator p => Getter (HeaderParam p a) Bool
isProtected HeaderParam p Text
p, Key
"cty" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Getting Text (HeaderParam p Text) Text
-> HeaderParam p Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (HeaderParam p Text) Text
forall p a. Lens' (HeaderParam p a) a
param HeaderParam p Text
p)) Maybe (HeaderParam p Text)
cty
      , (NonEmpty Text -> (Bool, Pair))
-> Maybe (NonEmpty Text) -> Maybe (Bool, Pair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty Text
p -> (Bool
True, Key
"crit" Key -> NonEmpty Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty Text
p)) Maybe (NonEmpty Text)
crit
      ]


data JWERecipient a p = JWERecipient
  { JWERecipient a p -> a p
_jweHeader :: a p
  , JWERecipient a p -> Maybe Base64Octets
_jweEncryptedKey :: Maybe Types.Base64Octets  -- ^ JWE Encrypted Key
  }

instance FromJSON (JWERecipient a p) where
  parseJSON :: Value -> Parser (JWERecipient a p)
parseJSON = String
-> (Object -> Parser (JWERecipient a p))
-> Value
-> Parser (JWERecipient a p)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWE Recipient" ((Object -> Parser (JWERecipient a p))
 -> Value -> Parser (JWERecipient a p))
-> (Object -> Parser (JWERecipient a p))
-> Value
-> Parser (JWERecipient a p)
forall a b. (a -> b) -> a -> b
$ \Object
o -> a p -> Maybe Base64Octets -> JWERecipient a p
forall (a :: * -> *) p.
a p -> Maybe Base64Octets -> JWERecipient a p
JWERecipient
    (a p -> Maybe Base64Octets -> JWERecipient a p)
-> Parser (a p) -> Parser (Maybe Base64Octets -> JWERecipient a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (a p)
forall a. HasCallStack => a
undefined -- o .:? "header"
    Parser (Maybe Base64Octets -> JWERecipient a p)
-> Parser (Maybe Base64Octets) -> Parser (JWERecipient a p)
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
"encrypted_key"

parseRecipient
  :: (HasParams a, ProtectionIndicator p)
  => Maybe Object -> Maybe Object -> Value -> Parser (JWERecipient a p)
parseRecipient :: Maybe Object -> Maybe Object -> Value -> Parser (JWERecipient a p)
parseRecipient Maybe Object
hp Maybe Object
hu = String
-> (Object -> Parser (JWERecipient a p))
-> Value
-> Parser (JWERecipient a p)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWE Recipient" ((Object -> Parser (JWERecipient a p))
 -> Value -> Parser (JWERecipient a p))
-> (Object -> Parser (JWERecipient a p))
-> Value
-> Parser (JWERecipient a p)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  Maybe Object
hr <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"header"
  a p -> Maybe Base64Octets -> JWERecipient a p
forall (a :: * -> *) p.
a p -> Maybe Base64Octets -> JWERecipient a p
JWERecipient
    (a p -> Maybe Base64Octets -> JWERecipient a p)
-> Parser (a p) -> Parser (Maybe Base64Octets -> JWERecipient a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Object -> Maybe Object -> Parser (a p)
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Maybe Object -> Maybe Object -> Parser (a p)
parseParams Maybe Object
hp (Maybe Object
hu Maybe Object -> Maybe Object -> Maybe Object
forall a. Semigroup a => a -> a -> a
<> Maybe Object
hr)  -- TODO fail on key collision in (hr <> hu)
    Parser (Maybe Base64Octets -> JWERecipient a p)
-> Parser (Maybe Base64Octets) -> Parser (JWERecipient a p)
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
"encrypted_key"

-- parseParamsFor :: HasParams b => Proxy b -> Maybe Object -> Maybe Object -> Parser a

data JWE a p = JWE
  { JWE a p -> Maybe Text
_protectedRaw :: Maybe T.Text       -- ^ Encoded protected header, if available
  , JWE a p -> Maybe Base64Octets
_jweIv :: Maybe Types.Base64Octets  -- ^ JWE Initialization Vector
  , JWE a p -> Maybe Base64Octets
_jweAad :: Maybe Types.Base64Octets -- ^ JWE AAD
  , JWE a p -> Base64Octets
_jweCiphertext :: Types.Base64Octets  -- ^ JWE Ciphertext
  , JWE a p -> Maybe Base64Octets
_jweTag :: Maybe Types.Base64Octets  -- ^ JWE Authentication Tag
  , JWE a p -> [JWERecipient a p]
_jweRecipients :: [JWERecipient a p]
  }

instance (HasParams a, ProtectionIndicator p) => FromJSON (JWE a p) where
  parseJSON :: Value -> Parser (JWE a p)
parseJSON = String -> (Object -> Parser (JWE a p)) -> Value -> Parser (JWE a p)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWE JSON Serialization" ((Object -> Parser (JWE a p)) -> Value -> Parser (JWE a p))
-> (Object -> Parser (JWE a p)) -> Value -> Parser (JWE a p)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Value
hpB64 <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected"
    Maybe Object
hp <- Parser (Maybe Object)
-> (Value -> Parser (Maybe Object))
-> Maybe Value
-> Parser (Maybe Object)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Maybe Object -> Parser (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing)
      (String
-> (Text -> Parser (Maybe Object))
-> Value
-> Parser (Maybe Object)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"base64url-encoded header params"
        ((ByteString -> Parser (Maybe Object))
-> Text -> Parser (Maybe Object)
forall a. (ByteString -> Parser a) -> Text -> Parser a
Types.parseB64Url (Parser (Maybe Object)
-> (Maybe Object -> Parser (Maybe Object))
-> Maybe (Maybe Object)
-> Parser (Maybe Object)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (String -> Parser (Maybe Object)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"protected header contains invalid JSON")
          Maybe Object -> Parser (Maybe Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Maybe Object) -> Parser (Maybe Object))
-> (ByteString -> Maybe (Maybe Object))
-> ByteString
-> Parser (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Maybe Object)
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe (Maybe Object))
-> (ByteString -> ByteString) -> ByteString -> Maybe (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict)))
      Maybe Value
hpB64
    Maybe Object
hu <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unprotected"
    Maybe Text
-> Maybe Base64Octets
-> Maybe Base64Octets
-> Base64Octets
-> Maybe Base64Octets
-> [JWERecipient a p]
-> JWE a p
forall (a :: * -> *) p.
Maybe Text
-> Maybe Base64Octets
-> Maybe Base64Octets
-> Base64Octets
-> Maybe Base64Octets
-> [JWERecipient a p]
-> JWE a p
JWE
      (Maybe Text
 -> Maybe Base64Octets
 -> Maybe Base64Octets
 -> Base64Octets
 -> Maybe Base64Octets
 -> [JWERecipient a p]
 -> JWE a p)
-> Parser (Maybe Text)
-> Parser
     (Maybe Base64Octets
      -> Maybe Base64Octets
      -> Base64Octets
      -> Maybe Base64Octets
      -> [JWERecipient a p]
      -> JWE a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protected" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""))  -- raw protected header
      Parser
  (Maybe Base64Octets
   -> Maybe Base64Octets
   -> Base64Octets
   -> Maybe Base64Octets
   -> [JWERecipient a p]
   -> JWE a p)
-> Parser (Maybe Base64Octets)
-> Parser
     (Maybe Base64Octets
      -> Base64Octets
      -> Maybe Base64Octets
      -> [JWERecipient a p]
      -> JWE a p)
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
"iv"
      Parser
  (Maybe Base64Octets
   -> Base64Octets
   -> Maybe Base64Octets
   -> [JWERecipient a p]
   -> JWE a p)
-> Parser (Maybe Base64Octets)
-> Parser
     (Base64Octets
      -> Maybe Base64Octets -> [JWERecipient a p] -> JWE a p)
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
"aad"
      Parser
  (Base64Octets
   -> Maybe Base64Octets -> [JWERecipient a p] -> JWE a p)
-> Parser Base64Octets
-> Parser (Maybe Base64Octets -> [JWERecipient a p] -> JWE a p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Base64Octets
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ciphertext"
      Parser (Maybe Base64Octets -> [JWERecipient a p] -> JWE a p)
-> Parser (Maybe Base64Octets)
-> Parser ([JWERecipient a p] -> JWE a p)
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
"tag"
      Parser ([JWERecipient a p] -> JWE a p)
-> Parser [JWERecipient a p] -> Parser (JWE a p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"recipients" Parser [Value]
-> ([Value] -> Parser [JWERecipient a p])
-> Parser [JWERecipient a p]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser (JWERecipient a p))
-> [Value] -> Parser [JWERecipient a p]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Maybe Object -> Maybe Object -> Value -> Parser (JWERecipient a p)
forall (a :: * -> *) p.
(HasParams a, ProtectionIndicator p) =>
Maybe Object -> Maybe Object -> Value -> Parser (JWERecipient a p)
parseRecipient Maybe Object
hp Maybe Object
hu))
  -- TODO flattened serialization


wrap
  :: MonadRandom m
  => AlgWithParams
  -> KeyMaterial
  -> B.ByteString  -- ^ message (key to wrap)
  -> m (Either Error (AlgWithParams, B.ByteString))
wrap :: AlgWithParams
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrap alg :: AlgWithParams
alg@AlgWithParams
RSA_OAEP (RSAKeyMaterial RSAKeyParameters
k) ByteString
m = (Error -> Error)
-> (ByteString -> (AlgWithParams, ByteString))
-> Either Error ByteString
-> Either Error (AlgWithParams, ByteString)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Error -> Error
RSAError (AlgWithParams
alg,) (Either Error ByteString
 -> Either Error (AlgWithParams, ByteString))
-> m (Either Error ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  OAEPParams SHA1 ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (SHA1
-> MaskGenAlgorithm ByteString ByteString
-> Maybe ByteString
-> OAEPParams SHA1 ByteString ByteString
forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
OAEP.OAEPParams SHA1
SHA1 (SHA1 -> MaskGenAlgorithm ByteString ByteString
forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA1
SHA1) Maybe ByteString
forall a. Maybe a
Nothing) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k) ByteString
m
wrap AlgWithParams
RSA_OAEP KeyMaterial
_ ByteString
_ = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (AlgWithParams, ByteString)
forall a b. a -> Either a b
Left (Error -> Either Error (AlgWithParams, ByteString))
-> Error -> Either Error (AlgWithParams, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Error
AlgorithmMismatch String
"Cannot use RSA_OAEP with non-RSA key"
wrap alg :: AlgWithParams
alg@AlgWithParams
RSA_OAEP_256 (RSAKeyMaterial RSAKeyParameters
k) ByteString
m = (Error -> Error)
-> (ByteString -> (AlgWithParams, ByteString))
-> Either Error ByteString
-> Either Error (AlgWithParams, ByteString)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Error -> Error
RSAError (AlgWithParams
alg,) (Either Error ByteString
 -> Either Error (AlgWithParams, ByteString))
-> m (Either Error ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  OAEPParams SHA256 ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (SHA256
-> MaskGenAlgorithm ByteString ByteString
-> Maybe ByteString
-> OAEPParams SHA256 ByteString ByteString
forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
OAEP.OAEPParams SHA256
SHA256 (SHA256 -> MaskGenAlgorithm ByteString ByteString
forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA256
SHA256) Maybe ByteString
forall a. Maybe a
Nothing) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k) ByteString
m
wrap AlgWithParams
RSA_OAEP_256 KeyMaterial
_ ByteString
_ = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (AlgWithParams, ByteString)
forall a b. a -> Either a b
Left (Error -> Either Error (AlgWithParams, ByteString))
-> Error -> Either Error (AlgWithParams, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Error
AlgorithmMismatch String
"Cannot use RSA_OAEP_256 with non-RSA key"
wrap AlgWithParams
A128KW (OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))) ByteString
m
  = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A128KW,) (ByteString -> (AlgWithParams, ByteString))
-> Either Error ByteString
-> Either Error (AlgWithParams, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable AES128 -> ByteString -> Either Error ByteString
forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (ByteString -> CryptoFailable AES128
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k :: CryptoFailable AES128) ByteString
m
wrap AlgWithParams
A192KW (OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))) ByteString
m
  = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A192KW,) (ByteString -> (AlgWithParams, ByteString))
-> Either Error ByteString
-> Either Error (AlgWithParams, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable AES192 -> ByteString -> Either Error ByteString
forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (ByteString -> CryptoFailable AES192
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k :: CryptoFailable AES192) ByteString
m
wrap AlgWithParams
A256KW (OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))) ByteString
m
  = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A256KW,) (ByteString -> (AlgWithParams, ByteString))
-> Either Error ByteString
-> Either Error (AlgWithParams, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable AES256 -> ByteString -> Either Error ByteString
forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (ByteString -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k :: CryptoFailable AES256) ByteString
m
wrap (A128GCMKW AESGCMParameters
_) KeyMaterial
k ByteString
m = (AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *).
MonadRandom m =>
(AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrapAESGCM AESGCMParameters -> AlgWithParams
A128GCMKW Enc
A128GCM KeyMaterial
k ByteString
m
wrap (A192GCMKW AESGCMParameters
_) KeyMaterial
k ByteString
m = (AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *).
MonadRandom m =>
(AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrapAESGCM AESGCMParameters -> AlgWithParams
A192GCMKW Enc
A192GCM KeyMaterial
k ByteString
m
wrap (A256GCMKW AESGCMParameters
_) KeyMaterial
k ByteString
m = (AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *).
MonadRandom m =>
(AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrapAESGCM AESGCMParameters -> AlgWithParams
A256GCMKW Enc
A256GCM KeyMaterial
k ByteString
m
wrap AlgWithParams
_ KeyMaterial
_ ByteString
_ = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (AlgWithParams, ByteString)
forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented

wrapAESKW
  :: BlockCipher128 cipher
  => CryptoFailable cipher
  -> B.ByteString -- ^ plaintext key (to be encrypted)
  -> Either Error B.ByteString -- ^ encrypted key
wrapAESKW :: CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW CryptoFailable cipher
cipher ByteString
m = case CryptoFailable cipher
cipher of
  CryptoFailed CryptoError
e -> Error -> Either Error ByteString
forall a b. a -> Either a b
Left (CryptoError -> Error
CryptoError CryptoError
e)
  CryptoPassed cipher
cipher' -> ByteString -> Either Error ByteString
forall a b. b -> Either a b
Right (cipher -> ByteString -> ByteString
forall m c cipher.
(ByteArrayAccess m, ByteArray c, BlockCipher128 cipher) =>
cipher -> m -> c
aesKeyWrap cipher
cipher' ByteString
m)

wrapAESGCM
  :: MonadRandom m
  => (AESGCMParameters -> AlgWithParams)
  -> Enc
  -> KeyMaterial
  -> B.ByteString
  -> m (Either Error (AlgWithParams, B.ByteString))
wrapAESGCM :: (AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrapAESGCM AESGCMParameters -> AlgWithParams
f Enc
enc (OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))) ByteString
m =
  ((ByteString, ByteString, ByteString)
 -> (AlgWithParams, ByteString))
-> Either Error (ByteString, ByteString, ByteString)
-> Either Error (AlgWithParams, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteString
iv, ByteString
tag, ByteString
m') -> (AESGCMParameters -> AlgWithParams
f (Base64Octets -> Base64Octets -> AESGCMParameters
AESGCMParameters (ByteString -> Base64Octets
Types.Base64Octets ByteString
iv) (ByteString -> Base64Octets
Types.Base64Octets ByteString
tag)), ByteString
m'))
  (Either Error (ByteString, ByteString, ByteString)
 -> Either Error (AlgWithParams, ByteString))
-> m (Either Error (ByteString, ByteString, ByteString))
-> m (Either Error (AlgWithParams, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Enc
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *).
MonadRandom m =>
Enc
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
encrypt Enc
enc ByteString
k ByteString
m ByteString
""
wrapAESGCM AESGCMParameters -> AlgWithParams
_ Enc
_ KeyMaterial
_ ByteString
_ = Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (AlgWithParams, ByteString)
 -> m (Either Error (AlgWithParams, ByteString)))
-> Either Error (AlgWithParams, ByteString)
-> m (Either Error (AlgWithParams, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (AlgWithParams, ByteString)
forall a b. a -> Either a b
Left (Error -> Either Error (AlgWithParams, ByteString))
-> Error -> Either Error (AlgWithParams, ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Error
AlgorithmMismatch String
"Cannot use AESGCMKW with non-Oct key"

encrypt
  :: MonadRandom m
  => Enc
  -> B.ByteString -- ^ key
  -> B.ByteString  -- ^ message
  -> B.ByteString  -- ^ AAD
  -> m (Either Error (B.ByteString, B.ByteString, B.ByteString))
encrypt :: Enc
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
encrypt Enc
A128CBC_HS256 ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
32 -> AES128
-> SHA256
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (AES128
forall a. HasCallStack => a
undefined :: AES128) SHA256
SHA256 ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall
encrypt Enc
A192CBC_HS384 ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
48 -> AES192
-> SHA384
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (AES192
forall a. HasCallStack => a
undefined :: AES192) SHA384
SHA384 ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall
encrypt Enc
A256CBC_HS512 ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
64 -> AES256
-> SHA512
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (AES256
forall a. HasCallStack => a
undefined :: AES256) SHA512
SHA512 ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall
encrypt Enc
A128GCM ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
16 -> AES128
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (AES128
forall a. HasCallStack => a
undefined :: AES128) ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall
encrypt Enc
A192GCM ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
24 -> AES192
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (AES192
forall a. HasCallStack => a
undefined :: AES192) ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall
encrypt Enc
A256GCM ByteString
k ByteString
m ByteString
a = case ByteString -> Int
B.length ByteString
k of
  Int
32 -> AES256
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (AES256
forall a. HasCallStack => a
undefined :: AES256) ByteString
k ByteString
m ByteString
a
  Int
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
KeySizeTooSmall

_cbcHmacEnc
  :: forall e h m. (BlockCipher e, HashAlgorithm h, MonadRandom m)
  => e
  -> h
  -> B.ByteString -- ^ key
  -> B.ByteString -- ^ message
  -> B.ByteString -- ^ additional authenticated data
  -> m (Either Error (B.ByteString, B.ByteString, B.ByteString))  -- ^ IV, cipertext and MAC
_cbcHmacEnc :: e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc e
_ h
_ ByteString
k ByteString
m ByteString
aad = do
  let
    kLen :: Int
kLen = ByteString -> Int
B.length ByteString
k Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
    (ByteString
eKey, ByteString
mKey) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
kLen ByteString
k
    aadLen :: ByteString
aadLen = ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, Maybe Int) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe Int) -> ByteString)
-> (ByteString, Maybe Int) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> Maybe (Word8, Int)) -> Int -> (ByteString, Maybe Int)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN Int
8 (\Int
x -> (Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
256)) (ByteString -> Int
B.length ByteString
aad)
  case ByteString -> CryptoFailable e
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
eKey of
    CryptoFailed CryptoError
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
    CryptoPassed (e
e :: e) -> do
      ByteString
iv <- Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16
      let Just IV e
iv' = ByteString -> Maybe (IV e)
forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
iv
      let m' :: ByteString
m' = Format -> ByteString -> ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ e -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize e
e) ByteString
m
      let c :: ByteString
c = e -> IV e -> ByteString -> ByteString
forall cipher ba.
(BlockCipher cipher, ByteArray ba) =>
cipher -> IV cipher -> ba -> ba
cbcEncrypt e
e IV e
iv' ByteString
m'
      let hmacInput :: ByteString
hmacInput = [ByteString] -> ByteString
B.concat [ByteString
aad, ByteString
iv, ByteString
c, ByteString
aadLen]
      let tag :: ByteString
tag = Int -> ByteString -> ByteString
B.take Int
kLen (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
forall a. ByteArray a => [Word8] -> a
BA.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
mKey ByteString
hmacInput :: HMAC h)
      Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString)
-> Either Error (ByteString, ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
iv, ByteString
c, ByteString
tag)

_gcmEnc
  :: forall e m. (BlockCipher e, MonadRandom m)
  => e
  -> B.ByteString -- ^ key
  -> B.ByteString -- ^ message
  -> B.ByteString -- ^ additional authenticated data
  -> m (Either Error (B.ByteString, B.ByteString, B.ByteString))  -- ^ IV, tag and ciphertext
_gcmEnc :: e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc e
_ ByteString
k ByteString
m ByteString
aad = do
  ByteString
iv <- Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
12
  case ByteString -> CryptoFailable e
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k of
    CryptoFailed CryptoError
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
    CryptoPassed (e
e :: e) -> case AEADMode -> e -> ByteString -> CryptoFailable (AEAD e)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit AEADMode
AEAD_GCM e
e ByteString
iv of
      CryptoFailed CryptoError
_ -> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ Error -> Either Error (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
      CryptoPassed AEAD e
aead -> do
        let m' :: ByteString
m' = Format -> ByteString -> ByteString
forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 (Int -> Format) -> Int -> Format
forall a b. (a -> b) -> a -> b
$ e -> Int
forall cipher. BlockCipher cipher => cipher -> Int
blockSize e
e) ByteString
m
        let (ByteString
c, AEAD e
aeadFinal) = AEAD e -> ByteString -> (ByteString, AEAD e)
forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt (AEAD e -> ByteString -> AEAD e
forall aad cipher.
ByteArrayAccess aad =>
AEAD cipher -> aad -> AEAD cipher
aeadAppendHeader AEAD e
aead ByteString
aad) ByteString
m'
        let tag :: ByteString
tag = [Word8] -> ByteString
forall a. ByteArray a => [Word8] -> a
BA.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthTag -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack (AuthTag -> [Word8]) -> AuthTag -> [Word8]
forall a b. (a -> b) -> a -> b
$ AEAD e -> Int -> AuthTag
forall cipher. AEAD cipher -> Int -> AuthTag
aeadFinalize AEAD e
aeadFinal Int
16
        Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error (ByteString, ByteString, ByteString)
 -> m (Either Error (ByteString, ByteString, ByteString)))
-> Either Error (ByteString, ByteString, ByteString)
-> m (Either Error (ByteString, ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString)
-> Either Error (ByteString, ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
iv, ByteString
tag, ByteString
c)