1{- authentication tokens 2 - 3 - Copyright 2016 Joey Hess <id@joeyh.name> 4 - 5 - License: BSD-2-clause 6 -} 7 8module Utility.AuthToken ( 9 AuthToken, 10 toAuthToken, 11 fromAuthToken, 12 nullAuthToken, 13 genAuthToken, 14 AllowedAuthTokens, 15 allowedAuthTokens, 16 isAllowedAuthToken, 17) where 18 19import qualified Utility.SimpleProtocol as Proto 20import Utility.Hash 21 22import Data.SecureMem 23import Data.Maybe 24import Data.Char 25import Data.Byteable 26import qualified Data.Text as T 27import qualified Data.Text.Encoding as TE 28import qualified Data.ByteString.Lazy as L 29import "crypto-api" Crypto.Random 30 31-- | An AuthToken is stored in secure memory, with constant time comparison. 32-- 33-- It can have varying length, depending on the security needs of the 34-- application. 35-- 36-- To avoid decoding issues, and presentation issues, the content 37-- of an AuthToken is limited to ASCII characters a-z, and 0-9. 38-- This is enforced by all exported AuthToken constructors. 39newtype AuthToken = AuthToken SecureMem 40 deriving (Show, Eq) 41 42allowedChar :: Char -> Bool 43allowedChar c = isAsciiUpper c || isAsciiLower c || isDigit c 44 45instance Proto.Serializable AuthToken where 46 serialize = T.unpack . fromAuthToken 47 deserialize = toAuthToken . T.pack 48 49fromAuthToken :: AuthToken -> T.Text 50fromAuthToken (AuthToken t ) = TE.decodeLatin1 (toBytes t) 51 52-- | Upper-case characters are lower-cased to make them fit in the allowed 53-- character set. This allows AuthTokens to be compared effectively 54-- case-insensitively. 55-- 56-- Returns Nothing if any disallowed characters are present. 57toAuthToken :: T.Text -> Maybe AuthToken 58toAuthToken t 59 | all allowedChar s = Just $ AuthToken $ 60 secureMemFromByteString $ TE.encodeUtf8 $ T.pack s 61 | otherwise = Nothing 62 where 63 s = map toLower $ T.unpack t 64 65-- | The empty AuthToken, for those times when you don't want any security. 66nullAuthToken :: AuthToken 67nullAuthToken = AuthToken $ secureMemFromByteString $ TE.encodeUtf8 T.empty 68 69-- | Generates an AuthToken of a specified length. This is done by 70-- generating a random bytestring, hashing it with sha2 512, and truncating 71-- to the specified length. 72-- 73-- That limits the maximum length to 128, but with 512 bytes of entropy, 74-- that should be sufficient for any application. 75genAuthToken :: Int -> IO AuthToken 76genAuthToken len = do 77 g <- newGenIO :: IO SystemRandom 78 return $ 79 case genBytes 512 g of 80 Left e -> error $ "failed to generate auth token: " ++ show e 81 Right (s, _) -> fromMaybe (error "auth token encoding failed") $ 82 toAuthToken $ T.pack $ take len $ 83 show $ sha2_512 $ L.fromChunks [s] 84 85-- | For when several AuthTokens are allowed to be used. 86newtype AllowedAuthTokens = AllowedAuthTokens [AuthToken] 87 88allowedAuthTokens :: [AuthToken] -> AllowedAuthTokens 89allowedAuthTokens = AllowedAuthTokens 90 91-- | Note that every item in the list is checked, even if the first one 92-- is allowed, so that comparison is constant-time. 93isAllowedAuthToken :: AuthToken -> AllowedAuthTokens -> Bool 94isAllowedAuthToken t (AllowedAuthTokens l) = go False l 95 where 96 go ok [] = ok 97 go ok (i:is) 98 | t == i = go True is 99 | otherwise = go ok is 100