src/Crypto/Macaroon/Serializer/Base64.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-|
   3 Module      : Crypto.Macaroon.Serializer.Base64
   4 Copyright   : (c) 2015 Julien Tanguy
   5 License     : BSD3
   6
   7 Maintainer  : julien.tanguy@jhome.fr
   8 Stability   : experimental
   9 Portability : portable
  10
  11 Base64 serializer/deserializer
  12
  13 -}
  14 module Crypto.Macaroon.Serializer.Base64 (
  15         serialize
  16       , deserialize
  17       ) where
  18
  19 import Control.Applicative
  20 import Control.Monad
  21 import qualified Data.ByteString            as BS
  22 import qualified Data.ByteString.Base64.URL as B64
  23 import qualified Data.ByteString.Char8      as B8
  24 import Data.Attoparsec.ByteString
  25 import qualified Data.Attoparsec.ByteString.Char8 as A8
  26 import           Data.Bits
  27 import           Data.Char
  28 import           Data.Hex
  29 import           Data.Int
  30 import           Data.List
  31 import           Data.Maybe
  32 import           Data.Word
  33 import           Data.Serialize
  34 import Crypto.Macaroon.Internal
  35
  36
  37 -- | Serialize a macaroon in an URL-safe Base64 encoding
  38 serialize :: Macaroon -> BS.ByteString
  39 serialize m = B8.filter (/= '=') . B64.encode . runPut $ do
  40     packetize "location" (location m)
  41     packetize "identifier" (identifier m)
  42     forM_ (caveats m) $ \c -> do
  43         packetize "cid" (cid c)
  44         unless (cl c == location m && vid c == BS.empty) $ do
  45             packetize "vid" (vid c)
  46             packetize "cl" (cl c)
  47     packetize "signature" (signature m)
  48
  49 packetize :: BS.ByteString -> BS.ByteString -> Put
  50 packetize key dat = do
  51     let size = 4 + 2 + BS.length key + BS.length dat
  52     putByteString $ B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
  53     putByteString key
  54     putByteString " "
  55     putByteString dat
  56     putByteString "\n"
  57
  58 deserialize :: BS.ByteString -> Either String Macaroon
  59 deserialize = parseOnly macaroon . B64.decodeLenient
  60
  61
  62 macaroon :: Parser Macaroon
  63 macaroon = do
  64     ps <- many packet <* endOfInput
  65     let ([("location",l),("identifier",i)],ps') = splitAt 2 ps
  66     let (caveats,sig) = splitAt (length ps' - 1) ps'
  67     let [("signature",s)] = sig
  68     return $ MkMacaroon l i (map (mkCaveat l) (groupBy splitCavs caveats)) s
  69   where
  70     mkCaveat _ [("cid",c),("vid",v),("cl",l)] = MkCaveat c v l
  71     mkCaveat l [("cid",c)] = MkCaveat c BS.empty l
  72     mkCaveat _ _ = error "Malformed caveat"
  73     splitCavs _ ("cid",_) = False
  74     splitCavs _ _ = True
  75
  76 packet :: Parser (BS.ByteString, BS.ByteString)
  77 packet = do
  78     size <- A8.take 4
  79     case A8.parseOnly (A8.hexadecimal :: Parser Word16) size of
  80         Left e -> fail e
  81         Right s -> do
  82             bs <- A8.take (fromIntegral $ s - 4)
  83             let (key, dat) = B8.break (== ' ') bs
  84             return (key, B8.tail $ B8.init dat)
  85