module Network.Iron
( seal
, sealWith
, unseal
, unsealWith
, password
, passwords
, passwordWithId
, passwordsWithId
, Password
, PasswordId
, LookupPassword
, onePassword
, Options(..)
, EncryptionOpts(..)
, IntegrityOpts(..)
, IronCipher(..)
, IronMAC(..)
, SHA256(SHA256)
, IronSalt(..)
, urlSafeBase64
) where
import Control.Monad (liftM, when)
import Crypto.Cipher.AES (AES128, AES256 (..))
import Crypto.Cipher.Types
import Crypto.Data.Padding
import Crypto.Error (CryptoFailable (..), maybeCryptoError)
import Crypto.Hash.Algorithms (SHA256 (..))
import Crypto.Hash.Algorithms (SHA1 (..))
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import Crypto.MAC.HMAC (Context, HMAC, finalize, hmac,
hmacGetDigest, initialize, updates)
import Crypto.Random
import Data.Aeson
import qualified Data.Aeson as JSON (eitherDecode', encode)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as BL
import Data.SecureMem (SecureMem(..), ToSecureMem(..))
import Data.Byteable (Byteable(..), constEqBytes)
import qualified Data.Map as M
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Default (Default(..))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Char (isAscii, isAlphaNum)
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Clock.POSIX
import Network.Iron.Util
import Numeric (showHex)
data Options = Options
{ ironEncryption :: EncryptionOpts
, ironIntegrity :: IntegrityOpts
, ironTTL :: NominalDiffTime
, ironTimestampSkew :: NominalDiffTime
, ironLocaltimeOffset :: NominalDiffTime
} deriving Show
data IronCipher = AES128CTR | AES256CBC deriving Show
class IsIronCipher a where
ivSize :: a -> Int
keySize :: a -> Int
ironEncrypt :: a -> ByteString -> ByteString -> ByteString -> Maybe ByteString
ironDecrypt :: a -> ByteString -> ByteString -> ByteString -> Maybe ByteString
class IsIronMAC a where
macKeySize :: a -> Int
ironMac :: a -> ByteString -> ByteString -> ByteString
data IronMAC = forall alg . (IsIronMAC alg, Show alg) => IronMAC alg
instance Show IronMAC where
show (IronMAC alg) = show alg
instance IsIronMAC IronMAC where
macKeySize (IronMAC alg) = macKeySize alg
ironMac (IronMAC alg) = ironMac alg
data IronSalt = IronSalt ByteString
| IronGenSalt Int
deriving Show
data EncryptionOpts = EncryptionOpts
{ ieSalt :: IronSalt
, ieAlgorithm :: IronCipher
, ieIterations :: Int
, ieIV :: Maybe ByteString
} deriving Show
data IntegrityOpts = IntegrityOpts
{ iiSalt :: IronSalt
, iiAlgorithm :: IronMAC
, iiIterations :: Int
} deriving Show
defaultsEncrypt :: IronCipher -> EncryptionOpts
defaultsEncrypt algo = EncryptionOpts
{ ieSalt = IronGenSalt 256
, ieAlgorithm = algo
, ieIterations = 1
, ieIV = Nothing }
defaultsIntegrity :: IronMAC -> IntegrityOpts
defaultsIntegrity algo = IntegrityOpts
{ iiSalt = IronGenSalt 256
, iiAlgorithm = algo
, iiIterations = 1 }
defaults :: Options
defaults = Options
{ ironEncryption = def
, ironIntegrity = def
, ironTTL = 0
, ironTimestampSkew = 60
, ironLocaltimeOffset = 0
}
instance Default EncryptionOpts where
def = defaultsEncrypt AES256CBC
instance Default IntegrityOpts where
def = defaultsIntegrity (IronMAC SHA256)
instance Default Options where
def = defaults
type PasswordId = ByteString
data Password = MkPassword
{ passwordId :: PasswordId
, encKey :: KeyPass
, intKey :: KeyPass
} deriving (Show, Eq)
data KeyPass = Key SecureMem
| Password SecureMem
deriving (Show, Eq)
password :: ToSecureMem a => a -> Password
password p = passwords p p
passwords :: ToSecureMem a => a -> a -> Password
passwords e i = password' mempty e i
passwordWithId :: ToSecureMem a => PasswordId -> a -> Maybe Password
passwordWithId k p = passwordsWithId k p p
passwordsWithId :: ToSecureMem a => PasswordId -> a -> a -> Maybe Password
passwordsWithId k e i | validId k = Just $ password' k e i
| otherwise = Nothing
validId :: PasswordId -> Bool
validId k = not (S8.null k) && S8.all inRange k
where inRange c = isAscii c && isAlphaNum c || c == '_'
passwordValid :: Byteable a => EncryptionOpts -> a -> Bool
passwordValid EncryptionOpts{..} sec = keySize ieAlgorithm <= byteableLength sec
password' :: ToSecureMem a => PasswordId -> a -> a -> Password
password' k e i = MkPassword k (passwd e) (passwd i)
where passwd = Password . toSecureMem
type LookupPassword = PasswordId -> Maybe Password
onePassword :: ToSecureMem a => a -> LookupPassword
onePassword = const . Just . password
seal :: ToJSON a => Password -> a -> IO ByteString
seal password = liftM fromJust <$> sealWith defaults password
sealWith :: ToJSON a => Options -> Password -> a -> IO (Maybe ByteString)
sealWith opts p v = do
s <- getSealStuff opts
return $ seal' opts s p v
data SealStuff = SealStuff
{ ssNow :: POSIXTime
, ssEncSalt :: ByteString
, ssIv :: ByteString
, ssIntSalt :: ByteString
} deriving (Show)
getSealStuff :: Options -> IO SealStuff
getSealStuff opts@Options{..} = do
now <- getPOSIXTime
drg1 <- getSystemDRG
let (encSalt, drg2) = genSaltMaybe (ieSalt ironEncryption) drg1
let (intSalt, drg3) = genSaltMaybe (iiSalt ironIntegrity) drg2
let (iv, _) = genIVMaybe (ieAlgorithm ironEncryption) (ieIV ironEncryption) drg3
return $ SealStuff (now + ironLocaltimeOffset) encSalt iv intSalt
seal' :: forall a. ToJSON a => Options -> SealStuff -> Password -> a -> Maybe ByteString
seal' opts SealStuff{..} sec a = encrypt a >>= fmap strCookie . mac . strEncCookie
where
encrypt :: a -> Maybe EncCookie
encrypt obj = do
key <- rightJust $ generateKey ieIterations size ssEncSalt (encKey sec)
ctext <- ironEncrypt ieAlgorithm key ssIv json
return $ EncCookie (passwordId sec) ssEncSalt ssIv expiration ctext
where
EncryptionOpts{..} = ironEncryption opts
json = BL.toStrict $ JSON.encode obj
expiration = expTime opts ssNow
size = keySize ieAlgorithm
mac :: ByteString -> Maybe Cookie
mac str = Cookie str ssIntSalt <$> rightJust digest
where
digest = hmacWithPassword intOpts key ssIntSalt str
intOpts = ironIntegrity opts
key = intKey sec
data EncCookie = EncCookie
{ ckPasswordId :: PasswordId
, ckEncSalt :: ByteString
, ckIv :: ByteString
, ckExpiration :: Maybe NominalDiffTime
, ckText :: ByteString
} deriving Show
data Cookie = Cookie
{ ckEnc :: ByteString
, ckIntSalt :: ByteString
, ckIntDigest :: ByteString
} deriving Show
strEncCookie :: EncCookie -> ByteString
strEncCookie (EncCookie pid s iv e t) = cat [macPrefix, pid, s, b64url iv, b64url t, expStr e]
strCookie :: Cookie -> ByteString
strCookie (Cookie a b c) = cat [a, b, c]
parseCookie :: ByteString -> Either String (EncCookie, Cookie)
parseCookie ck = do
when (length parts /= 8) $ Left "Incorrect number of sealed components"
when (pfx /= macPrefix) $ Left "Wrong mac prefix"
eck <- EncCookie <$> pure a <*> pure b <*> b64' c <*> exp e <*> b64' d
return (eck, Cookie enc f g)
where
parts = uncat ck
(pfx:a:b:c:d:e:f:g:[]) = parts
enc = cat $ take 6 parts
exp :: ByteString -> Either String (Maybe NominalDiffTime)
exp "" = Right Nothing
exp n = maybe (Left "Invalid expiration") (Right . Just) $ parseExpMsec n
b64' = b64urldec
cat :: [ByteString] -> ByteString
cat = BS.intercalate (S8.singleton '*')
uncat :: ByteString -> [ByteString]
uncat = S8.split '*'
expStr :: Maybe NominalDiffTime -> ByteString
expStr = maybe "" (S8.pack . show . round)
expTime :: Options -> POSIXTime -> Maybe NominalDiffTime
expTime Options{ironTTL} now | ironTTL > 0 = Just ((now + ironTTL) * 1000)
| otherwise = Nothing
instance IsIronMAC SHA256 where
macKeySize _ = 32
ironMac _ key text = b64 $ hmacGetDigest (hmac key text :: HMAC SHA256)
macWithKey :: IronMAC -> ByteString -> ByteString -> ByteString
macWithKey algo key text = urlSafeBase64 (ironMac algo key text)
generateKey :: Int -> Int -> ByteString -> KeyPass -> Either String ByteString
generateKey _ s _ (Key k) | byteableLength k >= s = Right (toBytes k)
| otherwise = Left "Key buffer (password) too small"
generateKey n s l (Password p) | BS.null l = Left "Missing salt"
| otherwise = Right (generateKey' n s l p)
generateKey' :: Byteable p => Int -> Int -> ByteString -> p -> ByteString
generateKey' iterations size salt p = PBKDF2.generate prf params (toBytes p) salt
where
prf = PBKDF2.prfHMAC SHA1
params = PBKDF2.Parameters iterations size
hmacWithPassword :: IntegrityOpts -> KeyPass -> ByteString -> ByteString
-> Either String ByteString
hmacWithPassword IntegrityOpts{..} key salt text = do
key' <- generateKey iiIterations (macKeySize iiAlgorithm) salt key
Right $ macWithKey iiAlgorithm key' text
aesSetup :: BlockCipher c => ByteString -> ByteString -> Maybe (c, IV c, Format)
aesSetup key iv = (,,) <$> ctx <*> iv' <*> p
where
ctx = maybeCryptoError (cipherInit key)
iv' = makeIV iv
p = fmap (PKCS7 . blockSize) ctx
instance IsIronCipher IronCipher where
ivSize AES128CTR = blockSize (undefined :: AES128)
ivSize AES256CBC = blockSize (undefined :: AES256)
keySize AES128CTR = 16
keySize AES256CBC = 32
ironEncrypt AES128CTR key iv text = do
(ctx :: AES128, iv', p) <- aesSetup key iv
return $ ctrCombine ctx iv' (pad p text)
ironEncrypt AES256CBC key iv text = do
(ctx :: AES256, iv', p) <- aesSetup key iv
let text' = pad p text
return $ cbcEncrypt ctx iv' text'
ironDecrypt AES128CTR key iv ctext = do
(ctx :: AES128, iv', p) <- aesSetup key iv
unpad p (ctrCombine ctx iv' ctext)
ironDecrypt AES256CBC key iv ctext = do
(ctx :: AES256, iv', p) <- aesSetup key iv
let text' = cbcDecrypt ctx iv' ctext
unpad p text'
unseal :: FromJSON a => LookupPassword -> ByteString -> IO (Either String a)
unseal p = unsealWith defaults p
unsealWith :: FromJSON a => Options -> LookupPassword -> ByteString -> IO (Either String a)
unsealWith opts p t = do
now <- getPOSIXTime
return $ unseal' opts now p t
unseal' :: FromJSON a => Options -> POSIXTime -> LookupPassword -> ByteString -> Either String a
unseal' opts now p cookie = do
(eck, ck) <- parseCookie cookie
_ <- checkExpiration now (ironTimestampSkew opts) eck
MkPassword _ enc int <- getPassword opts (ckPasswordId eck) p
ok <- verify ck int
decrypt eck enc >>= JSON.eitherDecode' . BL.fromStrict
where
decrypt :: EncCookie -> KeyPass -> Either String ByteString
decrypt EncCookie{..} sec = do
let EncryptionOpts{..} = ironEncryption opts
size = keySize ieAlgorithm
key <- generateKey ieIterations size ckEncSalt sec
case ironDecrypt ieAlgorithm key ckIv ckText of
Just ctext -> Right ctext
Nothing -> Left "Iron decryption failed"
verify :: Cookie -> KeyPass -> Either String ()
verify Cookie{..} sec = do
digest <- hmacWithPassword (ironIntegrity opts) sec ckIntSalt ckEnc
if constEqBytes ckIntDigest digest
then Right ()
else Left "Bad hmac value"
checkExpiration :: NominalDiffTime -> NominalDiffTime -> EncCookie -> Either String ()
checkExpiration now skew EncCookie{ckExpiration} = if isExpired now skew ckExpiration
then Left "Expired seal"
else Right ()
getPassword :: Options -> PasswordId -> LookupPassword -> Either String Password
getPassword opts pid lookup = case lookup pid of
Just p -> Right p
Nothing -> Left $ "Cannot find password: " <> S8.unpack pid
isExpired :: POSIXTime -> NominalDiffTime -> Maybe POSIXTime -> Bool
isExpired _ _ Nothing = False
isExpired now skew (Just exp) = exp <= (now skew)
genSalt :: DRG gen => Int -> gen -> (ByteString, gen)
genSalt saltBits gen = withRandomBytes gen (saltBits `quot` 8) B16.encode
genIV :: DRG gen => Int -> gen -> (ByteString, gen)
genIV size gen = withRandomBytes gen size id
genSaltMaybe :: DRG gen => IronSalt -> gen -> (ByteString, gen)
genSaltMaybe (IronSalt salt) = \gen -> (salt, gen)
genSaltMaybe (IronGenSalt len) = genSalt len
genIVMaybe :: DRG gen => IronCipher -> Maybe ByteString -> gen -> (ByteString, gen)
genIVMaybe _ (Just iv) = \gen -> (iv, gen)
genIVMaybe algo Nothing = genIV (ivSize algo)
macPrefix, macFormatVersion :: ByteString
macPrefix = "Fe26." <> macFormatVersion
macFormatVersion = "2"