-- 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 Control.Lens (view, views)
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 Crypto.JOSE.Types.URI
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
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
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
  { forall p. JWEHeader p -> Maybe AlgWithParams
_jweAlg :: Maybe AlgWithParams
  , forall p. JWEHeader p -> HeaderParam p Enc
_jweEnc :: HeaderParam p Enc
  , forall p. JWEHeader p -> Maybe Text
_jweZip :: Maybe T.Text  -- protected header only  "DEF" (DEFLATE) defined
  , forall p. JWEHeader p -> Maybe (HeaderParam p URI)
_jweJku :: Maybe (HeaderParam p Types.URI)
  , forall p. JWEHeader p -> Maybe (HeaderParam p JWK)
_jweJwk :: Maybe (HeaderParam p JWK)
  , forall p. JWEHeader p -> Maybe (HeaderParam p Text)
_jweKid :: Maybe (HeaderParam p T.Text)
  , forall p. JWEHeader p -> Maybe (HeaderParam p URI)
_jweX5u :: Maybe (HeaderParam p Types.URI)
  , forall p.
JWEHeader p -> Maybe (HeaderParam p (NonEmpty SignedCertificate))
_jweX5c :: Maybe (HeaderParam p (NonEmpty Types.SignedCertificate))
  , forall p. JWEHeader p -> Maybe (HeaderParam p Base64SHA1)
_jweX5t :: Maybe (HeaderParam p Types.Base64SHA1)
  , forall p. JWEHeader p -> Maybe (HeaderParam p Base64SHA256)
_jweX5tS256 :: Maybe (HeaderParam p Types.Base64SHA256)
  , forall p. JWEHeader p -> Maybe (HeaderParam p Text)
_jweTyp :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of object)
  , forall p. JWEHeader p -> Maybe (HeaderParam p Text)
_jweCty :: Maybe (HeaderParam p T.Text)  -- ^ Content Type (of payload)
  , forall p. JWEHeader p -> Maybe (NonEmpty Text)
_jweCrit :: Maybe (NonEmpty T.Text)
  }
  deriving (JWEHeader p -> JWEHeader p -> Bool
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
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 :: forall p.
ProtectionIndicator p =>
AlgWithParams -> Enc -> JWEHeader p
newJWEHeader AlgWithParams
alg Enc
enc =
  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 (forall a. a -> Maybe a
Just AlgWithParams
alg) (forall p a. p -> a -> HeaderParam p a
HeaderParam forall a. ProtectionIndicator a => a
getProtected Enc
enc) forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z forall {a}. Maybe a
z
  where z :: Maybe a
z = forall {a}. Maybe a
Nothing

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


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

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

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

data JWE a p = JWE
  { forall (a :: * -> *) p. JWE a p -> Maybe Text
_protectedRaw :: Maybe T.Text       -- ^ Encoded protected header, if available
  , forall (a :: * -> *) p. JWE a p -> Maybe Base64Octets
_jweIv :: Maybe Types.Base64Octets  -- ^ JWE Initialization Vector
  , forall (a :: * -> *) p. JWE a p -> Maybe Base64Octets
_jweAad :: Maybe Types.Base64Octets -- ^ JWE AAD
  , forall (a :: * -> *) p. JWE a p -> Base64Octets
_jweCiphertext :: Types.Base64Octets  -- ^ JWE Ciphertext
  , forall (a :: * -> *) p. JWE a p -> Maybe Base64Octets
_jweTag :: Maybe Types.Base64Octets  -- ^ JWE Authentication Tag
  , forall (a :: * -> *) p. 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JWE JSON Serialization" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe Value
hpB64 <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected"
    Maybe Object
hp <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {a}. Maybe a
Nothing)
      (forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"base64url-encoded header params"
        (forall a. (ByteString -> Parser a) -> Text -> Parser a
Types.parseB64Url (forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"protected header contains invalid JSON")
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict)))
      Maybe Value
hpB64
    Maybe Object
hu <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unprotected"
    forall (a :: * -> *) p.
