Allow API key auth on AddR route
This commit is contained in:
parent
77b0b6d4a0
commit
c209fcf060
|
@ -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)
|
||||
|
|
10
espial.cabal
10
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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue