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

{-|

Data types for the JOSE library.

-}
module Crypto.JOSE.Types
  (
    Base64Integer(..)
  , _Base64Integer
  , SizedBase64Integer(..)
  , makeSizedBase64Integer
  , checkSize
  , Base64Octets(..)
  , Base64SHA1(..)
  , Base64SHA256(..)
  , Base64X509(..)
  , SignedCertificate
  , URI
  , base64url
  ) where

import Control.Lens
import Data.Aeson
import Data.Aeson.Types (Parser)
import qualified Data.ByteString as B
import Data.X509
import Network.URI (URI)

import Crypto.JOSE.Types.Internal


-- | A base64url encoded octet sequence interpreted as an integer.
--
-- The value is encoded in the minimum number of octets (no leading
-- zeros) with the exception of @0@ which is encoded as @AA@.
-- A leading zero when decoding is an error.
--
newtype Base64Integer = Base64Integer Integer
  deriving (Base64Integer -> Base64Integer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64Integer -> Base64Integer -> Bool
$c/= :: Base64Integer -> Base64Integer -> Bool
== :: Base64Integer -> Base64Integer -> Bool
$c== :: Base64Integer -> Base64Integer -> Bool
Eq, Int -> Base64Integer -> ShowS
[Base64Integer] -> ShowS
Base64Integer -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base64Integer] -> ShowS
$cshowList :: [Base64Integer] -> ShowS
show :: Base64Integer -> [Char]
$cshow :: Base64Integer -> [Char]
showsPrec :: Int -> Base64Integer -> ShowS
$cshowsPrec :: Int -> Base64Integer -> ShowS
Show)
makePrisms ''Base64Integer

instance FromJSON Base64Integer where
  parseJSON :: Value -> Parser Base64Integer
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url integer" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Base64Integer
Base64Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Parser Integer
parseOctets)

-- | Parse an octet sequence into an integer.
--
-- This function deals with ugly special cases from
-- <https://tools.ietf.org/html/rfc7518#section-2>, specifically
--
-- * The empty sequence is invalid
-- * Leading null byte is invalid (unless it is the only byte)
--
parseOctets :: B.ByteString -> Parser Integer
parseOctets :: ByteString -> Parser Integer
parseOctets ByteString
s
  | ByteString -> Bool
B.null ByteString
s      = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"empty octet sequence"
  | ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
"\NUL"   = forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
  | HasCallStack => ByteString -> Word8
B.head ByteString
s forall a. Eq a => a -> a -> Bool
== Word8
0 = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"leading null byte"
  | Bool
otherwise     = forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Integer
bsToInteger ByteString
s)

instance ToJSON Base64Integer where
  -- Urgh, special case: https://tools.ietf.org/html/rfc7518#section-2
  toJSON :: Base64Integer -> Value
toJSON (Base64Integer Integer
0) = Value
"AA"
  toJSON (Base64Integer Integer
x) = ByteString -> Value
encodeB64Url forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> ByteString
integerToBS Integer
x


-- | A base64url encoded octet sequence interpreted as an integer
-- and where the number of octets carries explicit bit-length
-- information.
--
data SizedBase64Integer = SizedBase64Integer Int Integer
  deriving (Int -> SizedBase64Integer -> ShowS
[SizedBase64Integer] -> ShowS
SizedBase64Integer -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SizedBase64Integer] -> ShowS
$cshowList :: [SizedBase64Integer] -> ShowS
show :: SizedBase64Integer -> [Char]
$cshow :: SizedBase64Integer -> [Char]
showsPrec :: Int -> SizedBase64Integer -> ShowS
$cshowsPrec :: Int -> SizedBase64Integer -> ShowS
Show)

instance Eq SizedBase64Integer where
  SizedBase64Integer Int
_ Integer
n == :: SizedBase64Integer -> SizedBase64Integer -> Bool
== SizedBase64Integer Int
_ Integer
m = Integer
n forall a. Eq a => a -> a -> Bool
== Integer
m

-- | Create a 'SizedBase64Integer'' from an 'Integer'.
makeSizedBase64Integer :: Integer -> SizedBase64Integer
makeSizedBase64Integer :: Integer -> SizedBase64Integer
makeSizedBase64Integer Integer
x = Int -> Integer -> SizedBase64Integer
SizedBase64Integer (Integer -> Int
intBytes Integer
x) Integer
x

instance FromJSON SizedBase64Integer where
  parseJSON :: Value -> Parser SizedBase64Integer
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"full size base64url integer" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Integer -> SizedBase64Integer
SizedBase64Integer (ByteString -> Int
B.length ByteString
bytes) (ByteString -> Integer
bsToInteger ByteString
bytes))

instance ToJSON SizedBase64Integer where
  toJSON :: SizedBase64Integer -> Value
toJSON (SizedBase64Integer Int
w Integer
n) = ByteString -> Value
encodeB64Url forall a b. (a -> b) -> a -> b
$ forall a. Integral a => Int -> a -> ByteString
sizedIntegerToBS Int
w Integer
n

-- | Parsed a 'SizedBase64Integer' with an expected number of /bytes/.
--
checkSize :: Int -> SizedBase64Integer -> Parser SizedBase64Integer
checkSize :: Int -> SizedBase64Integer -> Parser SizedBase64Integer
checkSize Int
n a :: SizedBase64Integer
a@(SizedBase64Integer Int
m Integer
_) = if Int
n forall a. Eq a => a -> a -> Bool
== Int
m
  then forall (m :: * -> *) a. Monad m => a -> m a
return SizedBase64Integer
a
  else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"expected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
" octets, found " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
m


