{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module CryptoID
  ( module CryptoID
  , module Data.CryptoID.Poly.ImplicitNamespace
  , module Data.UUID.Cryptographic.ImplicitNamespace
  , module System.FilePath.Cryptographic.ImplicitNamespace
  ) where

import CryptoID.TH

import ClassyPrelude hiding (fromString)
import Model

import Data.CryptoID.Poly.ImplicitNamespace
import Data.UUID.Cryptographic.ImplicitNamespace
import System.FilePath.Cryptographic.ImplicitNamespace

import Data.UUID.Types
import Web.PathPieces

import           Data.CaseInsensitive   (CI)
import qualified Data.CaseInsensitive as CI


instance PathPiece UUID where
  fromPathPiece = fromString . unpack
  toPathPiece = pack . toString


-- Generates CryptoUUID... Datatypes
decCryptoIDs [ ''SubmissionId
             , ''CourseId
             , ''SheetId
             , ''FileId
             , ''UserId
             ]
{- TODO: Do we need/want CryptoUUIDs for Sheet numbers? -}



newtype SubmissionMode = SubmissionMode (Maybe CryptoUUIDSubmission)
  deriving (Show, Read, Eq)

pattern NewSubmission :: SubmissionMode
pattern NewSubmission = SubmissionMode Nothing
pattern ExistingSubmission :: CryptoUUIDSubmission -> SubmissionMode
pattern ExistingSubmission cID = SubmissionMode (Just cID)

instance PathPiece SubmissionMode where
    fromPathPiece "new" = Just $ SubmissionMode Nothing
    fromPathPiece s     = SubmissionMode . Just <$> fromPathPiece s

    toPathPiece (SubmissionMode Nothing)  = "new"
    toPathPiece (SubmissionMode (Just x)) = toPathPiece x

newtype ZIPArchiveName objID = ZIPArchiveName (CryptoID (CI FilePath) objID)
  deriving (Show, Read, Eq)

instance PathPiece (ZIPArchiveName objID) where
    fromPathPiece (map CI.mk . unpack -> s)
      | Just s' <- stripSuffix (map CI.mk ".zip") s = Just . ZIPArchiveName . CryptoID . CI.mk $ map CI.original s'
      | otherwise = Nothing

    toPathPiece (ZIPArchiveName CryptoID{..}) = pack (CI.foldedCase ciphertext) <> ".zip"