packages feed

asap (empty) → 0.0.1

raw patch · 7 files changed

+323/−0 lines, 7 filesdep +asapdep +basedep +base64-bytestringsetup-changed

Dependencies added: asap, base, base64-bytestring, bytestring, hedgehog, jwt, lens, mtl, semigroups, text, time, transformers, uuid

Files

+ LICENSE.txt view
@@ -0,0 +1,13 @@+Copyright 2019 Atlassian Pty Ltd++   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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ asap.cabal view
@@ -0,0 +1,42 @@+name:                asap+version:             0.0.1+synopsis:            Atlassian Service Authentication Protocol+description:         Atlassian Service Authentication Protocol.+homepage:            https://bitbucket.org/atlassian-marketplace/haskell-asap+author:              Atlassian Marketplace+maintainer:          marketplace@atlassian.com+license:             Apache-2.0+license-file:        LICENSE.txt+category:            Web+build-type:          Simple+cabal-version:       >=1.8++source-repository head+  type:             git+  location:         https://bitbucket.org/atlassian-marketplace/haskell-asap.git++library+  hs-source-dirs:      lib+  exposed-modules:     Web.JWT.ASAP+  other-modules:       Web.JWT.ASAP.Env+                     , Web.JWT.ASAP.Error+  build-depends:       base                 >= 4.8 && < 4.12+                     , base64-bytestring    >= 1.0 && < 1.1+                     , bytestring           >= 0.10.8 && < 0.11+                     , jwt                  >= 0.10 && < 0.11+                     , mtl                  >= 2.2.2 && < 2.3+                     , text                 >= 1.2 && < 1.3+                     , transformers         >= 0.5 && < 0.6+                     , time                 >= 1.8 && < 1.9+                     , semigroups           >= 0.18 && < 0.19+                     , lens                 >= 4.16 && < 4.17+                     , uuid                 >= 1.3 && < 1.4++test-suite asap-tests+  type:                exitcode-stdio-1.0+  main-is:             test/Main.hs+  build-depends:       asap+                     , base+                     , time+                     , jwt+                     , hedgehog             >= 0.6 && < 0.7
+ lib/Web/JWT/ASAP.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module Web.JWT.ASAP (+  module Web.JWT.ASAP.Error+, module Web.JWT.ASAP.Env+, Expiry(..)+, MaxAge(..)+, defaultTokenExpiry+, defaultTokenMaxAge+, timedClaim+, expiringClaim+, maxAgeClaimGenerator'+, maxAgeClaimGenerator+, asapReadRsaSecret+, asapAuthHeader+, asapAuthHeaderFromEnv+, 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 (..))++newtype Expiry+  = Expiry NominalDiffTime+  deriving (Show, Eq, Ord)++newtype MaxAge+  = MaxAge NominalDiffTime+  deriving (Show, Eq, Ord)++defaultTokenExpiry ::+  Expiry+defaultTokenExpiry =+  Expiry $ 10 * 60++defaultTokenMaxAge ::+  MaxAge+defaultTokenMaxAge =+  MaxAge $ 9 * 60++timedClaim ::+  Expiry+  -> NominalDiffTime+  -> UUID+  -> JWT.JWTClaimsSet+timedClaim (Expiry expiryTime) time uuid =+  mempty+    { JWT.iat = JWT.numericDate time+    , JWT.exp = JWT.numericDate $ time + expiryTime+    , JWT.jti = JWT.stringOrURI $ UUID.toText uuid+    }++expiringClaim ::+  Expiry+  -> IO JWT.JWTClaimsSet+expiringClaim expiry = do+  liftA2 (timedClaim expiry) getPOSIXTime UUID.nextRandom++maxAgeClaimGenerator' ::+  (Monad m) =>+  MaxAge+  -> m NominalDiffTime+  -> m JWT.JWTClaimsSet+  -> (JWT.JWTClaimsSet -> m ())+  -> m JWT.JWTClaimsSet+  -> m JWT.JWTClaimsSet+maxAgeClaimGenerator' maxAge time newClaim =+  regenerateWhen predicate newClaim+  where+    predicate claim =+      maybe (pure False) (\iat -> laterThanMaxAge maxAge iat <$> time) $ JWT.iat claim++maxAgeClaimGenerator ::+  MaxAge+  -> Expiry+  -> IO (IO JWT.JWTClaimsSet)+maxAgeClaimGenerator maxAge expiry = do+  initialClaim <- newClaim+  ref <- newIORef initialClaim+  pure (maxAgeClaimGenerator' maxAge getPOSIXTime newClaim (writeIORef ref) (readIORef ref))+  where+    newClaim =+      expiringClaim expiry++asapReadRsaSecret ::+  (HasAsapError e, MonadError e m) =>+  ByteString+  -> m JWT.Signer+asapReadRsaSecret =+  maybe (throwError (asapInvalidSecret # ())) (pure . JWT.RSAPrivateKey) . JWT.readRsaSecret++asapAuthHeader ::+  JWT.Signer+  -> JWT.JOSEHeader+  -> JWT.JWTClaimsSet+  -> T.Text+asapAuthHeader signer header claim =+  "Bearer " <> JWT.encodeSigned signer header claim++asapAuthHeaderFromEnv ::+  (HasAsapError e, MonadError e m, MonadEnv m) =>+  JWT.JOSEHeader+  -> JWT.JWTClaimsSet+  -> m T.Text+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 }+      claim' = claim { JWT.iss = JWT.stringOrURI $ fromString issuer }+  signer <- asapReadRsaSecret pem+  pure (asapAuthHeader signer header' claim')++dataUriData ::+  String+  -> String+dataUriData =+  snd . break (== ',')++laterThanMaxAge ::+  MaxAge+  -> JWT.NumericDate+  -> NominalDiffTime+  -> Bool+laterThanMaxAge (MaxAge maxAgeTime) iat time = do+  time - JWT.secondsSinceEpoch iat >= maxAgeTime++regenerateWhen ::+  Monad m =>+  (a -> m Bool)+  -> m a+  -> (a -> m ())+  -> m a+  -> m a+regenerateWhen predicate ma put get = do+  c <- get+  b <- predicate c+  if b+    then do+      c' <- ma+      put c'+      pure c'+    else pure c
+ lib/Web/JWT/ASAP/Env.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Web.JWT.ASAP.Env (+  MonadEnv (..)+, asapLookupEnv+) where++import           Control.Lens         (( # ))+import           Control.Monad.Except (ExceptT, MonadError (..))+import           Control.Monad.Trans  (lift)+import           System.Environment   (lookupEnv)+import           Web.JWT.ASAP.Error++class MonadEnv m where+  lookupEnv' :: String -> m (Maybe String)++instance MonadEnv IO where+  lookupEnv' =+    lookupEnv++instance (Monad m, MonadEnv m) => MonadEnv (ExceptT e m) where+  lookupEnv' =+    lift . lookupEnv'++asapLookupEnv :: (MonadError e m, HasAsapError e, MonadEnv m) => String -> m String+asapLookupEnv s =+  maybe (throwError (asapMissingEnv # s)) pure =<< lookupEnv' s
+ lib/Web/JWT/ASAP/Error.hs view
@@ -0,0 +1,31 @@+module Web.JWT.ASAP.Error (+  HasAsapError (..)+, AsapError (..)+) where++import           Control.Lens (Prism', prism')++class HasAsapError e where+  asapMissingEnv :: Prism' e String+  asapInvalidSecret :: Prism' e ()++instance HasAsapError AsapError where+  asapMissingEnv =+    prism' AsapMissingEnv f+    where+      f (AsapMissingEnv a) =+        Just a+      f _ =+        Nothing+  asapInvalidSecret =+    prism' (const AsapInvalidSecret) f+    where+      f AsapInvalidSecret =+        Just ()+      f _ =+        Nothing++data AsapError+  = AsapMissingEnv String+  | AsapInvalidSecret+  deriving (Eq, Ord, Show)
+ test/Main.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Monad  (unless)+import           Data.Time+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           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))++isExpiredProp :: Property+isExpiredProp =+  property $ do+    maxAge@(MaxAge maxAgeTime) <- forAll genMaxAge+    iat <- forAll genInDecade+    -- 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)++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering++  results <- checkParallel $+    Group "ASAP" [ ("laterThanMaxAge", isExpiredProp)+                 ]++  unless results exitFailure