55 lines
1.8 KiB
Haskell
55 lines
1.8 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Data.UUID.Instances
|
|
() where
|
|
|
|
import ClassyPrelude.Yesod hiding (Proxy(..))
|
|
import Data.UUID (UUID)
|
|
import qualified Data.UUID as UUID
|
|
|
|
import Database.Persist.Sql
|
|
import Utils.Persist
|
|
import Data.Proxy
|
|
|
|
import Text.Blaze (ToMarkup(..))
|
|
|
|
import Servant.Docs (ToSample(..), samples)
|
|
import Crypto.Random
|
|
|
|
|
|
instance PathPiece UUID where
|
|
fromPathPiece = UUID.fromString . unpack
|
|
toPathPiece = pack . UUID.toString
|
|
|
|
instance PersistField UUID where
|
|
toPersistValue = PersistLiteralEscaped . UUID.toASCIIBytes
|
|
|
|
fromPersistValue (PersistText t) = maybe (Left "Failed to parse UUID") Right $ UUID.fromText t
|
|
fromPersistValue (PersistByteString bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
|
|
fromPersistValue (PersistLiteralEscaped bs) = maybe (Left "Failed to parse UUID") Right $ UUID.fromASCIIBytes bs
|
|
fromPersistValue x = Left $ fromPersistValueErrorSql (Proxy @UUID) x
|
|
|
|
instance PersistFieldSql UUID where
|
|
sqlType _ = SqlOther "uuid"
|
|
|
|
instance ToMarkup UUID where
|
|
toMarkup uuid = [shamlet|
|
|
$newline never
|
|
<span .uuid>
|
|
#{UUID.toText uuid}
|
|
|]
|
|
|
|
instance ToWidget site UUID where
|
|
toWidget = toWidget . toMarkup
|
|
|
|
sampleNotRandom :: MonadPseudoRandom ChaChaDRG a -> a
|
|
sampleNotRandom = fst . withDRG (drgNewSeed $ seedFromInteger 0)
|
|
|
|
instance ToSample UUID where
|
|
toSamples _ = samples $ sampleNotRandom getRandoms
|
|
where getRandoms = fmap (maybe id (:) . UUID.fromByteString . fromStrict) (getRandomBytes 16) <*> getRandoms
|