src/Crypto/Macaroon/Internal.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-|
   3 Module      : Crypto.Macaroon.Internal
   4 Copyright   : (c) 2015 Julien Tanguy
   5 License     : BSD3
   6
   7 Maintainer  : julien.tanguy@jhome.fr
   8 Stability   : experimental
   9 Portability : portable
  10
  11
  12 Internal representation of a macaroon
  13 -}
  14 module Crypto.Macaroon.Internal where
  15
  16
  17 import           Control.DeepSeq
  18 import           Crypto.Cipher.AES
  19 import           Crypto.Hash
  20 import           Data.Byteable
  21 import qualified Data.ByteString        as BS
  22 import qualified Data.ByteString.Base64 as B64
  23 import qualified Data.ByteString.Char8  as B8
  24 import           Data.Char
  25 import           Data.Hex
  26 import           Data.Serialize
  27 import           Data.Word
  28
  29 -- |Type alias for Macaroons and Caveat keys and identifiers
  30 type Key = BS.ByteString
  31
  32 -- |Type alias For Macaroons and Caveat locations
  33 type Location = BS.ByteString
  34
  35 type Sig = BS.ByteString
  36
  37 -- | Main structure of a macaroon
  38 data Macaroon = MkMacaroon { location   :: Location
  39                            -- ^ Target location
  40                            , identifier :: Key
  41                            -- ^ Macaroon Identifier
  42                            , caveats    :: [Caveat]
  43                            -- ^ List of caveats
  44                            , signature  :: Sig
  45                            -- ^ Macaroon HMAC signature
  46                            } deriving (Eq)
  47
  48
  49 instance NFData Macaroon where
  50     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
  51
  52
  53 -- | Caveat structure
  54 data Caveat = MkCaveat { cid :: Key
  55                        -- ^ Caveat identifier
  56                        , vid :: Key
  57                        -- ^ Caveat verification key identifier
  58                        , cl  :: Location
  59                        -- ^ Caveat target location
  60
  61                        } deriving (Eq)
  62
  63 instance NFData Caveat where
  64     rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
  65
  66
  67 putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString
  68 putPacket key dat = BS.concat [
  69     B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
  70     , key
  71     , " "
  72     , dat
  73     , "\n"
  74     ]
  75   where
  76     size = 4 + 2 + BS.length key + BS.length dat
  77
  78 addCaveat :: Location
  79           -> Key
  80           -> Key
  81           -> Macaroon
  82           -> Macaroon
  83 addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
  84   where
  85     cavs = caveats m
  86     cav' = MkCaveat cid vid loc
  87     sig = toBytes $ (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
  88