casa-types (empty) → 0.0.0

raw patch · 3 files changed

+114/−0 lines, 3 filesdep +aesondep +attoparsecdep +base

Dependencies added: aeson, attoparsec, base, base16-bytestring, bytestring, hashable, path-pieces, persistent, text

Files

• LICENSE +24/−0
• casa-types.cabal +30/−0
• src/Casa/Types.hs +60/−0

@@ -0,0 +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.

@@ -0,0 +1,30 @@+cabal-version:  1.12+synopsis:       Types for Casa+description:    Types for Casa <https://casa.fpcomplete.com/>+name:           casa-types+copyright:      2018-2019 FP Complete+author:         Chris Done+maintainer:     chrisdone@fpcomplete.com+license:        BSD3+license-file:   LICENSE+category: Development+version:        0.0.0+build-type:     Simple++library+  exposed-modules:+    Casa.Types+  other-modules: Paths_casa_types+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall+  build-depends:+       base >= 4.5 && < 4.7+    , bytestring+    , attoparsec+    , base16-bytestring+    , text+    , hashable+    , aeson+    , path-pieces+    , persistent

@@ -0,0 +1,60 @@+{-# 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 as S+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+             (result, wrong) | S.null wrong -> pure result+             _ -> 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