diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,23 @@ -# ChangeLog for casa-types - -## 0.0.2 - -* Move to base16-bytestring 1.0 +# ChangeLog for `casa-types` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## 0.0.3 - 2025-09-26 + +* Add URLs to Cabal file. + +## 0.0.2 - 2020-11-11 + +* Move to `base16-bytestring >= 1.0.0.0`. + +## 0.0.1 - 2020-03-05 + +* Relax upper bound to allow `base < 5`. + +## 0.0.0 - 2020-03-05 + +* Initial version. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,24 +1,24 @@ -Copyright (c) 2019, Stack contributors -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 Stack nor the - names of its 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 STACK 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. +Copyright (c) 2019, Stack contributors +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 Stack nor the + names of its 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 STACK 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/casa-types.cabal b/casa-types.cabal --- a/casa-types.cabal +++ b/casa-types.cabal @@ -1,32 +1,47 @@ -cabal-version: 1.12 -synopsis: Types for Casa -description: Types for Casa +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.38.2. +-- +-- see: https://github.com/sol/hpack + name: casa-types -copyright: 2018-2019 FP Complete +version: 0.0.3 +synopsis: Types for Casa +description: Types for Casa (Content-Addressable Storage Archive). See + +category: Development +homepage: https://github.com/commercialhaskell/casa#readme +bug-reports: https://github.com/commercialhaskell/casa/issues author: Chris Done -maintainer: chrisdone@fpcomplete.com +maintainer: Chris Done , + Mike Pilgrem +copyright: 2018-2019 FP Complete, + 2024-2025 Haskell Foundation license: BSD3 license-file: LICENSE -category: Development -version: 0.0.2 build-type: Simple extra-source-files: - ChangeLog.md + ChangeLog.md +source-repository head + type: git + location: https://github.com/commercialhaskell/casa + subdir: casa-types + library exposed-modules: - Casa.Types - other-modules: Paths_casa_types - hs-source-dirs: src - default-language: Haskell2010 + Casa.Types + hs-source-dirs: + src ghc-options: -Wall build-depends: - base < 10 - , bytestring - , attoparsec - , base16-bytestring >= 1 - , text - , hashable - , aeson - , path-pieces - , persistent + aeson >=0.5.0.0 + , attoparsec >=0.10.0.0 + , base >=4.8 && <5 + , base16-bytestring >=1.0.0.0 + , bytestring >=0.10.2.0 + , hashable >=1.1.2.0 + , path-pieces >=0.1.0 + , persistent >=1.2.0 + , text >=0.11.1.5 + default-language: Haskell2010 diff --git a/src/Casa/Types.hs b/src/Casa/Types.hs --- a/src/Casa/Types.hs +++ b/src/Casa/Types.hs @@ -1,59 +1,68 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- | - -module Casa.Types where - -import Control.Monad -import Data.Aeson -import qualified Data.Attoparsec.ByteString as Atto.B -import qualified Data.Attoparsec.Text as Atto.T -import Data.ByteString (ByteString) -import qualified Data.ByteString.Base16 as Hex -import qualified Data.ByteString.Builder as S -import Data.Hashable -import Database.Persist -import Database.Persist.Sql -import Data.Text (Text) -import qualified Data.Text.Encoding as T -import Web.PathPieces - --- | A SHA256 key to address blobs. -newtype BlobKey = - BlobKey - { unBlobKey :: ByteString - } - deriving (Read, Eq, Ord, Hashable, PersistField, PersistFieldSql) - -instance Show BlobKey where - show (BlobKey key) = show (Hex.encode key) - -instance FromJSON BlobKey where - parseJSON = parseJSON >=> (either fail pure . blobKeyHexParser) - -instance ToJSON BlobKey where - toJSON = String . T.decodeUtf8 . Hex.encode . unBlobKey - -instance PathPiece BlobKey where - fromPathPiece = - either (const Nothing) Just . - blobKeyHexParser - toPathPiece = T.decodeUtf8 . Hex.encode . unBlobKey - --- | Parse a blob key in hex format. -blobKeyHexParser :: Text -> Either String BlobKey -blobKeyHexParser = - Atto.T.parseOnly - (fmap - BlobKey - (do bytes <- Atto.T.take 64 - case Hex.decode (T.encodeUtf8 bytes) of - Right result -> pure result - Left _ -> fail "Invalid hex key.")) - --- | Parse a blob key in binary format. -blobKeyBinaryParser :: Atto.B.Parser BlobKey -blobKeyBinaryParser = fmap BlobKey (Atto.B.take 32) - -blobKeyToBuilder :: BlobKey -> S.Builder -blobKeyToBuilder = S.byteString . unBlobKey +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | Types and functions for use with Casa (Content-Addressable Storage +-- Archive). See . + +module Casa.Types + ( BlobKey (..) + , blobKeyHexParser + , blobKeyBinaryParser + , blobKeyToBuilder + ) where + +import Control.Monad ( (>=>) ) +import Data.Aeson ( FromJSON (..), ToJSON (..), Value (..) ) +import qualified Data.Attoparsec.ByteString as Atto.B +import qualified Data.Attoparsec.Text as Atto.T +import Data.ByteString ( ByteString ) +import qualified Data.ByteString.Base16 as Hex +import qualified Data.ByteString.Builder as S +import Data.Hashable ( Hashable ) +import Data.Text ( Text ) +import qualified Data.Text.Encoding as T +import Database.Persist ( PersistField ) +import Database.Persist.Sql ( PersistFieldSql ) +import Web.PathPieces ( PathPiece (..) ) + +-- | A SHA256 key to address blobs. +newtype BlobKey = + BlobKey + { unBlobKey :: ByteString + } + deriving (Eq, Hashable, PersistField, PersistFieldSql, Ord, Read) + +instance Show BlobKey where + + show (BlobKey key) = show (Hex.encode key) + +instance FromJSON BlobKey where + + parseJSON = parseJSON >=> (either fail pure . blobKeyHexParser) + +instance ToJSON BlobKey where + + toJSON = String . T.decodeUtf8 . Hex.encode . unBlobKey + +instance PathPiece BlobKey where + + fromPathPiece = either (const Nothing) Just . blobKeyHexParser + + toPathPiece = T.decodeUtf8 . Hex.encode . unBlobKey + +-- | Parse a blob key in hex format. +blobKeyHexParser :: Text -> Either String BlobKey +blobKeyHexParser = + Atto.T.parseOnly $ + BlobKey <$> do + bytes <- Atto.T.take 64 + case Hex.decode (T.encodeUtf8 bytes) of + Right result -> pure result + Left _ -> fail "Invalid hex key." + +-- | Parse a blob key in binary format. +blobKeyBinaryParser :: Atto.B.Parser BlobKey +blobKeyBinaryParser = BlobKey <$> Atto.B.take 32 + +-- | Yield a t'S.Builder' value corresponding to the given t'BlobKey' value. +blobKeyToBuilder :: BlobKey -> S.Builder +blobKeyToBuilder = S.byteString . unBlobKey