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 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
decCryptoIDs [ ''SubmissionId
@ -41,6 +44,15 @@ instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) Submission
return . CryptoID . CI.mk $ map CI.original piece'
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)
deriving (Show, Read, Eq)