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

module JWT where

import Data.Maybe

import Control.Lens
import Data.Aeson
import Data.Default.Class (def)
import Data.HashMap.Strict (insert)
import Data.Time
import Network.URI (parseURI)
import Safe (headMay)
import System.Locale
import Test.Hspec

import Crypto.JOSE
import Crypto.JWT


intDate :: String -> Maybe NumericDate
intDate = fmap NumericDate . parseTime defaultTimeLocale "%F %T"

exampleClaimsSet :: ClaimsSet
exampleClaimsSet = emptyClaimsSet
  & claimIss .~ Just (fromString "joe")
  & claimExp .~ intDate "2011-03-22 18:43:00"
  & over unregisteredClaims (insert "http://example.com/is_root" (Bool True))
  & addClaim "http://example.com/is_root" (Bool True)

spec :: Spec
spec = do
  describe "JWT Claims Set" $ do
    it "parses from JSON correctly" $
      let
        claimsJSON = "\
          \{\"iss\":\"joe\",\r\n\
          \ \"exp\":1300819380,\r\n\
          \ \"http://example.com/is_root\":true}"
      in
        decode claimsJSON `shouldBe` Just exampleClaimsSet

    it "formats to a parsable and equal value" $
      decode (encode exampleClaimsSet) `shouldBe` Just exampleClaimsSet

  describe "StringOrURI" $
    it "parses from JSON correctly" $ do
      (decode "[\"foo\"]" >>= headMay >>= getString) `shouldBe` Just "foo"
      (decode "[\"http://example.com\"]" >>= headMay >>= getURI)
        `shouldBe` parseURI "http://example.com"
      decode "[\":\"]" `shouldBe` (Nothing :: Maybe [StringOrURI])
      decode "[12345]" `shouldBe` (Nothing :: Maybe [StringOrURI])

  describe "NumericDate" $
    it "parses from JSON correctly" $ do
      decode "[0]"          `shouldBe` fmap (:[]) (intDate "1970-01-01 00:00:00")
      decode "[1382245921]" `shouldBe` fmap (:[]) (intDate "2013-10-20 05:12:01")
      decode "[\"notnum\"]"       `shouldBe` (Nothing :: Maybe [NumericDate])

  describe "§6.1.  Example Unsecured JWT" $
    it "can be decoded and validated" $
      let
        exampleJWT = "eyJhbGciOiJub25lIn0\
          \.\
          \eyJpc3MiOiJqb2UiLA0KICJleHAiOjEzMDA4MTkzODAsDQogImh0dHA6Ly9leGFt\
          \cGxlLmNvbS9pc19yb290Ijp0cnVlfQ\
          \."
        jwt = decodeCompact exampleJWT
        k = fromJust $ decode "{\"kty\":\"oct\",\"k\":\"\"}"
      in do
        fmap jwtClaimsSet jwt `shouldBe` Right exampleClaimsSet
        fmap (validateJWSJWT algs def k) jwt `shouldBe` Right True
          where algs = ValidationAlgorithms [None]