From c209fcf060659197eba01bf65dab1100ed1f95f6 Mon Sep 17 00:00:00 2001 From: Berk Ozkutuk Date: Wed, 13 Apr 2022 22:18:05 +0300 Subject: [PATCH] Allow API key auth on AddR route --- app/migration/Main.hs | 26 +++++++++++++++++++++++++- espial.cabal | 10 +++++++++- package.yaml | 2 ++ src/Foundation.hs | 33 ++++++++++++++++++++++++++++++++- src/Model.hs | 6 +++++- src/ModelCustom.hs | 17 +++++++++++++++++ 6 files changed, 90 insertions(+), 4 deletions(-) diff --git a/app/migration/Main.hs b/app/migration/Main.hs index a3bac05..28bc19a 100644 --- a/app/migration/Main.hs +++ b/app/migration/Main.hs @@ -51,8 +51,12 @@ data MigrationOpts , privateDefault :: Maybe Bool , archiveDefault :: Maybe Bool , privacyLock :: Maybe Bool } + | CreateApiKey { conn :: Text + , userName :: Text } | DeleteUser { conn :: Text , userName :: Text } + | DeleteApiKey { conn :: Text + , userName :: Text } | ImportBookmarks { conn :: Text , userName :: Text , bookmarkFile :: FilePath } @@ -92,13 +96,33 @@ main = do (UniqueUserName userName) (User userName hash' Nothing False False False) [ UserPasswordHash P.=. hash' - , UserApiToken P.=. Nothing , UserPrivateDefault P.=. fromMaybe False privateDefault , UserArchiveDefault P.=. fromMaybe False archiveDefault , UserPrivacyLock P.=. fromMaybe False privacyLock ] pure () :: DB () + CreateApiKey {..} -> + P.runSqlite conn $ do + apiKey@(ApiKey plainKey) <- liftIO generateApiKey + muser <- P.getBy (UniqueUserName userName) + case muser of + Nothing -> liftIO (print (userName ++ " not found")) + Just (P.Entity uid _) -> do + -- API key is only displayed once after creation, + -- since it is stored in hashed form. + let hashedKey = hashApiKey apiKey + P.update uid [ UserApiToken P.=. Just hashedKey ] + liftIO $ print plainKey + + DeleteApiKey {..} -> + P.runSqlite conn $ do + muser <- P.getBy (UniqueUserName userName) + case muser of + Nothing -> liftIO (print (userName ++ " not found")) + Just (P.Entity uid _) -> do + P.update uid [ UserApiToken P.=. Nothing ] + DeleteUser {..} -> P.runSqlite conn $ do muser <- P.getBy (UniqueUserName userName) diff --git a/espial.cabal b/espial.cabal index 35d5c8c..cceebe7 100644 --- a/espial.cabal +++ b/espial.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.34.6. -- -- see: https://github.com/sol/hpack @@ -163,6 +163,7 @@ library aeson >=1.4 , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 + , base64 , bcrypt >=0.0.8 , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 @@ -173,6 +174,7 @@ library , conduit >=1.0 && <2.0 , connection , containers + , cryptohash-sha256 , data-default , directory >=1.1 && <1.4 , entropy @@ -273,6 +275,7 @@ executable espial aeson >=1.4 , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 + , base64 , bcrypt >=0.0.8 , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 @@ -283,6 +286,7 @@ executable espial , conduit >=1.0 && <2.0 , connection , containers + , cryptohash-sha256 , data-default , directory >=1.1 && <1.4 , entropy @@ -380,6 +384,7 @@ executable migration aeson >=1.4 , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 + , base64 , bcrypt >=0.0.8 , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 @@ -390,6 +395,7 @@ executable migration , conduit >=1.0 && <2.0 , connection , containers + , cryptohash-sha256 , data-default , directory >=1.1 && <1.4 , entropy @@ -493,6 +499,7 @@ test-suite test aeson >=1.4 , attoparsec , base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 + , base64 , bcrypt >=0.0.8 , blaze-html >=0.9 && <1.0 , bytestring >=0.9 && <0.11 @@ -503,6 +510,7 @@ test-suite test , conduit >=1.0 && <2.0 , connection , containers + , cryptohash-sha256 , data-default , directory >=1.1 && <1.4 , entropy diff --git a/package.yaml b/package.yaml index 75b9596..33abd73 100644 --- a/package.yaml +++ b/package.yaml @@ -141,6 +141,8 @@ dependencies: - parser-combinators - html-entities - connection +- base64 +- cryptohash-sha256 # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Foundation.hs b/src/Foundation.hs index 1ba1880..ed1fc23 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -17,6 +17,7 @@ import Yesod.Auth.Message import qualified Data.CaseInsensitive as CI import qualified Data.Text.Encoding as TE import qualified Yesod.Core.Unsafe as Unsafe +import qualified Network.Wai as Wai data App = App { appSettings :: AppSettings @@ -67,8 +68,20 @@ instance Yesod App where else id yesodMiddleware :: HandlerFor App res -> HandlerFor App res - yesodMiddleware = customMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware + yesodMiddleware = customMiddleware . defaultYesodMiddleware . customCsrfMiddleware where + customCsrfMiddleware handler = do + maybeRoute <- getCurrentRoute + dontCheckCsrf <- case maybeRoute of + -- `maybeAuthId` checks for the validity of the Authorization + -- header anyway, but it is still a good idea to limit this + -- flexibility to designated routes. + -- For the time being, `AddR` is the only route that accepts an + -- authentication token. + Just AddR -> isJust <$> lookupHeader "Authorization" + _ -> pure False + (if dontCheckCsrf then id else defaultCsrfMiddleware) handler + customMiddleware handler = do addHeader "X-Frame-Options" "DENY" yesod <- getYesod @@ -167,6 +180,24 @@ instance YesodAuth App where onLogout = deleteSession userNameKey redirectToReferer = const True + maybeAuthId = do + req <- waiRequest + let mAuthHeader = lookup "Authorization" (Wai.requestHeaders req) + extractKey = stripPrefix "ApiKey " . TE.decodeUtf8 + case mAuthHeader of + Just authHeader -> + case extractKey authHeader of + Just apiKey -> do + user <- liftHandler $ runDB $ getApiKeyUser (ApiKey apiKey) + let userId = entityKey <$> user + pure userId + -- Since we disable CSRF middleware in the presence of Authorization + -- header, we need to explicitly check for the validity of the header + -- content. Otherwise, a dummy Authorization header with garbage input + -- could be provided to circumvent CSRF token requirement, making the app + -- vulnerable to CSRF attacks. + Nothing -> pure Nothing + _ -> defaultMaybeAuthId instance YesodAuthPersist App diff --git a/src/Model.hs b/src/Model.hs index edab4e4..ab72f21 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -34,7 +34,7 @@ User json Id Int64 name Text passwordHash BCrypt - apiToken Text Maybe + apiToken HashedApiKey Maybe privateDefault Bool archiveDefault Bool privacyLock Bool @@ -159,6 +159,10 @@ getUserByName :: UserNameP -> DB (Maybe (Entity User)) getUserByName (UserNameP uname) = selectFirst [UserName CP.==. uname] [] +getApiKeyUser :: ApiKey -> DB (Maybe (Entity User)) +getApiKeyUser apiKey = + selectFirst [UserApiToken CP.==. Just (hashApiKey apiKey)] [] + -- returns a list of pair of bookmark with tags merged into a string bookmarksTagsQuery :: Key User diff --git a/src/ModelCustom.hs b/src/ModelCustom.hs index bc2b079..dd6b4e2 100644 --- a/src/ModelCustom.hs +++ b/src/ModelCustom.hs @@ -12,6 +12,8 @@ import qualified Data.Aeson as A import System.Entropy (getEntropy) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Base64.URL as Base64Url +import qualified Crypto.Hash.SHA256 as SHA256 mkSlug :: Int -> IO T.Text mkSlug size = @@ -58,3 +60,18 @@ hashPassword rawPassword = do validatePasswordHash :: BCrypt -> T.Text -> Bool validatePasswordHash hash' pass = do validatePassword (TE.encodeUtf8 (unBCrypt hash')) (TE.encodeUtf8 pass) + +newtype ApiKey = ApiKey { unApiKey :: T.Text } + +newtype HashedApiKey + = HashedApiKey T.Text + deriving stock (Eq, Ord, Show) + deriving newtype (PersistField, PersistFieldSql, A.FromJSON, A.ToJSON) + +generateApiKey :: IO ApiKey +generateApiKey = do + bytes <- getEntropy 32 + pure $ ApiKey $ Base64Url.encodeBase64 bytes + +hashApiKey :: ApiKey -> HashedApiKey +hashApiKey = HashedApiKey . TE.decodeUtf8 . Base64Url.encodeBase64' . SHA256.hash . TE.encodeUtf8 . unApiKey