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

instance FromJSON Base64Integer where
  parseJSON :: Value -> Parser Base64Integer
parseJSON = [Char]
-> (Text -> Parser Base64Integer) -> Value -> Parser Base64Integer
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url integer" ((Text -> Parser Base64Integer) -> Value -> Parser Base64Integer)
-> (Text -> Parser Base64Integer) -> Value -> Parser Base64Integer
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser Base64Integer)
-> Text -> Parser Base64Integer
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url
    ((Integer -> Base64Integer)
-> Parser Integer -> Parser Base64Integer
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Base64Integer
Base64Integer (Parser Integer -> Parser Base64Integer)
-> (ByteString -> Parser Integer)
-> ByteString
-> Parser 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      = [Char] -> Parser Integer
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"empty octet sequence"
  | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\NUL"   = Integer -> Parser Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
  | HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
s Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = [Char] -> Parser Integer
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"leading null byte"
  | Bool
otherwise     = Integer -> Parser Integer
forall a. a -> Parser a
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 (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> ByteString
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]
(Int -> SizedBase64Integer -> ShowS)
-> (SizedBase64Integer -> [Char])
-> ([SizedBase64Integer] -> ShowS)
-> Show SizedBase64Integer
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizedBase64Integer -> ShowS
showsPrec :: Int -> SizedBase64Integer -> ShowS
$cshow :: SizedBase64Integer -> [Char]
show :: SizedBase64Integer -> [Char]
$cshowList :: [SizedBase64Integer] -> ShowS
showList :: [SizedBase64Integer] -> ShowS
Show)

instance Eq SizedBase64Integer where
  SizedBase64Integer Int
_ Integer
n == :: SizedBase64Integer -> SizedBase64Integer -> Bool
== SizedBase64Integer Int
_ Integer
m = Integer
n Integer -> Integer -> Bool
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 = [Char]
-> (Text -> Parser SizedBase64Integer)
-> Value
-> Parser SizedBase64Integer
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"full size base64url integer" ((Text -> Parser SizedBase64Integer)
 -> Value -> Parser SizedBase64Integer)
-> (Text -> Parser SizedBase64Integer)
-> Value
-> Parser SizedBase64Integer
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser SizedBase64Integer)
-> Text -> Parser SizedBase64Integer
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    SizedBase64Integer -> Parser SizedBase64Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SizedBase64Integer -> Parser SizedBase64Integer)
-> SizedBase64Integer -> Parser SizedBase64Integer
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 (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ByteString
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m
  then SizedBase64Integer -> Parser SizedBase64Integer
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SizedBase64Integer
a
  else [Char] -> Parser SizedBase64Integer
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser SizedBase64Integer)
-> [Char] -> Parser SizedBase64Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"expected " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" octets, found " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
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
(Base64Octets -> Base64Octets -> Bool)
-> (Base64Octets -> Base64Octets -> Bool) -> Eq Base64Octets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64Octets -> Base64Octets -> Bool
== :: Base64Octets -> Base64Octets -> Bool
$c/= :: Base64Octets -> Base64Octets -> Bool
/= :: Base64Octets -> Base64Octets -> Bool
Eq, Int -> Base64Octets -> ShowS
[Base64Octets] -> ShowS
Base64Octets -> [Char]
(Int -> Base64Octets -> ShowS)
-> (Base64Octets -> [Char])
-> ([Base64Octets] -> ShowS)
-> Show Base64Octets
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64Octets -> ShowS
showsPrec :: Int -> Base64Octets -> ShowS
$cshow :: Base64Octets -> [Char]
show :: Base64Octets -> [Char]
$cshowList :: [Base64Octets] -> ShowS
showList :: [Base64Octets] -> ShowS
Show)

instance FromJSON Base64Octets where
  parseJSON :: Value -> Parser Base64Octets
parseJSON = [Char]
-> (Text -> Parser Base64Octets) -> Value -> Parser Base64Octets
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Base64Octets" ((Text -> Parser Base64Octets) -> Value -> Parser Base64Octets)
-> (Text -> Parser Base64Octets) -> Value -> Parser Base64Octets
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser Base64Octets) -> Text -> Parser Base64Octets
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (Base64Octets -> Parser Base64Octets
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64Octets -> Parser Base64Octets)
-> (ByteString -> Base64Octets)
-> ByteString
-> Parser Base64Octets
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
(Base64SHA1 -> Base64SHA1 -> Bool)
-> (Base64SHA1 -> Base64SHA1 -> Bool) -> Eq Base64SHA1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64SHA1 -> Base64SHA1 -> Bool
== :: Base64SHA1 -> Base64SHA1 -> Bool
$c/= :: Base64SHA1 -> Base64SHA1 -> Bool
/= :: Base64SHA1 -> Base64SHA1 -> Bool
Eq, Int -> Base64SHA1 -> ShowS
[Base64SHA1] -> ShowS
Base64SHA1 -> [Char]
(Int -> Base64SHA1 -> ShowS)
-> (Base64SHA1 -> [Char])
-> ([Base64SHA1] -> ShowS)
-> Show Base64SHA1
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64SHA1 -> ShowS
showsPrec :: Int -> Base64SHA1 -> ShowS
$cshow :: Base64SHA1 -> [Char]
show :: Base64SHA1 -> [Char]
$cshowList :: [Base64SHA1] -> ShowS
showList :: [Base64SHA1] -> ShowS
Show)

