1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Service.Crypto 3 ( signature 4 , MonadSign 5 , sign 6 , unSign 7 ) where 8 9 import Control.Monad (mfilter) 10 import Control.Monad.IO.Class (MonadIO) 11 import qualified Crypto.Hash as Hash 12 import qualified Crypto.MAC.HMAC as HMAC 13 import qualified Data.ByteArray as BA 14 import Data.ByteArray.Encoding (convertToBase, convertFromBase, Base(Base64URLUnpadded)) 15 import qualified Data.ByteString as BS 16 import Data.Monoid ((<>)) 17 18 import Databrary.Ops 19 import Databrary.Has 20 import Databrary.Service.Types 21 import Databrary.Service.Entropy 22 23 hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString 24 hmac key = (convertToBase Base64URLUnpadded :: HMAC.HMAC Hash.Skein256_224 -> BS.ByteString) . HMAC.hmac key 25 26 hmacLength :: Int 27 hmacLength = BS.length $ hmac "" "" 28 29 signature :: BS.ByteString -> Secret -> BS.ByteString 30 signature msg (Secret secret) = hmac secret msg 31 32 nonceBytes, nonceLength :: Int 33 nonceBytes = 6 34 nonceLength = BA.length $ encodeNonce $ BA.zero nonceBytes -- 8 35 36 encodeNonce :: BS.ByteString -> BS.ByteString 37 encodeNonce = convertToBase Base64URLUnpadded 38 39 type MonadSign c m = (MonadIO m, MonadHas Entropy c m, MonadHas Secret c m) 40 41 sign :: MonadSign c m => BS.ByteString -> m BS.ByteString 42 sign msg = do 43 nonce <- focusIO $ entropyBytes nonceBytes 44 sig <- peeks $ signature (msg <> nonce) 45 return $ sig <> encodeNonce nonce <> msg 46 47 unSign :: (MonadHas Secret c m) => BS.ByteString -> m (Maybe BS.ByteString) 48 unSign sigmsg = do 49 sig' <- mapM (peeks . signature . (msg <>)) nonce 50 return $ msg <$ mfilter (BA.constEq sig) sig' 51 where 52 (sig, noncemsg) = BS.splitAt hmacLength sigmsg 53 (nonce64, msg) = BS.splitAt nonceLength noncemsg 54 nonce = rightJust $ convertFromBase Base64URLUnpadded nonce64