Update jose to 0.6 (#997)

main/Main.hs

@@ -2,6 +2,7 @@
 
 module Main where
 
+
 import           PostgREST.App            (postgrest)
 import           PostgREST.Config         (AppConfig (..),
                                            PgVersion (..),
@@ -11,19 +12,19 @@ import           PostgREST.DbStructure    (getDbStructure)
 import           PostgREST.Error          (encodeError)
 import           PostgREST.OpenAPI        (isMalformedProxyUri)
 import           PostgREST.Types          (DbStructure, Schema)
-import           Protolude hiding         (replace, hPutStrLn)
+import           Protolude                hiding (hPutStrLn, replace)
 
 import           Control.Retry            (RetryStatus, capDelay,
                                            exponentialBackoff,
                                            retrying, rsPreviousDelay)
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Base64   as B64
 import           Data.IORef               (IORef, atomicWriteIORef,
                                            newIORef, readIORef)
 import           Data.String              (IsString (..))
 import           Data.Text                (pack, replace, stripPrefix, strip)
 import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
 import           Data.Text.IO             (hPutStrLn)
-import qualified Data.ByteString.Base64   as B64
-import qualified Data.ByteString          as BS
 import qualified Hasql.Decoders           as HD
 import qualified Hasql.Encoders           as HE
 import qualified Hasql.Pool               as P

postgrest.cabal

@@ -66,7 +66,7 @@ library
                      , http-types
                      , insert-ordered-containers
                      , interpolatedstring-perl6
-                     , jose < 0.6
+                     , jose >= 0.6
                      , lens
                      , lens-aeson
                      , network-uri
@@ -110,7 +110,8 @@ Test-Suite spec
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   Hs-Source-Dirs:      test
   Main-Is:             Main.hs
-  Other-Modules:       Feature.AuthSpec
+  Other-Modules:       Feature.AudienceJwtSecretSpec
+                     , Feature.AuthSpec
                      , Feature.AsymmetricJwtSpec
                      , Feature.BinaryJwtSecretSpec
                      , Feature.ConcurrentSpec

src/PostgREST/Auth.hs

@@ -18,16 +18,12 @@ module PostgREST.Auth (
   , parseJWK
   ) where
 
-import           Protolude        hiding ((&))
+import           Control.Lens.Operators
-import           Control.Lens
 import           Data.Aeson             (Value (..), decode, toJSON)
-import qualified Data.ByteString.Lazy    as BL
 import qualified Data.HashMap.Strict    as M
+import           Protolude
 
-import           Crypto.JOSE.Compact
+import qualified Crypto.JOSE.Types      as JOSE.Types
-import           Crypto.JOSE.JWK
-import           Crypto.JOSE.JWS
-import           Crypto.JOSE.Types
 import           Crypto.JWT
 
 {-|
@@ -42,20 +38,19 @@ data JWTAttempt = JWTInvalid JWTError
   Receives the JWT secret and audience (from config) and a JWT and returns a map
   of JWT claims.
 -}
-jwtClaims :: Maybe JWK -> Text -> BL.ByteString  -> IO JWTAttempt
+jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString  -> IO JWTAttempt
-jwtClaims _ "" "" = return $ JWTClaims M.empty
+jwtClaims _ Nothing "" = return $ JWTClaims M.empty
 jwtClaims secret audience payload =
   case secret of
     Nothing -> return JWTMissingSecret
-    Just jwk -> do
+    Just s -> do
-      let validation = set audiencePredicate (==  fromString audience) defaultJWTValidationSettings
+      let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
       eJwt <- runExceptT $ do
         jwt <- decodeCompact payload
-        validateJWSJWT validation jwk jwt
+        verifyClaims validation s jwt
-        return jwt
       return $ case eJwt of
         Left e    -> JWTInvalid e
-        Right jwt -> JWTClaims . claims2map . jwtClaimsSet $ jwt
+        Right jwt -> JWTClaims . claims2map $ jwt
 
 {-|
   Whether a response from jwtClaims contains a role claim
@@ -89,4 +84,4 @@ hs256jwk key =
     & jwkUse .~ Just Sig
     & jwkAlg .~ (Just $ JWSAlg HS256)
  where
-  km = OctKeyMaterial (OctKeyParameters Oct (Base64Octets key))
+  km = OctKeyMaterial (OctKeyParameters (JOSE.Types.Base64Octets key))

src/PostgREST/Config.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
 {-|
 Module      : PostgREST.Config
@@ -23,18 +24,24 @@ module PostgREST.Config ( prettyVersion
                         )
        where
 
-import           System.IO.Error             (IOError)
 import           Control.Applicative
+import           Control.Monad                (fail)
+import           Control.Lens                 (preview)
+import           Crypto.JWT                   (StringOrURI,
+                                               stringOrUri)
 import qualified Data.ByteString              as B
 import qualified Data.ByteString.Char8        as BS
 import qualified Data.CaseInsensitive         as CI
 import qualified Data.Configurator            as C
 import qualified Data.Configurator.Parser     as C
-import           Data.Configurator.Types     (Value(..))
+import           Data.Configurator.Types      as C
 import           Data.List                    (lookup)
 import           Data.Monoid
 import           Data.Scientific              (floatingOrInteger)
-import           Data.Text                   (strip, intercalate, lines, dropAround)
+import           Data.String                  (String)
+import           Data.Text                    (dropAround,
+                                               intercalate, lines,
+                                               strip)
 import           Data.Text.Encoding           (encodeUtf8)
 import           Data.Text.IO                 (hPutStrLn)
 import           Data.Version                 (versionBranch)
@@ -42,11 +49,13 @@ import           Network.Wai
 import           Network.Wai.Middleware.Cors  (CorsResourcePolicy (..))
 import           Options.Applicative          hiding (str)
 import           Paths_postgrest              (version)
+import           Protolude                    hiding (hPutStrLn,
+                                               intercalate, (<>))
 import           System.IO                    (hPrint)
+import           System.IO.Error              (IOError)
 import           Text.Heredoc
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<>), (<$>))
+import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
 import qualified Text.PrettyPrint.ANSI.Leijen as L
-import           Protolude hiding            (intercalate, (<>), hPutStrLn)
 
 -- | Config file settings for the server
 data AppConfig = AppConfig {
@@ -59,7 +68,7 @@ data AppConfig = AppConfig {
 
   , configJwtSecret         :: Maybe B.ByteString
   , configJwtSecretIsBase64 :: Bool
-  , configJwtAudience       :: Text
+  , configJwtAudience       :: Maybe StringOrURI
 
   , configPool              :: Int
   , configMaxRows           :: Maybe Integer
@@ -108,9 +117,9 @@ readOptions = do
     (C.readConfig =<< C.load [C.Required cfgPath])
     configNotfoundHint
 
-  let (mAppConf, errs) = flip C.runParserA conf $
+  let (mAppConf, errs) = flip C.runParserM conf $
-        AppConfig <$>
+        AppConfig
-            C.key "db-uri"
+          <$> C.key "db-uri"
           <*> C.key "db-anon-role"
           <*> (mfilter (/= "") <$> C.key "server-proxy-uri")
           <*> C.key "db-schema"
@@ -118,7 +127,7 @@ readOptions = do
           <*> (fromMaybe 3000 . join . fmap coerceInt <$> C.key "server-port")
           <*> (fmap encodeUtf8 . mfilter (/= "") <$> C.key "jwt-secret")
           <*> (fromMaybe False . join . fmap coerceBool <$> C.key "secret-is-base64")
-          <*> (fromMaybe "" <$> C.key "jwt-aud")
+          <*> parseJwtAudience "jwt-aud"
           <*> (fromMaybe 10 . join . fmap coerceInt <$> C.key "db-pool")
           <*> (join . fmap coerceInt <$> C.key "max-rows")
           <*> (mfilter (/= "") <$> C.key "pre-request")
@@ -132,6 +141,14 @@ readOptions = do
       return appConf
 
   where
+    parseJwtAudience :: Name -> C.ConfigParserM (Maybe StringOrURI)
+    parseJwtAudience k =
+      C.key k >>= \case
+        Nothing -> pure Nothing -- no audience in config file
+        Just aud -> case preview stringOrUri (aud :: String) of
+          Nothing -> fail "Invalid Jwt audience. Check your configuration."
+          aud' -> pure aud'
+
     coerceInt :: (Read i, Integral i) => Value -> Maybe i
     coerceInt (Number x) = rightToMaybe $ floatingOrInteger x
     coerceInt (String x) = readMaybe $ toS x

stack.yaml

@@ -1,11 +1,9 @@
-resolver: lts-9.0
+resolver: lts-9.6
 extra-deps:
   - configurator-ng-0.0.0.1
   - critbit-0.2.0.0
-  - hasql-pool-0.4.1
   - hjsonpointer-1.1.1
   - hjsonschema-1.5.0.1
-  - jose-0.5.0.3
   - Ranged-sets-0.3.0
   - protolude-0.2
 ghc-options:

test/SpecHelper.hs

@@ -68,7 +68,7 @@ _baseCfg :: AppConfig
 _baseCfg =  -- Connection Settings
   AppConfig mempty "postgrest_test_anonymous" Nothing "test" "localhost" 3000
             -- Jwt settings
-            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False ""
+            (Just $ encodeUtf8 "reallyreallyreallyreallyverysafe") False Nothing
             -- Connection Modifiers
             10 Nothing (Just "test.switch_role")
             -- Debug Settings
@@ -99,7 +99,7 @@ testCfgAudienceJWT :: Text -> AppConfig
 testCfgAudienceJWT testDbConn = (testCfg testDbConn) {
     configJwtSecret = Just . B64.decodeLenient $
       "cmVhbGx5cmVhbGx5cmVhbGx5cmVhbGx5dmVyeXNhZmU=",
-    configJwtAudience = "youraudience"
+    configJwtAudience = Just "youraudience"
   }
 
 testCfgAsymJWK :: Text -> AppConfig