-- | A base64url encoded octet sequence.  Used for payloads,
-- signatures, symmetric keys, salts, initialisation vectors, etc.
--
newtype Base64Octets = Base64Octets B.ByteString
  deriving (Base64Octets -> Base64Octets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64Octets -> Base64Octets -> Bool
$c/= :: Base64Octets -> Base64Octets -> Bool
== :: Base64Octets -> Base64Octets -> Bool
$c== :: Base64Octets -> Base64Octets -> Bool
Eq, Int -> Base64Octets -> ShowS
[Base64Octets] -> ShowS
Base64Octets -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base64Octets] -> ShowS
$cshowList :: [Base64Octets] -> ShowS
show :: Base64Octets -> [Char]
$cshow :: Base64Octets -> [Char]
showsPrec :: Int -> Base64Octets -> ShowS
$cshowsPrec :: Int -> Base64Octets -> ShowS
Show)

instance FromJSON Base64Octets where
  parseJSON :: Value -> Parser Base64Octets
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Base64Octets" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64Octets
Base64Octets)

instance ToJSON Base64Octets where
  toJSON :: Base64Octets -> Value
toJSON (Base64Octets ByteString
bytes) = ByteString -> Value
encodeB64Url ByteString
bytes


-- | A base64url encoded SHA-1 digest.  Used for X.509 certificate
-- thumbprints.
--
newtype Base64SHA1 = Base64SHA1 B.ByteString
  deriving (Base64SHA1 -> Base64SHA1 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64SHA1 -> Base64SHA1 -> Bool
$c/= :: Base64SHA1 -> Base64SHA1 -> Bool
== :: Base64SHA1 -> Base64SHA1 -> Bool
$c== :: Base64SHA1 -> Base64SHA1 -> Bool
Eq, Int -> Base64SHA1 -> ShowS
[Base64SHA1] -> ShowS
Base64SHA1 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base64SHA1] -> ShowS
$cshowList :: [Base64SHA1] -> ShowS
show :: Base64SHA1 -> [Char]
$cshow :: Base64SHA1 -> [Char]
showsPrec :: Int -> Base64SHA1 -> ShowS
$cshowsPrec :: Int -> Base64SHA1 -> ShowS
Show)

instance FromJSON Base64SHA1 where
  parseJSON :: Value -> Parser Base64SHA1
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url SHA-1" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    case ByteString -> Int
B.length ByteString
bytes of
      Int
20 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Base64SHA1
Base64SHA1 ByteString
bytes
      Int
_  -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"incorrect number of bytes")

instance ToJSON Base64SHA1 where
  toJSON :: Base64SHA1 -> Value
toJSON (Base64SHA1 ByteString
bytes) = ByteString -> Value
encodeB64Url ByteString
bytes


-- | A base64url encoded SHA-256 digest.  Used for X.509 certificate
-- thumbprints.
--
newtype Base64SHA256 = Base64SHA256 B.ByteString
  deriving (Base64SHA256 -> Base64SHA256 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64SHA256 -> Base64SHA256 -> Bool
$c/= :: Base64SHA256 -> Base64SHA256 -> Bool
== :: Base64SHA256 -> Base64SHA256 -> Bool
$c== :: Base64SHA256 -> Base64SHA256 -> Bool
Eq, Int -> Base64SHA256 -> ShowS
[Base64SHA256] -> ShowS
Base64SHA256 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base64SHA256] -> ShowS
$cshowList :: [Base64SHA256] -> ShowS
show :: Base64SHA256 -> [Char]
$cshow :: Base64SHA256 -> [Char]
showsPrec :: Int -> Base64SHA256 -> ShowS
$cshowsPrec :: Int -> Base64SHA256 -> ShowS
Show)

instance FromJSON Base64SHA256 where
  parseJSON :: Value -> Parser Base64SHA256
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url SHA-256" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    case ByteString -> Int
B.length ByteString
bytes of
      Int
32 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Base64SHA256
Base64SHA256 ByteString
bytes
      Int
_  -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"incorrect number of bytes")

instance ToJSON Base64SHA256 where
  toJSON :: Base64SHA256 -> Value
toJSON (Base64SHA256 ByteString
bytes) = ByteString -> Value
encodeB64Url ByteString
bytes


-- | A base64 encoded X.509 certificate.
--
newtype Base64X509 = Base64X509 SignedCertificate
  deriving (Base64X509 -> Base64X509 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64X509 -> Base64X509 -> Bool
$c/= :: Base64X509 -> Base64X509 -> Bool
== :: Base64X509 -> Base64X509 -> Bool
$c== :: Base64X509 -> Base64X509 -> Bool
Eq, Int -> Base64X509 -> ShowS
[Base64X509] -> ShowS
Base64X509 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Base64X509] -> ShowS
$cshowList :: [Base64X509] -> ShowS
show :: Base64X509 -> [Char]
$cshow :: Base64X509 -> [Char]
showsPrec :: Int -> Base64X509 -> ShowS
$cshowsPrec :: Int -> Base64X509 -> ShowS
Show)

instance FromJSON Base64X509 where
  parseJSON :: Value -> Parser Base64X509
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url X.509 certificate" forall a b. (a -> b) -> a -> b
$ forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64 forall a b. (a -> b) -> a -> b
$
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Base64X509
Base64X509) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] SignedCertificate
decodeSignedCertificate

instance ToJSON Base64X509 where
  toJSON :: Base64X509 -> Value
toJSON (Base64X509 SignedCertificate
x509) = ByteString -> Value
encodeB64 forall a b. (a -> b) -> a -> b
$ forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject SignedCertificate
x509