module KeyDB
    ( TrustMap
    , SigAndTrust
    , SubKey(..)
    , KeyData(..)
    , KeyDB
    , emptyKeyDB
    , keyData
    , kkData
    , lookupKeyData
    , transmute
    , transmuteAt
    , alterKeyDB
    , mergeKeyDB
    , mapKeyDB
    -- These probably don't belong here
    , selectKey0
    , flattenTop
    , flattenAllUids
    , flattenSub
    , sortByHint
    , flattenKeys
    , flattenFiltered
    , UidString(..)
    ) where

import Control.Monad
import Data.Functor
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.OpenPGP
import Data.Ord

import KeyRing.Types

type TrustMap = Map.Map FilePath Packet
type SigAndTrust = ( MappedPacket
                   , TrustMap     ) -- trust packets
data SubKey = SubKey MappedPacket [SigAndTrust] deriving Show

data UidString = UidString { unUidString :: String } deriving (Show, Eq, Ord)

-- | This is a GPG Identity which includes a master key and all its UIDs and
-- subkeys and associated signatures.
data KeyData = KeyData
    { keyMappedPacket :: MappedPacket                               -- main key
    , keySigAndTrusts :: [SigAndTrust]                              -- sigs on main key
    , keyUids         :: (Map.Map UidString ([SigAndTrust],OriginMap)) -- uids
    , keySubKeys      :: (Map.Map KeyKey SubKey)                    -- subkeys
    } deriving Show


data KeyDB = KeyDB
    { byKeyKey :: Map.Map KeyKey KeyData
    } deriving Show

emptyKeyDB :: KeyDB
emptyKeyDB = KeyDB { byKeyKey = Map.empty }

keyData :: KeyDB -> [KeyData]
keyData db = Map.elems (byKeyKey db)

kkData :: KeyDB -> [(KeyKey, KeyData)]
kkData db = Map.toList (byKeyKey db)

lookupKeyData :: KeyKey -> KeyDB -> Maybe KeyData
lookupKeyData kk db = Map.lookup kk (byKeyKey db)

transmute :: (Monad m, Monad kiki, Traversable kiki) =>
       ((KeyData, [info]) -> opcode -> m (kiki (KeyData, [info]))) -- ^ interpreter
       -> (KeyData -> [opcode])                                    -- ^ instructions
       -> KeyDB                                                    -- ^ initial state
       -> m (kiki (KeyDB, [info]))
transmute perform update db = do
    let performAll kd = foldM (\kkd op -> join <$> mapM (`perform` op) kkd)
                              (pure (kd,[]))
                              (update kd)
    r <- sequenceA <$> mapM performAll (byKeyKey db)
    return $ r <&> \bkk -> ( db { byKeyKey = fst <$> bkk }
                           , concatMap snd $ Map.elems bkk )

alterKeyDB :: (Maybe KeyData -> Maybe KeyData) -> KeyKey -> KeyDB -> KeyDB
alterKeyDB update kk db = db { byKeyKey = Map.alter update kk (byKeyKey db) }

transmuteAt :: ( Monad m
               , Functor kiki
               ) => (Maybe KeyData -> m (kiki (KeyData,[info]))) -> KeyKey -> KeyDB -> m (kiki (KeyDB,[info]))
transmuteAt go kk db = do
    kdr <- go (Map.lookup kk $ byKeyKey db)
    return $ kdr <&> \(kd',rrs) -> ( alterKeyDB (const $ Just kd') kk db
                                   , rrs )

mergeKeyDB :: (KeyData -> KeyData -> KeyData) -> KeyDB -> KeyDB -> KeyDB
mergeKeyDB mergeKeyData db dbtrans =
    KeyDB { byKeyKey = Map.unionWith mergeKeyData (byKeyKey db) (byKeyKey dbtrans) }

mapKeyDB :: Monad m => (KeyData -> m KeyData) -> KeyDB -> m KeyDB
mapKeyDB f db = fmap (\m -> db { byKeyKey = m }) $ mapM f (byKeyKey db)

selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
selectKey0 wantPublic (spec,mtag) db = do
    let Message ps = flattenKeys wantPublic $ byKeyKey db
        ys = snd $ seek_key spec ps
    flip (maybe (listToMaybe ys)) mtag $ \tag -> do
      case ys of
          y:ys1 -> listToMaybe $ snd $ seek_key (KeyTag y tag) ys1
          []    -> Nothing


flattenKeys :: Bool -> Map.Map KeyKey KeyData -> Message
flattenKeys isPublic db = Message $ concatMap (map packet . flattenTop "" isPublic . snd)
                                              (prefilter . Map.assocs $ db)
 where
    prefilter = if isPublic then id else filter isSecret
                 where
                  isSecret (_,(KeyData
                                  (MappedPacket { packet=(SecretKeyPacket {})})
                                  _
                                  _
                                  _)) = True
                  isSecret _          = False

flattenUid :: FilePath -> Bool -> (UidString,([SigAndTrust],OriginMap)) -> [MappedPacket]
flattenUid fname ispub (UidString str,(sigs,om)) =
    (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs

flattenSub :: FilePath -> Bool -> SubKey -> [MappedPacket]
flattenSub fname ispub (SubKey key sigs) = unk ispub key: concatSort fname head (unsig fname ispub) sigs

flattenAllUids :: FilePath -> Bool -> Map.Map UidString ([SigAndTrust],OriginMap) -> [MappedPacket]
flattenAllUids fname ispub uids =
    concatSort fname head (flattenUid fname ispub) (Map.assocs uids)

flattenTop :: FilePath -> Bool -> KeyData -> [MappedPacket]
flattenTop fname ispub (KeyData key sigs uids subkeys) =
    unk ispub key :
            ( flattenAllUids fname ispub uids
             ++ concatSort fname head (flattenSub fname ispub) (Map.elems subkeys))

sortByHint :: FilePath -> (a -> MappedPacket) -> [a] -> [a]
sortByHint fname f = sortBy (comparing gethint)
  where
    gethint = maybe defnum originalNum . Map.lookup fname . locations . f
    defnum = -1

concatSort ::
  FilePath -> ([a] -> MappedPacket) -> (b -> [a]) -> [b] -> [a]
concatSort fname getp f = concat . sortByHint fname getp . map f

unk :: Bool -> MappedPacket -> MappedPacket
unk isPublic = if isPublic then toPacket secretToPublic else id
                where toPacket f mp@(MappedPacket {packet=p}) = mp {packet=(f p)}


unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket]
unsig fname isPublic (sig,trustmap) =
    sig : map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap)
  where
    f n _ = n==fname -- && trace ("fname=n="++show n) True
    asMapped n p = let m = mappedPacket fname p
                   in m { locations = fmap (\x->x {originalNum=n}) (locations m) }

flattenFiltered :: Bool -> (KeyData -> Bool) -> KeyDB -> Message
flattenFiltered wantPublic pred db = flattenKeys wantPublic $ Map.filter pred (byKeyKey db)