asap 0.0.2 → 0.0.3

raw patch · 4 files changed

+156/−51 lines, 4 filesdep −base64-bytestringdep ~mtldep ~textPVP ok

version bump matches the API change (PVP)

Dependencies removed: base64-bytestring

Dependency ranges changed: mtl, text

API changes (from Hackage documentation)

Files

• asap.cabal +6/−3
• lib/Web/JWT/ASAP.hs +35/−26
• test/Main.hs +33/−22
• test/Util.hs +82/−0

@@ -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

@@ -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 ::

@@ -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

@@ -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))