fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Additional Instances for CryptoFileNameSubmission

Browse Source
This commit is contained in:
Gregor Kleen 2018-12-17 15:12:33 +01:00
parent c15715afb9
commit e3e8f9e048
1 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/CryptoID.hs
View File

@ -25,6 +25,9 @@ import Web.PathPieces
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..), FromJSON(..), FromJSONKey(..), FromJSONKeyFunction(..), Value(..), withText)
import Data.Aeson.Encoding (text)
-- Generates CryptoUUID... and CryptoFileName... Datatypes -- Generates CryptoUUID... and CryptoFileName... Datatypes
decCryptoIDs [ ''SubmissionId decCryptoIDs [ ''SubmissionId
@ -41,6 +44,15 @@ instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) Submission
return . CryptoID . CI.mk $ map CI.original piece' return . CryptoID . CI.mk $ map CI.original piece'
toPathPiece = Text.pack . ("uwa" <>) . CI.foldedCase . ciphertext toPathPiece = Text.pack . ("uwa" <>) . CI.foldedCase . ciphertext
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => ToJSON (E.CryptoID namespace (CI FilePath)) where
toJSON = String . toPathPiece
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => ToJSONKey (E.CryptoID namespace (CI FilePath)) where
toJSONKey = ToJSONKeyText toPathPiece (text . toPathPiece)
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => FromJSON (E.CryptoID namespace (CI FilePath)) where
parseJSON = withText "CryptoFileNameSubmission" $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => FromJSONKey (E.CryptoID namespace (CI FilePath)) where
fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
newtype SubmissionMode = SubmissionMode (Maybe CryptoFileNameSubmission) newtype SubmissionMode = SubmissionMode (Maybe CryptoFileNameSubmission)
deriving (Show, Read, Eq) deriving (Show, Read, Eq)