{-# 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
    { BlobKey -> ByteString
unBlobKey :: ByteString
    }
  deriving (ReadPrec [BlobKey]
ReadPrec BlobKey
Int -> ReadS BlobKey
ReadS [BlobKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlobKey]
$creadListPrec :: ReadPrec [BlobKey]
readPrec :: ReadPrec BlobKey
$creadPrec :: ReadPrec BlobKey
readList :: ReadS [BlobKey]
$creadList :: ReadS [BlobKey]
readsPrec :: Int -> ReadS BlobKey
$creadsPrec :: Int -> ReadS BlobKey
Read, BlobKey -> BlobKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlobKey -> BlobKey -> Bool
$c/= :: BlobKey -> BlobKey -> Bool
== :: BlobKey -> BlobKey -> Bool
$c== :: BlobKey -> BlobKey -> Bool
Eq, Eq BlobKey
BlobKey -> BlobKey -> Bool
BlobKey -> BlobKey -> Ordering
BlobKey -> BlobKey -> BlobKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlobKey -> BlobKey -> BlobKey
$cmin :: BlobKey -> BlobKey -> BlobKey
max :: BlobKey -> BlobKey -> BlobKey
$cmax :: BlobKey -> BlobKey -> BlobKey
>= :: BlobKey -> BlobKey -> Bool
$c>= :: BlobKey -> BlobKey -> Bool
> :: BlobKey -> BlobKey -> Bool
$c> :: BlobKey -> BlobKey -> Bool
<= :: BlobKey -> BlobKey -> Bool
$c<= :: BlobKey -> BlobKey -> Bool
< :: BlobKey -> BlobKey -> Bool
$c< :: BlobKey -> BlobKey -> Bool
compare :: BlobKey -> BlobKey -> Ordering
$ccompare :: BlobKey -> BlobKey -> Ordering
Ord, Eq BlobKey
Int -> BlobKey -> Int
BlobKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlobKey -> Int
$chash :: BlobKey -> Int
hashWithSalt :: Int -> BlobKey -> Int
$chashWithSalt :: Int -> BlobKey -> Int
Hashable, PersistValue -> Either Text BlobKey
BlobKey -> PersistValue
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text BlobKey
$cfromPersistValue :: PersistValue -> Either Text BlobKey
toPersistValue :: BlobKey -> PersistValue
$ctoPersistValue :: BlobKey -> PersistValue
PersistField, PersistField BlobKey
Proxy BlobKey -> SqlType
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy BlobKey -> SqlType
$csqlType :: Proxy BlobKey -> SqlType
PersistFieldSql)

instance Show BlobKey where
  show :: BlobKey -> String
show (BlobKey ByteString
key) = forall a. Show a => a -> String
show (ByteString -> ByteString
Hex.encode ByteString
key)

instance FromJSON BlobKey where
  parseJSON :: Value -> Parser BlobKey
parseJSON = forall a. FromJSON a => Value -> Parser a
parseJSON forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String BlobKey
blobKeyHexParser)

instance ToJSON BlobKey where
  toJSON :: BlobKey -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Hex.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> ByteString
unBlobKey

instance PathPiece BlobKey where
  fromPathPiece :: Text -> Maybe BlobKey
fromPathPiece =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Text -> Either String BlobKey
blobKeyHexParser
  toPathPiece :: BlobKey -> Text
toPathPiece = ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Hex.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> ByteString
unBlobKey

-- | Parse a blob key in hex format.
blobKeyHexParser :: Text -> Either String BlobKey
blobKeyHexParser :: Text -> Either String BlobKey
blobKeyHexParser =
  forall a. Parser a -> Text -> Either String a
Atto.T.parseOnly
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
       ByteString -> BlobKey
BlobKey
       (do Text
bytes <- Int -> Parser Text
Atto.T.take Int
64
           case ByteString -> Either String ByteString
Hex.decode (Text -> ByteString
T.encodeUtf8 Text
bytes) of
             Right ByteString
result -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
result
             Left String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid hex key."))

-- | Parse a blob key in binary format.
blobKeyBinaryParser :: Atto.B.Parser BlobKey
blobKeyBinaryParser :: Parser BlobKey
blobKeyBinaryParser = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> BlobKey
BlobKey (Int -> Parser ByteString
Atto.B.take Int
32)

blobKeyToBuilder :: BlobKey -> S.Builder
blobKeyToBuilder :: BlobKey -> Builder
blobKeyToBuilder = ByteString -> Builder
S.byteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlobKey -> ByteString
unBlobKey