Maybe Text
-> Maybe Base64Octets
-> Maybe Base64Octets
-> Base64Octets
-> Maybe Base64Octets
-> [JWERecipient a p]
-> JWE a p
JWE
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protected" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""))  -- raw protected header
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"iv"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aad"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ciphertext"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"recipients" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (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 :: forall (m :: * -> *).
MonadRandom m =>
AlgWithParams
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrap alg :: AlgWithParams
alg@AlgWithParams
RSA_OAEP (RSAKeyMaterial RSAKeyParameters
k) ByteString
m = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Error -> Error
RSAError (AlgWithParams
alg,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
OAEP.OAEPParams SHA1
SHA1 (forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA1
SHA1) forall {a}. Maybe a
Nothing) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k) ByteString
m
wrap AlgWithParams
RSA_OAEP KeyMaterial
_ ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Error -> Error
RSAError (AlgWithParams
alg,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall hash (m :: * -> *).
(HashAlgorithm hash, MonadRandom m) =>
OAEPParams hash ByteString ByteString
-> PublicKey -> ByteString -> m (Either Error ByteString)
OAEP.encrypt (forall hash seed output.
hash
-> MaskGenAlgorithm seed output
-> Maybe ByteString
-> OAEPParams hash seed output
OAEP.OAEPParams SHA256
SHA256 (forall seed output hashAlg.
(ByteArrayAccess seed, ByteArray output, HashAlgorithm hashAlg) =>
hashAlg -> seed -> Int -> output
mgf1 SHA256
SHA256) forall {a}. Maybe a
Nothing) (RSAKeyParameters -> PublicKey
rsaPublicKey RSAKeyParameters
k) ByteString
m
wrap AlgWithParams
RSA_OAEP_256 KeyMaterial
_ ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left 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
  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A128KW,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (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
  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A192KW,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (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
  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (AlgWithParams
A256KW,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW (forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k :: CryptoFailable AES256) ByteString
m
wrap (A128GCMKW AESGCMParameters
_) KeyMaterial
k ByteString
m = 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 = 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 = 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall cipher.
BlockCipher128 cipher =>
CryptoFailable cipher -> ByteString -> Either Error ByteString
wrapAESKW CryptoFailable cipher
cipher ByteString
m = case CryptoFailable cipher
cipher of
  CryptoFailed CryptoError
e -> forall a b. a -> Either a b
Left (CryptoError -> Error
CryptoError CryptoError
e)
  CryptoPassed cipher
cipher' -> forall a b. b -> Either a b
Right (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 :: forall (m :: * -> *).
MonadRandom m =>
(AESGCMParameters -> AlgWithParams)
-> Enc
-> KeyMaterial
-> ByteString
-> m (Either Error (AlgWithParams, ByteString))
wrapAESGCM AESGCMParameters -> AlgWithParams
f Enc
enc (OctKeyMaterial (OctKeyParameters (Types.Base64Octets ByteString
k))) ByteString
m =
  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'))
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left 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 :: forall (m :: * -> *).
MonadRandom m =>
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 -> forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (forall a. HasCallStack => a
undefined :: AES128) SHA256
SHA256 ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (forall a. HasCallStack => a
undefined :: AES192) SHA384
SHA384 ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
e
-> h
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_cbcHmacEnc (forall a. HasCallStack => a
undefined :: AES256) SHA512
SHA512 ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (forall a. HasCallStack => a
undefined :: AES128) ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (forall a. HasCallStack => a
undefined :: AES192) ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc (forall a. HasCallStack => a
undefined :: AES256) ByteString
k ByteString
m ByteString
a
  Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall e h (m :: * -> *).
(BlockCipher e, HashAlgorithm h, MonadRandom m) =>
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 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN Int
8 (\Int
x -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x, Int
x forall a. Integral a => a -> a -> a
`div` Int
256)) (ByteString -> Int
B.length ByteString
aad)
  case forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
eKey of
    CryptoFailed CryptoError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
    CryptoPassed (e
e :: e) -> do
      ByteString
iv <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
16
      case forall b c. (ByteArrayAccess b, BlockCipher c) => b -> Maybe (IV c)
makeIV ByteString
iv of
        Maybe (IV e)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (CryptoError -> Error
CryptoError CryptoError
CryptoError_IvSizeInvalid)
        Just IV e
iv' -> do
          let m' :: ByteString
m' = forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 forall a b. (a -> b) -> a -> b
$ forall cipher. BlockCipher cipher => cipher -> Int
blockSize e
e) ByteString
m
          let c :: ByteString
c = 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 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert forall a b. (a -> b) -> a -> b
$ forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
BA.takeView (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac ByteString
mKey ByteString
hmacInput :: HMAC h) Int
kLen
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 :: forall e (m :: * -> *).
(BlockCipher e, MonadRandom m) =>
e
-> ByteString
-> ByteString
-> ByteString
-> m (Either Error (ByteString, ByteString, ByteString))
_gcmEnc e
_ ByteString
k ByteString
m ByteString
aad = do
  ByteString
iv <- forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
12
  case forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
cipherInit ByteString
k of
    CryptoFailed CryptoError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
    CryptoPassed (e
e :: e) -> case forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
aeadInit AEADMode
AEAD_GCM e
e ByteString
iv of
      CryptoFailed CryptoError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Error
AlgorithmNotImplemented -- FIXME
      CryptoPassed AEAD e
aead -> do
        let m' :: ByteString
m' = forall byteArray.
ByteArray byteArray =>
Format -> byteArray -> byteArray
pad (Int -> Format
PKCS7 forall a b. (a -> b) -> a -> b
$ forall cipher. BlockCipher cipher => cipher -> Int
blockSize e
e) ByteString
m
        let (ByteString
c, AEAD e
aeadFinal) = forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt (forall aad cipher.
ByteArrayAccess aad =>
AEAD cipher -> aad -> AEAD cipher
aeadAppendHeader AEAD e
aead ByteString
aad) ByteString
m'
        let tag :: ByteString
tag = forall a. ByteArray a => [Word8] -> a
BA.pack forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack forall a b. (a -> b) -> a -> b
$ forall cipher. AEAD cipher -> Int -> AuthTag
aeadFinalize AEAD e
aeadFinal Int
16
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (ByteString
iv, ByteString
tag, ByteString
c)