instance FromJSON Base64SHA1 where
  parseJSON :: Value -> Parser Base64SHA1
parseJSON = [Char] -> (Text -> Parser Base64SHA1) -> Value -> Parser Base64SHA1
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url SHA-1" ((Text -> Parser Base64SHA1) -> Value -> Parser Base64SHA1)
-> (Text -> Parser Base64SHA1) -> Value -> Parser Base64SHA1
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser Base64SHA1) -> Text -> Parser Base64SHA1
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    case ByteString -> Int
B.length ByteString
bytes of
      Int
20 -> Base64SHA1 -> Parser Base64SHA1
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64SHA1 -> Parser Base64SHA1)
-> Base64SHA1 -> Parser Base64SHA1
forall a b. (a -> b) -> a -> b
$ ByteString -> Base64SHA1
Base64SHA1 ByteString
bytes
      Int
_  -> [Char] -> Parser Base64SHA1
forall a. [Char] -> Parser a
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
(Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Bool) -> Eq Base64SHA256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64SHA256 -> Base64SHA256 -> Bool
== :: Base64SHA256 -> Base64SHA256 -> Bool
$c/= :: Base64SHA256 -> Base64SHA256 -> Bool
/= :: Base64SHA256 -> Base64SHA256 -> Bool
Eq, Int -> Base64SHA256 -> ShowS
[Base64SHA256] -> ShowS
Base64SHA256 -> [Char]
(Int -> Base64SHA256 -> ShowS)
-> (Base64SHA256 -> [Char])
-> ([Base64SHA256] -> ShowS)
-> Show Base64SHA256
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64SHA256 -> ShowS
showsPrec :: Int -> Base64SHA256 -> ShowS
$cshow :: Base64SHA256 -> [Char]
show :: Base64SHA256 -> [Char]
$cshowList :: [Base64SHA256] -> ShowS
showList :: [Base64SHA256] -> ShowS
Show)

instance FromJSON Base64SHA256 where
  parseJSON :: Value -> Parser Base64SHA256
parseJSON = [Char]
-> (Text -> Parser Base64SHA256) -> Value -> Parser Base64SHA256
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url SHA-256" ((Text -> Parser Base64SHA256) -> Value -> Parser Base64SHA256)
-> (Text -> Parser Base64SHA256) -> Value -> Parser Base64SHA256
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser Base64SHA256) -> Text -> Parser Base64SHA256
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64Url (\ByteString
bytes ->
    case ByteString -> Int
B.length ByteString
bytes of
      Int
32 -> Base64SHA256 -> Parser Base64SHA256
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64SHA256 -> Parser Base64SHA256)
-> Base64SHA256 -> Parser Base64SHA256
forall a b. (a -> b) -> a -> b
$ ByteString -> Base64SHA256
Base64SHA256 ByteString
bytes
      Int
_  -> [Char] -> Parser Base64SHA256
forall a. [Char] -> Parser a
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
(Base64X509 -> Base64X509 -> Bool)
-> (Base64X509 -> Base64X509 -> Bool) -> Eq Base64X509
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64X509 -> Base64X509 -> Bool
== :: Base64X509 -> Base64X509 -> Bool
$c/= :: Base64X509 -> Base64X509 -> Bool
/= :: Base64X509 -> Base64X509 -> Bool
Eq, Int -> Base64X509 -> ShowS
[Base64X509] -> ShowS
Base64X509 -> [Char]
(Int -> Base64X509 -> ShowS)
-> (Base64X509 -> [Char])
-> ([Base64X509] -> ShowS)
-> Show Base64X509
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64X509 -> ShowS
showsPrec :: Int -> Base64X509 -> ShowS
$cshow :: Base64X509 -> [Char]
show :: Base64X509 -> [Char]
$cshowList :: [Base64X509] -> ShowS
showList :: [Base64X509] -> ShowS
Show)

instance FromJSON Base64X509 where
  parseJSON :: Value -> Parser Base64X509
parseJSON = [Char] -> (Text -> Parser Base64X509) -> Value -> Parser Base64X509
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"base64url X.509 certificate" ((Text -> Parser Base64X509) -> Value -> Parser Base64X509)
-> (Text -> Parser Base64X509) -> Value -> Parser Base64X509
forall a b. (a -> b) -> a -> b
$ (ByteString -> Parser Base64X509) -> Text -> Parser Base64X509
forall a. (ByteString -> Parser a) -> Text -> Parser a
parseB64 ((ByteString -> Parser Base64X509) -> Text -> Parser Base64X509)
-> (ByteString -> Parser Base64X509) -> Text -> Parser Base64X509
forall a b. (a -> b) -> a -> b
$
    ([Char] -> Parser Base64X509)
-> (SignedCertificate -> Parser Base64X509)
-> Either [Char] SignedCertificate
-> Parser Base64X509
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser Base64X509
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (Base64X509 -> Parser Base64X509
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Base64X509 -> Parser Base64X509)
-> (SignedCertificate -> Base64X509)
-> SignedCertificate
-> Parser Base64X509
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Base64X509
Base64X509) (Either [Char] SignedCertificate -> Parser Base64X509)
-> (ByteString -> Either [Char] SignedCertificate)
-> ByteString
-> Parser 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 (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject SignedCertificate
x509