{-# 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 qualified Data.CryptoID as E
import Data.CryptoID.Poly.ImplicitNamespace
import Data.UUID.Cryptographic.ImplicitNamespace
import System.FilePath.Cryptographic.ImplicitNamespace

import qualified Data.Text as Text

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

instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where
  fromPathPiece = fmap CI.mk . fromPathPiece
  toPathPiece = toPathPiece . CI.original

instance {-# OVERLAPS #-} PathMultiPiece FilePath where
  fromPathMultiPiece = Just . unpack . intercalate "/"
  toPathMultiPiece = Text.splitOn "/" . pack
  
instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
  fromPathMultiPiece = fmap CI.mk . fromPathMultiPiece
  toPathMultiPiece = toPathMultiPiece . CI.foldedCase


-- Generates CryptoUUID... and CryptoFileName... Datatypes
decCryptoIDs [ ''SubmissionId
             , ''FileId
             , ''UserId
             , ''CourseId
             ]

instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
  fromPathPiece (Text.unpack -> piece) = do
    piece' <- (stripPrefix `on` map CI.mk) "uwa" piece
    return . CryptoID . CI.mk $ map CI.original piece'
  toPathPiece = Text.pack . ("uwa" <>) . CI.foldedCase . ciphertext


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

pattern NewSubmission :: SubmissionMode
pattern NewSubmission = SubmissionMode Nothing
pattern ExistingSubmission :: CryptoFileNameSubmission -> 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