Allow API key auth on AddR route
This commit is contained in:
parent
91fa462f8c
commit
f03c9eb293
|
@ -51,8 +51,12 @@ data MigrationOpts
|
||||||
, privateDefault :: Maybe Bool
|
, privateDefault :: Maybe Bool
|
||||||
, archiveDefault :: Maybe Bool
|
, archiveDefault :: Maybe Bool
|
||||||
, privacyLock :: Maybe Bool }
|
, privacyLock :: Maybe Bool }
|
||||||
|
| CreateApiKey { conn :: Text
|
||||||
|
, userName :: Text }
|
||||||
| DeleteUser { conn :: Text
|
| DeleteUser { conn :: Text
|
||||||
, userName :: Text }
|
, userName :: Text }
|
||||||
|
| DeleteApiKey { conn :: Text
|
||||||
|
, userName :: Text }
|
||||||
| ImportBookmarks { conn :: Text
|
| ImportBookmarks { conn :: Text
|
||||||
, userName :: Text
|
, userName :: Text
|
||||||
, bookmarkFile :: FilePath }
|
, bookmarkFile :: FilePath }
|
||||||
|
@ -92,13 +96,33 @@ main = do
|
||||||
(UniqueUserName userName)
|
(UniqueUserName userName)
|
||||||
(User userName hash' Nothing False False False)
|
(User userName hash' Nothing False False False)
|
||||||
[ UserPasswordHash P.=. hash'
|
[ UserPasswordHash P.=. hash'
|
||||||
, UserApiToken P.=. Nothing
|
|
||||||
, UserPrivateDefault P.=. fromMaybe False privateDefault
|
, UserPrivateDefault P.=. fromMaybe False privateDefault
|
||||||
, UserArchiveDefault P.=. fromMaybe False archiveDefault
|
, UserArchiveDefault P.=. fromMaybe False archiveDefault
|
||||||
, UserPrivacyLock P.=. fromMaybe False privacyLock
|
, UserPrivacyLock P.=. fromMaybe False privacyLock
|
||||||
]
|
]
|
||||||
pure () :: DB ()
|
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 {..} ->
|
DeleteUser {..} ->
|
||||||
P.runSqlite conn $ do
|
P.runSqlite conn $ do
|
||||||
muser <- P.getBy (UniqueUserName userName)
|
muser <- P.getBy (UniqueUserName userName)
|
||||||
|
|
10
espial.cabal
10
espial.cabal
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 1.12
|
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
|
-- see: https://github.com/sol/hpack
|
||||||
|
|
||||||
|
@ -163,6 +163,7 @@ library
|
||||||
aeson >=1.4
|
aeson >=1.4
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
|
, base64
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
, blaze-html >=0.9 && <1.0
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
|
@ -173,6 +174,7 @@ library
|
||||||
, conduit >=1.0 && <2.0
|
, conduit >=1.0 && <2.0
|
||||||
, connection
|
, connection
|
||||||
, containers
|
, containers
|
||||||
|
, cryptohash-sha256
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, entropy
|
, entropy
|
||||||
|
@ -273,6 +275,7 @@ executable espial
|
||||||
aeson >=1.4
|
aeson >=1.4
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
|
, base64
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
, blaze-html >=0.9 && <1.0
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
|
@ -283,6 +286,7 @@ executable espial
|
||||||
, conduit >=1.0 && <2.0
|
, conduit >=1.0 && <2.0
|
||||||
, connection
|
, connection
|
||||||
, containers
|
, containers
|
||||||
|
, cryptohash-sha256
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, entropy
|
, entropy
|
||||||
|
@ -380,6 +384,7 @@ executable migration
|
||||||
aeson >=1.4
|
aeson >=1.4
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
|
, base64
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
, blaze-html >=0.9 && <1.0
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
|
@ -390,6 +395,7 @@ executable migration
|
||||||
, conduit >=1.0 && <2.0
|
, conduit >=1.0 && <2.0
|
||||||
, connection
|
, connection
|
||||||
, containers
|
, containers
|
||||||
|
, cryptohash-sha256
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, entropy
|
, entropy
|
||||||
|
@ -493,6 +499,7 @@ test-suite test
|
||||||
aeson >=1.4
|
aeson >=1.4
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
, base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5
|
||||||
|
, base64
|
||||||
, bcrypt >=0.0.8
|
, bcrypt >=0.0.8
|
||||||
, blaze-html >=0.9 && <1.0
|
, blaze-html >=0.9 && <1.0
|
||||||
, bytestring >=0.9 && <0.11
|
, bytestring >=0.9 && <0.11
|
||||||
|
@ -503,6 +510,7 @@ test-suite test
|
||||||
, conduit >=1.0 && <2.0
|
, conduit >=1.0 && <2.0
|
||||||
, connection
|
, connection
|
||||||
, containers
|
, containers
|
||||||
|
, cryptohash-sha256
|
||||||
, data-default
|
, data-default
|
||||||
, directory >=1.1 && <1.4
|
, directory >=1.1 && <1.4
|
||||||
, entropy
|
, entropy
|
||||||
|
|
|
@ -141,6 +141,8 @@ dependencies:
|
||||||
- parser-combinators
|
- parser-combinators
|
||||||
- html-entities
|
- html-entities
|
||||||
- connection
|
- connection
|
||||||
|
- base64
|
||||||
|
- cryptohash-sha256
|
||||||
|
|
||||||
# The library contains all of our application code. The executable
|
# The library contains all of our application code. The executable
|
||||||
# defined below is just a thin wrapper.
|
# defined below is just a thin wrapper.
|
||||||
|
|
|
@ -17,6 +17,7 @@ import Yesod.Auth.Message
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.Text.Encoding as TE
|
import qualified Data.Text.Encoding as TE
|
||||||
import qualified Yesod.Core.Unsafe as Unsafe
|
import qualified Yesod.Core.Unsafe as Unsafe
|
||||||
|
import qualified Network.Wai as Wai
|
||||||
|
|
||||||
data App = App
|
data App = App
|
||||||
{ appSettings :: AppSettings
|
{ appSettings :: AppSettings
|
||||||
|
@ -67,8 +68,20 @@ instance Yesod App where
|
||||||
else id
|
else id
|
||||||
|
|
||||||
yesodMiddleware :: HandlerFor App res -> HandlerFor App res
|
yesodMiddleware :: HandlerFor App res -> HandlerFor App res
|
||||||
yesodMiddleware = customMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
|
yesodMiddleware = customMiddleware . defaultYesodMiddleware . customCsrfMiddleware
|
||||||
where
|
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
|
customMiddleware handler = do
|
||||||
addHeader "X-Frame-Options" "DENY"
|
addHeader "X-Frame-Options" "DENY"
|
||||||
yesod <- getYesod
|
yesod <- getYesod
|
||||||
|
@ -167,6 +180,24 @@ instance YesodAuth App where
|
||||||
onLogout =
|
onLogout =
|
||||||
deleteSession userNameKey
|
deleteSession userNameKey
|
||||||
redirectToReferer = const True
|
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
|
instance YesodAuthPersist App
|
||||||
|
|
||||||
|
|
|
@ -34,7 +34,7 @@ User json
|
||||||
Id Int64
|
Id Int64
|
||||||
name Text
|
name Text
|
||||||
passwordHash BCrypt
|
passwordHash BCrypt
|
||||||
apiToken Text Maybe
|
apiToken HashedApiKey Maybe
|
||||||
privateDefault Bool
|
privateDefault Bool
|
||||||
archiveDefault Bool
|
archiveDefault Bool
|
||||||
privacyLock Bool
|
privacyLock Bool
|
||||||
|
@ -159,6 +159,10 @@ getUserByName :: UserNameP -> DB (Maybe (Entity User))
|
||||||
getUserByName (UserNameP uname) =
|
getUserByName (UserNameP uname) =
|
||||||
selectFirst [UserName CP.==. 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
|
-- returns a list of pair of bookmark with tags merged into a string
|
||||||
bookmarksTagsQuery
|
bookmarksTagsQuery
|
||||||
:: Key User
|
:: Key User
|
||||||
|
|
|
@ -12,6 +12,8 @@ import qualified Data.Aeson as A
|
||||||
import System.Entropy (getEntropy)
|
import System.Entropy (getEntropy)
|
||||||
import qualified Data.ByteString.Builder as BB
|
import qualified Data.ByteString.Builder as BB
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
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 :: Int -> IO T.Text
|
||||||
mkSlug size =
|
mkSlug size =
|
||||||
|
@ -58,3 +60,18 @@ hashPassword rawPassword = do
|
||||||
validatePasswordHash :: BCrypt -> T.Text -> Bool
|
validatePasswordHash :: BCrypt -> T.Text -> Bool
|
||||||
validatePasswordHash hash' pass = do
|
validatePasswordHash hash' pass = do
|
||||||
validatePassword (TE.encodeUtf8 (unBCrypt hash')) (TE.encodeUtf8 pass)
|
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