-- Copyright (C) 2013  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 OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{-|

JSON Web Encryption data types specified under JSON Web Algorithms.

-}
module Crypto.JOSE.JWA.JWE where

import Data.Maybe (catMaybes)

import Crypto.JOSE.JWK
import Crypto.JOSE.TH
import Crypto.JOSE.Types
import Crypto.JOSE.Types.Internal (insertToObject)

import Data.Aeson
import qualified Data.Aeson.KeyMap as M


-- | RFC 7518 §4.  Cryptographic Algorithms for Key Management
--
data AlgWithParams
  = RSA1_5
  | RSA_OAEP
  | RSA_OAEP_256
  | A128KW
  | A192KW
  | A256KW
  | Dir
  | ECDH_ES ECDHParameters
  | ECDH_ES_A128KW ECDHParameters
  | ECDH_ES_A192KW ECDHParameters
  | ECDH_ES_A256KW ECDHParameters
  | A128GCMKW AESGCMParameters
  | A192GCMKW AESGCMParameters
  | A256GCMKW AESGCMParameters
  | PBES2_HS256_A128KW PBES2Parameters
  | PBES2_HS384_A192KW PBES2Parameters
  | PBES2_HS512_A256KW PBES2Parameters
  deriving (AlgWithParams -> AlgWithParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlgWithParams -> AlgWithParams -> Bool
$c/= :: AlgWithParams -> AlgWithParams -> Bool
== :: AlgWithParams -> AlgWithParams -> Bool
$c== :: AlgWithParams -> AlgWithParams -> Bool
Eq, Int -> AlgWithParams -> ShowS
[AlgWithParams] -> ShowS
AlgWithParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlgWithParams] -> ShowS
$cshowList :: [AlgWithParams] -> ShowS
show :: AlgWithParams -> String
$cshow :: AlgWithParams -> String
showsPrec :: Int -> AlgWithParams -> ShowS
$cshowsPrec :: Int -> AlgWithParams -> ShowS
Show)

instance FromJSON AlgWithParams where
  parseJSON :: Value -> Parser AlgWithParams
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Encryption alg and params" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case forall v. Key -> KeyMap v -> Maybe v
M.lookup Key
"alg" Object
o of
      Maybe Value
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"alg\" parameter is required"
      Just Value
"RSA1_5"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
RSA1_5
      Just Value
"RSA-OAEP"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
RSA_OAEP
      Just Value
"RSA-OAEP-256"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
RSA_OAEP_256
      Just Value
"A128KW"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
A128KW
      Just Value
"A192KW"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
A192KW
      Just Value
"A256KW"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
A256KW
      Just Value
"dir"                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AlgWithParams
Dir
      Just Value
"ECDH-ES"            -> ECDHParameters -> AlgWithParams
ECDH_ES            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"ECDH-ES+A128KW"     -> ECDHParameters -> AlgWithParams
ECDH_ES_A128KW     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"ECDH-ES+A192KW"     -> ECDHParameters -> AlgWithParams
ECDH_ES_A192KW     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"ECDH-ES+A256KW"     -> ECDHParameters -> AlgWithParams
ECDH_ES_A256KW     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"A128GCMKW"          -> AESGCMParameters -> AlgWithParams
A128GCMKW          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"A192GCMKW"          -> AESGCMParameters -> AlgWithParams
A192GCMKW          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"A256GCMKW"          -> AESGCMParameters -> AlgWithParams
A256GCMKW          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"PBES2-HS256+A128KW" -> PBES2Parameters -> AlgWithParams
PBES2_HS256_A128KW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"PBES2-HS384+A192KW" -> PBES2Parameters -> AlgWithParams
PBES2_HS384_A192KW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Just Value
"PBES2-HS512+A256KW" -> PBES2Parameters -> AlgWithParams
PBES2_HS512_A256KW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Maybe Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unrecognised value; expected: "
         forall a. [a] -> [a] -> [a]
++ String
"[\"RSA1_5\",\"RSA-OAEP\",\"RSA-OAEP-256\",\"A128KW\",\"A192KW\",\"A256KW\",\"dir\",\"ECDH-ES\",\"ECDH-ES+A128KW\",\"ECDH-ES+A192KW\",\"ECDH-ES+A256KW\",\"A128GCMKW\",\"A192GCMKW\",\"A256GCMKW\",\"PBES2-HS256+A128KW\",\"PBES2-HS384+A128KW\",\"PBES2-HS512+A128KW\"]"

algObject :: Value -> Value
algObject :: Value -> Value
algObject Value
s = [Pair] -> Value
object [(Key
"alg", Value
s)]

algWithParamsObject :: ToJSON a => a -> Value -> Value
algWithParamsObject :: forall a. ToJSON a => a -> Value -> Value
algWithParamsObject a
a Value
s = forall v. ToJSON v => Key -> v -> Value -> Value
insertToObject Key
"alg" Value
s (forall a. ToJSON a => a -> Value
toJSON a
a)

instance ToJSON AlgWithParams where
  toJSON :: AlgWithParams -> Value
toJSON AlgWithParams
RSA1_5       = Value -> Value
algObject Value
"RSA1_5"
  toJSON AlgWithParams
RSA_OAEP     = Value -> Value
algObject Value
"RSA-OAEP"
  toJSON AlgWithParams
RSA_OAEP_256 = Value -> Value
algObject Value
"RSA-OAEP-256"
  toJSON AlgWithParams
A128KW       = Value -> Value
algObject Value
"A128KW"
  toJSON AlgWithParams
A192KW       = Value -> Value
algObject Value
"A192KW"
  toJSON AlgWithParams
A256KW       = Value -> Value
algObject Value
"A256KW"
  toJSON AlgWithParams
Dir          = Value -> Value
algObject Value
"Dir"
  toJSON (ECDH_ES ECDHParameters
params)             = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject ECDHParameters
params Value
"ECDH-ES"
  toJSON (ECDH_ES_A128KW ECDHParameters
params)      = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject ECDHParameters
params Value
"ECDH-ES+A128KW"
  toJSON (ECDH_ES_A192KW ECDHParameters
params)      = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject ECDHParameters
params Value
"ECDH-ES+A192KW"
  toJSON (ECDH_ES_A256KW ECDHParameters
params)      = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject ECDHParameters
params Value
"ECDH-ES+A256KW"
  toJSON (A128GCMKW AESGCMParameters
params)           = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject AESGCMParameters
params Value
"A128GCMKW"
  toJSON (A192GCMKW AESGCMParameters
params)           = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject AESGCMParameters
params Value
"A192GCMKW"
  toJSON (A256GCMKW AESGCMParameters
params)           = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject AESGCMParameters
params Value
"A256GCMKW"
  toJSON (PBES2_HS256_A128KW PBES2Parameters
params)  = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject PBES2Parameters
params Value
"PBES2-HS256+A128KW"
  toJSON (PBES2_HS384_A192KW PBES2Parameters
params)  = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject PBES2Parameters
params Value
"PBES2-HS384+A192KW"
  toJSON (PBES2_HS512_A256KW PBES2Parameters
params)  = forall a. ToJSON a => a -> Value -> Value
algWithParamsObject PBES2Parameters
params Value
"PBES2-HS512+A256KW"


-- | RFC 7518 §4.6.1.  Header Parameters Used for ECDH Key Agreement
--
data ECDHParameters = ECDHParameters
  { ECDHParameters -> JWK
_epk :: JWK                 -- ^ Ephemeral Public Key ; a JWK PUBLIC key
  , ECDHParameters -> Maybe Base64Octets
_apu :: Maybe Base64Octets  -- ^ Agreement PartyUInfo
  , ECDHParameters -> Maybe Base64Octets
_apv :: Maybe Base64Octets  -- ^ Agreement PartyVInfo
  } deriving (ECDHParameters -> ECDHParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ECDHParameters -> ECDHParameters -> Bool
$c/= :: ECDHParameters -> ECDHParameters -> Bool
== :: ECDHParameters -> ECDHParameters -> Bool
$c== :: ECDHParameters -> ECDHParameters -> Bool
Eq, Int -> ECDHParameters -> ShowS
[ECDHParameters] -> ShowS
ECDHParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ECDHParameters] -> ShowS
$cshowList :: [ECDHParameters] -> ShowS
show :: ECDHParameters -> String
$cshow :: ECDHParameters -> String
showsPrec :: Int -> ECDHParameters -> ShowS
$cshowsPrec :: Int -> ECDHParameters -> ShowS
Show)

instance FromJSON ECDHParameters where
  parseJSON :: Value -> Parser ECDHParameters
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ECDH Parameters" forall a b. (a -> b) -> a -> b
$ \Object
o -> JWK -> Maybe Base64Octets -> Maybe Base64Octets -> ECDHParameters
ECDHParameters
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epk"
    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
"apu"
    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
"apv"

instance ToJSON ECDHParameters where
  toJSON :: ECDHParameters -> Value
