diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/AuthToken.hs | 99 | ||||
| -rw-r--r-- | Utility/WebApp.hs | 25 |
2 files changed, 101 insertions, 23 deletions
diff --git a/Utility/AuthToken.hs b/Utility/AuthToken.hs new file mode 100644 index 000000000..191b4f5c9 --- /dev/null +++ b/Utility/AuthToken.hs @@ -0,0 +1,99 @@ +{- authentication tokens + - + - Copyright 2016 Joey Hess <id@joeyh.name> + - + - License: BSD-2-clause + -} + +module Utility.AuthToken ( + AuthToken, + toAuthToken, + fromAuthToken, + nullAuthToken, + genAuthToken, + AllowedAuthTokens, + allowedAuthTokens, + isAllowedAuthToken, +) where + +import qualified Utility.SimpleProtocol as Proto +import Utility.Hash + +import Data.SecureMem +import Data.Maybe +import Data.Char +import Data.Byteable +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.ByteString.Lazy as L +import "crypto-api" Crypto.Random + +-- | An AuthToken is stored in secue memory, with constant time comparison. +-- +-- It can have varying length, depending on the security needs of the +-- application. +-- +-- To avoid decoding issues, and presentation issues, the content +-- of an AuthToken is limited to ASCII characters a-z, and 0-9. +-- This is enforced by all exported AuthToken constructors. +newtype AuthToken = AuthToken SecureMem + deriving (Show, Eq) + +allowedChar :: Char -> Bool +allowedChar c = isAsciiUpper c || isAsciiLower c || isDigit c + +instance Proto.Serializable AuthToken where + serialize = T.unpack . fromAuthToken + deserialize = toAuthToken . T.pack + +fromAuthToken :: AuthToken -> T.Text +fromAuthToken (AuthToken t ) = TE.decodeLatin1 (toBytes t) + +-- | Upper-case characters are lower-cased to make them fit in the allowed +-- character set. This allows AuthTokens to be compared effectively +-- case-insensitively. +-- +-- Returns Nothing if any disallowed characters are present. +toAuthToken :: T.Text -> Maybe AuthToken +toAuthToken t + | all allowedChar s = Just $ AuthToken $ + secureMemFromByteString $ TE.encodeUtf8 $ T.pack s + | otherwise = Nothing + where + s = map toLower $ T.unpack t + +-- | The empty AuthToken, for those times when you don't want any security. +nullAuthToken :: AuthToken +nullAuthToken = AuthToken $ secureMemFromByteString $ TE.encodeUtf8 T.empty + +-- | Generates an AuthToken of a specified length. This is done by +-- generating a random bytestring, hashing it with sha2 512, and truncating +-- to the specified length. +-- +-- That limits the maximum length to 128, but with 512 bytes of entropy, +-- that should be sufficient for any application. +genAuthToken :: Int -> IO AuthToken +genAuthToken len = do + g <- newGenIO :: IO SystemRandom + return $ + case genBytes 512 g of + Left e -> error $ "failed to generate auth token: " ++ show e + Right (s, _) -> fromMaybe (error "auth token encoding failed") $ + toAuthToken $ T.pack $ take len $ + show $ sha2_512 $ L.fromChunks [s] + +-- | For when several AuthTokens are allowed to be used. +newtype AllowedAuthTokens = AllowedAuthTokens [AuthToken] + +allowedAuthTokens :: [AuthToken] -> AllowedAuthTokens +allowedAuthTokens = AllowedAuthTokens + +-- | Note that every item in the list is checked, even if the first one +-- is allowed, so that comparison is constant-time. +isAllowedAuthToken :: AuthToken -> AllowedAuthTokens -> Bool +isAllowedAuthToken t (AllowedAuthTokens l) = go False l + where + go ok [] = ok + go ok (i:is) + | t == i = go True is + | otherwise = go ok is diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 63ca33520..a90772b10 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -12,7 +12,7 @@ module Utility.WebApp where import Common import Utility.Tmp import Utility.FileMode -import Utility.Hash +import Utility.AuthToken import qualified Yesod import qualified Network.Wai as Wai @@ -23,7 +23,6 @@ import qualified Data.CaseInsensitive as CI import Network.Socket import "crypto-api" Crypto.Random import qualified Web.ClientSession as CS -import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Text.Encoding as TE @@ -31,8 +30,6 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromText) import Blaze.ByteString.Builder (Builder) import Control.Arrow ((***)) import Control.Concurrent -import Data.SecureMem -import Data.Byteable #ifdef __ANDROID__ import Data.Endian #endif @@ -159,24 +156,6 @@ webAppSessionBackend _ = do Just . Yesod.clientSessionBackend key . fst <$> Yesod.clientSessionDateCacher timeout -type AuthToken = SecureMem - -toAuthToken :: T.Text -> AuthToken -toAuthToken = secureMemFromByteString . TE.encodeUtf8 - -fromAuthToken :: AuthToken -> T.Text -fromAuthToken = TE.decodeLatin1 . toBytes - -{- Generates a random sha2_512 string, encapsulated in a SecureMem, - - suitable to be used for an authentication secret. -} -genAuthToken :: IO AuthToken -genAuthToken = do - g <- newGenIO :: IO SystemRandom - return $ - case genBytes 512 g of - Left e -> error $ "failed to generate auth token: " ++ show e - Right (s, _) -> toAuthToken $ T.pack $ show $ sha2_512 $ L.fromChunks [s] - {- A Yesod isAuthorized method, which checks the auth cgi parameter - against a token extracted from the Yesod application. - @@ -193,7 +172,7 @@ checkAuthToken extractAuthToken r predicate webapp <- Yesod.getYesod req <- Yesod.getRequest let params = Yesod.reqGetParams req - if (toAuthToken <$> lookup "auth" params) == Just (extractAuthToken webapp) + if (toAuthToken =<< lookup "auth" params) == Just (extractAuthToken webapp) then return Yesod.Authorized else Yesod.sendResponseStatus unauthorized401 () |