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