Update jose to 0.6 (#997)

2017-10-15 10:49:25 -04:00
parent d1a8c3a6f8
commit 2b5ae34c5a
6 changed files with 117 additions and 105 deletions
@@ -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
@@ -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
@@ -18,16 +18,12 @@ module PostgREST.Auth (
  , parseJWK
  ) where

-import           Protolude        hiding ((&))
-import           Control.Lens
+import           Control.Lens.Operators
 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           Crypto.JOSE.JWK
-import           Crypto.JOSE.JWS
-import           Crypto.JOSE.Types
+import qualified Crypto.JOSE.Types      as 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 _ "" "" = return $ JWTClaims M.empty
+jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString  -> IO JWTAttempt
+jwtClaims _ Nothing "" = return $ JWTClaims M.empty
 jwtClaims secret audience payload =
  case secret of
    Nothing -> return JWTMissingSecret
-    Just jwk -> do
-      let validation = set audiencePredicate (==  fromString audience) defaultJWTValidationSettings
+    Just s -> do
+      let validation = defaultJWTValidationSettings (maybe (const True) (==) audience)
      eJwt <- runExceptT $ do
        jwt <- decodeCompact payload
-        validateJWSJWT validation jwk jwt
-        return jwt
+        verifyClaims validation s 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))
@@ -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 $
-        AppConfig <$>
-            C.key "db-uri"
+  let (mAppConf, errs) = flip C.runParserM conf $
+        AppConfig
+          <$> 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
@@ -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:
@@ -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