diff --git a/asap.cabal b/asap.cabal --- a/asap.cabal +++ b/asap.cabal @@ -1,5 +1,5 @@ name: asap -version: 0.0.2 +version: 0.0.3 synopsis: Atlassian Service Authentication Protocol description: Atlassian Service Authentication Protocol. homepage: https://bitbucket.org/atlassian-marketplace/haskell-asap @@ -21,7 +21,6 @@ other-modules: Web.JWT.ASAP.Env , Web.JWT.ASAP.Error build-depends: base >= 4.8 && < 4.13 - , base64-bytestring >= 1.0 && < 1.1 , bytestring >= 0.10.8 && < 0.11 , jwt >= 0.10 && < 0.11 , mtl >= 2.2.2 && < 2.3 @@ -33,9 +32,13 @@ test-suite asap-tests type: exitcode-stdio-1.0 - main-is: test/Main.hs + hs-source-dirs: test + main-is: Main.hs + other-modules: Util build-depends: asap , base + , mtl , time , jwt + , text , hedgehog >= 0.6 && < 0.7 diff --git a/lib/Web/JWT/ASAP.hs b/lib/Web/JWT/ASAP.hs --- a/lib/Web/JWT/ASAP.hs +++ b/lib/Web/JWT/ASAP.hs @@ -15,26 +15,27 @@ , asapReadRsaSecret , asapAuthHeader , asapAuthHeaderFromEnv +, asapSignerFromEnv , laterThanMaxAge ) where -import Control.Applicative (liftA2) -import Control.Lens (view, ( # )) -import Control.Monad.Except (MonadError (..)) -import Data.ByteString (ByteString) -import Data.ByteString.Base64 (decodeLenient) -import Data.ByteString.Lens (packedChars) -import Data.IORef (newIORef, readIORef, writeIORef) -import Data.String (fromString) -import qualified Data.Text as T -import Data.Time (NominalDiffTime) -import Data.Time.Clock.POSIX (getPOSIXTime) -import Data.UUID (UUID) -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID -import qualified Web.JWT as JWT -import Web.JWT.ASAP.Env (MonadEnv (..), asapLookupEnv) -import Web.JWT.ASAP.Error (HasAsapError (..)) +import Control.Applicative (liftA2) +import Control.Lens (view, ( # ), _tail) +import Control.Monad.Except (MonadError (..)) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 as BS (unlines) +import Data.ByteString.Lens (packedChars) +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.String (fromString) +import qualified Data.Text as T +import Data.Time (NominalDiffTime) +import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.UUID (UUID) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import qualified Web.JWT as JWT +import Web.JWT.ASAP.Env +import Web.JWT.ASAP.Error newtype Expiry = Expiry NominalDiffTime @@ -69,7 +70,7 @@ expiringClaim :: Expiry -> IO JWT.JWTClaimsSet -expiringClaim expiry = do +expiringClaim expiry = liftA2 (timedClaim expiry) getPOSIXTime UUID.nextRandom maxAgeClaimGenerator' :: @@ -80,8 +81,8 @@ -> (JWT.JWTClaimsSet -> m ()) -> m JWT.JWTClaimsSet -> m JWT.JWTClaimsSet -maxAgeClaimGenerator' maxAge time newClaim = - regenerateWhen predicate newClaim +maxAgeClaimGenerator' maxAge time = + regenerateWhen predicate where predicate claim = maybe (pure False) (\iat -> laterThanMaxAge maxAge iat <$> time) $ JWT.iat claim @@ -121,25 +122,33 @@ asapAuthHeaderFromEnv header claim = do issuer <- asapLookupEnv "ASAP_ISSUER" keyId <- asapLookupEnv "ASAP_KEY_ID" - dataUri <- asapLookupEnv "ASAP_PRIVATE_KEY" - let pem = decodeLenient . view packedChars $ dataUriData dataUri - header' = header { JWT.kid = Just $ fromString keyId } + let header' = header { JWT.kid = Just $ fromString keyId } claim' = claim { JWT.iss = JWT.stringOrURI $ fromString issuer } - signer <- asapReadRsaSecret pem + signer <- asapSignerFromEnv pure (asapAuthHeader signer header' claim') +asapSignerFromEnv :: + (HasAsapError e, MonadError e m, MonadEnv m) => + m JWT.Signer +asapSignerFromEnv = do + pem <- toPem . view packedChars . dataUriData <$> asapLookupEnv "ASAP_PRIVATE_KEY" + asapReadRsaSecret pem + where + toPem c = + BS.unlines [ "-----BEGIN RSA PRIVATE KEY-----", c, "-----END RSA PRIVATE KEY-----" ] + dataUriData :: String -> String dataUriData = - snd . break (== ',') + view _tail . dropWhile (/= ',') laterThanMaxAge :: MaxAge -> JWT.NumericDate -> NominalDiffTime -> Bool -laterThanMaxAge (MaxAge maxAgeTime) iat time = do +laterThanMaxAge (MaxAge maxAgeTime) iat time = time - JWT.secondsSinceEpoch iat >= maxAgeTime regenerateWhen :: diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,31 +2,15 @@ module Main where -import Control.Monad (unless) -import Data.Time +import Control.Monad (unless, void) +import Data.Text (Text) import Hedgehog -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import System.Exit (exitFailure) -import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) -import qualified Web.JWT as JWT +import System.Exit (exitFailure) +import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) +import qualified Web.JWT as JWT import Web.JWT.ASAP -nominalYear :: NominalDiffTime -nominalYear = - nominalDay * 365 - -nominalDecade :: NominalDiffTime -nominalDecade = - nominalYear * 10 - -genInDecade :: Gen NominalDiffTime -genInDecade = - Gen.realFrac_ (Range.constant 0 nominalDecade) - -genMaxAge :: Gen MaxAge -genMaxAge = - MaxAge <$> Gen.realFrac_ (Range.constant 0 (9 * 60)) +import Util isExpiredProp :: Property isExpiredProp = @@ -36,6 +20,31 @@ -- numericDate rounds so we have to + 1 to make a later time assert $ maybe False (\iat' -> laterThanMaxAge maxAge iat' (iat + maxAgeTime + 1)) (JWT.numericDate iat) +asapSignerFromEnvProp :: Property +asapSignerFromEnvProp = + withTests 1 . property $ do + let signer = runWithEnv asapSignerFromEnv [("ASAP_PRIVATE_KEY", exampleDataUri)] + void signer === Right () + +asapAuthHeaderFromEnvProp :: Property +asapAuthHeaderFromEnvProp = + withTests 1 . property $ do + let env = [ ("ASAP_PRIVATE_KEY", exampleDataUri) + , ("ASAP_ISSUER", "haskell-asap") + , ("ASAP_KEY_ID", "haskell-asap-demo1") + ] + header = runWithEnv (asapAuthHeaderFromEnv mempty mempty) env + header === Right ("Bearer " <> emptyClaimHeader) + +emptyClaimHeader :: Text +emptyClaimHeader = + "eyJhbGciOiJSUzI1NiIsImtpZCI6Imhhc2tlbGwtYXNhcC1kZW1vMSIsInR5cCI6IkpXVCJ9.eyJpc3M\ + \iOiJoYXNrZWxsLWFzYXAifQ.E95y64Fc42ulqZ--3jClZiPqXJiaOCucceJwJLFWaBYA7Evlb7fhLGy-\ + \QJTzZ7_nHTfK6omspCObPT2DA-KNNT63DjShsW5cZjyCB2zMhtnWFB63wttlIoxs7EePBI8QpmdNcCTt\ + \cokMIL0yULSE-9BZaPehs38yo71fHH3Zzk9LLnPf76FkuTsCmKi26NcL2WcQV3tSrHro1upyGq3i29dt\ + \60dkokO6plCXQFq_CNfNneytUWg0LpqJhPCO0pAiiVedEjobi8tHdJgNzD81v-QgBPr2k1eqnMtYMjzs\ + \wq_g-HxCO_rtjrgGBhcovRvIZm1-ssAJVg9JA9cGGdxq_Q" + main :: IO () main = do hSetBuffering stdout LineBuffering @@ -43,6 +52,8 @@ results <- checkParallel $ Group "ASAP" [ ("laterThanMaxAge", isExpiredProp) + , ("asapSignerFromEnv", asapSignerFromEnvProp) + , ("asapAuthHeaderFromEnvProp", asapAuthHeaderFromEnvProp) ] unless results exitFailure diff --git a/test/Util.hs b/test/Util.hs new file mode 100644 --- /dev/null +++ b/test/Util.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +module Util where + +import Control.Monad.Except +import Control.Monad.Reader +import Data.Time +import Hedgehog (Gen) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Web.JWT.ASAP + +newtype PureEnv a = + PureEnv { runPureEnv :: ReaderT [(String, String)] (Either AsapError) a } + +runWithEnv :: PureEnv a -> [(String, String)] -> Either AsapError a +runWithEnv = + runReaderT . runPureEnv + +instance Functor PureEnv where + fmap f = + PureEnv . fmap f . runPureEnv + +instance Applicative PureEnv where + pure = + PureEnv . pure + f <*> fa = + PureEnv (runPureEnv f <*> runPureEnv fa) + +instance Monad PureEnv where + fa >>= f = + PureEnv (runPureEnv fa >>= runPureEnv . f) + +instance MonadError AsapError PureEnv where + throwError = + PureEnv . throwError + catchError fa f = + PureEnv (catchError (runPureEnv fa) (runPureEnv . f)) + +instance MonadEnv PureEnv where + lookupEnv' s = + PureEnv (ReaderT (pure . lookup s)) + +exampleDataUri :: String +exampleDataUri = + "data:application/pkcs8;kid=haskell-asap-test;base64,MIIEvQIBADANBgkqhkiG9w0BAQEF\ + \AASCBKcwggSjAgEAAoIBAQC/1EaVWX/IopFgxptgkduG0a5IC3PTyvhKtvxXhOCCGueL0dpMunAAKzsy\ + \xCSJsU3DQWMu3xeH+aqPI2aIklLBTqKkPcYxLT+Q99i1cZITfCGRwTRvBKARVf9I36EERwkjuLtnEEQi\ + \kg6kL6rC+86VPXR5RIsVCDafnc3ASR77mRc2sIoxLx40cYh2ax15tC9Z778ZFEhkFW/ZdgC5xEgnh4N3\ + \Wvano9m2d+vhbEwz/6O+WzJZvGX19fsNHamEyfil+pfb28FE6GxQxqfV1PTtNPz1xMgw1rBZJRZ6Gnsr\ + \Z+lQVU3eU1f1Rt1kbW9T9hkoQ3RgiYS1Fl841A4nEhrnAgMBAAECggEAETkBzU7nxh+yZbnvIVB3ITea\ + \KiW9FHrYp/yd002+ym+X8lm4+8KRY7J98iTiEuq0TJ+GRCMLfc3QnmFTR1e7zlc9Cvnw3WFun5lg/4le\ + \0BkI+okaKA2GQYgzD1vknPmzvF1NlgdD1sa+Qcd10WPCPGv0FR8uTYkbPmFwo57tBTGlVao/8NYFClfA\ + \PUqA2Ghb5tHtYELwIOlWqBTVkNQf5sEV8okApFjtkjxP3pO8YD3uPUG0kdghqnlbQaA1UXDKbLmh+NQF\ + \lF1tw2Dri8s9yzOdr1ujALdEcoKCmbWPXDvxZsu/xiUCpWCtmtUeyZAT+LA6t5cFykAXqrXdN4KEAQKB\ + \gQD+E3DVJEElxcrozzcgtsoiPZd38gD57kgF6C3VtdTzHA4ZMGoX8eF8TXUoisAEfhfnkcx2/HUu1DXI\ + \58SI37LpIPeJYyv36GwzeuS3cr5NtGaEXp+u/YE8Eft5FGgeXR8W2/wyOFoYzjoNt//SvzmabPo63Vwk\ + \jxgwXBYPOulpZwKBgQDBSClcgiQvwibFuHyjtGrSJlvsj6eQbLBekZY8hSqlJeJTUkxyOtMpldQ0gdmS\ + \5J6IsjdJ6mMU6Il5iwF2Mk/M+UMoHvlMCrvTKoThCo8wFAZL6LVEhNsPQzSHzs38qZgb81dBgTgJnvyr\ + \q50NPI1EDLlTn/2hh15WxHw3EydSgQKBgQDhiOJM4UzPOd9ff6lg6cFOWbwd5f2F3kWisLIXFbx9PTcq\ + \lvZmYPkWvS81mMzQcBnKHnsQWBOxSQChYVLtaR1IolH5a8X43yFFJV7nlPxmv6+M6u32iONyLkg696lg\ + \4qqZQReCgNFBWbbgvKdjLQn2EayiGiMT9M21B9kxFctiGwKBgC3KELJvym7eCh1xVWXbCit7Fu/2IHZg\ + \qW/eAb+YtL+nN/URXDb7pKcHbdx6nrbkHoK35c1HD+4WIOuAePotdSZULwrEO78+E701J4HA5Kc5Nzyo\ + \hrkS2GrHOxypa7dd3kFQ5u0H1eTBm453+571J2plsUoUbxvjXAAmUF8j1H8BAoGAYNycYkiZeTt9AN4S\ + \PK5N75HlAsi5iT6kRh90nFtKIAR9V0SNEeA3MnrCKdF22mNaQBbiDOu0fmdyNLRz0dp7nu3Bp7JZ6KvP\ + \tARzFTtgRrz41jCT2F+1R5zYdwK2LnTkjPIAdDL3/oeywaYPr9HIqYLzod2jh4KhZVttg1EpT2k=" + +nominalYear :: NominalDiffTime +nominalYear = + nominalDay * 365 + +nominalDecade :: NominalDiffTime +nominalDecade = + nominalYear * 10 + +genInDecade :: Gen NominalDiffTime +genInDecade = + Gen.realFrac_ (Range.constant 0 nominalDecade) + +genMaxAge :: Gen MaxAge +genMaxAge = + MaxAge <$> Gen.realFrac_ (Range.constant 0 (9 * 60))