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

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

    instance FromJSON BlobKey where
      parseJSON :: Value -> Parser BlobKey
    parseJSON = Value -> Parser Text
    forall a. FromJSON a => Value -> Parser a
    parseJSON (Value -> Parser Text)
    -> (Text -> Parser BlobKey) -> Value -> Parser BlobKey
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> ((String -> Parser BlobKey)
    -> (BlobKey -> Parser BlobKey)
    -> Either String BlobKey
    -> Parser BlobKey
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> Parser BlobKey
    forall a. String -> Parser a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail BlobKey -> Parser BlobKey
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either String BlobKey -> Parser BlobKey)
    -> (Text -> Either String BlobKey) -> Text -> Parser BlobKey
    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 (Text -> Value) -> (BlobKey -> Text) -> BlobKey -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    T.decodeUtf8 (ByteString -> Text) -> (BlobKey -> ByteString) -> BlobKey -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Hex.encode (ByteString -> ByteString)
    -> (BlobKey -> ByteString) -> BlobKey -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BlobKey -> ByteString
    unBlobKey

    instance PathPiece BlobKey where
      fromPathPiece :: Text -> Maybe BlobKey
    fromPathPiece =
        (String -> Maybe BlobKey)
    -> (BlobKey -> Maybe BlobKey)
    -> Either String BlobKey
    -> Maybe BlobKey
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe BlobKey -> String -> Maybe BlobKey
    forall a b. a -> b -> a
    const Maybe BlobKey
    forall a. Maybe a
    Nothing) BlobKey -> Maybe BlobKey
    forall a. a -> Maybe a
    Just (Either String BlobKey -> Maybe BlobKey)
    -> (Text -> Either String BlobKey) -> Text -> Maybe BlobKey
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        Text -> Either String BlobKey
    blobKeyHexParser
      toPathPiece :: BlobKey -> Text
    toPathPiece = ByteString -> Text
    T.decodeUtf8 (ByteString -> Text) -> (BlobKey -> ByteString) -> BlobKey -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Hex.encode (ByteString -> ByteString)
    -> (BlobKey -> ByteString) -> BlobKey -> ByteString
    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 =
      Parser BlobKey -> Text -> Either String BlobKey
    forall a. Parser a -> Text -> Either String a
    Atto.T.parseOnly
        ((ByteString -> BlobKey) -> Parser Text ByteString -> Parser BlobKey
    forall a b. (a -> b) -> Parser Text a -> Parser Text b
    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 -> ByteString -> Parser Text ByteString
    forall a. a -> Parser Text a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    result
                 Left String
    _ -> String -> Parser Text ByteString
    forall a. String -> Parser Text a
    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 = (ByteString -> BlobKey)
    -> Parser ByteString ByteString -> Parser BlobKey
    forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> BlobKey
    BlobKey (Int -> Parser ByteString ByteString
    Atto.B.take Int
    32)

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