diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for cbor-tool + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (c) 2017, Duncan Coutts + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Duncan Coutts nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE RankNTypes #-} +module Main + ( main -- :: IO () + ) where + +import Control.Monad +import System.FilePath +import System.Environment +import System.Exit ( exitFailure ) +import System.IO ( hPutStrLn, stderr ) +import Text.Printf ( printf ) + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif +import qualified Data.Aeson as Aeson +import Data.Aeson.Encode.Pretty as Aeson.Pretty +import qualified Data.ByteString.Lazy as LB + +import qualified Data.Text.Lazy.IO as LT +import qualified Data.Text.Lazy.Builder as LT + +import Codec.CBOR.JSON +import Codec.CBOR.Pretty +import Codec.CBOR.Read as Read +import qualified Codec.CBOR.Write as Write +import Codec.CBOR.Term ( decodeTerm, encodeTerm ) + +-------------------------------------------------------------------------------- +-- JSON -> CBOR conversion + +-- | Convert an arbitrary JSON file into CBOR format. +jsonToCbor :: FilePath -> IO () +jsonToCbor file = do + bs <- LB.readFile file + case Aeson.decode bs of + Nothing -> fail "invalid JSON file!" + Just v -> do + let encVal = encodeValue v + cborFile = dropExtension file <.> "cbor" + -- Now write the blob + LB.writeFile cborFile (Write.toLazyByteString encVal) + +-------------------------------------------------------------------------------- +-- Dumping code + +-- | Dump a CBOR file as JSON +dumpCborAsJson :: Bool -> FilePath -> IO () +dumpCborAsJson lenient file = LB.readFile file >>= go + where go :: LB.ByteString -> IO () + go bs = + case deserialiseFromBytes (decodeValue lenient) bs of + Left (Read.DeserialiseFailure off err) -> + fail $ "deserialization error (at offset " ++ show off ++ "): " ++ err + Right (trailing, v) -> do + let builder = Aeson.Pretty.encodePrettyToTextBuilder v + LT.putStrLn (LT.toLazyText builder) + unless (LB.null trailing) (go trailing) + +-- | Dump a CBOR file as a Term, or optionally as pretty hex +dumpCborFile :: Bool -> FilePath -> IO () +dumpCborFile pretty file = LB.readFile file >>= go + where go :: LB.ByteString -> IO () + go bs = + case deserialiseFromBytes decodeTerm bs of + Left (Read.DeserialiseFailure off err) -> + fail $ "deserialization error (at offset " ++ show off ++ "): " ++ err + Right (trailing, v) -> do + if pretty + then putStrLn (prettyHexEnc $ encodeTerm v) + else print v + unless (LB.null trailing) (go trailing) + +dumpAsHex :: FilePath -> IO () +dumpAsHex file = do + bs <- LB.readFile file + putStrLn (showHexString bs) + +-- | Show a @'ByteString'@ as a hex string. +showHexString :: LB.ByteString -> String +showHexString = concat . toHex + where + toHex = map (printf "%02X ") . LB.unpack + +-------------------------------------------------------------------------------- +-- Driver code + +-- | Main entry point. +main :: IO () +main = do + let help = unlines + [ "usage: cbor-tool [options] " + , "" + , " Useful tool for dealing with and analyzing raw files containing" + , " CBOR values. and are both mandatory options." + , "" + , " Actions:" + , "" + , " dump [--json|--hex|--pretty|--term] [--lenient] " + , " Read the CBOR values inside and dump them in the" + , " specified format. --json will dump JSON files, while --hex" + , " will dump the output in hexadecimal format. --pretty will" + , " use the internal 'Encoding' pretty-printer. --term is the" + , " internal 'Term' format type. You must specify either" + , " --json, --hex, --pretty, or --term (there is no default)." + , "" + , " When printing CBOR as JSON, the only valid type for JSON" + , " object keys is a UTF8 string. If you have a CBOR map that" + , " uses non-String types for keys, this will cause the decoder" + , " to fail when creating JSON. Use the --lenient option to" + , " remove this restriction -- this will allow numbers to also" + , " be valid as CBOR keys, by printing them as strings. However," + , " this may risk collision of some keys as CBOR is more general," + , " resulting in invalid JSON -- so use it with caution." + , "" + , " encode [--json] " + , " Read the in a specified format and dump a copy of" + , " the input in CBOR form under .cbor. --json reads" + , " JSON files. You must specify --json (there is no default," + , " for future compatibility.)" + ] + + args <- getArgs + case args of + ("dump" : "--json" : "--lenient" : file : _) -> dumpCborAsJson True file + ("dump" : "--json" : file : _) -> dumpCborAsJson False file + ("dump" : "--hex" : file : _) -> dumpAsHex file + ("dump" : "--pretty" : file : _) -> dumpCborFile True file + ("dump" : "--term" : file : _) -> dumpCborFile False file + ("encode" : "--json" : file : _) -> jsonToCbor file + _ -> hPutStrLn stderr help >> exitFailure diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbor-tool.cabal b/cbor-tool.cabal new file mode 100644 --- /dev/null +++ b/cbor-tool.cabal @@ -0,0 +1,35 @@ +name: cbor-tool +version: 0.1.0.0 +synopsis: A tool for manipulating CBOR. +description: A tool for dumping and converting CBOR-encoded data. +homepage: https://github.com/well-typed/cborg +license: BSD3 +license-file: LICENSE.txt +author: Duncan Coutts +maintainer: duncan@community.haskell.org, ben@smart-cactus.org +copyright: 2015-2017 Duncan Coutts, + 2015-2017 Well-Typed LLP, + 2015 IRIS Connect Ltd +category: Codec +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +executable cbor-tool + main-is: Main.hs + other-extensions: CPP, BangPatterns + ghc-options: -Wall + build-depends: + base >=4.6 && <5.0, + filepath >=1.0 && <1.5, + aeson >=0.7 && <1.3, + aeson-pretty >=0.8 && <0.9, + scientific >=0.3 && <0.4, + bytestring >=0.10 && <0.11, + unordered-containers >=0.2 && <0.3, + text >=1.1 && <1.3, + vector >=0.10 && <0.13, + + cborg ==0.1.*, + cborg-json ==0.1.* + default-language: Haskell2010