toJSON (ECDHParameters JWK
epk Maybe Base64Octets
apu Maybe Base64Octets
apv) = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
    [ forall a. a -> Maybe a
Just (Key
"epk" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= JWK
epk)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"apu" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe Base64Octets
apu
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
"apu" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe Base64Octets
apv
    ]


-- | RFC 7518 §4.7.1.  Header Parameters Used for AES GCM Key Encryption
--
data AESGCMParameters = AESGCMParameters
  { AESGCMParameters -> Base64Octets
_iv :: Base64Octets  -- ^ Initialization Vector  (must be 96 bits?)
  , AESGCMParameters -> Base64Octets
_tag :: Base64Octets -- ^ Authentication Tag (must be 128 bits?)
  } deriving (AESGCMParameters -> AESGCMParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AESGCMParameters -> AESGCMParameters -> Bool
$c/= :: AESGCMParameters -> AESGCMParameters -> Bool
== :: AESGCMParameters -> AESGCMParameters -> Bool
$c== :: AESGCMParameters -> AESGCMParameters -> Bool
Eq, Int -> AESGCMParameters -> ShowS
[AESGCMParameters] -> ShowS
AESGCMParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AESGCMParameters] -> ShowS
$cshowList :: [AESGCMParameters] -> ShowS
show :: AESGCMParameters -> String
$cshow :: AESGCMParameters -> String
showsPrec :: Int -> AESGCMParameters -> ShowS
$cshowsPrec :: Int -> AESGCMParameters -> ShowS
Show)

instance FromJSON AESGCMParameters where
  parseJSON :: Value -> Parser AESGCMParameters
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AES-GCM Parameters" forall a b. (a -> b) -> a -> b
$ \Object
o -> Base64Octets -> Base64Octets -> AESGCMParameters
AESGCMParameters
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser 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 a
.: Key
"tag"

instance ToJSON AESGCMParameters where
  toJSON :: AESGCMParameters -> Value
toJSON (AESGCMParameters Base64Octets
iv Base64Octets
tag) = [Pair] -> Value
object [Key
"iv" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
iv, Key
"tag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
tag]


-- | RFC 7518 §4.8.1.  Header Parameters Used for PBES2 Key Encryption
--
data PBES2Parameters =  PBES2Parameters
  { PBES2Parameters -> Base64Octets
_p2s :: Base64Octets   -- ^ PBKDF2 salt input
  , PBES2Parameters -> Int
_p2c :: Int            -- ^ PBKDF2 iteration count ; POSITIVE integer
  } deriving (PBES2Parameters -> PBES2Parameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBES2Parameters -> PBES2Parameters -> Bool
$c/= :: PBES2Parameters -> PBES2Parameters -> Bool
== :: PBES2Parameters -> PBES2Parameters -> Bool
$c== :: PBES2Parameters -> PBES2Parameters -> Bool
Eq, Int -> PBES2Parameters -> ShowS
[PBES2Parameters] -> ShowS
PBES2Parameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBES2Parameters] -> ShowS
$cshowList :: [PBES2Parameters] -> ShowS
show :: PBES2Parameters -> String
$cshow :: PBES2Parameters -> String
showsPrec :: Int -> PBES2Parameters -> ShowS
$cshowsPrec :: Int -> PBES2Parameters -> ShowS
Show)

instance FromJSON PBES2Parameters where
  parseJSON :: Value -> Parser PBES2Parameters
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AES-GCM Parameters" forall a b. (a -> b) -> a -> b
$ \Object
o -> Base64Octets -> Int -> PBES2Parameters
PBES2Parameters
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"p2s"  -- TODO salt input value must be >= 8 octets
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"p2c"

instance ToJSON PBES2Parameters where
  toJSON :: PBES2Parameters -> Value
toJSON (PBES2Parameters Base64Octets
p2s Int
p2c) = [Pair] -> Value
object [Key
"p2s" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64Octets
p2s, Key
"p2c" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
p2c]


-- | RFC 7518 §5  Cryptographic Algorithms for Content Encryption
--
$(deriveJOSEType "Enc" [
  "A128CBC-HS256"   -- AES HMAC SHA authenticated encryption  Required
  , "A192CBC-HS384" -- AES HMAC SHA authenticated encryption  Optional
  , "A256CBC-HS512" -- AES HMAC SHA authenticated encryption  Required
  , "A128GCM"       -- AES in Galois/Counter Mode             Recommended
  , "A192GCM"       -- AES in Galois/Counter Mode             Optional
  , "A256GCM"       -- AES in Galois/Counter Mode             Recommended
  ])